From git at git.haskell.org Mon Jan 1 12:09:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Jan 2018 12:09:35 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: fix thinko (f455675) Message-ID: <20180101120935.6D6ED3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/f455675d015da33afb29a39e0d5f232508831d6b/ghc >--------------------------------------------------------------- commit f455675d015da33afb29a39e0d5f232508831d6b Author: Gabor Greif Date: Mon Jan 1 13:08:45 2018 +0100 WIP: fix thinko >--------------------------------------------------------------- f455675d015da33afb29a39e0d5f232508831d6b compiler/simplStg/StgCse.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index df3acab..bf8f4fc 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -424,16 +424,16 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut | isBndr def , ((_:_),rest) <- partition isBndr alts = Just (def:rest) + grouped ((DEFAULT, _, _) : _) = Nothing grouped alts | ((_:_:_),rest) <- partition isBndr alts = Just ((DEFAULT, [], StgApp bndr []) : rest) - grouped ((DEFAULT, _, _) : _) = Nothing grouped alts | (cons@(_:_:_),rest) <- partition (\case (_,_,StgConApp _ [] [])->True; _->False) alts , let itsCon (_,_,StgConApp c [] []) = c itsCon _ = pprPanic "mkStgCase" (text "not StgConApp") gcons = groupBy ((==) `on` itsCon) cons , (((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) gcons - = pprTrace "mkStgCase##" (ppr others) $ Just ((DEFAULT, [], res) : concat others ++ rest) + = Just ((DEFAULT, [], res) : concat others ++ rest) grouped _ = Nothing -- Utilities From git at git.haskell.org Mon Jan 1 18:09:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Jan 2018 18:09:07 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: optimise literals (bd6163c) Message-ID: <20180101180907.EF7A63A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/bd6163c85b8d64e8dcd75f3d7bf3b62450d96640/ghc >--------------------------------------------------------------- commit bd6163c85b8d64e8dcd75f3d7bf3b62450d96640 Author: Gabor Greif Date: Mon Jan 1 19:08:26 2018 +0100 WIP: optimise literals >--------------------------------------------------------------- bd6163c85b8d64e8dcd75f3d7bf3b62450d96640 compiler/simplStg/StgCse.hs | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index bf8f4fc..2e1c4b2 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -412,29 +412,39 @@ stgCseRhs env bndr (StgRhsClosure ccs info occs upd args body) mkStgCase :: StgExpr -> OutId -> AltType -> [StgAlt] -> StgExpr mkStgCase scrut bndr ty alts | all isBndr alts = scrut - | Just alts' <- grouped alts = StgCase scrut bndr ty alts' - | otherwise = StgCase scrut bndr ty alts + | Just alts' <- lump alts = StgCase scrut bndr ty alts' + | otherwise = StgCase scrut bndr ty alts where -- see Note [All alternatives are the binder] isBndr (_, _, StgApp f []) = f == bndr isBndr _ = False -- see Note [Lumping alternatives together] - grouped (def@(DEFAULT, _, _) : alts) + lump (def@(DEFAULT, _, _) : alts) | isBndr def , ((_:_),rest) <- partition isBndr alts = Just (def:rest) - grouped ((DEFAULT, _, _) : _) = Nothing - grouped alts | ((_:_:_),rest) <- partition isBndr alts + lump ((DEFAULT, _, _):_) = Nothing + lump alts + | (lits@(_:_:_),rest) <- partition + (\case (_,_,StgLit l) -> True; _ -> False) alts + , let itsLit (_,_,StgLit l) = l + itsLit _ = pprPanic "mkStgCase" (text "not StgLit") + glits = groupBy ((==) `on` itsLit) lits + , sglits@(((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) glits + , let opt = Just ((DEFAULT, [], res) : concat others ++ rest) + = pprTrace "mkStgCase LIT" (ppr alts <+> text " --------> " <+> ppr opt) opt + lump alts | ((_:_:_),rest) <- partition isBndr alts = Just ((DEFAULT, [], StgApp bndr []) : rest) - grouped alts - | (cons@(_:_:_),rest) <- partition (\case (_,_,StgConApp _ [] [])->True; _->False) alts + lump alts + | (cons@(_:_:_),rest) <- partition + (\case (_,_,StgConApp _ [] []) -> True; _ -> False) alts , let itsCon (_,_,StgConApp c [] []) = c itsCon _ = pprPanic "mkStgCase" (text "not StgConApp") gcons = groupBy ((==) `on` itsCon) cons , (((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) gcons = Just ((DEFAULT, [], res) : concat others ++ rest) - grouped _ = Nothing + lump _ = Nothing -- Utilities From git at git.haskell.org Mon Jan 1 22:23:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Jan 2018 22:23:18 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: cleanups (e0655ec) Message-ID: <20180101222318.1C8913A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/e0655ec059180eef447fee4050b4cdc405d23996/ghc >--------------------------------------------------------------- commit e0655ec059180eef447fee4050b4cdc405d23996 Author: Gabor Greif Date: Mon Jan 1 22:20:37 2018 +0100 WIP: cleanups >--------------------------------------------------------------- e0655ec059180eef447fee4050b4cdc405d23996 compiler/simplStg/StgCse.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 2e1c4b2..0562ae5 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -427,13 +427,12 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut lump ((DEFAULT, _, _):_) = Nothing lump alts | (lits@(_:_:_),rest) <- partition - (\case (_,_,StgLit l) -> True; _ -> False) alts + (\case (_,_,StgLit _) -> True; _ -> False) alts , let itsLit (_,_,StgLit l) = l itsLit _ = pprPanic "mkStgCase" (text "not StgLit") glits = groupBy ((==) `on` itsLit) lits , sglits@(((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) glits - , let opt = Just ((DEFAULT, [], res) : concat others ++ rest) - = pprTrace "mkStgCase LIT" (ppr alts <+> text " --------> " <+> ppr opt) opt + = Just ((DEFAULT, [], res) : concat others ++ rest) lump alts | ((_:_:_),rest) <- partition isBndr alts = Just ((DEFAULT, [], StgApp bndr []) : rest) lump alts From git at git.haskell.org Tue Jan 2 04:21:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 04:21:47 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: fix travis (92f6a67) Message-ID: <20180102042147.302273A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/92f6a671a6a8091b27931a68438cd1d822039918/ghc >--------------------------------------------------------------- commit 92f6a671a6a8091b27931a68438cd1d822039918 Author: Gabor Greif Date: Tue Jan 2 05:21:32 2018 +0100 WIP: fix travis >--------------------------------------------------------------- 92f6a671a6a8091b27931a68438cd1d822039918 compiler/simplStg/StgCse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 0562ae5..13807a3 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -431,7 +431,7 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut , let itsLit (_,_,StgLit l) = l itsLit _ = pprPanic "mkStgCase" (text "not StgLit") glits = groupBy ((==) `on` itsLit) lits - , sglits@(((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) glits + , (((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) glits = Just ((DEFAULT, [], res) : concat others ++ rest) lump alts | ((_:_:_),rest) <- partition isBndr alts = Just ((DEFAULT, [], StgApp bndr []) : rest) From git at git.haskell.org Tue Jan 2 17:54:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 17:54:05 +0000 (UTC) Subject: [commit: ghc] master: Rewrite Note [The polymorphism rule of join points] (862c59e) Message-ID: <20180102175405.7A62E3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/862c59e7bf714e6059392ea401bb0a568c959725/ghc >--------------------------------------------------------------- commit 862c59e7bf714e6059392ea401bb0a568c959725 Author: Joachim Breitner Date: Tue Jan 2 17:33:47 2018 +0100 Rewrite Note [The polymorphism rule of join points] I found the reference to CPS unhelpful, but Simon gave me a good explanation in #14610 that I believe is going to be more enlightening for future readers. Differential Revision: https://phabricator.haskell.org/D4281 >--------------------------------------------------------------- 862c59e7bf714e6059392ea401bb0a568c959725 compiler/coreSyn/CoreSyn.hs | 69 ++++++++++++++++++++++++++++++++------------- 1 file changed, 50 insertions(+), 19 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 9b9d20d..27a4c99 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -706,33 +706,64 @@ polymorphic in its return type. That is, if its type is forall a1 ... ak. t1 -> ... -> tn -> r where its join arity is k+n, none of the type parameters ai may occur free in r. -The most direct explanation is that given - join j @a1 ... @ak x1 ... xn = e1 in e2 +In some way, this falls out of the fact that given -our typing rules require `e1` and `e2` to have the same type. Therefore the type -of `e1`---the return type of the join point---must be the same as the type of -e2. Since the type variables aren't bound in `e2`, its type can't include them, -and thus neither can the type of `e1`. + join + j @a1 ... @ak x1 ... xn = e1 + in e2 + +then all calls to `j` are in tail-call positions of `e`, and expressions in +tail-call positions in `e` have the same type as `e`. +Therefore the type of `e1` -- the return type of the join point -- must be the +same as the type of e2. +Since the type variables aren't bound in `e2`, its type can't include them, and +thus neither can the type of `e1`. + +This unfortunately prevents the `go` in the following code from being a +join-point: + + iter :: forall a. Int -> (a -> a) -> a -> a + iter @a n f x = go @a n f x + where + go :: forall a. Int -> (a -> a) -> a -> a + go @a 0 _ x = x + go @a n f x = go @a (n-1) f (f x) + +In this case, a static argument transformation would fix that (see +ticket #14620): + + iter :: forall a. Int -> (a -> a) -> a -> a + iter @a n f x = go' @a n f x + where + go' :: Int -> (a -> a) -> a -> a + go' 0 _ x = x + go' n f x = go' (n-1) f (f x) + +In general, loopification could be employed to do that (see #14068.) + +Can we simply drop the requirement, and allow `go` to be a join-point? We +could, and it would work. But we could not longer apply the case-of-join-point +transformation universally. This transformation would do: -There's a deeper explanation in terms of the sequent calculus in Section 5.3 of -a previous paper: + case (join go @a n f x = case n of 0 -> x + n -> go @a (n-1) f (f x) + in go @Bool n neg True) of + True -> e1; False -> e2 - Paul Downen, Luke Maurer, Zena Ariola, and Simon Peyton Jones. "Sequent - calculus as a compiler intermediate language." ICFP'16. + ===> - https://www.microsoft.com/en-us/research/wp-content/uploads/2016/04/sequent-calculus-icfp16.pdf + join go @a n f x = case n of 0 -> case x of True -> e1; False -> e2 + n -> go @a (n-1) f (f x) + in go @Bool n neg True -The quick version: Consider the CPS term (the paper uses the sequent calculus, -but we can translate readily): +but that is ill-typed, as `x` is type `a`, not `Bool`. - \k -> join j @a1 ... @ak x1 ... xn = e1 k in e2 k -Since `j` is a join point, it doesn't bind a continuation variable but reuses -the variable `k` from the context. But the parameters `ai` are not in `k`'s -scope, and `k`'s type determines the return type of `j`; thus the `ai`s don't -appear in the return type of `j`. (Also, since `e1` and `e2` are passed the same -continuation, they must have the same type; hence the direct explanation above.) +This is also justifies why we do not consider the `e` in `e |> co` to be in +tail position: A cast changes the type, but the type must be the same. But +operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for +ideas how to fix this. ************************************************************************ * * From git at git.haskell.org Tue Jan 2 18:51:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 18:51:17 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: check isEvaldUnfolding (8f627c9) Message-ID: <20180102185117.73CBD3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/8f627c9f25b643e2b743b93d1b1059efcdc409ef/ghc >--------------------------------------------------------------- commit 8f627c9f25b643e2b743b93d1b1059efcdc409ef Author: Gabor Greif Date: Tue Jan 2 19:50:47 2018 +0100 WIP: check isEvaldUnfolding unfortunately it does not cover the "wild_*" variables :-( >--------------------------------------------------------------- 8f627c9f25b643e2b743b93d1b1059efcdc409ef compiler/codeGen/StgCmmClosure.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 8bcea14..8c49628 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -69,6 +69,7 @@ module StgCmmClosure ( import GhcPrelude import StgSyn +import CoreSyn (isEvaldUnfolding) import SMRep import Cmm import PprCmmExpr() @@ -626,6 +627,10 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function +getCallMethod _ _name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info + | isEvaldUnfolding (idUnfolding id) + = pprTrace "getCallMethod" (ppr id) ReturnIt -- seems to come from case, must be (tagged) WHNF already + getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust = ReturnIt -- seems to come from case, must be (tagged) WHNF already From git at git.haskell.org Tue Jan 2 20:55:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 20:55:23 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Fix markup (a2e9549) Message-ID: <20180102205523.8EB683A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2e95495c1f770f20c2e882e72401cad5ed864d6/ghc >--------------------------------------------------------------- commit a2e95495c1f770f20c2e882e72401cad5ed864d6 Author: Ben Gamari Date: Sat Dec 23 11:23:40 2017 -0500 users-guide: Fix markup >--------------------------------------------------------------- a2e95495c1f770f20c2e882e72401cad5ed864d6 docs/users_guide/using-warnings.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index cf41c28..bd3c41d 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -580,10 +580,10 @@ of ``-W(no-)*``. foreign import "&f" f :: FunPtr t - The first form declares that \`f\` is a (pure) C function that takes - no arguments and returns a pointer to a C function with type \`t\`, - whereas the second form declares that \`f\` itself is a C function - with type \`t\`. The first declaration is usually a mistake, and one + The first form declares that ``f`` is a (pure) C function that takes + no arguments and returns a pointer to a C function with type ``t``, + whereas the second form declares that ``f`` itself is a C function + with type ``t``. The first declaration is usually a mistake, and one that is hard to debug because it results in a crash, hence this warning. From git at git.haskell.org Tue Jan 2 20:55:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 20:55:29 +0000 (UTC) Subject: [commit: ghc] master: Fix sign error in kelvinToC. (b31c721) Message-ID: <20180102205529.28F373A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b31c7214b7ccf31b6a78faac1a3cc5c39cdff56d/ghc >--------------------------------------------------------------- commit b31c7214b7ccf31b6a78faac1a3cc5c39cdff56d Author: Galen Huntington Date: Sun Dec 31 23:43:15 2017 -0800 Fix sign error in kelvinToC. >--------------------------------------------------------------- b31c7214b7ccf31b6a78faac1a3cc5c39cdff56d docs/users_guide/glasgow_exts.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 201aa77..03ea986 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -12878,7 +12878,7 @@ GHC offers a helping hand here, doing all of this for you. For every use of ``assert`` in the user's source: :: kelvinToC :: Double -> Double - kelvinToC k = assert (k >= 0.0) (k+273.15) + kelvinToC k = assert (k >= 0.0) (k-273.15) GHC will rewrite this to also include the source location where the assertion was made, :: From git at git.haskell.org Tue Jan 2 20:55:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 20:55:26 +0000 (UTC) Subject: [commit: ghc] master: Prevent "C--" translating to "C–" in the User's Guide. (12f5c00) Message-ID: <20180102205526.5A29F3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12f5c00543e1f3dc7109e3575fcc4a973aebdacc/ghc >--------------------------------------------------------------- commit 12f5c00543e1f3dc7109e3575fcc4a973aebdacc Author: Steven Shaw Date: Tue Dec 19 07:35:44 2017 +1000 Prevent "C--" translating to "C–" in the User's Guide. i.e. escape "--" so that it doesn't translate to an "en dash". >--------------------------------------------------------------- 12f5c00543e1f3dc7109e3575fcc4a973aebdacc docs/users_guide/debug-info.rst | 4 +-- docs/users_guide/debugging.rst | 68 +++++++++++++++++++------------------- docs/users_guide/extending_ghc.rst | 2 +- 3 files changed, 37 insertions(+), 37 deletions(-) diff --git a/docs/users_guide/debug-info.rst b/docs/users_guide/debug-info.rst index 915591a..aca3733 100644 --- a/docs/users_guide/debug-info.rst +++ b/docs/users_guide/debug-info.rst @@ -268,10 +268,10 @@ GHC may produce the following standard DIEs in the ``.debug_info`` section, Represents a compilation unit (e.g. a Haskell module). ``DW_TAG_subprogram`` - Represents a C-- top-level basic block. + Represents a C-\\- top-level basic block. ``DW_TAG_lexical_block`` - Represents a C-- basic block. Note that this is a slight departure from the + Represents a C-\\- basic block. Note that this is a slight departure from the intended meaning of this DIE type as it does not necessarily reflect lexical scope in the source program. diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index d0f479c..efa6e28 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -352,90 +352,90 @@ These flags dump various phases of GHC's STG pipeline. Show the output of the intermediate STG-to-STG pass. (*lots* of output!) -C-- representation -~~~~~~~~~~~~~~~~~~ +C-\\- representation +~~~~~~~~~~~~~~~~~~~~ -These flags dump various phases of GHC's C-- pipeline. +These flags dump various phases of GHC's C-\\- pipeline. .. ghc-flag:: -ddump-cmm-verbose - :shortdesc: Show output from each C-- pipeline pass + :shortdesc: Show output from each C-\\- pipeline pass :type: dynamic - Dump output from all C-- pipeline stages. In case of + Dump output from all C-\\- pipeline stages. In case of ``.cmm`` compilation this also dumps the result of file parsing. .. ghc-flag:: -ddump-cmm-from-stg - :shortdesc: Dump STG-to-C-- output + :shortdesc: Dump STG-to-C-\\- output :type: dynamic - Dump the result of STG-to-C-- conversion + Dump the result of STG-to-C-\\- conversion .. ghc-flag:: -ddump-cmm-raw - :shortdesc: Dump raw C-- + :shortdesc: Dump raw C-\\- :type: dynamic - Dump the “raw” C--. + Dump the “raw” C-\\-. .. ghc-flag:: -ddump-cmm-cfg - :shortdesc: Dump the results of the C-- control flow optimisation pass. + :shortdesc: Dump the results of the C-\\- control flow optimisation pass. :type: dynamic - Dump the results of the C-- control flow optimisation pass. + Dump the results of the C-\\- control flow optimisation pass. .. ghc-flag:: -ddump-cmm-cbe :shortdesc: Dump the results of common block elimination :type: dynamic - Dump the results of the C-- Common Block Elimination (CBE) pass. + Dump the results of the C-\\- Common Block Elimination (CBE) pass. .. ghc-flag:: -ddump-cmm-switch :shortdesc: Dump the results of switch lowering passes :type: dynamic - Dump the results of the C-- switch lowering pass. + Dump the results of the C-\\- switch lowering pass. .. ghc-flag:: -ddump-cmm-proc :shortdesc: Dump the results of proc-point analysis :type: dynamic - Dump the results of the C-- proc-point analysis pass. + Dump the results of the C-\\- proc-point analysis pass. .. ghc-flag:: -ddump-cmm-sp - :shortdesc: Dump the results of the C-- stack layout pass. + :shortdesc: Dump the results of the C-\\- stack layout pass. :type: dynamic - Dump the results of the C-- stack layout pass. + Dump the results of the C-\\- stack layout pass. .. ghc-flag:: -ddump-cmm-sink - :shortdesc: Dump the results of the C-- sinking pass. + :shortdesc: Dump the results of the C-\\- sinking pass. :type: dynamic - Dump the results of the C-- sinking pass. + Dump the results of the C-\\- sinking pass. .. ghc-flag:: -ddump-cmm-caf - :shortdesc: Dump the results of the C-- CAF analysis pass. + :shortdesc: Dump the results of the C-\\- CAF analysis pass. :type: dynamic - Dump the results of the C-- CAF analysis pass. + Dump the results of the C-\\- CAF analysis pass. .. ghc-flag:: -ddump-cmm-procmap - :shortdesc: Dump the results of the C-- proc-point map pass. + :shortdesc: Dump the results of the C-\\- proc-point map pass. :type: dynamic - Dump the results of the C-- proc-point map pass. + Dump the results of the C-\\- proc-point map pass. .. ghc-flag:: -ddump-cmm-split - :shortdesc: Dump the results of the C-- proc-point splitting pass. + :shortdesc: Dump the results of the C-\\- proc-point splitting pass. :type: dynamic - Dump the results of the C-- proc-point splitting pass. + Dump the results of the C-\\- proc-point splitting pass. .. ghc-flag:: -ddump-cmm-info - :shortdesc: Dump the results of the C-- info table augmentation pass. + :shortdesc: Dump the results of the C-\\- info table augmentation pass. :type: dynamic - Dump the results of the C-- info table augmentation pass. + Dump the results of the C-\\- info table augmentation pass. .. ghc-flag:: -ddump-cmm-cps :shortdesc: Dump the results of the CPS pass @@ -444,10 +444,10 @@ These flags dump various phases of GHC's C-- pipeline. Dump the results of the CPS pass. .. ghc-flag:: -ddump-cmm - :shortdesc: Dump the final C-- output + :shortdesc: Dump the final C-\\- output :type: dynamic - Dump the result of the C-- pipeline processing + Dump the result of the C-\\- pipeline processing @@ -466,20 +466,20 @@ Native code generator ~~~~~~~~~~~~~~~~~~~~~ These flags dump various stages of the :ref:`native code generator's -` pipeline, which starts with C-- and produces native +` pipeline, which starts with C-\\- and produces native assembler. .. ghc-flag:: -ddump-opt-cmm - :shortdesc: Dump the results of C-- to C-- optimising passes + :shortdesc: Dump the results of C-\\- to C-\\- optimising passes :type: dynamic - Dump the results of C-- to C-- optimising passes performed by the NCG. + Dump the results of C-\\- to C-\\- optimising passes performed by the NCG. .. ghc-flag:: -ddump-asm-native :shortdesc: Dump initial assembly :type: dynamic - Dump the initial assembler output produced from C--. + Dump the initial assembler output produced from C-\\-. .. ghc-flag:: -ddump-asm-liveness :shortdesc: Dump assembly augmented with register liveness @@ -700,10 +700,10 @@ Checking for consistency Ditto for STG level. (note: currently doesn't work). .. ghc-flag:: -dcmm-lint - :shortdesc: C-- pass sanity checking + :shortdesc: C-\\- pass sanity checking :type: dynamic - Ditto for C-- level. + Ditto for C-\\- level. .. ghc-flag:: -fllvm-fill-undef-with-garbage :shortdesc: Intruct LLVM to fill dead STG registers with garbage diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst index 8af5989..e49effb 100644 --- a/docs/users_guide/extending_ghc.rst +++ b/docs/users_guide/extending_ghc.rst @@ -179,7 +179,7 @@ GHC's intermediate language, Core. Plugins are suitable for experimental analysis or optimization, and require no changes to GHC's source code to use. -Plugins cannot optimize/inspect C--, nor can they implement things like +Plugins cannot optimize/inspect C-\\-, nor can they implement things like parser/front-end modifications like GCC, apart from limited changes to the constraint solver. If you feel strongly that any of these restrictions are too onerous, From git at git.haskell.org Tue Jan 2 23:56:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 23:56:23 +0000 (UTC) Subject: [commit: ghc] master: Reformat Control.Monad.mfilter docs (69f1e49) Message-ID: <20180102235623.357A83A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/69f1e49dfe33de4e077ec8b1e43432929a4e833e/ghc >--------------------------------------------------------------- commit 69f1e49dfe33de4e077ec8b1e43432929a4e833e Author: Nathan Collins Date: Tue Dec 5 00:09:23 2017 -0800 Reformat Control.Monad.mfilter docs The formatting was bad, with everything running together, and a paranthesis was missing. Now the examples and relation between `filter` and `mfilter` are typeset as code blocks instead of inline. >--------------------------------------------------------------- 69f1e49dfe33de4e077ec8b1e43432929a4e833e libraries/base/Control/Monad.hs | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 3570144..8d664e6 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -283,12 +283,25 @@ f <$!> m = do -- ----------------------------------------------------------------------------- -- Other MonadPlus functions --- | Direct 'MonadPlus' equivalent of 'filter' --- @'filter'@ = @(mfilter:: (a -> Bool) -> [a] -> [a]@ --- applicable to any 'MonadPlus', for example --- @mfilter odd (Just 1) == Just 1@ --- @mfilter odd (Just 2) == Nothing@ - +-- | Direct 'MonadPlus' equivalent of 'Data.List.filter'. +-- +-- ==== __Examples__ +-- +-- The 'Data.List.filter' function is just 'mfilter' specialized to +-- the list monad: +-- +-- @ +-- 'Data.List.filter' = ( 'mfilter' :: (a -> Bool) -> [a] -> [a] ) +-- @ +-- +-- An example using 'mfilter' with the 'Maybe' monad: +-- +-- @ +-- >>> mfilter odd (Just 1) +-- Just 1 +-- >>> mfilter odd (Just 2) +-- Nothing +-- @ mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a {-# INLINABLE mfilter #-} mfilter p ma = do From git at git.haskell.org Tue Jan 2 23:56:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 23:56:28 +0000 (UTC) Subject: [commit: ghc] master: Add example to Control.Monad.join docs (a67c264) Message-ID: <20180102235628.B924C3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a67c264201a5d73d3624a73359f36adfaf6ec33c/ghc >--------------------------------------------------------------- commit a67c264201a5d73d3624a73359f36adfaf6ec33c Author: Nathan Collins Date: Sat Dec 9 18:58:03 2017 -0800 Add example to Control.Monad.join docs The example is using `join . atomically` to run IO actions computed by STM transactions. I couldn't figure out how to link to the STM docs in `Control.Monad.STM`, because that module comes from the `stm` package, not from `base`, even though `stm` is also part of the GHC source tree. So, instead I linked to the STM docs in `GHC.Conc`, which seems inferior to linking to `Control.Monad.STM`, but better than having no links at all. >--------------------------------------------------------------- a67c264201a5d73d3624a73359f36adfaf6ec33c libraries/base/GHC/Base.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 35de446..7875fef 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -596,6 +596,33 @@ liftA3 f a b c = liftA2 f a b <*> c -- | The 'join' function is the conventional monad join operator. It -- is used to remove one level of monadic structure, projecting its -- bound argument into the outer level. +-- +-- ==== __Examples__ +-- +-- A common use of 'join' is to run an 'IO' computation returned from +-- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions +-- can't perform 'IO' directly. Recall that +-- +-- @ +-- 'GHC.Conc.atomically' :: STM a -> IO a +-- @ +-- +-- is used to run 'GHC.Conc.STM' transactions atomically. So, by +-- specializing the types of 'GHC.Conc.atomically' and 'join' to +-- +-- @ +-- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b) +-- 'join' :: IO (IO b) -> IO b +-- @ +-- +-- we can compose them as +-- +-- @ +-- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b +-- @ +-- +-- to run an 'GHC.Conc.STM' transaction and the 'IO' action it +-- returns. join :: (Monad m) => m (m a) -> m a join x = x >>= id From git at git.haskell.org Tue Jan 2 23:56:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 23:56:34 +0000 (UTC) Subject: [commit: ghc] master: Make System.IO.openTempFile thread-safe on Windows (46287af) Message-ID: <20180102235634.5340F3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46287af0911f7cb446c62850630f85af567ac512/ghc >--------------------------------------------------------------- commit 46287af0911f7cb446c62850630f85af567ac512 Author: Tamar Christina Date: Tue Jan 2 16:02:49 2018 -0500 Make System.IO.openTempFile thread-safe on Windows This calls out to the Win32 API `GetTempFileName` to generate a temporary file. Using `uUnique = 0` guarantees that the file we get back is unique and the file is "reserved" by creating it. Test Plan: ./validate I can't think of any sensible tests that shouldn't run for a while to verify. So the example in #10731 was ran for a while and no collisions in new code Reviewers: hvr, bgamari, erikd Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #10731 Differential Revision: https://phabricator.haskell.org/D4278 >--------------------------------------------------------------- 46287af0911f7cb446c62850630f85af567ac512 libraries/base/System/IO.hs | 96 +++++++++++++++++++++++++-------------- libraries/base/cbits/Win32Utils.c | 43 ++++++++++++++++++ libraries/base/changelog.md | 3 ++ 3 files changed, 109 insertions(+), 33 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 46287af0911f7cb446c62850630f85af567ac512 From git at git.haskell.org Tue Jan 2 23:56:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 23:56:37 +0000 (UTC) Subject: [commit: ghc] master: Windows: fix all failing tests. (27b7b4d) Message-ID: <20180102235637.2CAFE3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27b7b4db9af99aeb88dce7ef0e85131199bbf2ff/ghc >--------------------------------------------------------------- commit 27b7b4db9af99aeb88dce7ef0e85131199bbf2ff Author: Tamar Christina Date: Tue Jan 2 16:00:57 2018 -0500 Windows: fix all failing tests. This makes the testsuite pass clean on Windows again. It also fixes the `libstdc++-6.dll` error harbormaster was showing. I'm marking some tests as isolated tests to reduce their flakiness (mostly concurrency tests) when the test system is under heavy load. Updates process submodule. Test Plan: ./validate Reviewers: hvr, bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4277 >--------------------------------------------------------------- 27b7b4db9af99aeb88dce7ef0e85131199bbf2ff libraries/base/tests/IO/all.T | 9 +- libraries/process | 2 +- rts/win32/veh_excn.c | 8 +- testsuite/driver/runtests.py | 33 ++++-- testsuite/driver/testglobals.py | 6 + testsuite/driver/testlib.py | 7 +- testsuite/tests/backpack/cabal/T14304/all.T | 3 +- testsuite/tests/concurrent/should_run/all.T | 2 +- testsuite/tests/ghci/linking/dyn/Makefile | 2 +- testsuite/tests/ghci/linking/dyn/T13606.hs | 128 --------------------- testsuite/tests/ghci/linking/dyn/T13606.stdout | 2 - testsuite/tests/ghci/linking/dyn/Triangle.fx | 10 -- testsuite/tests/ghci/linking/dyn/all.T | 4 +- testsuite/tests/perf/compiler/all.T | 11 +- testsuite/tests/perf/haddock/all.T | 7 +- testsuite/tests/perf/should_run/all.T | 7 +- testsuite/tests/quasiquotation/Makefile | 6 +- testsuite/tests/quasiquotation/T14028Quote.hs | 5 +- testsuite/tests/rts/T13082/all.T | 19 ++- testsuite/tests/rts/all.T | 4 +- .../tests/simplCore/should_compile/T14152a.hs | 1 - testsuite/tests/simplCore/should_compile/all.T | 4 +- 22 files changed, 101 insertions(+), 179 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 27b7b4db9af99aeb88dce7ef0e85131199bbf2ff From git at git.haskell.org Tue Jan 2 23:56:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 23:56:40 +0000 (UTC) Subject: [commit: ghc] master: Fix #14608 by restoring an unboxed tuple check (ecff651) Message-ID: <20180102235640.A51103A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee/ghc >--------------------------------------------------------------- commit ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee Author: Ryan Scott Date: Tue Jan 2 16:03:08 2018 -0500 Fix #14608 by restoring an unboxed tuple check Commit 714bebff44076061d0a719c4eda2cfd213b7ac3d removed a check in the bytecode compiler that caught illegal uses of unboxed tuples (and now sums) in case alternatives, which causes the program in #14608 to panic. This restores the check (using modern, levity-polymorphic vocabulary). Test Plan: make test TEST=T14608 Reviewers: hvr, bgamari, dfeuer, simonpj Reviewed By: dfeuer, simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14608 Differential Revision: https://phabricator.haskell.org/D4276 >--------------------------------------------------------------- ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee compiler/ghci/ByteCodeGen.hs | 5 +++++ testsuite/tests/ghci/should_fail/T14608.hs | 7 +++++++ testsuite/tests/ghci/should_fail/T14608.script | 1 + testsuite/tests/ghci/should_fail/T14608.stderr | 3 +++ testsuite/tests/ghci/should_fail/all.T | 1 + 5 files changed, 17 insertions(+) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 697dc63..d537080 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -962,6 +962,11 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple | null real_bndrs = do rhs_code <- schemeE d_alts s p_alts rhs return (my_discr alt, rhs_code) + -- If an alt attempts to match on an unboxed tuple or sum, we must + -- bail out, as the bytecode compiler can't handle them. + -- (See Trac #14608.) + | any (\bndr -> typePrimRep (idType bndr) `lengthExceeds` 1) bndrs + = multiValException -- algebraic alt with some binders | otherwise = let (tot_wds, _ptrs_wds, args_offsets) = diff --git a/testsuite/tests/ghci/should_fail/T14608.hs b/testsuite/tests/ghci/should_fail/T14608.hs new file mode 100644 index 0000000..87d5617 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE UnboxedTuples #-} +module T14608 where + +data UnboxedTupleData = MkUTD (# (),() #) + +doThings :: UnboxedTupleData -> () +doThings (MkUTD t) = () diff --git a/testsuite/tests/ghci/should_fail/T14608.script b/testsuite/tests/ghci/should_fail/T14608.script new file mode 100644 index 0000000..c37a742 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.script @@ -0,0 +1 @@ +:load T14608.hs diff --git a/testsuite/tests/ghci/should_fail/T14608.stderr b/testsuite/tests/ghci/should_fail/T14608.stderr new file mode 100644 index 0000000..fe84063 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.stderr @@ -0,0 +1,3 @@ +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. diff --git a/testsuite/tests/ghci/should_fail/all.T b/testsuite/tests/ghci/should_fail/all.T index 58a396e..2851373 100644 --- a/testsuite/tests/ghci/should_fail/all.T +++ b/testsuite/tests/ghci/should_fail/all.T @@ -1,2 +1,3 @@ test('T10549', [], ghci_script, ['T10549.script']) test('T10549a', [], ghci_script, ['T10549a.script']) +test('T14608', [], ghci_script, ['T14608.script']) From git at git.haskell.org Tue Jan 2 23:56:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 23:56:31 +0000 (UTC) Subject: [commit: ghc] master: Rename HEq_sc and Coercible_sc to heq_sel and coercible_sel (3382ade) Message-ID: <20180102235631.8394B3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3382ade3eb7ce09737d52e7c1f3ecc3431bf00fb/ghc >--------------------------------------------------------------- commit 3382ade3eb7ce09737d52e7c1f3ecc3431bf00fb Author: Matthew Pickering Date: Tue Jan 2 16:29:00 2018 -0500 Rename HEq_sc and Coercible_sc to heq_sel and coercible_sel These functions are record selectors. To the unfamiliar, when inspecting core, they looked like data constructors as they started with an upper case letter. We rename them so that it is more clear that firstly they are functions and secondly that they are selectors. Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4280 >--------------------------------------------------------------- 3382ade3eb7ce09737d52e7c1f3ecc3431bf00fb compiler/prelude/TysWiredIn.hs | 4 ++-- testsuite/tests/indexed-types/should_compile/T7837.stderr | 4 ++-- testsuite/tests/simplCore/should_compile/Makefile | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 32c6117..2ee7e14 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -255,13 +255,13 @@ mkWiredInIdName mod fs uniq id heqTyConName, heqDataConName, heqSCSelIdName :: Name heqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~~") heqTyConKey heqTyCon heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") heqDataConKey heqDataCon -heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "HEq_sc") heqSCSelIdKey heqSCSelId +heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "heq_sel") heqSCSelIdKey heqSCSelId -- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercible") coercibleTyConKey coercibleTyCon coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon -coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "Coercible_sc") coercibleSCSelIdKey coercibleSCSelId +coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercibleSCSelIdKey coercibleSCSelId charTyConName, charDataConName, intTyConName, intDataConName :: Name charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon diff --git a/testsuite/tests/indexed-types/should_compile/T7837.stderr b/testsuite/tests/indexed-types/should_compile/T7837.stderr index eb68261..44b894e 100644 --- a/testsuite/tests/indexed-types/should_compile/T7837.stderr +++ b/testsuite/tests/indexed-types/should_compile/T7837.stderr @@ -1,5 +1,5 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) -Rule fired: Class op HEq_sc (BUILTIN) +Rule fired: Class op heq_sel (BUILTIN) Rule fired: normalize/Double (T7837) -Rule fired: Class op HEq_sc (BUILTIN) +Rule fired: Class op heq_sel (BUILTIN) diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index 5790407..33322f3 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -205,8 +205,8 @@ T12877: T13025: $(RM) -f T13025.o T13025.hi T13025a.o T13025a.hi '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13025a.hs - -'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13025.hs -ddump-simpl | grep -c HEq_sc - # No lines should match 'HEq_sc' so wc should output zeros + -'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13025.hs -ddump-simpl | grep -c heq_sel + # No lines should match 'heq_sel' so wc should output zeros .PHONY: str-rules str-rules: From git at git.haskell.org Tue Jan 2 23:56:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Jan 2018 23:56:25 +0000 (UTC) Subject: [commit: ghc] master: Improve Control.Monad docs (4887c30) Message-ID: <20180102235625.EEBBC3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4887c3086149a15a1e16c765682debcfbb9de145/ghc >--------------------------------------------------------------- commit 4887c3086149a15a1e16c765682debcfbb9de145 Author: Nathan Collins Date: Sat Dec 9 18:59:05 2017 -0800 Improve Control.Monad docs Summary: * Reformat Control.Monad.mfilter docs The formatting was bad, with everything running together, and a paranthesis was missing. Now the examples and relation between `filter` and `mfilter` are typeset as code blocks instead of inline. * Add example to Control.Monad.join docs The example is using `join . atomically` to run IO actions computed by STM transactions. I couldn't figure out how to link to the STM docs in `Control.Monad.STM`, because that module comes from the `stm` package, not from `base`, even though `stm` is also part of the GHC source tree. So, instead I linked to the STM docs in `GHC.Conc`, which seems inferior to linking to `Control.Monad.STM`, but better than having no links at all. * Add example to Control.Monad.forever docs The example is a simple TCP echo server. To make the uses of `forever` stand out in the example code, I only link to the non-`forever` functions (e.g. `forkFinally`) in the import lists. Reviewers: bgamari, hvr Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4259 >--------------------------------------------------------------- 4887c3086149a15a1e16c765682debcfbb9de145 libraries/base/Control/Monad.hs | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 8d664e6..d9bfdeb 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -152,7 +152,37 @@ f >=> g = \x -> f x >>= g (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) (<=<) = flip (>=>) --- | @'forever' act@ repeats the action infinitely. +-- | Repeat an action indefinitely. +-- +-- ==== __Examples__ +-- +-- Simple network servers can be created by writing a function to +-- handle a single client connection and then using 'forever' to +-- accept client connections and fork threads to handle them. +-- +-- For example, here is a [TCP echo +-- server](https://en.wikipedia.org/wiki/Echo_Protocol) implemented +-- with 'forever': +-- +-- @ +-- import "Control.Concurrent" ( 'Control.Concurrent.forkFinally' ) +-- import "Control.Monad" ( 'forever' ) +-- import Network ( PortID(..), accept, listenOn ) +-- import "System.IO" ( 'System.IO.hClose', 'System.IO.hGetLine', 'System.IO.hPutStrLn' ) +-- +-- main :: IO () +-- main = do +-- sock <- listenOn (PortNumber 7) +-- 'forever' $ do +-- (handle, _, _) <- accept sock +-- echo handle \`forkFinally\` const (hClose handle) +-- where +-- echo handle = 'forever' $ +-- hGetLine handle >>= hPutStrLn handle +-- @ +-- +-- The @Network@ module is provided by the [network +-- package](https://hackage.haskell.org/package/network). forever :: (Applicative f) => f a -> f b {-# INLINE forever #-} forever a = let a' = a *> a' in a' From git at git.haskell.org Wed Jan 3 06:23:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 06:23:36 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: add an assert (751266d) Message-ID: <20180103062336.4951F3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/751266de5d593d7ec02ee05ce732a1605a420583/ghc >--------------------------------------------------------------- commit 751266de5d593d7ec02ee05ce732a1605a420583 Author: Gabor Greif Date: Wed Jan 3 07:21:36 2018 +0100 WIP: add an assert that we don't enter an Id that already *is* evald >--------------------------------------------------------------- 751266de5d593d7ec02ee05ce732a1605a420583 compiler/codeGen/StgCmmExpr.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 663afdc..1de03e5 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -843,7 +843,8 @@ cgIdApp fun_id args = do -- ToDo: does ReturnIt guarantee tagged? EnterIt -> ASSERT( null args ) -- Discarding arguments - emitEnter fun + ASSERT2( not (isEvaldUnfolding (idUnfolding fun_id)), ppr fun_id <+> ppr (idUnfolding fun_id) $$ ppr cg_fun_id <+> ppr (idUnfolding cg_fun_id)) + if isEvaldUnfolding (idUnfolding fun_id) then pprPanic "cgIdApp" (ppr fun_id <+> ppr (idUnfolding fun_id) $$ ppr cg_fun_id <+> ppr (idUnfolding cg_fun_id)) else emitEnter fun SlowCall -> do -- A slow function call via the RTS apply routines { tickySlowCall lf_info args From git at git.haskell.org Wed Jan 3 08:15:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 08:15:55 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: an experiment (69221a6) Message-ID: <20180103081555.2D9B53A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/69221a67b0a792d38152a6606c300132494f0004/ghc >--------------------------------------------------------------- commit 69221a67b0a792d38152a6606c300132494f0004 Author: Gabor Greif Date: Wed Jan 3 09:15:43 2018 +0100 WIP: an experiment >--------------------------------------------------------------- 69221a67b0a792d38152a6606c300132494f0004 compiler/coreSyn/MkCore.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 72b6abf..588ce5d 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -200,7 +200,7 @@ mkWildCase :: CoreExpr -> Type -> Type -> [CoreAlt] -> CoreExpr -- Make a case expression whose case binder is unused -- The alts should not have any occurrences of WildId mkWildCase scrut scrut_ty res_ty alts - = Case scrut (mkWildValBinder scrut_ty) res_ty alts + = Case scrut (mkWildValBinder scrut_ty `setIdUnfolding` evaldUnfolding) res_ty alts mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr mkIfThenElse guard then_expr else_expr From git at git.haskell.org Wed Jan 3 12:43:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:00 +0000 (UTC) Subject: [commit: ghc] master: Small refactoring in Coercion (3bf910d) Message-ID: <20180103124300.0D66D3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3bf910d0ff7f82b4c316dcc08c143dbb65362366/ghc >--------------------------------------------------------------- commit 3bf910d0ff7f82b4c316dcc08c143dbb65362366 Author: Simon Peyton Jones Date: Tue Jan 2 17:11:55 2018 +0000 Small refactoring in Coercion * Kill unused mkHomoPhantomCo * Refactor downgradeRole_maybe to be more perspicuous * Don't export toPhantomCo (not used externally) >--------------------------------------------------------------- 3bf910d0ff7f82b4c316dcc08c143dbb65362366 compiler/types/Coercion.hs | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 2a94755..3f83b09 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -32,7 +32,7 @@ module Coercion ( mkNthCo, mkNthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCos, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkHomoForAllCos_NoRefl, - mkPhantomCo, mkHomoPhantomCo, toPhantomCo, + mkPhantomCo, mkUnsafeCo, mkHoleCo, mkUnivCo, mkSubCo, mkAxiomInstCo, mkProofIrrelCo, downgradeRole, maybeSubCo, mkAxiomRuleCo, @@ -909,8 +909,9 @@ mkKindCo co | otherwise = KindCo co --- input coercion is Nominal; see also Note [Role twiddling functions] mkSubCo :: Coercion -> Coercion +-- Input coercion is Nominal, result is Representational +-- see also Note [Role twiddling functions] mkSubCo (Refl Nominal ty) = Refl Representational ty mkSubCo (TyConAppCo Nominal tc cos) = TyConAppCo Representational tc (applyRoles tc cos) @@ -927,12 +928,16 @@ downgradeRole_maybe :: Role -- ^ desired role -> Coercion -> Maybe Coercion -- In (downgradeRole_maybe dr cr co) it's a precondition that -- cr = coercionRole co -downgradeRole_maybe Representational Nominal co = Just (mkSubCo co) -downgradeRole_maybe Nominal Representational _ = Nothing -downgradeRole_maybe Phantom Phantom co = Just co -downgradeRole_maybe Phantom _ co = Just (toPhantomCo co) -downgradeRole_maybe _ Phantom _ = Nothing -downgradeRole_maybe _ _ co = Just co + +downgradeRole_maybe Nominal Nominal co = Just co +downgradeRole_maybe Nominal _ _ = Nothing + +downgradeRole_maybe Representational Nominal co = Just (mkSubCo co) +downgradeRole_maybe Representational Representational co = Just co +downgradeRole_maybe Representational Phantom _ = Nothing + +downgradeRole_maybe Phantom Phantom co = Just co +downgradeRole_maybe Phantom _ co = Just (toPhantomCo co) -- | Like 'downgradeRole_maybe', but panics if the change isn't a downgrade. -- See Note [Role twiddling functions] @@ -1019,14 +1024,6 @@ mkPhantomCo :: Coercion -> Type -> Type -> Coercion mkPhantomCo h t1 t2 = mkUnivCo (PhantomProv h) Phantom t1 t2 --- | Make a phantom coercion between two types of the same kind. -mkHomoPhantomCo :: Type -> Type -> Coercion -mkHomoPhantomCo t1 t2 - = ASSERT( k1 `eqType` typeKind t2 ) - mkPhantomCo (mkNomReflCo k1) t1 t2 - where - k1 = typeKind t1 - -- takes any coercion and turns it into a Phantom coercion toPhantomCo :: Coercion -> Coercion toPhantomCo co From git at git.haskell.org Wed Jan 3 12:43:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:02 +0000 (UTC) Subject: [commit: ghc] master: Tiny refactor around fillInferResult (1e12783) Message-ID: <20180103124302.C93423A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1e12783b658043dfa836ad6003da0e283faa7716/ghc >--------------------------------------------------------------- commit 1e12783b658043dfa836ad6003da0e283faa7716 Author: Simon Peyton Jones Date: Tue Jan 2 17:10:40 2018 +0000 Tiny refactor around fillInferResult ...arising from Richard's fix to Trac #14618 >--------------------------------------------------------------- 1e12783b658043dfa836ad6003da0e283faa7716 compiler/typecheck/TcUnify.hs | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index eb96757..fc2763a 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -565,7 +565,13 @@ tcSubTypeET orig ctxt (Check ty_actual) ty_expected tcSubTypeET _ _ (Infer inf_res) ty_expected = ASSERT2( not (ir_inst inf_res), ppr inf_res $$ ppr ty_expected ) - do { co <- fillInferResult ty_expected inf_res + -- An (Infer inf_res) ExpSigmaType passed into tcSubTypeET never + -- has the ir_inst field set. Reason: in patterns (which is what + -- tcSubTypeET is used for) do not agressively instantiate + do { co <- fill_infer_result ty_expected inf_res + -- Since ir_inst is false, we can skip fillInferResult + -- and go straight to fill_infer_result + ; return (mkWpCastN (mkTcSymCo co)) } ------------------------ @@ -638,7 +644,7 @@ tcSubTypeDS_NC_O :: CtOrigin -- origin used for instantiation only -- ty_expected is deeply skolemised tcSubTypeDS_NC_O inst_orig ctxt m_thing ty_actual ty_expected = case ty_expected of - Infer inf_res -> fillInferResult_Inst inst_orig ty_actual inf_res + Infer inf_res -> fillInferResult inst_orig ty_actual inf_res Check ty -> tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty where eq_orig = TypeEqOrigin { uo_actual = ty_actual, uo_expected = ty @@ -852,24 +858,24 @@ tcInfer instantiate tc_check ; res_ty <- readExpType res_ty ; return (result, res_ty) } -fillInferResult_Inst :: CtOrigin -> TcType -> InferResult -> TcM HsWrapper --- If wrap = fillInferResult_Inst t1 t2 +fillInferResult :: CtOrigin -> TcType -> InferResult -> TcM HsWrapper +-- If wrap = fillInferResult t1 t2 -- => wrap :: t1 ~> t2 -- See Note [Deep instantiation of InferResult] -fillInferResult_Inst orig ty inf_res@(IR { ir_inst = instantiate_me }) +fillInferResult orig ty inf_res@(IR { ir_inst = instantiate_me }) | instantiate_me = do { (wrap, rho) <- deeplyInstantiate orig ty - ; co <- fillInferResult rho inf_res + ; co <- fill_infer_result rho inf_res ; return (mkWpCastN co <.> wrap) } | otherwise - = do { co <- fillInferResult ty inf_res + = do { co <- fill_infer_result ty inf_res ; return (mkWpCastN co) } -fillInferResult :: TcType -> InferResult -> TcM TcCoercionN --- If wrap = fillInferResult t1 t2 +fill_infer_result :: TcType -> InferResult -> TcM TcCoercionN +-- If wrap = fill_infer_result t1 t2 -- => wrap :: t1 ~> t2 -fillInferResult orig_ty (IR { ir_uniq = u, ir_lvl = res_lvl +fill_infer_result orig_ty (IR { ir_uniq = u, ir_lvl = res_lvl , ir_ref = ref }) = do { (ty_co, ty_to_fill_with) <- promoteTcType res_lvl orig_ty From git at git.haskell.org Wed Jan 3 12:43:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:15 +0000 (UTC) Subject: [commit: ghc] master: White space only (112266c) Message-ID: <20180103124315.686D03A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/112266ce62e4fa831b21038be72f8b9ecdf6bfcf/ghc >--------------------------------------------------------------- commit 112266ce62e4fa831b21038be72f8b9ecdf6bfcf Author: Simon Peyton Jones Date: Tue Jan 2 17:13:31 2018 +0000 White space only >--------------------------------------------------------------- 112266ce62e4fa831b21038be72f8b9ecdf6bfcf compiler/types/TyCoRep.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 64e1068..d9cc42b 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1464,7 +1464,7 @@ tyCoFVsOfCo (HoleCo h) fv_cand in_scope acc tyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1 - `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc + `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc tyCoFVsOfCo (SymCo co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfCo (TransCo co1 co2) fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc tyCoFVsOfCo (NthCo _ co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc From git at git.haskell.org Wed Jan 3 12:43:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:05 +0000 (UTC) Subject: [commit: ghc] master: Comments about join point types (f3a0fe2) Message-ID: <20180103124305.9B1973A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3a0fe2da0c3da597cc65afb0e362eb436be5498/ghc >--------------------------------------------------------------- commit f3a0fe2da0c3da597cc65afb0e362eb436be5498 Author: Simon Peyton Jones Date: Tue Jan 2 17:08:16 2018 +0000 Comments about join point types ...provked by #14620 >--------------------------------------------------------------- f3a0fe2da0c3da597cc65afb0e362eb436be5498 compiler/simplCore/OccurAnal.hs | 41 ++++------------------------------------- compiler/types/Type.hs | 34 +++++++++++++++++++++++++++++++++- 2 files changed, 37 insertions(+), 38 deletions(-) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index e2beb74..2be47fb 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -701,39 +701,6 @@ costs us anything when, for some `j`: This appears to be very rare in practice. TODO Perhaps we should gather statistics to be sure. -Note [Excess polymorphism and join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -In principle, if a function would be a join point except that it fails -the polymorphism rule (see Note [The polymorphism rule of join points] in -CoreSyn), it can still be made a join point with some effort. This is because -all tail calls must return the same type (they return to the same context!), and -thus if the return type depends on an argument, that argument must always be the -same. - -For instance, consider: - - let f :: forall a. a -> Char -> [a] - f @a x c = ... f @a x 'a' ... - in ... f @Int 1 'b' ... f @Int 2 'c' ... - -(where the calls are tail calls). `f` fails the polymorphism rule because its -return type is [a], where [a] is bound. But since the type argument is always -'Int', we can rewrite it as: - - let f' :: Int -> Char -> [Int] - f' x c = ... f' x 'a' ... - in ... f' 1 'b' ... f 2 'c' ... - -and now we can make f' a join point: - - join f' :: Int -> Char -> [Int] - f' x c = ... jump f' x 'a' ... - in ... jump f' 1 'b' ... jump f' 2 'c' ... - -It's not clear that this comes up often, however. TODO: Measure how often and -add this analysis if necessary. - ------------------------------------------------------------ Note [Adjusting right-hand sides] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1760,12 +1727,12 @@ occAnal env (Tick tickish body) occAnal env (Cast expr co) = case occAnal env expr of { (usage, expr') -> let usage1 = zapDetailsIf (isRhsEnv env) usage + -- usage1: if we see let x = y `cast` co + -- then mark y as 'Many' so that we don't + -- immediately inline y again. usage2 = addManyOccsSet usage1 (coVarsOfCo co) - -- See Note [Gather occurrences of coercion variables] + -- usage2: see Note [Gather occurrences of coercion variables] in (markAllNonTailCalled usage2, Cast expr' co) - -- If we see let x = y `cast` co - -- then mark y as 'Many' so that we don't - -- immediately inline y again. } occAnal env app@(App _ _) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 8176270..acc7a63 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -2067,7 +2067,39 @@ isValidJoinPointType arity ty | otherwise = False -{- +{- Note [Excess polymorphism and join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In principle, if a function would be a join point except that it fails +the polymorphism rule (see Note [The polymorphism rule of join points] in +CoreSyn), it can still be made a join point with some effort. This is because +all tail calls must return the same type (they return to the same context!), and +thus if the return type depends on an argument, that argument must always be the +same. + +For instance, consider: + + let f :: forall a. a -> Char -> [a] + f @a x c = ... f @a y 'a' ... + in ... f @Int 1 'b' ... f @Int 2 'c' ... + +(where the calls are tail calls). `f` fails the polymorphism rule because its +return type is [a], where [a] is bound. But since the type argument is always +'Int', we can rewrite it as: + + let f' :: Int -> Char -> [Int] + f' x c = ... f' y 'a' ... + in ... f' 1 'b' ... f 2 'c' ... + +and now we can make f' a join point: + + join f' :: Int -> Char -> [Int] + f' x c = ... jump f' y 'a' ... + in ... jump f' 1 'b' ... jump f' 2 'c' ... + +It's not clear that this comes up often, however. TODO: Measure how often and +add this analysis if necessary. See Trac #14620. + + ************************************************************************ * * \subsection{Sequencing on types} From git at git.haskell.org Wed Jan 3 12:43:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:09 +0000 (UTC) Subject: [commit: ghc] master: No deferred type errors under a forall (298ec78) Message-ID: <20180103124309.27F323A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/298ec78c8832b391c19d662576e59c3e16bd43b0/ghc >--------------------------------------------------------------- commit 298ec78c8832b391c19d662576e59c3e16bd43b0 Author: Simon Peyton Jones Date: Wed Jan 3 10:51:18 2018 +0000 No deferred type errors under a forall As Trac #14605 showed, we can't defer a type error under a 'forall' (when unifying two forall types). The fix is simple. >--------------------------------------------------------------- 298ec78c8832b391c19d662576e59c3e16bd43b0 compiler/typecheck/TcErrors.hs | 29 ++++++++++++++-------- docs/users_guide/glasgow_exts.rst | 23 +++++++++++++++++ testsuite/tests/typecheck/should_fail/T14605.hs | 14 +++++++++++ .../tests/typecheck/should_fail/T14605.stderr | 10 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 67 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 6710434..e372c30 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -378,16 +378,25 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given implic' = implic { ic_skols = tvs' , ic_given = map (tidyEvVar env1) given , ic_info = info' } - ctxt' = ctxt { cec_tidy = env1 - , cec_encl = implic' : cec_encl ctxt - - , cec_suppress = insoluble || cec_suppress ctxt - -- Suppress inessential errors if there - -- are insolubles anywhere in the - -- tree rooted here, or we've come across - -- a suppress-worthy constraint higher up (Trac #11541) - - , cec_binds = evb } + ctxt1 | termEvidenceAllowed info = ctxt + | otherwise = ctxt { cec_defer_type_errors = TypeError } + -- If we go inside an implication that has no term + -- evidence (i.e. unifying under a forall), we can't defer + -- type errors. You could imagine using the /enclosing/ + -- bindings (in cec_binds), but that may not have enough stuff + -- in scope for the bindings to be well typed. So we just + -- switch off deferred type errors altogether. See Trac #14605. + + ctxt' = ctxt1 { cec_tidy = env1 + , cec_encl = implic' : cec_encl ctxt + + , cec_suppress = insoluble || cec_suppress ctxt + -- Suppress inessential errors if there + -- are insolubles anywhere in the + -- tree rooted here, or we've come across + -- a suppress-worthy constraint higher up (Trac #11541) + + , cec_binds = evb } dead_givens = case status of IC_Solved { ics_dead = dead } -> dead diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 03ea986..6704b87 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -11231,6 +11231,29 @@ demonstrates: Prelude> fst x True +Limitations of deferred type errors +----------------------------------- +The errors that can be deferred are: + +- Out of scope term variables +- Equality constraints; e.g. `ord True` gives rise to an insoluble equality constraint `Char ~ Bool`, which can be deferred. +- Type-class and implicit-parameter constraints + +All other type errors are reported immediately, and cannot be deferred; for +example, an ill-kinded type signature, an instance declaration that is +non-terminating or ill-formed, a type-family instance that does not +obey the declared injectivity constraints, etc etc. + +In a few cases, even equality constraints cannot be deferred. Specifically: + +- Kind-equalities cannot be deferred, e.g. :: + + f :: Int Bool -> Char + + This type signature contains a kind error which cannot be deferred. + +- Type equalities under a forall cannot be deferred (c.f. Trac #14605). + .. _template-haskell: Template Haskell diff --git a/testsuite/tests/typecheck/should_fail/T14605.hs b/testsuite/tests/typecheck/should_fail/T14605.hs new file mode 100644 index 0000000..4f75d59 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14605.hs @@ -0,0 +1,14 @@ +{-# Language TypeApplications #-} +{-# Language ImpredicativeTypes #-} +-- This isn't a test for impredicative types; it's +-- just that visible type application on a for-all type +-- is an easy way to provoke the error. +-- +-- The ticket #14605 has a much longer example that +-- also fails; it does not use ImpredicativeTypes + +module T14605 where + +import GHC.Prim (coerce) + +duplicate = coerce @(forall x. ()) @(forall x. x) diff --git a/testsuite/tests/typecheck/should_fail/T14605.stderr b/testsuite/tests/typecheck/should_fail/T14605.stderr new file mode 100644 index 0000000..09181c6 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14605.stderr @@ -0,0 +1,10 @@ + +T14605.hs:14:13: error: + • Couldn't match representation of type ‘x1’ with that of ‘()’ + arising from a use of ‘coerce’ + ‘x1’ is a rigid type variable bound by + the type () + at T14605.hs:14:1-49 + • In the expression: coerce @(forall x. ()) @(forall x. x) + In an equation for ‘duplicate’: + duplicate = coerce @(forall x. ()) @(forall x. x) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 2d8137f..b8c3c4c 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -464,3 +464,4 @@ test('T14390', normal, compile_fail, ['']) test('MissingExportList03', normal, compile_fail, ['']) test('T14618', normal, compile_fail, ['']) test('T14607', normal, compile, ['']) +test('T14605', normal, compile_fail, ['']) From git at git.haskell.org Wed Jan 3 12:43:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:18 +0000 (UTC) Subject: [commit: ghc] master: Comments only (2c7b183) Message-ID: <20180103124318.447F43A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c7b18309cab95636d4d520c60b880dacc45497b/ghc >--------------------------------------------------------------- commit 2c7b18309cab95636d4d520c60b880dacc45497b Author: Simon Peyton Jones Date: Fri Dec 22 17:49:41 2017 +0000 Comments only >--------------------------------------------------------------- 2c7b18309cab95636d4d520c60b880dacc45497b compiler/typecheck/TcSimplify.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 56d6c78..f1d7e9a 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1086,6 +1086,11 @@ decideQuantifiedTyVars mono_tvs name_taus psigs candidates ; qtvs <- quantifyTyVars mono_tvs dvs_plus ; return (qtvs, co_vars) } + -- Return all the CoVars that (transitively) might be mentioned + -- in the tau_tys etc. We don't need to do a closeOverKinds on + -- co_vars to get the transitive ones, becuase the grown_tvs + -- are already closed over kinds, and hence contain all such + -- co_vars ------------------ growThetaTyVars :: ThetaType -> TyCoVarSet -> TyCoVarSet From git at git.haskell.org Wed Jan 3 12:43:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:12 +0000 (UTC) Subject: [commit: ghc] master: Fix OptCoercion (9e5535c) Message-ID: <20180103124312.95AD43A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e5535ca667e060ce1431d42cdfc3a13ae080a88/ghc >--------------------------------------------------------------- commit 9e5535ca667e060ce1431d42cdfc3a13ae080a88 Author: Simon Peyton Jones Date: Tue Jan 2 17:25:58 2018 +0000 Fix OptCoercion In the presence of -fdefer-type-errors, OptCoercion can encounter a mal-formed coerercion with type T a ~ T a b and that was causing a subsequent Lint error. This caused Trac #14607. Easily fixed by turning an ASSERT into a guard. >--------------------------------------------------------------- 9e5535ca667e060ce1431d42cdfc3a13ae080a88 compiler/types/OptCoercion.hs | 4 +++- testsuite/tests/typecheck/should_fail/T14607.hs | 23 ++++++++++++++++++++++ .../tests/typecheck/should_fail/T14607.stderr | 21 ++++++++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 48 insertions(+), 1 deletion(-) diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index e8379ad..24dc8a4 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -934,8 +934,10 @@ etaTyConAppCo_maybe tc co , tc1 == tc2 , isInjectiveTyCon tc r -- See Note [NthCo and newtypes] in TyCoRep , let n = length tys1 + , tys2 `lengthIs` n -- This can fail in an erroneous progam + -- E.g. T a ~# T a b + -- Trac #14607 = ASSERT( tc == tc1 ) - ASSERT( tys2 `lengthIs` n ) Just (decomposeCo n co) -- NB: n might be <> tyConArity tc -- e.g. data family T a :: * -> * diff --git a/testsuite/tests/typecheck/should_fail/T14607.hs b/testsuite/tests/typecheck/should_fail/T14607.hs new file mode 100644 index 0000000..891d3cc --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14607.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} + -- This line is crucial to the bug + +{-# Language GADTs #-} +{-# Language InstanceSigs #-} +{-# Language KindSignatures #-} +{-# Language TypeFamilies #-} +{-# Language DataKinds #-} +{-# Language FlexibleInstances #-} + +module T14607 where + +import Data.Kind + +data LamCons :: Type -> Type -> () -> Type where + C :: LamCons a a '() + +class Mk a where + mk :: LamCons a a '() + +instance Mk a where + mk :: LamCons a '() + mk = mk diff --git a/testsuite/tests/typecheck/should_fail/T14607.stderr b/testsuite/tests/typecheck/should_fail/T14607.stderr new file mode 100644 index 0000000..740f89a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14607.stderr @@ -0,0 +1,21 @@ + +T14607.hs:22:9: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Expecting one more argument to ‘LamCons a '()’ + Expected a type, but ‘LamCons a '()’ has kind ‘() -> *’ + • In the type signature: mk :: LamCons a '() + In the instance declaration for ‘Mk a’ + +T14607.hs:22:19: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Expected a type, but ‘ '()’ has kind ‘()’ + • In the second argument of ‘LamCons’, namely ‘ '()’ + In the type signature: mk :: LamCons a '() + In the instance declaration for ‘Mk a’ + +T14607.hs:23:8: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type ‘LamCons a '()’ + with actual type ‘LamCons a0 a0 '()’ + • In the expression: mk + In an equation for ‘mk’: mk = mk + In the instance declaration for ‘Mk a’ + • Relevant bindings include + mk :: LamCons a '() (bound at T14607.hs:23:3) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index b1a0e75..2d8137f 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -463,3 +463,4 @@ test('T14350', normal, compile_fail, ['']) test('T14390', normal, compile_fail, ['']) test('MissingExportList03', normal, compile_fail, ['']) test('T14618', normal, compile_fail, ['']) +test('T14607', normal, compile, ['']) From git at git.haskell.org Wed Jan 3 12:43:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:21 +0000 (UTC) Subject: [commit: ghc] master: More informative pretty-printing for phantom coercions (83b96a4) Message-ID: <20180103124321.0AD6B3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/83b96a47a5f859729a2e48efcbc10211fbf0435d/ghc >--------------------------------------------------------------- commit 83b96a47a5f859729a2e48efcbc10211fbf0435d Author: Simon Peyton Jones Date: Tue Jan 2 17:07:33 2018 +0000 More informative pretty-printing for phantom coercions >--------------------------------------------------------------- 83b96a47a5f859729a2e48efcbc10211fbf0435d compiler/iface/IfaceType.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index c5a4a3d..62b33cd 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -1083,8 +1083,10 @@ ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2) text "UnsafeCo" <+> ppr r <+> pprParendIfaceType ty1 <+> pprParendIfaceType ty2 -ppr_co _ (IfaceUnivCo _ _ ty1 ty2) - = angleBrackets ( ppr ty1 <> comma <+> ppr ty2 ) +ppr_co _ (IfaceUnivCo prov role ty1 ty2) + = text "Univ" <> (parens $ + sep [ ppr role <+> pprIfaceUnivCoProv prov + , dcolon <+> ppr ty1 <> comma <+> ppr ty2 ]) ppr_co ctxt_prec (IfaceInstCo co ty) = maybeParen ctxt_prec TyConPrec $ @@ -1124,6 +1126,17 @@ ppr_role r = underscore <> pp_role Representational -> char 'R' Phantom -> char 'P' +------------------ +pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc +pprIfaceUnivCoProv IfaceUnsafeCoerceProv + = text "unsafe" +pprIfaceUnivCoProv (IfacePhantomProv co) + = text "phantom" <+> pprParendIfaceCoercion co +pprIfaceUnivCoProv (IfaceProofIrrelProv co) + = text "irrel" <+> pprParendIfaceCoercion co +pprIfaceUnivCoProv (IfacePluginProv s) + = text "plugin" <+> doubleQuotes (text s) + ------------------- instance Outputable IfaceTyCon where ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc) From git at git.haskell.org Wed Jan 3 12:43:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 12:43:25 +0000 (UTC) Subject: [commit: ghc] master: Get evaluated-ness right in the back end (bd438b2) Message-ID: <20180103124325.0C4E13A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd438b2d67ec8f5d8ac8472f13b3175b569951b9/ghc >--------------------------------------------------------------- commit bd438b2d67ec8f5d8ac8472f13b3175b569951b9 Author: Simon Peyton Jones Date: Wed Jan 3 10:48:26 2018 +0000 Get evaluated-ness right in the back end See Trac #14626, comment:4. We want to maintain evaluted-ness info on Ids into the code generateor for two reasons (see Note [Preserve evaluated-ness in CorePrep] in CorePrep) - DataToTag magic - Potentially using it in the codegen (this is Gabor's current work) But it was all being done very inconsistently, and actually outright wrong -- the DataToTag magic hasn't been working for years. This patch tidies it all up, with Notes to match. >--------------------------------------------------------------- bd438b2d67ec8f5d8ac8472f13b3175b569951b9 compiler/basicTypes/IdInfo.hs | 7 +- compiler/coreSyn/CorePrep.hs | 142 +++++++++++++-------- compiler/coreSyn/CoreTidy.hs | 9 +- compiler/iface/ToIface.hs | 11 +- compiler/main/TidyPgm.hs | 30 +++-- testsuite/tests/codeGen/should_compile/Makefile | 3 + testsuite/tests/codeGen/should_compile/T14626.hs | 15 +++ .../tests/codeGen/should_compile/T14626.stdout | 2 + testsuite/tests/codeGen/should_compile/all.T | 3 + .../tests/deSugar/should_compile/T2431.stderr | 32 ++--- .../tests/roles/should_compile/Roles13.stderr | 52 ++++---- .../tests/simplCore/should_compile/T13143.stderr | 4 +- .../tests/simplCore/should_compile/T3717.stderr | 2 +- .../tests/simplCore/should_compile/T3772.stdout | 4 +- .../tests/simplCore/should_compile/T4908.stderr | 6 +- .../tests/simplCore/should_compile/T4930.stderr | 2 +- .../tests/simplCore/should_compile/T7360.stderr | 6 +- .../tests/simplCore/should_compile/T9400.stderr | 64 +++++----- .../simplCore/should_compile/spec-inline.stderr | 4 +- .../tests/stranal/should_compile/T10694.stderr | 96 ++++++++------ 20 files changed, 298 insertions(+), 196 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bd438b2d67ec8f5d8ac8472f13b3175b569951b9 From git at git.haskell.org Wed Jan 3 16:11:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:11:01 +0000 (UTC) Subject: [commit: ghc] wip/T13861: Revert "WIP: clean up some cruft" (a67a28d) Message-ID: <20180103161101.6830C3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/a67a28d26584511d78ddd6c8ece7191a04f3101b/ghc >--------------------------------------------------------------- commit a67a28d26584511d78ddd6c8ece7191a04f3101b Author: Gabor Greif Date: Wed Jan 3 11:26:26 2018 +0100 Revert "WIP: clean up some cruft" This reverts commit a0fdeba207e457924a2b7204dd4f7db14d5e4364. >--------------------------------------------------------------- a67a28d26584511d78ddd6c8ece7191a04f3101b compiler/codeGen/StgCmmClosure.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 8c49628..9de4f9d 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards #-} - +{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -224,8 +224,13 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description + deriving Show - +deriving instance Show TopLevelFlag +deriving instance Show OneShotInfo +deriving instance Show ArgDescr +deriving instance Show StandardFormInfo +instance Show DataCon where show _ = "" ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms From git at git.haskell.org Wed Jan 3 16:11:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:11:05 +0000 (UTC) Subject: [commit: ghc] wip/T13861: Get evaluated-ness right in the back end (5badb2e) Message-ID: <20180103161105.605E83A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/5badb2e8da31e15265f169d2556000c11d71e8bf/ghc >--------------------------------------------------------------- commit 5badb2e8da31e15265f169d2556000c11d71e8bf Author: Simon Peyton Jones Date: Wed Jan 3 10:48:26 2018 +0000 Get evaluated-ness right in the back end See Trac #14626, comment:4. We want to maintain evaluted-ness info on Ids into the code generateor for two reasons (see Note [Preserve evaluated-ness in CorePrep] in CorePrep) - DataToTag magic - Potentially using it in the codegen (this is Gabor's current work) But it was all being done very inconsistently, and actually outright wrong -- the DataToTag magic hasn't been working for years. This patch tidies it all up, with Notes to match. Conflicts: testsuite/tests/codeGen/should_compile/all.T >--------------------------------------------------------------- 5badb2e8da31e15265f169d2556000c11d71e8bf compiler/basicTypes/IdInfo.hs | 7 +- compiler/coreSyn/CorePrep.hs | 142 +++++++++++++-------- compiler/coreSyn/CoreTidy.hs | 9 +- compiler/iface/ToIface.hs | 11 +- compiler/main/TidyPgm.hs | 30 +++-- testsuite/tests/codeGen/should_compile/Makefile | 3 + testsuite/tests/codeGen/should_compile/T14626.hs | 15 +++ .../tests/codeGen/should_compile/T14626.stdout | 2 + testsuite/tests/codeGen/should_compile/all.T | 3 + .../tests/deSugar/should_compile/T2431.stderr | 32 ++--- .../tests/roles/should_compile/Roles13.stderr | 52 ++++---- .../tests/simplCore/should_compile/T13143.stderr | 4 +- .../tests/simplCore/should_compile/T3717.stderr | 2 +- .../tests/simplCore/should_compile/T3772.stdout | 4 +- .../tests/simplCore/should_compile/T4908.stderr | 6 +- .../tests/simplCore/should_compile/T4930.stderr | 2 +- .../tests/simplCore/should_compile/T7360.stderr | 6 +- .../tests/simplCore/should_compile/T9400.stderr | 64 +++++----- .../simplCore/should_compile/spec-inline.stderr | 4 +- .../tests/stranal/should_compile/T10694.stderr | 96 ++++++++------ 20 files changed, 298 insertions(+), 196 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5badb2e8da31e15265f169d2556000c11d71e8bf From git at git.haskell.org Wed Jan 3 16:11:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:11:08 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: DON'T PUSH, misc local changes (091e9e3) Message-ID: <20180103161108.344483A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/091e9e35398d472432f32f8d82b278663f7735bf/ghc >--------------------------------------------------------------- commit 091e9e35398d472432f32f8d82b278663f7735bf Author: Gabor Greif Date: Wed Jan 3 15:57:17 2018 +0100 WIP: DON'T PUSH, misc local changes >--------------------------------------------------------------- 091e9e35398d472432f32f8d82b278663f7735bf compiler/codeGen/StgCmmClosure.hs | 7 +++++++ compiler/codeGen/StgCmmExpr.hs | 6 ++++-- libffi/ghc.mk | 2 ++ testsuite/tests/codeGen/should_compile/all.T | 3 ++- utils/gen-dll/Main.hs | 2 +- 5 files changed, 16 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 9de4f9d..03f0169 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -60,6 +60,7 @@ module StgCmmClosure ( cafBlackHoleInfoTable, indStaticInfoTable, staticClosureNeedsLink, + LambdaFormInfo(LFThunk) ) where #include "../includes/MachDeps.h" @@ -597,6 +598,12 @@ getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info -- n_args=0 because it'd be ill-typed to apply a saturated -- constructor application to anything +getCallMethod _ _name id lf 0 _v_args _cg_loc _self_loop_info + | isEvaldUnfolding (idUnfolding id) && trace lf "getCallMethod##" (ppr id $$ (text . show $ lf) $$ ppr (idUnfolding id)) False + = undefined + where trace LFLetNoEscape _ _ = GhcPrelude.id + trace _ s d = pprTrace s d + getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) n_args _v_args _cg_loc _self_loop_info | is_fun -- it *might* be a function, so we must "call" it (which is always safe) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 1de03e5..ef4b22d 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -835,6 +835,8 @@ cgIdApp fun_id args = do n_args = length args v_args = length $ filter (isVoidTy . stgArgType) args node_points dflags = nodeMustPointToIt dflags lf_info + --okay LFThunk{} = True + --okay _ = False case getCallMethod dflags fun_name cg_fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of -- A value in WHNF, so we can just return it. ReturnIt @@ -843,8 +845,8 @@ cgIdApp fun_id args = do -- ToDo: does ReturnIt guarantee tagged? EnterIt -> ASSERT( null args ) -- Discarding arguments - ASSERT2( not (isEvaldUnfolding (idUnfolding fun_id)), ppr fun_id <+> ppr (idUnfolding fun_id) $$ ppr cg_fun_id <+> ppr (idUnfolding cg_fun_id)) - if isEvaldUnfolding (idUnfolding fun_id) then pprPanic "cgIdApp" (ppr fun_id <+> ppr (idUnfolding fun_id) $$ ppr cg_fun_id <+> ppr (idUnfolding cg_fun_id)) else emitEnter fun + --ASSERT2( okay lf_info || not (isEvaldUnfolding (idUnfolding fun_id)), ppr fun_id <+> ppr (idUnfolding fun_id) $$ ppr cg_fun_id <+> ppr (idUnfolding cg_fun_id)) + if isEvaldUnfolding (idUnfolding fun_id) then pprTrace "cgIdApp" (ppr fun_id <+> ppr (idUnfolding fun_id) $$ ppr cg_fun_id <+> ppr (idUnfolding cg_fun_id)) $ emitEnter fun else emitEnter fun SlowCall -> do -- A slow function call via the RTS apply routines { tickySlowCall lf_info args diff --git a/libffi/ghc.mk b/libffi/ghc.mk index 6bc8897..776da70 100644 --- a/libffi/ghc.mk +++ b/libffi/ghc.mk @@ -89,7 +89,9 @@ $(libffi_STAMP_CONFIGURE): $(TOUCH_DEP) cd libffi && \ cd build && \ CC=$(CC_STAGE1) \ + CPP="$(CC_STAGE1) -E" \ CXX=$(CC_STAGE1) \ + CXXCPP="$(CC_STAGE1:gcc=g++) -E" \ LD=$(LD) \ AR=$(AR_STAGE1) \ NM=$(NM) \ diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 53092c9..d5acef4 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -38,7 +38,8 @@ test('T12355', normal, compile, ['']) test('T14373a', [], multimod_compile, ['T14373a', '-fasm -O2 -ddump-cmm-from-stg -dsuppress-uniques']) test('T14373b', [], - multimod_compile, ['T14373b', '-fasm -O2 -ddump-cmm-from-stg -dsuppress-uniques']) + multimod_compile, ['T14373b', '-v -O2 -dsuppress-uniques']) +# multimod_compile, ['T14373b', '-fasm -O2 -ddump-cmm-from-stg -dsuppress-uniques']) test('T14626', normal, run_command, ['$MAKE -s --no-print-directory T14626']) diff --git a/utils/gen-dll/Main.hs b/utils/gen-dll/Main.hs index 0383b8e..7cc965b 100644 --- a/utils/gen-dll/Main.hs +++ b/utils/gen-dll/Main.hs @@ -85,7 +85,7 @@ In the end we end up with libfoo-pt1.dll, libfoo-pt2.dll and libfoo-pt3.dll along with libfoo.dll.a. To the rest of the pipeline the split is - completely transparant as -lfoo will just continue to work, and the linker + completely transparent as -lfoo will just continue to work, and the linker is responsible for populating the IAT (Import Address Table) with the actual dlls we need. From git at git.haskell.org Wed Jan 3 16:11:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:11:11 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (7a25659) Message-ID: <20180103161111.015A43A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a25659efc4d22086a9e75dc90e3701c1706c625/ghc >--------------------------------------------------------------- commit 7a25659efc4d22086a9e75dc90e3701c1706c625 Author: Gabor Greif Date: Wed Jan 3 16:58:36 2018 +0100 Typos in comments >--------------------------------------------------------------- 7a25659efc4d22086a9e75dc90e3701c1706c625 compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/CoreUtils.hs | 4 ++-- docs/users_guide/glasgow_exts.rst | 2 +- utils/gen-dll/Main.hs | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 16f69cc..2bfb558 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -1085,7 +1085,7 @@ How might it not be evaluated? Well, we might have floated it out of the scope of a `seq`, or dropped the `seq` altogether. We only do this if 'e' is not a WHNF. But if it's a simple -variable (common case) we need to know it's evaluated-ness flag. +variable (common case) we need to know its evaluated-ness flag. Example: data T = MkT !Bool f v = case v of diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index d35ae23..fbe7ebd 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -1500,7 +1500,7 @@ But we restrict it sharply: _ -> ...v...v.... Should v be considered ok-for-speculation? Its scrutinee may be evaluated, but the alternatives are incomplete so we should not - evalutate it strictly. + evaluate it strictly. Now, all this is for lifted types, but it'd be the same for any finite unlifted type. We don't have many of them, but we might @@ -1538,7 +1538,7 @@ evaluate them. Indeed, in general primops are, well, primitive and do not perform evaluation. There is one primop, dataToTag#, which does /require/ a lifted -argument to be evaluted. To ensure this, CorePrep adds an +argument to be evaluated. To ensure this, CorePrep adds an eval if it can't see the argument is definitely evaluated (see [dataToTag magic] in CorePrep). diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 6704b87..34efbfd 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -12404,7 +12404,7 @@ Bang patterns and Strict Haskell In high-performance Haskell code (e.g. numeric code) eliminating thunks from an inner loop can be a huge win. GHC supports three extensions to allow the programmer to specify -use of strict (call-by-value) evalution rather than lazy (call-by-need) +use of strict (call-by-value) evaluation rather than lazy (call-by-need) evaluation. - Bang patterns (:extension:`BangPatterns`) makes pattern matching and diff --git a/utils/gen-dll/Main.hs b/utils/gen-dll/Main.hs index 0383b8e..7cc965b 100644 --- a/utils/gen-dll/Main.hs +++ b/utils/gen-dll/Main.hs @@ -85,7 +85,7 @@ In the end we end up with libfoo-pt1.dll, libfoo-pt2.dll and libfoo-pt3.dll along with libfoo.dll.a. To the rest of the pipeline the split is - completely transparant as -lfoo will just continue to work, and the linker + completely transparent as -lfoo will just continue to work, and the linker is responsible for populating the IAT (Import Address Table) with the actual dlls we need. From git at git.haskell.org Wed Jan 3 16:16:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:16:39 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14626' created Message-ID: <20180103161639.CB8FD3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14626 Referencing: 8c2e74a795e42fdd398c96b70549169edcf94004 From git at git.haskell.org Wed Jan 3 16:16:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:16:42 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: don't reenter WHNF thing for re-tagging (30279a7) Message-ID: <20180103161642.CF2313A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/30279a76c4327e6ade820d4e4274b0cb6380e3c7/ghc >--------------------------------------------------------------- commit 30279a76c4327e6ade820d4e4274b0cb6380e3c7 Author: Gabor Greif Date: Wed Dec 27 19:47:50 2017 +0100 WIP: don't reenter WHNF thing for re-tagging this is a very crude test. How to make it more robust? >--------------------------------------------------------------- 30279a76c4327e6ade820d4e4274b0cb6380e3c7 compiler/codeGen/StgCmmClosure.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 2501ec9..feb9987 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards #-} - +{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -223,8 +223,13 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description + deriving Show - +deriving instance Show TopLevelFlag +deriving instance Show OneShotInfo +deriving instance Show ArgDescr +deriving instance Show StandardFormInfo +instance Show DataCon where show _ = "" ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms @@ -581,6 +586,10 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt +getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" + = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt + getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -- n_args=0 because it'd be ill-typed to apply a saturated From git at git.haskell.org Wed Jan 3 16:16:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:16:45 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: cleanups (d8d7b51) Message-ID: <20180103161645.B3F9E3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/d8d7b51de90777e6233ba4d0afcd0f52f46487a9/ghc >--------------------------------------------------------------- commit d8d7b51de90777e6233ba4d0afcd0f52f46487a9 Author: Gabor Greif Date: Thu Dec 28 10:58:55 2017 +0100 WIP: cleanups and add TODO (also this should be more performant, by consing less) >--------------------------------------------------------------- d8d7b51de90777e6233ba4d0afcd0f52f46487a9 compiler/codeGen/StgCmmClosure.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index feb9987..39d156f 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE CPP, RecordWildCards #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -223,13 +223,8 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description - deriving Show -deriving instance Show TopLevelFlag -deriving instance Show OneShotInfo -deriving instance Show ArgDescr -deriving instance Show StandardFormInfo -instance Show DataCon where show _ = "" + ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms @@ -586,9 +581,9 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info - | occNameString (nameOccName name) == "wild" - = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt +getCallMethod _ name _ (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" -- TODO: make this robust + = ReturnIt -- seems to come from case, must be (tagged) WHNF already getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt From git at git.haskell.org Wed Jan 3 16:16:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:16:48 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: ooops (e5e583e) Message-ID: <20180103161648.9415D3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/e5e583ee7f8f3711f5be854e269b3cd1c58e7e09/ghc >--------------------------------------------------------------- commit e5e583ee7f8f3711f5be854e269b3cd1c58e7e09 Author: Gabor Greif Date: Thu Dec 28 12:00:23 2017 +0100 WIP: ooops >--------------------------------------------------------------- e5e583ee7f8f3711f5be854e269b3cd1c58e7e09 compiler/codeGen/StgCmmClosure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 39d156f..bc9bb65 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -581,7 +581,7 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ name _ (LFUnknown False) 0 _v_args cg_loc _self_loop_info +getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust = ReturnIt -- seems to come from case, must be (tagged) WHNF already From git at git.haskell.org Wed Jan 3 16:16:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:16:51 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: look at evaluated-ness (e2514f6) Message-ID: <20180103161651.6D4153A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/e2514f666c5d39ed241f4f16176fddce8cad1829/ghc >--------------------------------------------------------------- commit e2514f666c5d39ed241f4f16176fddce8cad1829 Author: Gabor Greif Date: Wed Jan 3 16:55:15 2018 +0100 WIP: look at evaluated-ness >--------------------------------------------------------------- e2514f666c5d39ed241f4f16176fddce8cad1829 compiler/codeGen/StgCmmClosure.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index bc9bb65..63d3178 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -69,6 +69,7 @@ module StgCmmClosure ( import GhcPrelude import StgSyn +import CoreSyn (isEvaldUnfolding) import SMRep import Cmm import PprCmmExpr() @@ -625,6 +626,15 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function +getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info + | isEvaldUnfolding (idUnfolding id) + , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + = pprTrace "getCallMethod" (ppr id) ReturnIt -- seems to come from case, must be (tagged) WHNF already +{- +getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" -- TODO: make this robust + = ReturnIt -- seems to come from case, must be (tagged) WHNF already +-} getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) EnterIt -- Not a function From git at git.haskell.org Wed Jan 3 16:16:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 16:16:54 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: silence for benchmarks (8c2e74a) Message-ID: <20180103161654.5B1963A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/8c2e74a795e42fdd398c96b70549169edcf94004/ghc >--------------------------------------------------------------- commit 8c2e74a795e42fdd398c96b70549169edcf94004 Author: Gabor Greif Date: Wed Jan 3 17:15:12 2018 +0100 WIP: silence for benchmarks >--------------------------------------------------------------- 8c2e74a795e42fdd398c96b70549169edcf94004 compiler/codeGen/StgCmmClosure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 63d3178..21466fc 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -629,7 +629,7 @@ getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - = pprTrace "getCallMethod" (ppr id) ReturnIt -- seems to come from case, must be (tagged) WHNF already + = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust From git at git.haskell.org Wed Jan 3 17:41:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 17:41:35 +0000 (UTC) Subject: [commit: ghc] wip/T14626: Test the absence of re-tagging (9ad6982) Message-ID: <20180103174135.725193A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/9ad6982e4074c1fdeff967cafa51e436023d69bb/ghc >--------------------------------------------------------------- commit 9ad6982e4074c1fdeff967cafa51e436023d69bb Author: Gabor Greif Date: Wed Jan 3 18:40:19 2018 +0100 Test the absence of re-tagging >--------------------------------------------------------------- 9ad6982e4074c1fdeff967cafa51e436023d69bb testsuite/tests/codeGen/should_compile/Makefile | 4 ++++ testsuite/tests/codeGen/should_compile/T14626.hs | 7 +++++++ testsuite/tests/codeGen/should_compile/T14626.stdout | 3 +++ 3 files changed, 14 insertions(+) diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile index a841438..eaad461 100644 --- a/testsuite/tests/codeGen/should_compile/Makefile +++ b/testsuite/tests/codeGen/should_compile/Makefile @@ -7,6 +7,10 @@ T2578: T14626: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-uniques T14626.hs | grep case + echo == CMM == + # we don't want to see re-tagging, like: R1 = R1 & (-8); + - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm -dsuppress-uniques -fforce-recomp T14626.hs | grep 'R1 = R1 & (-[48])' + echo == /CMM == debug: # Without optimisations, we should get annotations for basically diff --git a/testsuite/tests/codeGen/should_compile/T14626.hs b/testsuite/tests/codeGen/should_compile/T14626.hs index a665694..76c7e2e 100644 --- a/testsuite/tests/codeGen/should_compile/T14626.hs +++ b/testsuite/tests/codeGen/should_compile/T14626.hs @@ -13,3 +13,10 @@ f v = case v of -- f v = case v of -- MkT y -> case y of z -> dataToTag# z -- But it was! See Trac #14626 comment:4 + + +data Letters = A | B | C | D | E | F + +consonant A = B +consonant E = C +consonant other = other diff --git a/testsuite/tests/codeGen/should_compile/T14626.stdout b/testsuite/tests/codeGen/should_compile/T14626.stdout index 31e280e..35803ee 100644 --- a/testsuite/tests/codeGen/should_compile/T14626.stdout +++ b/testsuite/tests/codeGen/should_compile/T14626.stdout @@ -1,2 +1,5 @@ case dt of dt { __DEFAULT -> T14626.MkT dt } case v of { T14626.MkT y [Occ=Once] -> + case ds of wild { +== CMM == +== /CMM == From git at git.haskell.org Wed Jan 3 23:56:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 23:56:18 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: yes, this crashes (f4d1e75) Message-ID: <20180103235618.2EBE33A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/f4d1e759e7d413a0ff0fedf933f440610c4161e0/ghc >--------------------------------------------------------------- commit f4d1e759e7d413a0ff0fedf933f440610c4161e0 Author: Gabor Greif Date: Wed Jan 3 22:53:06 2018 +0100 WIP: yes, this crashes trying allowing only OtherCon next >--------------------------------------------------------------- f4d1e759e7d413a0ff0fedf933f440610c4161e0 compiler/codeGen/StgCmmClosure.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 21466fc..720d9a9 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -628,7 +628,8 @@ getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) - , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info From git at git.haskell.org Wed Jan 3 23:56:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Jan 2018 23:56:20 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: exclude top-level values for now (04263e0) Message-ID: <20180103235620.EFF4F3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/04263e0580d39a2c138489b40da20ec6866ab7b2/ghc >--------------------------------------------------------------- commit 04263e0580d39a2c138489b40da20ec6866ab7b2 Author: Gabor Greif Date: Thu Jan 4 00:56:00 2018 +0100 WIP: exclude top-level values for now as they probably won't get tagged correctly this way >--------------------------------------------------------------- 04263e0580d39a2c138489b40da20ec6866ab7b2 compiler/codeGen/StgCmmClosure.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 720d9a9..089e3a4 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, RecordWildCards #-} +{-# LANGUAGE CPP, RecordWildCards, LambdaCase #-} ----------------------------------------------------------------------------- -- @@ -69,7 +69,7 @@ module StgCmmClosure ( import GhcPrelude import StgSyn -import CoreSyn (isEvaldUnfolding) +import CoreSyn (isEvaldUnfolding, Unfolding(..)) import SMRep import Cmm import PprCmmExpr() @@ -626,10 +626,12 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function -getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info +getCallMethod _ _name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id + , OtherCon _ <- idUnfolding id + -- , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info From git at git.haskell.org Thu Jan 4 01:24:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 01:24:44 +0000 (UTC) Subject: [commit: ghc] master: Make typeToLHsType produce kind signatures for tycon applications (649e777) Message-ID: <20180104012444.233343A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/649e777211fe08432900093002547d7358f92d82/ghc >--------------------------------------------------------------- commit 649e777211fe08432900093002547d7358f92d82 Author: Ryan Scott Date: Wed Jan 3 20:11:31 2018 -0500 Make typeToLHsType produce kind signatures for tycon applications Summary: `GeneralizedNewtypeDeriving` generates calls to `coerce` which take visible type arguments. These types must be produced by way of `typeToLHsType`, which converts a `Type` to an `LHsType`. However, `typeToLHsType` was leaving off important kind information when a `Type` contained a poly-kinded tycon application, leading to incorrectly generated code in #14579. This fixes the issue by tweaking `typeToLHsType` to generate explicit kind signatures for tycon applications. This makes the generated code noisier, but at least the program from #14579 now works correctly. Test Plan: make test TEST=T14579 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14579 Differential Revision: https://phabricator.haskell.org/D4264 >--------------------------------------------------------------- 649e777211fe08432900093002547d7358f92d82 compiler/hsSyn/HsUtils.hs | 60 +++++++++++++++++++++- .../tests/deriving/should_compile/T14578.stderr | 21 +++++--- testsuite/tests/deriving/should_compile/T14579.hs | 12 +++++ testsuite/tests/deriving/should_compile/all.T | 1 + 4 files changed, 85 insertions(+), 9 deletions(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index e3bc371..6db2133 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -122,6 +122,7 @@ import Util import Bag import Outputable import Constants +import TyCon import Data.Either import Data.Function @@ -641,9 +642,15 @@ typeToLHsType ty go (AppTy t1 t2) = nlHsAppTy (go t1) (go t2) go (LitTy (NumTyLit n)) = noLoc $ HsTyLit (HsNumTy noSourceText n) go (LitTy (StrTyLit s)) = noLoc $ HsTyLit (HsStrTy noSourceText s) - go (TyConApp tc args) = nlHsTyConApp (getRdrName tc) (map go args') + go ty@(TyConApp tc args) + | any isInvisibleTyConBinder (tyConBinders tc) + -- We must produce an explicit kind signature here to make certain + -- programs kind-check. See Note [Kind signatures in typeToLHsType]. + = noLoc $ HsKindSig lhs_ty (go (typeKind ty)) + | otherwise = lhs_ty where - args' = filterOutInvisibleTypes tc args + lhs_ty = nlHsTyConApp (getRdrName tc) (map go args') + args' = filterOutInvisibleTypes tc args go (CastTy ty _) = go ty go (CoercionTy co) = pprPanic "toLHsSigWcType" (ppr co) @@ -654,6 +661,55 @@ typeToLHsType ty go_tv tv = noLoc $ KindedTyVar (noLoc (getRdrName tv)) (go (tyVarKind tv)) +{- +Note [Kind signatures in typeToLHsType] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are types that typeToLHsType can produce which require explicit kind +signatures in order to kind-check. Here is an example from Trac #14579: + + newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a) deriving Eq + newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a)) deriving Eq + +The derived Eq instance for Glurp (without any kind signatures) would be: + + instance Eq a => Eq (Glurp a) where + (==) = coerce @(Wat 'Proxy -> Wat 'Proxy -> Bool) + @(Glurp a -> Glurp a -> Bool) + (==) + +(Where the visible type applications use types produced by typeToLHsType.) + +The type 'Proxy has an underspecified kind, so we must ensure that +typeToLHsType ascribes it with its kind: ('Proxy :: Proxy a). + +We must be careful not to produce too many kind signatures, or else +typeToLHsType can produce noisy types like +('Proxy :: Proxy (a :: (Type :: Type))). In pursuit of this goal, we adopt the +following criterion for choosing when to annotate types with kinds: + +* If there is a tycon application with any invisible arguments, annotate + the tycon application with its kind. + +Why is this the right criterion? The problem we encountered earlier was the +result of an invisible argument (the `a` in ('Proxy :: Proxy a)) being +underspecified, so producing a kind signature for 'Proxy will catch this. +If there are no invisible arguments, then there is nothing to do, so we can +avoid polluting the result type with redundant noise. + +What about a more complicated tycon, such as this? + + T :: forall {j} (a :: j). a -> Type + +Unlike in the previous 'Proxy example, annotating an application of `T` to an +argument (e.g., annotating T ty to obtain (T ty :: Type)) will not fix +its invisible argument `j`. But because we apply this strategy recursively, +`j` will be fixed because the kind of `ty` will be fixed! That is to say, +something to the effect of (T (ty :: j) :: Type) will be produced. + +This strategy certainly isn't foolproof, as tycons that contain type families +in their kind might break down. But we'd likely need visible kind application +to make those work. +-} {- ********************************************************************* * * diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr index e4230ad..63375ae 100644 --- a/testsuite/tests/deriving/should_compile/T14578.stderr +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -73,15 +73,20 @@ Derived class instances: GHC.Base.Semigroup (T14578.Wat f g a) where (GHC.Base.<>) = GHC.Prim.coerce - @(T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + @(T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.<>) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) - -> T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) GHC.Base.sconcat GHC.Base.stimes @@ -89,8 +94,10 @@ Derived class instances: @(forall (b :: TYPE GHC.Types.LiftedRep). GHC.Real.Integral b => b - -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(forall (b :: TYPE GHC.Types.LiftedRep). GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a) GHC.Base.stimes diff --git a/testsuite/tests/deriving/should_compile/T14579.hs b/testsuite/tests/deriving/should_compile/T14579.hs new file mode 100644 index 0000000..1945244 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14579.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeInType #-} +module T14579 where + +import Data.Kind +import Data.Proxy + +newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a) + deriving Eq + +newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a)) + deriving Eq diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index af9a577..8752bbd 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -99,3 +99,4 @@ test('T14094', normal, compile, ['']) test('T14339', normal, compile, ['']) test('T14331', normal, compile, ['']) test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) +test('T14579', normal, compile, ['']) From git at git.haskell.org Thu Jan 4 14:04:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 14:04:40 +0000 (UTC) Subject: [commit: ghc] master: Cache the number of data cons in DataTyCon and SumTyCon (6c34824) Message-ID: <20180104140440.13FC93A5F6@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c34824434a67baa34e4ee2ddb753708eb61c5bc/ghc >--------------------------------------------------------------- commit 6c34824434a67baa34e4ee2ddb753708eb61c5bc Author: Bartosz Nitka Date: Tue Dec 26 12:54:27 2017 +0000 Cache the number of data cons in DataTyCon and SumTyCon This is a follow-up after faf60e85 - Make tagForCon non-linear. On the mailing list @simonpj suggested to solve the linear behavior by caching the sizes. Test Plan: ./validate Reviewers: simonpj, simonmar, bgamari, austin Reviewed By: simonpj Subscribers: carter, goldfire, rwbarton, thomie, simonpj Differential Revision: https://phabricator.haskell.org/D4131 >--------------------------------------------------------------- 6c34824434a67baa34e4ee2ddb753708eb61c5bc compiler/codeGen/StgCmmClosure.hs | 11 ++--- compiler/iface/BuildTyCl.hs | 15 +----- compiler/prelude/TysWiredIn.hs | 65 ++++++++++++-------------- compiler/types/TyCon.hs | 48 ++++++++++--------- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 8 +++- 6 files changed, 69 insertions(+), 82 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6c34824434a67baa34e4ee2ddb753708eb61c5bc From git at git.haskell.org Thu Jan 4 17:01:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 17:01:38 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: "ds" is the suspect (b30d61f) Message-ID: <20180104170138.93E673A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/b30d61f64772d744e06e2acbab21895cb20d9bf7/ghc >--------------------------------------------------------------- commit b30d61f64772d744e06e2acbab21895cb20d9bf7 Author: Gabor Greif Date: Thu Jan 4 14:17:02 2018 +0100 WIP: "ds" is the suspect let's see what happens for /= "ds"... >--------------------------------------------------------------- b30d61f64772d744e06e2acbab21895cb20d9bf7 compiler/codeGen/StgCmmClosure.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 089e3a4..ef03eee 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -626,13 +626,24 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function -getCallMethod _ _name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info +getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id , OtherCon _ <- idUnfolding id - -- , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + , let str = occNameString (nameOccName name) + , take 4 str == "wild" || take 2 str == "ds" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + , take 4 str == "wild" || take 2 str == "ds" = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already + + + + +{- + , head str /= '$' + -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ text str $$ ppr (idUnfolding id)) True +-} {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust From git at git.haskell.org Thu Jan 4 17:41:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 17:41:02 +0000 (UTC) Subject: [commit: ghc] master: Stop double-stacktrace in ASSERT failures (e2998d7) Message-ID: <20180104174102.C15553A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2998d720c6b6bf72c86201d816f256a8ba704e6/ghc >--------------------------------------------------------------- commit e2998d720c6b6bf72c86201d816f256a8ba704e6 Author: Simon Peyton Jones Date: Thu Jan 4 16:12:39 2018 +0000 Stop double-stacktrace in ASSERT failures We were getting the stack trace printed twice in assertion failures (e.g. see the Description of Trac #14552). This fixes it, by deleting code. (c.f. Trac #14635 which reports the same bug in documentation). >--------------------------------------------------------------- e2998d720c6b6bf72c86201d816f256a8ba704e6 compiler/utils/Outputable.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 3050fa1..793b8fb 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -1203,9 +1203,7 @@ warnPprTrace True file line msg x -- line number. Should typically be accessed with the ASSERT family of macros assertPprPanic :: HasCallStack => String -> Int -> SDoc -> a assertPprPanic _file _line msg - = pprPanic "ASSERT failed!" doc - where - doc = sep [ msg, callStackDoc ] + = pprPanic "ASSERT failed!" msg pprDebugAndThen :: DynFlags -> (String -> a) -> SDoc -> SDoc -> a pprDebugAndThen dflags cont heading pretty_msg From git at git.haskell.org Thu Jan 4 17:41:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 17:41:06 +0000 (UTC) Subject: [commit: ghc] master: Drop dead Given bindings in setImplicationStatus (954cbc7) Message-ID: <20180104174106.A8DDB3A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/954cbc7c106a20639960f55ebb85c5c972652d41/ghc >--------------------------------------------------------------- commit 954cbc7c106a20639960f55ebb85c5c972652d41 Author: Simon Peyton Jones Date: Thu Jan 4 12:32:13 2018 +0000 Drop dead Given bindings in setImplicationStatus Trac #13032 pointed out that we sometimes generate unused bindings for Givens, and (worse still) we can't always discard them later (we don't drop a case binding unless we can prove that the scrutinee is non-bottom. It looks as if this may be a major reason for the performace problems in #14338 (see comment:29). This patch fixes the problem at source, by pruning away all the dead Givens. See Note [Delete dead Given evidence bindings] Remarkably, compiler allocation falls by 23% in perf/compiler/T12227! I have not confirmed whether this change actualy helps with >--------------------------------------------------------------- 954cbc7c106a20639960f55ebb85c5c972652d41 compiler/basicTypes/VarEnv.hs | 5 +- compiler/typecheck/TcEvidence.hs | 7 +- compiler/typecheck/TcInstDcls.hs | 33 ++- compiler/typecheck/TcRnMonad.hs | 6 +- compiler/typecheck/TcRnTypes.hs | 46 +++- compiler/typecheck/TcSMonad.hs | 36 ++- compiler/typecheck/TcSimplify.hs | 247 ++++++++++++--------- compiler/typecheck/TcUnify.hs | 17 +- .../indexed-types/should_compile/T7837.stderr | 1 - testsuite/tests/perf/compiler/all.T | 3 +- .../tests/simplCore/should_compile/T4398.stderr | 18 +- testsuite/tests/typecheck/should_compile/T13032.hs | 12 + .../tests/typecheck/should_compile/T13032.stderr | 20 ++ testsuite/tests/typecheck/should_compile/all.T | 1 + 14 files changed, 270 insertions(+), 182 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 954cbc7c106a20639960f55ebb85c5c972652d41 From git at git.haskell.org Thu Jan 4 17:41:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 17:41:09 +0000 (UTC) Subject: [commit: ghc] master: comments only (86ea3b1) Message-ID: <20180104174109.A6C503A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/86ea3b1e261ad59dfa7ac13d422a4d657dc83e92/ghc >--------------------------------------------------------------- commit 86ea3b1e261ad59dfa7ac13d422a4d657dc83e92 Author: Simon Peyton Jones Date: Thu Jan 4 16:14:56 2018 +0000 comments only >--------------------------------------------------------------- 86ea3b1e261ad59dfa7ac13d422a4d657dc83e92 compiler/typecheck/TcFlatten.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index c4fc1df..bb7bb06 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -64,7 +64,7 @@ Note [The flattening story] fmv ~ Int we NEVER unify fmv. - - A unification flatten-skolems, fmv, ONLY gets unified when either + - A unification flatten-skolem, fmv, ONLY gets unified when either a) The CFunEqCan takes a step, using an axiom b) By unflattenWanteds They are never unified in any other form of equality. From git at git.haskell.org Thu Jan 4 17:41:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 17:41:13 +0000 (UTC) Subject: [commit: ghc] master: Fix deep, dark corner of pattern synonyms (307d1df) Message-ID: <20180104174113.52D833A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/307d1dfe1d705379eafad6dba65e651ae3465cda/ghc >--------------------------------------------------------------- commit 307d1dfe1d705379eafad6dba65e651ae3465cda Author: Simon Peyton Jones Date: Thu Jan 4 17:18:15 2018 +0000 Fix deep, dark corner of pattern synonyms Trac #14552 showed a very obscure case where we can't infer a good pattern-synonym type. The error message is horrible, but at least we no longer crash and burn. >--------------------------------------------------------------- 307d1dfe1d705379eafad6dba65e651ae3465cda compiler/typecheck/TcPatSyn.hs | 50 ++++++++++++++++++++++++ testsuite/tests/patsyn/should_fail/T14552.hs | 43 ++++++++++++++++++++ testsuite/tests/patsyn/should_fail/T14552.stderr | 9 +++++ testsuite/tests/patsyn/should_fail/all.T | 1 + 4 files changed, 103 insertions(+) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 7e21af5..0086a83 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -91,6 +91,12 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, univ_tvs = filterOut (`elemVarSet` ex_tv_set) qtvs req_theta = map evVarPred req_dicts + -- See Note [Type variables whose kind is captured] + ; let bad_tvs = [ tv | tv <- univ_tvs + , tyCoVarsOfType (tyVarKind tv) + `intersectsVarSet` ex_tv_set ] + ; mapM_ (badUnivTv ex_tvs) bad_tvs + ; prov_dicts <- mapM zonkId prov_dicts ; let filtered_prov_dicts = mkMinimalBySCs evVarPred prov_dicts prov_theta = map evVarPred filtered_prov_dicts @@ -105,6 +111,19 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, (map nlHsVar args, map idType args) pat_ty rec_fields } +badUnivTv :: [TyVar] -> TyVar -> TcM () +badUnivTv ex_tvs bad_tv + = addErrTc $ + vcat [ text "Universal type variable" <+> quotes (ppr bad_tv) + <+> text "has existentially bound kind:" + , nest 2 (ppr_with_kind bad_tv) + , hang (text "Existentially-bound variables:") + 2 (vcat (map ppr_with_kind ex_tvs)) + , text "Probable fix: give the pattern synoym a type signature" + ] + where + ppr_with_kind tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv) + {- Note [Remove redundant provided dicts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Recall that @@ -126,6 +145,37 @@ Similarly consider The pattern (Bam x y) binds two (Ord a) dictionaries, but we only need one. Agian mkMimimalWithSCs removes the redundant one. + +Note [Type variables whose kind is captured] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data AST a = Sym [a] + class Prj s where { prj :: [a] -> Maybe (s a) + pattern P x <= Sym (prj -> Just x) + +Here we get a matcher with this type + $mP :: forall s a. Prj s => AST a -> (s a -> r) -> r -> r + +No problem. But note that 's' is not fixed by the type of the +pattern (AST a), nor is it existentially bound. It's really only +fixed by the type of the continuation. + +Trac #14552 showed that this can go wrong if the kind of 's' mentions +existentially bound variables. We obviously can't make a type like + $mP :: forall (s::k->*) a. Prj s => AST a -> (forall k. s a -> r) + -> r -> r +But neither is 's' itself existentially bound, so the forall (s::k->*) +can't go in the inner forall either. (What would the matcher apply +the continuation to?) + +So we just fail in this case, with a pretty terrible error message. +Maybe we could do better, but I can't see how. (It'd be possible to +default 's' to (Any k), but that probably isn't what the user wanted, +and it not straightforward to implement, because by the time we see +the problem, simplifyInfer has already skolemised 's'.) + +This stuff can only happen in the presence of view patterns, with +TypeInType, so it's a bit of a corner case. -} tcCheckPatSynDecl :: PatSynBind GhcRn GhcRn diff --git a/testsuite/tests/patsyn/should_fail/T14552.hs b/testsuite/tests/patsyn/should_fail/T14552.hs new file mode 100644 index 0000000..77f0857 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14552.hs @@ -0,0 +1,43 @@ +{-# Language RankNTypes, ViewPatterns, PatternSynonyms, TypeOperators, ScopedTypeVariables, + KindSignatures, PolyKinds, DataKinds, TypeFamilies, TypeInType, GADTs #-} + +module T14552 where + +import Data.Kind +import Data.Proxy + +data family Sing a + +type a --> b = (a, b) -> Type + +type family F (f::a --> b) (x::a) :: b + +newtype Limit :: (k --> Type) -> Type where + Limit :: (forall xx. Proxy xx -> F f xx) -> Limit f + +data Exp :: [Type] -> Type -> Type where + TLam :: (forall aa. Proxy aa -> Exp xs (F w aa)) + -> Exp xs (Limit w) + +pattern FOO f <- TLam (($ Proxy) -> f) + + +{- +TLam :: forall (xs::[Type]) (b::Type). -- Universal + forall k (w :: k --> Type). -- Existential + (b ~ Limit w) => + => (forall (aa :: k). Proxy aa -> Exp xs (F w aa)) + -> Exp xs b + +-} + +{- +mfoo :: Exp xs b + -> (forall k (w :: k --> Type). + (b ~ Limit w) + => Exp xs (F w aa) + -> r) + -> r +mfoo scrut k = case srcut of + TLam g -> k (g Proxy) +-} diff --git a/testsuite/tests/patsyn/should_fail/T14552.stderr b/testsuite/tests/patsyn/should_fail/T14552.stderr new file mode 100644 index 0000000..1ead644 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14552.stderr @@ -0,0 +1,9 @@ + +T14552.hs:22:9: error: + • Universal type variable ‘aa’ has existentially bound kind: + aa :: k + Existentially-bound variables: + k :: * + w :: k --> * + Probable fix: give the pattern synoym a type signature + • In the declaration for pattern synonym ‘FOO’ diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 4bf631f..d2985d5 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -40,3 +40,4 @@ test('T14112', normal, compile_fail, ['']) test('T14114', normal, compile_fail, ['']) test('T14380', normal, compile_fail, ['']) test('T14498', normal, compile_fail, ['']) +test('T14552', normal, compile_fail, ['']) From git at git.haskell.org Thu Jan 4 21:36:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 21:36:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14618 by applying a subst in deeplyInstantiate (1779e3b) Message-ID: <20180104213607.103E03A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/1779e3bf4876d8ac46657275e5f0f2ee6877a5c9/ghc >--------------------------------------------------------------- commit 1779e3bf4876d8ac46657275e5f0f2ee6877a5c9 Author: Richard Eisenberg Date: Tue Dec 26 14:23:40 2017 -0500 Fix #14618 by applying a subst in deeplyInstantiate Previously, we were inexplicably not applying an instantiating substitution to arguments in non-prenex types. It's amazing this has been around for so long! I guess there aren't a lot of non-prenex types around. test case: typecheck/should_fail/T14618 (cherry picked from commit 722a6584bb338bc77ad978d14113b3b8e6a45cab) >--------------------------------------------------------------- 1779e3bf4876d8ac46657275e5f0f2ee6877a5c9 compiler/typecheck/Inst.hs | 7 ++++--- testsuite/tests/typecheck/should_fail/T14618.hs | 11 +++++++++++ .../tests/typecheck/should_fail/T14618.stderr | 23 ++++++++++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 39 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 6d656fe..9da96c4 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -257,8 +257,9 @@ deeply_instantiate :: CtOrigin deeply_instantiate orig subst ty | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty = do { (subst', tvs') <- newMetaTyVarsX subst tvs - ; ids1 <- newSysLocalIds (fsLit "di") (substTys subst' arg_tys) - ; let theta' = substTheta subst' theta + ; let arg_tys' = substTys subst' arg_tys + theta' = substTheta subst' theta + ; ids1 <- newSysLocalIds (fsLit "di") arg_tys' ; wrap1 <- instCall orig (mkTyVarTys tvs') theta' ; traceTc "Instantiating (deeply)" (vcat [ text "origin" <+> pprCtOrigin orig , text "type" <+> ppr ty @@ -271,7 +272,7 @@ deeply_instantiate orig subst ty <.> wrap2 <.> wrap1 <.> mkWpEvVarApps ids1, - mkFunTys arg_tys rho2) } + mkFunTys arg_tys' rho2) } | otherwise = do { let ty' = substTy subst ty diff --git a/testsuite/tests/typecheck/should_fail/T14618.hs b/testsuite/tests/typecheck/should_fail/T14618.hs new file mode 100644 index 0000000..da30d7a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RankNTypes #-} + +module T14618 where + +safeCoerce :: a -> b +safeCoerce = f' + where + f :: d -> forall c. d + f x = x + + f' = f diff --git a/testsuite/tests/typecheck/should_fail/T14618.stderr b/testsuite/tests/typecheck/should_fail/T14618.stderr new file mode 100644 index 0000000..8faa64c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.stderr @@ -0,0 +1,23 @@ + +T14618.hs:6:14: error: + • Couldn't match type ‘a’ with ‘b’ + ‘a’ is a rigid type variable bound by + the type signature for: + safeCoerce :: forall a b. a -> b + at T14618.hs:5:1-20 + ‘b’ is a rigid type variable bound by + the type signature for: + safeCoerce :: forall a b. a -> b + at T14618.hs:5:1-20 + Expected type: a -> b + Actual type: b -> b + • In the expression: f' + In an equation for ‘safeCoerce’: + safeCoerce + = f' + where + f :: d -> forall c. d + f x = x + f' = f + • Relevant bindings include + safeCoerce :: a -> b (bound at T14618.hs:6:1) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 553e10a..b1a0e75 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -462,3 +462,4 @@ test('T14325', normal, compile_fail, ['']) test('T14350', normal, compile_fail, ['']) test('T14390', normal, compile_fail, ['']) test('MissingExportList03', normal, compile_fail, ['']) +test('T14618', normal, compile_fail, ['']) From git at git.haskell.org Thu Jan 4 21:36:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 21:36:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Make System.IO.openTempFile thread-safe on Windows (2fc621d) Message-ID: <20180104213609.CFD3C3A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/2fc621df9200475c471cb62a0c30ce4eae2d1dcd/ghc >--------------------------------------------------------------- commit 2fc621df9200475c471cb62a0c30ce4eae2d1dcd Author: Tamar Christina Date: Tue Jan 2 16:02:49 2018 -0500 Make System.IO.openTempFile thread-safe on Windows This calls out to the Win32 API `GetTempFileName` to generate a temporary file. Using `uUnique = 0` guarantees that the file we get back is unique and the file is "reserved" by creating it. Test Plan: ./validate I can't think of any sensible tests that shouldn't run for a while to verify. So the example in #10731 was ran for a while and no collisions in new code Reviewers: hvr, bgamari, erikd Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #10731 Differential Revision: https://phabricator.haskell.org/D4278 (cherry picked from commit 46287af0911f7cb446c62850630f85af567ac512) >--------------------------------------------------------------- 2fc621df9200475c471cb62a0c30ce4eae2d1dcd libraries/base/System/IO.hs | 96 +++++++++++++++++++++++++-------------- libraries/base/cbits/Win32Utils.c | 43 ++++++++++++++++++ libraries/base/changelog.md | 3 ++ 3 files changed, 109 insertions(+), 33 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2fc621df9200475c471cb62a0c30ce4eae2d1dcd From git at git.haskell.org Thu Jan 4 21:36:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Jan 2018 21:36:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14608 by restoring an unboxed tuple check (ec6af9c) Message-ID: <20180104213613.476C73A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/ec6af9c49ba86d1cd7fa85527bcb97c605f2fd39/ghc >--------------------------------------------------------------- commit ec6af9c49ba86d1cd7fa85527bcb97c605f2fd39 Author: Ryan Scott Date: Tue Jan 2 16:03:08 2018 -0500 Fix #14608 by restoring an unboxed tuple check Commit 714bebff44076061d0a719c4eda2cfd213b7ac3d removed a check in the bytecode compiler that caught illegal uses of unboxed tuples (and now sums) in case alternatives, which causes the program in #14608 to panic. This restores the check (using modern, levity-polymorphic vocabulary). Test Plan: make test TEST=T14608 Reviewers: hvr, bgamari, dfeuer, simonpj Reviewed By: dfeuer, simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14608 Differential Revision: https://phabricator.haskell.org/D4276 (cherry picked from commit ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee) >--------------------------------------------------------------- ec6af9c49ba86d1cd7fa85527bcb97c605f2fd39 compiler/ghci/ByteCodeGen.hs | 5 +++++ testsuite/tests/ghci/should_fail/T14608.hs | 7 +++++++ testsuite/tests/ghci/should_fail/T14608.script | 1 + testsuite/tests/ghci/should_fail/T14608.stderr | 3 +++ testsuite/tests/ghci/should_fail/all.T | 1 + 5 files changed, 17 insertions(+) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 697dc63..d537080 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -962,6 +962,11 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple | null real_bndrs = do rhs_code <- schemeE d_alts s p_alts rhs return (my_discr alt, rhs_code) + -- If an alt attempts to match on an unboxed tuple or sum, we must + -- bail out, as the bytecode compiler can't handle them. + -- (See Trac #14608.) + | any (\bndr -> typePrimRep (idType bndr) `lengthExceeds` 1) bndrs + = multiValException -- algebraic alt with some binders | otherwise = let (tot_wds, _ptrs_wds, args_offsets) = diff --git a/testsuite/tests/ghci/should_fail/T14608.hs b/testsuite/tests/ghci/should_fail/T14608.hs new file mode 100644 index 0000000..87d5617 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE UnboxedTuples #-} +module T14608 where + +data UnboxedTupleData = MkUTD (# (),() #) + +doThings :: UnboxedTupleData -> () +doThings (MkUTD t) = () diff --git a/testsuite/tests/ghci/should_fail/T14608.script b/testsuite/tests/ghci/should_fail/T14608.script new file mode 100644 index 0000000..c37a742 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.script @@ -0,0 +1 @@ +:load T14608.hs diff --git a/testsuite/tests/ghci/should_fail/T14608.stderr b/testsuite/tests/ghci/should_fail/T14608.stderr new file mode 100644 index 0000000..fe84063 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.stderr @@ -0,0 +1,3 @@ +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. diff --git a/testsuite/tests/ghci/should_fail/all.T b/testsuite/tests/ghci/should_fail/all.T index 58a396e..2851373 100644 --- a/testsuite/tests/ghci/should_fail/all.T +++ b/testsuite/tests/ghci/should_fail/all.T @@ -1,2 +1,3 @@ test('T10549', [], ghci_script, ['T10549.script']) test('T10549a', [], ghci_script, ['T10549a.script']) +test('T14608', [], ghci_script, ['T14608.script']) From git at git.haskell.org Fri Jan 5 09:46:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 09:46:57 +0000 (UTC) Subject: [commit: ghc] master: Improve pretty-printing for pattern synonyms (c732711) Message-ID: <20180105094657.334153A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c73271163a3a025f0d1d49bcd6fa7763892dfb48/ghc >--------------------------------------------------------------- commit c73271163a3a025f0d1d49bcd6fa7763892dfb48 Author: Simon Peyton Jones Date: Fri Jan 5 09:11:32 2018 +0000 Improve pretty-printing for pattern synonyms Just better layout in output for the user >--------------------------------------------------------------- c73271163a3a025f0d1d49bcd6fa7763892dfb48 compiler/iface/IfaceSyn.hs | 12 +++++---- testsuite/tests/ghci/scripts/T11524a.stdout | 31 +++++++++++++--------- .../tests/patsyn/should_compile/T14394.stdout | 7 +++-- 3 files changed, 31 insertions(+), 19 deletions(-) diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index ac988c2..9afd2b8 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -862,11 +862,13 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name, = sdocWithDynFlags mk_msg where mk_msg dflags - = hsep [ text "pattern", pprPrefixOcc name, dcolon - , univ_msg, pprIfaceContextArr req_ctxt - , ppWhen insert_empty_ctxt $ parens empty <+> darrow - , ex_msg, pprIfaceContextArr prov_ctxt - , pprIfaceType $ foldr IfaceFunTy pat_ty arg_tys] + = hang (text "pattern" <+> pprPrefixOcc name) + 2 (dcolon <+> sep [univ_msg + , pprIfaceContextArr req_ctxt + , ppWhen insert_empty_ctxt $ parens empty <+> darrow + , ex_msg + , pprIfaceContextArr prov_ctxt + , pprIfaceType $ foldr IfaceFunTy pat_ty arg_tys ]) where univ_msg = pprUserIfaceForAll univ_bndrs ex_msg = pprUserIfaceForAll ex_bndrs diff --git a/testsuite/tests/ghci/scripts/T11524a.stdout b/testsuite/tests/ghci/scripts/T11524a.stdout index d1ab96e..ea91ef9 100644 --- a/testsuite/tests/ghci/scripts/T11524a.stdout +++ b/testsuite/tests/ghci/scripts/T11524a.stdout @@ -6,13 +6,13 @@ pattern Pu :: p -> p -- Defined at :18:1 pattern Pue :: a -> a1 -> (a, Ex) -- Defined at :19:1 pattern Pur :: (Eq a, Num a) => a -> [a] -- Defined at :20:1 -pattern Purp :: (Eq a, Num a) => Show a1 => a - -> a1 -> ([a], UnivProv a1) +pattern Purp + :: (Eq a, Num a) => Show a1 => a -> a1 -> ([a], UnivProv a1) -- Defined at :21:1 pattern Pure :: (Eq a, Num a) => a -> a1 -> ([a], Ex) -- Defined at :22:1 -pattern Purep :: (Eq a, Num a) => Show a1 => a - -> a1 -> ([a], ExProv) +pattern Purep + :: (Eq a, Num a) => Show a1 => a -> a1 -> ([a], ExProv) -- Defined at :23:1 pattern Pep :: () => Show a => a -> ExProv -- Defined at :24:1 @@ -31,19 +31,26 @@ pattern Pue :: forall {a}. () => forall {a1}. a -> a1 -> (a, Ex) -- Defined at :19:1 pattern Pur :: forall {a}. (Eq a, Num a) => a -> [a] -- Defined at :20:1 -pattern Purp :: forall {a} {a1}. (Eq a, Num a) => Show a1 => a - -> a1 -> ([a], UnivProv a1) +pattern Purp + :: forall {a} {a1}. + (Eq a, Num a) => + Show a1 => + a -> a1 -> ([a], UnivProv a1) -- Defined at :21:1 -pattern Pure :: forall {a}. (Eq a, Num a) => forall {a1}. a - -> a1 -> ([a], Ex) +pattern Pure + :: forall {a}. (Eq a, Num a) => forall {a1}. a -> a1 -> ([a], Ex) -- Defined at :22:1 -pattern Purep :: forall {a}. (Eq a, Num a) => forall {a1}. Show - a1 => a -> a1 -> ([a], ExProv) +pattern Purep + :: forall {a}. + (Eq a, Num a) => + forall {a1}. + Show a1 => + a -> a1 -> ([a], ExProv) -- Defined at :23:1 pattern Pep :: () => forall {a}. Show a => a -> ExProv -- Defined at :24:1 pattern Pup :: forall {a}. () => Show a => a -> UnivProv a -- Defined at :25:1 -pattern Puep :: forall {b}. () => forall {a}. Show a => a - -> b -> (ExProv, b) +pattern Puep + :: forall {b}. () => forall {a}. Show a => a -> b -> (ExProv, b) -- Defined at :26:1 diff --git a/testsuite/tests/patsyn/should_compile/T14394.stdout b/testsuite/tests/patsyn/should_compile/T14394.stdout index 2dc3415..6495f9e 100644 --- a/testsuite/tests/patsyn/should_compile/T14394.stdout +++ b/testsuite/tests/patsyn/should_compile/T14394.stdout @@ -1,7 +1,10 @@ pattern Foo :: () => (b ~ a) => a :~~: b -- Defined at :5:1 -pattern Bar :: forall k2 k1 (a :: k1) (b :: k2). () => (k2 ~ k1, - (b :: k2) ~~ (a :: k1)) => a :~~: b +pattern Bar + :: forall k2 k1 (a :: k1) (b :: k2). + () => + (k2 ~ k1, (b :: k2) ~~ (a :: k1)) => + a :~~: b -- Defined at :11:1 pattern Bam :: () => Ord a => a -> a -> (S a, S a) -- Defined at :21:1 From git at git.haskell.org Fri Jan 5 09:47:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 09:47:00 +0000 (UTC) Subject: [commit: ghc] master: Fix another obscure pattern-synonym crash (40cbab9) Message-ID: <20180105094700.ABF953A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/40cbab9afe52fbc780310e880912b56370065a62/ghc >--------------------------------------------------------------- commit 40cbab9afe52fbc780310e880912b56370065a62 Author: Simon Peyton Jones Date: Fri Jan 5 09:12:49 2018 +0000 Fix another obscure pattern-synonym crash This one, discovered by Iceland Jack (Trac #14507), shows that a pattern-bound coercion can show up in the argument type(s) of the matcher of a pattern synonym. The error message isn't great, but at least we now rightly reject the program. >--------------------------------------------------------------- 40cbab9afe52fbc780310e880912b56370065a62 compiler/typecheck/TcPatSyn.hs | 69 +++++++++++++++++++++--- testsuite/tests/patsyn/should_fail/T14507.hs | 19 +++++++ testsuite/tests/patsyn/should_fail/T14507.stderr | 8 +++ testsuite/tests/patsyn/should_fail/all.T | 1 + 4 files changed, 90 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 0086a83..b89c4be 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -91,16 +91,26 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, univ_tvs = filterOut (`elemVarSet` ex_tv_set) qtvs req_theta = map evVarPred req_dicts + ; prov_dicts <- mapM zonkId prov_dicts + ; let filtered_prov_dicts = mkMinimalBySCs evVarPred prov_dicts + prov_theta = map evVarPred filtered_prov_dicts + -- Filtering: see Note [Remove redundant provided dicts] + + -- Report bad universal type variables -- See Note [Type variables whose kind is captured] ; let bad_tvs = [ tv | tv <- univ_tvs , tyCoVarsOfType (tyVarKind tv) `intersectsVarSet` ex_tv_set ] - ; mapM_ (badUnivTv ex_tvs) bad_tvs + ; mapM_ (badUnivTvErr ex_tvs) bad_tvs - ; prov_dicts <- mapM zonkId prov_dicts - ; let filtered_prov_dicts = mkMinimalBySCs evVarPred prov_dicts - prov_theta = map evVarPred filtered_prov_dicts - -- Filtering: see Note [Remove redundant provided dicts] + -- Report coercions that esacpe + -- See Note [Coercions that escape] + ; args <- mapM zonkId args + ; let bad_args = [ (arg, bad_cos) | arg <- args ++ prov_dicts + , let bad_cos = filterDVarSet isId $ + (tyCoVarsOfTypeDSet (idType arg)) + , not (isEmptyDVarSet bad_cos) ] + ; mapM_ dependentArgErr bad_args ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs) ; tc_patsyn_finish lname dir is_infix lpat' @@ -111,8 +121,9 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, (map nlHsVar args, map idType args) pat_ty rec_fields } -badUnivTv :: [TyVar] -> TyVar -> TcM () -badUnivTv ex_tvs bad_tv +badUnivTvErr :: [TyVar] -> TyVar -> TcM () +-- See Note [Type variables whose kind is captured] +badUnivTvErr ex_tvs bad_tv = addErrTc $ vcat [ text "Universal type variable" <+> quotes (ppr bad_tv) <+> text "has existentially bound kind:" @@ -124,6 +135,22 @@ badUnivTv ex_tvs bad_tv where ppr_with_kind tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv) +dependentArgErr :: (Id, DTyCoVarSet) -> TcM () +-- See Note [Coercions that escape] +dependentArgErr (arg, bad_cos) + = addErrTc $ + vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" + , hang (text "Pattern-bound variable") + 2 (ppr arg <+> dcolon <+> ppr (idType arg)) + , nest 2 $ + hang (text "has a type that mentions pattern-bound coercion" + <> plural bad_co_list <> colon) + 2 (pprWithCommas ppr bad_co_list) + , text "Hint: use -fprint-explicit-coercions to see the coercions" + , text "Probable fix: add a pattern signature" ] + where + bad_co_list = dVarSetElems bad_cos + {- Note [Remove redundant provided dicts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Recall that @@ -176,6 +203,34 @@ the problem, simplifyInfer has already skolemised 's'.) This stuff can only happen in the presence of view patterns, with TypeInType, so it's a bit of a corner case. + +Note [Coercions that escape] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Trac #14507 showed an example where the inferred type of the matcher +for the pattern synonym was somethign like + $mSO :: forall (r :: TYPE rep) kk (a :: k). + TypeRep k a + -> ((Bool ~ k) => TypeRep Bool (a |> co_a2sv) -> r) + -> (Void# -> r) + -> r + +What is that co_a2sv :: Bool ~# *?? It was bound (via a superclass +selection) by the pattern being matched; and indeed it is implicit in +the context (Bool ~ k). You could imagine trying to extract it like +this: + $mSO :: forall (r :: TYPE rep) kk (a :: k). + TypeRep k a + -> ( co :: ((Bool :: *) ~ (k :: *)) => + let co_a2sv = sc_sel co + in TypeRep Bool (a |> co_a2sv) -> r) + -> (Void# -> r) + -> r + +But we simply don't allow that in types. Maybe one day but not now. + +How to detect this situation? We just look for free coercion variables +in the types of any of the arguments to the matcher. The error message +is not very helpful, but at least we don't get a Lint error. -} tcCheckPatSynDecl :: PatSynBind GhcRn GhcRn diff --git a/testsuite/tests/patsyn/should_fail/T14507.hs b/testsuite/tests/patsyn/should_fail/T14507.hs new file mode 100644 index 0000000..84166d0 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14507.hs @@ -0,0 +1,19 @@ +{-# Language PatternSynonyms, ViewPatterns, GADTs, ConstraintKinds, RankNTypes, KindSignatures, PolyKinds, ScopedTypeVariables, DataKinds, TypeInType, TypeOperators, TypeApplications, TypeFamilies, TypeFamilyDependencies #-} + +module T14507 where + +import Type.Reflection +import Data.Kind + +foo :: TypeRep a -> (Bool :~~: k, TypeRep a) +foo rep = error "urk" + +type family SING :: k -> Type where + SING = (TypeRep :: Bool -> Type) + +pattern RepN :: forall (a::kk). () => Bool~kk => SING a -> TypeRep (a::kk) +pattern RepN tr <- (foo -> ( HRefl :: Bool:~~:kk + , tr :: TypeRep (a::Bool))) + +pattern SO x <- RepN (id -> x) + diff --git a/testsuite/tests/patsyn/should_fail/T14507.stderr b/testsuite/tests/patsyn/should_fail/T14507.stderr new file mode 100644 index 0000000..2ed89cb --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14507.stderr @@ -0,0 +1,8 @@ + +T14507.hs:18:9: error: + • Iceland Jack! Iceland Jack! Stop torturing me! + Pattern-bound variable x :: TypeRep a + has a type that mentions pattern-bound coercion: co_a2CF + Hint: use -fprint-explicit-coercions to see the coercions + Probable fix: add a pattern signature + • In the declaration for pattern synonym ‘SO’ diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index d2985d5..2b3b85b 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -41,3 +41,4 @@ test('T14114', normal, compile_fail, ['']) test('T14380', normal, compile_fail, ['']) test('T14498', normal, compile_fail, ['']) test('T14552', normal, compile_fail, ['']) +test('T14507', normal, compile_fail, ['']) From git at git.haskell.org Fri Jan 5 17:18:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 17:18:06 +0000 (UTC) Subject: [commit: ghc] wip/float-join-points: More Wip on floating join points (6b7ae18) Message-ID: <20180105171806.1F99F3A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/float-join-points Link : http://ghc.haskell.org/trac/ghc/changeset/6b7ae187bdb8de9f62988c062876bae9952da442/ghc >--------------------------------------------------------------- commit 6b7ae187bdb8de9f62988c062876bae9952da442 Author: Simon Peyton Jones Date: Fri Jan 5 09:16:43 2018 +0000 More Wip on floating join points >--------------------------------------------------------------- 6b7ae187bdb8de9f62988c062876bae9952da442 compiler/coreSyn/CoreFVs.hs | 4 ++-- compiler/simplCore/SetLevels.hs | 4 +++- compiler/simplCore/SimplUtils.hs | 18 +++++++++++---- compiler/types/TyCoRep.hs | 45 ++++++++++++++++++++++++++++++++++---- compiler/types/Type.hs | 47 ---------------------------------------- compiler/types/Type.hs-boot | 4 ---- compiler/utils/FV.hs | 45 ++++++++++++++++++++++++++++++++++++++ 7 files changed, 105 insertions(+), 62 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6b7ae187bdb8de9f62988c062876bae9952da442 From git at git.haskell.org Fri Jan 5 17:18:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 17:18:09 +0000 (UTC) Subject: [commit: ghc] wip/float-join-points: Wip on floating join points (68ccfbd) Message-ID: <20180105171809.0EABF3A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/float-join-points Link : http://ghc.haskell.org/trac/ghc/changeset/68ccfbd60c7bca7a3fc2b1918b5e78b1c85e6014/ghc >--------------------------------------------------------------- commit 68ccfbd60c7bca7a3fc2b1918b5e78b1c85e6014 Author: Simon Peyton Jones Date: Fri Oct 27 16:20:24 2017 +0100 Wip on floating join points >--------------------------------------------------------------- 68ccfbd60c7bca7a3fc2b1918b5e78b1c85e6014 compiler/basicTypes/BasicTypes.hs | 5 +- compiler/basicTypes/Id.hs | 19 ++++- compiler/coreSyn/CoreFVs.hs | 30 ++++---- compiler/main/DynFlags.hs | 3 + compiler/simplCore/CoreMonad.hs | 17 +++-- compiler/simplCore/SetLevels.hs | 17 ++--- compiler/simplCore/SimplCore.hs | 16 ++-- compiler/simplCore/SimplEnv.hs | 45 ++++++++++-- compiler/simplCore/SimplUtils.hs | 150 +++++++++++++++++++++++--------------- compiler/simplCore/Simplify.hs | 96 +++++++++++++++++------- compiler/types/TyCoRep.hs | 23 +++--- compiler/types/Type.hs | 8 +- 12 files changed, 281 insertions(+), 148 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 68ccfbd60c7bca7a3fc2b1918b5e78b1c85e6014 From git at git.haskell.org Fri Jan 5 17:18:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 17:18:11 +0000 (UTC) Subject: [commit: ghc] wip/float-join-points: Allow joins to float to top level (9b522eb) Message-ID: <20180105171811.D18AD3A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/float-join-points Link : http://ghc.haskell.org/trac/ghc/changeset/9b522eba9829ea9ab0fb6d4d0b4cc762d1d0fd91/ghc >--------------------------------------------------------------- commit 9b522eba9829ea9ab0fb6d4d0b4cc762d1d0fd91 Author: Simon Peyton Jones Date: Fri Jan 5 17:14:56 2018 +0000 Allow joins to float to top level >--------------------------------------------------------------- 9b522eba9829ea9ab0fb6d4d0b4cc762d1d0fd91 compiler/simplCore/SetLevels.hs | 44 ++++++++++++++++++++++------------------- compiler/simplCore/Simplify.hs | 1 - 2 files changed, 24 insertions(+), 21 deletions(-) diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 4074d70..f0c9063 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -1026,12 +1026,7 @@ lvlBind :: LevelEnv -> LvlM (LevelledBind, LevelEnv) lvlBind env (AnnNonRec bndr rhs) - | isTyVar bndr -- Don't do anything for TyVar binders - -- (simplifier gets rid of them pronto) - || isCoVar bndr -- Difficult to fix up CoVar occurrences (see extendPolyLvlEnv) - -- so we will ignore this case for now - || isJoinId bndr - || not (profitableFloat env dest_lvl) + | not (profitableFloat env dest_lvl [bndr]) || (isTopLvl dest_lvl && not (exprIsTopLevelBindable deann_rhs bndr_ty)) -- We can't float an unlifted binding to top level (except -- literal strings), so we don't float it at all. It's a @@ -1061,12 +1056,12 @@ lvlBind env (AnnNonRec bndr rhs) ; return (NonRec (TB bndr2 (FloatMe dest_lvl)) rhs', env') } where - bndr_ty = idType bndr - ty_fvs = tyCoVarsOfType bndr_ty - rhs_fvs = freeVarsOf rhs - bind_fvs = rhs_fvs `unionDVarSet` dIdFreeVars bndr - abs_vars = abstractVars dest_lvl env bind_fvs - dest_lvl = destLevel env bind_fvs ty_fvs (isFunction rhs) is_bot is_join + bndr_ty = idType bndr + ty_fvs = tyCoVarsOfType bndr_ty + rhs_fvs = freeVarsOf rhs + bind_fvs = rhs_fvs `unionDVarSet` dIdFreeVars bndr + abs_vars = abstractVars dest_lvl env bind_fvs + dest_lvl = destLevel env bind_fvs ty_fvs (isFunction rhs) is_bot is_join deann_rhs = deAnnotate rhs mb_bot_str = exprBotStrictness_maybe deann_rhs @@ -1078,10 +1073,7 @@ lvlBind env (AnnNonRec bndr rhs) is_join = isJust mb_join_arity lvlBind env (AnnRec pairs) - | any isJoinId bndrs - || floatTopLvlOnly env && not (isTopLvl dest_lvl) - -- Only floating to the top level is allowed. - || not (profitableFloat env dest_lvl) + | not (profitableFloat env dest_lvl bndrs) = do { let bind_lvl = incMinorLvl (le_ctxt_lvl env) (env', bndrs') = substAndLvlBndrs Recursive env bind_lvl bndrs lvl_rhs (b,r) = lvlRhs env' Recursive is_bot (isJoinId_maybe b) r @@ -1162,11 +1154,23 @@ lvlBind env (AnnRec pairs) dest_lvl = destLevel env bind_fvs ty_fvs is_fun is_bot is_join abs_vars = abstractVars dest_lvl env bind_fvs -profitableFloat :: LevelEnv -> Level -> Bool -profitableFloat env dest_lvl - = (dest_lvl `ltMajLvl` le_ctxt_lvl env) -- Escapes a value lambda - || isTopLvl dest_lvl -- Going all the way to top level +profitableFloat :: LevelEnv -> Level -> [Id] -> Bool +profitableFloat env dest_lvl (bndr:_) + | isTyVar bndr -- Don't do anything for TyVar binders + -- (simplifier gets rid of them pronto) + || isCoVar bndr -- Difficult to fix up CoVar occurrences (see extendPolyLvlEnv) + -- so we will ignore this case for now + = False + + | isTopLvl dest_lvl + = True + + | otherwise + = not (isJoinId bndr) + && not (floatTopLvlOnly env) + && (dest_lvl `ltMajLvl` le_ctxt_lvl env) +profitableFloat _ _ [] = panic "profitableFloat" ---------------------------------------------------- -- Three help functions for the type-abstraction case diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 0d2b77f..19ada04 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -273,7 +273,6 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se (getOccFS bndr1) (idInfo bndr1) body1 ; let body_floats2 = body_floats1 `addLetFloats` let_floats - ; (rhs_floats, body3) <- floatLetBinds env top_lvl is_rec tvs' body_floats2 body2 From git at git.haskell.org Fri Jan 5 17:18:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 17:18:15 +0000 (UTC) Subject: [commit: ghc] wip/float-join-points's head updated: Allow joins to float to top level (9b522eb) Message-ID: <20180105171815.6D3343A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/float-join-points' now includes: 29ae833 Tidy up IfaceEqualityTyCon 1317ba6 Implement the EmptyDataDeriving proposal 1130c67 PPC NCG: Impl branch prediction, atomic ops. b0b80e9 Implement the basics of hex floating point literals e0df569 Use proper Unique for Name b938576 Add custom exception for fixIO 36f0cb7 TcRnDriver: Bracket family instance consistency output in -ddump-rn-trace cbd6a4d Introduce -dsuppress-stg-free-vars flag bd765f4 Fix atomicread/write operations d9b6015 Revert "Move check-ppr and check-api-annotations to testsuite/utils" 51321cf rts/PrimOps.cmm: add declaration for heapOverflow closure 4353756 CmmSink: Use a IntSet instead of a list 15f788f llvmGen: Pass vector arguments in vector registers by default eb37132 Bump haddock submodule 3c8e55c Name TypeRep constructor fields 19ca2ca Deserialize all function TypeReps 5d48f7c Fix documentation and comment issues df479f7 change example from msum to mfilter 436b3ef Clean up comments about match algorithm a bit. f6521e6 testsuite: Bump metrics of haddock.Cabal 4dfb790 rts/win32: Emit exception handler output to stderr 6f990c5 cmm/CBE: Fix comparison between blocks of different lengths a27056f cmm/CBE: Fix a few more zip uses 2ded536 Typo in glasgow_exts.rst 35642f4 Update ErrorCall documentation for the location argument 8613e61 DynFlags: Introduce -show-mods-loaded flag 59de290 Update autoconf test for gcc to require 4.7 and up 66b5b3e Specialise lcm :: Word -> Word -> Word (trac#14424) 275ac8e base: Add examples to Bifunctor documentation 7b0b9f6 Squashed 'hadrian/' content from commit 438dc57 5cee480 Merge commit '7b0b9f603bb1215e2b7af23c2404d637b95a4988' as 'hadrian' 0ff152c WIP on combining Step 1 and 3 of Trees That Grow 7d6fa32 Set up Linux, OSX and FreeBSD on CircleCI. b0cabc9 Set up AppVeyor, Windows CI. 6f665cc Sdist -> bindist -> tests 07e0d0d Revert "Sdist -> bindist -> tests" ed18f47 Factor out builds into steps. Address ghc/ghc#83 comments. ae7c33f testsuite: Bump haddock.compiler allocations 7d34f69 relnotes: Clarify a few things c1bc923 relnotes: Note enabling of -fllvm-pass-vectorse-in-regs 93b4820 Revert "WIP on combining Step 1 and 3 of Trees That Grow" 9f8dde0 Update link to Haskeline user preferences bf9ba7b base: Escape \ in CallStack example 14d885e Merge remote-tracking branch 'github/pr/83' 21970de Imrpove comments about equality types 30058b0 Fix another dark corner in the shortcut solver 2c2f3ce Minimise provided dictionaries in pattern synonyms fe6848f Fix in-scope set in simplifier 438dd1c WIP on Doing a combined Step 1 and 3 for Trees That Grow 803ed03 Invoke lintUnfolding only on top-level unfoldings (#14430) 6bd352a Remove left-overs from compareByteArray# inline conversion 10ff3e3 testsuite: Fix output of T14394 bdd2d28 Update Win32 version for GHC 8.4. 9773053 Merge initial Hadrian snapshot ce9a677 base: Add test for #14425 c59d6da base: Normalize style of approxRational 5834da4 base: Fix #14425 0656cb4 Update comment in GHC.Real (trac#14432) 6b52b4c Remove unreliable Core Lint empty case checks e6b13c9 testsuite: Add test for #5889 75291ab Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` f8e7fec Fix PPC NCG after blockID patch 5229c43 Squashed 'hadrian/' changes from 438dc576e7..5ebb69ae1e 506ba62 Merge commit '5229c43ccf77bcbffeced01dccb27398d017fa34' f11f252 Windows: Bump to GCC 7.2 for GHC 8.4 ba2ae2c Adds cmm-sources to base 426af53 Use LICENSE instead of ../LICENSE in the compiler.cabal file 5f158bc circleci: Bump down thread count 86c50a1 Declare proper spec version in `base.cabal` e3ec2e7 WIP on combined Step 1 and 3 for Trees That Grow, HsExpr 0a85190 Fix a TyVar bug in the flattener f570000 A bit more tc-tracing 47ad657 TTG3 Combined Step 1 and 3 for Trees That Grow f5dc8cc Add new mbmi and mbmi2 compiler flags 6dfe982 StaticPointers: Clarify documentation 5dea62f Adds rts/rts.cabal.in file 8b1020e RTS: Disable warnings in ffi.h ea26162 CLabel: Clean up unused label types 1aba27a CLabels: Remove CaseLabel 383016b Add dump flag for timing output d9f0c24 rts: Fix gc timing d0a641a Allow the rts lib to be called rts-1.0 3bed4aa Cabalify all the things e14945c Adjust AltCon Ord instance to match Core linter requirements. ec080ea users_guide: Fix "CancelSynchronousIo" casing c1fcd9b Squashed 'hadrian/' changes from 5ebb69a..fa3771f 07ac921 Pull recent Hadrian changes from upstream 2f46387 Detect overly long GC sync 2da7813 Document -ddump-timings c729734 configure: Fix incorrect quoting 12a7444 Adds -ghc-version flag to ghc. 835d8dd GHC.Prim use virtual-modules bb11a2d Relocatable GHC 74070bb Fix rts.cabal.in 912a72d Fix T4437 b8e324a base: Make documentation of atomically more accurate 7d16d8a Fix #elfi -> #elif; unbreak -Werror. ca3700a Rename ghc-version -> ghcversion-file 606bbc3 Stop generating make files when using hadrian. e66913d Bump hsc2hs submodule 25f36bd Bump haddock submodule ddded7e ghc-pkg: Add missing newlines to usage message 1b1ba9d rel-notes: Fix up formatting in release notes d213ee8 CircleCI: Disable artifact collection on OS X 66d1799 configure: Fix ar probed flags 0b20d9c base: Document GHC.Stack.CCS internals 314bc31 Revert "trees that grow" work 90a819b CircleCI: Add webhook for Harbormaster builds 2ca2259 Update ANNOUNCE 763ecac rts: Move libdwPrintBacktrace to public interface f376eba rts: Fix inconsistencies in how retainer and heap censuses are timed. 63e4ac3 Add warn-missing-export-lists 8a8a79a Update leftover reference to refer to [FunBind vs PatBind] dad9864 Remove hadrian sub-dir from .gitignore 0db4627 Test Trac #14488 bb2a08e testsuite: Add test for #14257 23116df cmm: Optimise remainders by powers of two eb5a40c base: Remove redundant subtraction in (^) and stimes 7a73a1c Bump stm submodule 2d1c671 ErrUtils: Refactor dump file logic c11f145 ErrUtils: Ensure timing dumps are always output on one line 360d740 Squashed 'hadrian/' changes from fa3771fe6b..4499b294e4 abdb555 Update Hadrian 341013e Revert "Add new mbmi and mbmi2 compiler flags" 5fdb858 Fix README 33cbc9f CircleCI: Perform nightly validation of unregisterised build 866f669 CircleCI: Try validating LLVM as well e2cc106 circleci: Build with Hadrian ad57e28 CircleCI: Install lbzip2 and patch 5e35627 rts/Printer: add closure name entries for small arrays (Fixes #14513) 30aa643 SysTools: Expand occurrences of $topdir anywhere in a Settings path 69cd1e9 SysTools: Split up TopDir logic into new module 599243e DynFlags: Expand $topdir in --info output 99089fc users-guide: Fix :default: placement f209e66 base: fdReady(): Fix timeouts > ~49 days overflowing. Fixes #14262. a1950e6 CircleCI: Reenable artifact collection on Darwin 471d677 Don't complain about UNPACK in -fno-code. 6282366 Follow symlinks in the Win32 code for System.Environment.getExecutablePath b241d6d Add obvious Outputable Integer instance. f713be7 RtsFlags: allow +RTS -K0 00b96b2 boot: Eliminate superfluous output 4efe5fe Check quantification for partial type signatues df1a0c0 typecheck: Consistently use pretty quotes in error messages eb86e86 Don't call alex for Cabal lib during GHC build e4dc2cd relnotes: Rework treatment of included package list 54fda25 base: Rip out old RTS statistics interface 17e71c1 CLabel.labelType: Make catch-all case explicit 048a913 cmm: Use LocalBlockLabel instead of AsmTempLabel to represent blocks 16dd532 CLabel: Refactor pprDynamicLinkerAsmLabel 55e621c nativeGen: Use plusUFMList instead of foldr 7dc82d6 nativeGen: Use foldl' instead of foldl 66c1c8e CLabel: More specific debug output from CLabel d3b80c7 Cmm: Add missing cases for BlockInfoTable 030d9d4 CLabel: A bit of documentation 4c65867 CircleCI: Disallow hscolour 1.24.3 3c0ffd1 CircleCI: Freeze all packages at fixed index state 5b3f33b Minor tweaks to codegens.rst b6428af Comments only: Trac #14511 b6a2691 Bump unix submodule f246d35 Darwin: Set deployment target d672b7f Darwin: Use gmp from homebrew 6998772 Make use of boot TyThings during typechecking. e1fb283 Handle CPP properly in Backpack 12efb23 Add trace injection bc761ad Cache TypeRep kinds aggressively 1acb922 Make the Con and Con' patterns produce evidence cfea745 template-haskell: Rip out FamFlavour 595f60f Fix ghc_packages d6fccfb Bump version to 8.5 30d6373 rts: fix filename case for mingw32 target 1ecbe9c utils/hsc2hs: update submodule 5f332e1 Forward-port changes from GHC 8.2 branch fa29df0 Refactor ConDecl: Trac #14529 e4a1f03 Revert accidental hsc2hs submodule downgrade de20440 Refactor kcHsTyVarBndrs 800009d Improve LiberateCase 5695f46 Occurrrence analysis improvements for NOINLINE functions 7733e44 Rip out hadrian subtree 4335c07 Add hadrian as a submodule 716acbb Improved panic message for zonkTcTyVarToTyVar 8b36ed1 Build only well-kinded types in type checker 8361b2c Fix SigTvs at the kind level abd5db6 Only look for locales of the form LL.VV 21be5bd Fixed misprint 'aqcuired' 6847c6b Improve Control.Monad.guard and Control.Monad.MonadPlus docs 00d7132 Add information about irrefutable pattern Syntax to XStrict. 21cdfe5 Add NOINLINE pragma to hPutStr' 4bfff7a rts: Don't default to single capability when profiled cafe983 Always use the safe open() call 708ed9c Allow users to ignore optimization changes 430d1f6 fdReady: Use C99 bools / CBool in signature 9d29925 base: fdReady(): Return only after sycall returns after `msecs` have passed be1ca0e Add regression test for #14040 a106a20 Minor refactor of TcExpr.tcApp e40db7b Detect levity-polymorphic uses of unsafeCoerce# 321b420 Tidy up of wired-in names aef4dee Add missing stderr for Trac #14561 63e968a Re-centre perf for T5321Fun 0a12d92 Further improvements to well-kinded types 6eb3257 Typofix in comment 6f6d105 Add test for Trac #14580 b1ea047 Fix an outright bug in the unflattener fa1afcd Better tc-trace messages eeb36eb typos in local var 16c7d9d Fix #14135 by validity checking matches d4c8d89 users-guide: Consistently document LLVM version requirement 4a331e6 users-guide: Fix various bits of markup 6814945 Fix tcDataKindSig 3910d3e Add some commentary re: fix to #11203 23b5b80 Add missing case to HsExpr.isMonadFailStmtContext 1e64fc8 Tiny refactor: use mkTyVarNamePairs f1fe5b4 Fix scoping of pattern-synonym existentials fb1f0a4 Blackholes can be large objects (#14497) 0302439 testsuite: Exit with non-zero exit code when tests fail 8c9906c testsuite: Semigroup/Monoid compat for T3001-2 244d144 Typos in comments a100763 Get rid of some stuttering in comments and docs 10ed319 Stop runRW# being magic ff1544d Rmove a call to mkStatePrimTy 71f96bb Sync up ghc-prim changelog from GHC 8.2 branch 1bd91a7 Fix #14578 by checking isCompoundHsType in more places 9caf40e Fix #14588 by checking for more bang patterns 9cb289a Remove hack put in place for #12512 b6304f8 Document ScopedTypeVariables' interaction with nested foralls 4d41e92 Improve treatment of sectioned holes 584cbd4 Simplify HsPatSynDetails 72938f5 Check for bogus quantified tyvars in partial type sigs a492af0 Refactor coercion holes f5cf9d1 Fix floating of equalities bcb519c Typos in comments 05551d0 Comments only [skip ci] fc257e4 Sync `ghc-prim` changelog from GHC 8.2 c88564d MkIface: Ensure syntactic compatibility with ghc 8.0.1 6549706 relnotes: Fix typo in pattern synonym example e237e1f Bump Cabal submodule d7d0aa3 Add GHC 8.6.1 release notes 02aaeab aclocal.m4: add minimal support for nios2 architecture e19b646 Compute InScopeSet in substInteractiveContext 722a658 Fix #14618 by applying a subst in deeplyInstantiate f2db228 Typos in comments [ci skip] 862c59e Rewrite Note [The polymorphism rule of join points] a2e9549 users-guide: Fix markup b31c721 Fix sign error in kelvinToC. 12f5c00 Prevent "C--" translating to "C–" in the User's Guide. 69f1e49 Reformat Control.Monad.mfilter docs a67c264 Add example to Control.Monad.join docs 4887c30 Improve Control.Monad docs 27b7b4d Windows: fix all failing tests. 46287af Make System.IO.openTempFile thread-safe on Windows ecff651 Fix #14608 by restoring an unboxed tuple check 3382ade Rename HEq_sc and Coercible_sc to heq_sel and coercible_sel 2c7b183 Comments only 83b96a4 More informative pretty-printing for phantom coercions f3a0fe2 Comments about join point types 1e12783 Tiny refactor around fillInferResult 3bf910d Small refactoring in Coercion 112266c White space only 9e5535c Fix OptCoercion bd438b2 Get evaluated-ness right in the back end 298ec78 No deferred type errors under a forall 7a25659 Typos in comments 649e777 Make typeToLHsType produce kind signatures for tycon applications 6c34824 Cache the number of data cons in DataTyCon and SumTyCon 954cbc7 Drop dead Given bindings in setImplicationStatus e2998d7 Stop double-stacktrace in ASSERT failures 86ea3b1 comments only 307d1df Fix deep, dark corner of pattern synonyms 68ccfbd Wip on floating join points 6b7ae18 More Wip on floating join points 9b522eb Allow joins to float to top level From git at git.haskell.org Fri Jan 5 21:16:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:13 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Do not inline showWord (8771319) Message-ID: <20180105211613.4390C3A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/8771319d11aae99daf3d8607d8d4f41cd365f27a/ghc >--------------------------------------------------------------- commit 8771319d11aae99daf3d8607d8d4f41cd365f27a Author: Joachim Breitner Date: Wed Aug 2 11:26:22 2017 -0400 Do not inline showWord mostly because otherwise the test setup of #7014 fails. (The test checks for the absence of certain primops in the code, but inlining showWords adds many of these.) >--------------------------------------------------------------- 8771319d11aae99daf3d8607d8d4f41cd365f27a libraries/base/GHC/Show.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 980b4a7..03b8f95 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -196,6 +196,7 @@ showWord w# cs | otherwise = case chr# (ord# '0'# +# word2Int# (w# `remWord#` 10##)) of c# -> showWord (w# `quotWord#` 10##) (C# c# : cs) +{-# NOINLINE showWord #-} deriving instance Show a => Show (Maybe a) deriving instance Show a => Show (NonEmpty a) From git at git.haskell.org Fri Jan 5 21:16:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:16 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Mark `eqString` as `NOINLINE` (8d7a23a) Message-ID: <20180105211616.501A23A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/8d7a23a8b297a0eeac2a9754561c52bae4733d9a/ghc >--------------------------------------------------------------- commit 8d7a23a8b297a0eeac2a9754561c52bae4733d9a Author: Joachim Breitner Date: Wed Aug 2 10:53:37 2017 -0400 Mark `eqString` as `NOINLINE` so that the built-in rule can still match. This will be a problem in general: With loopification, recursive functions can now inline (yay!) but many people out there probably rely on the fact that recursive functions cannot inline (ouch). Hopefully the recent warnings in GHC made them fix this before loopification reaches them. >--------------------------------------------------------------- 8d7a23a8b297a0eeac2a9754561c52bae4733d9a libraries/base/GHC/Base.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 052f13f..0ff4589 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -1183,6 +1183,7 @@ eqString :: String -> String -> Bool eqString [] [] = True eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 eqString _ _ = False +{-# NOINLINE eqString #-} {-# RULES "eqString" (==) = eqString #-} -- eqString also has a BuiltInRule in PrelRules.hs: From git at git.haskell.org Fri Jan 5 21:16:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:19 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Loopification: Clear OccInfo of loopified binding (f34acaa) Message-ID: <20180105211619.8EBE63A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/f34acaafd32233d84bb25a511b1af55d9deacd30/ghc >--------------------------------------------------------------- commit f34acaafd32233d84bb25a511b1af55d9deacd30 Author: Joachim Breitner Date: Mon Nov 6 14:25:48 2017 -0500 Loopification: Clear OccInfo of loopified binding as a loopified binding is no longer a loop breaker. This is a stab in the dark at maybe working around #14430, where I observe unsimplified unfoldings where I expec them to be simplified.. >--------------------------------------------------------------- f34acaafd32233d84bb25a511b1af55d9deacd30 compiler/coreSyn/CoreOpt.hs | 2 +- compiler/stranal/WorkWrap.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 550a0a7..e3462c4 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -679,7 +679,7 @@ loopificationJoinPointBinding_maybe bndr rhs -- To tread with caution, let's keep it this way bndr' = (`setIdUnfolding` noUnfolding) $ (`setInlinePragma` neverInlinePragma) $ - zapIdTailCallInfo $ + (`setIdOccInfo` noOccInfo) $ bndr in Just (bndr', join_bndr, mkLams bndrs body) diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 49045d9..4eb2f10 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -479,7 +479,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs work_act = case work_inline of -- See Note [Activation for workers] NoInline -> inl_act inl_prag - NoUserInline | isNeverActive (inl_act inl_prag) -> inl_act inl_prag + NoUserInline | isNeverActive (inl_act inl_prag) -> NeverActive _ -> wrap_act work_prag = InlinePragma { inl_src = SourceText "{-# INLINE" , inl_inline = work_inline From git at git.haskell.org Fri Jan 5 21:16:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:22 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Invoke lintUnfolding only on top-level unfoldings (#14430) (cc6b816) Message-ID: <20180105211622.51BC03A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/cc6b816575b6668c83843f389ee571fcc687802a/ghc >--------------------------------------------------------------- commit cc6b816575b6668c83843f389ee571fcc687802a Author: Joachim Breitner Date: Tue Nov 7 22:17:50 2017 -0500 Invoke lintUnfolding only on top-level unfoldings (#14430) as nested unfoldings are linted together with the top-level unfolding, and lintUnfolding does the wrong things for nestd unfoldings that mention join points. The easiest way of doing that was to pass a TopLevel flag through `tcUnfolding`, which is invoked both for top level and nested unfoldings. >--------------------------------------------------------------- cc6b816575b6668c83843f389ee571fcc687802a compiler/coreSyn/CoreLint.hs | 12 ++++++++++-- compiler/iface/TcIface.hs | 37 +++++++++++++++++++------------------ 2 files changed, 29 insertions(+), 20 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 20354ec..4b6defd 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -458,8 +458,16 @@ lintCoreBindings dflags pass local_in_scope binds * * ************************************************************************ -We use this to check all unfoldings that come in from interfaces -(it is very painful to catch errors otherwise): +Note [Linting Unfoldings from Interfaces] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We use this to check all top-level unfoldings that come in from interfaces +(it is very painful to catch errors otherwise). + +We do not need to call lintUnfolding on unfoldings that are nested within +top-level unfoldings; they are linted when we lint the top-level unfolding; +hence the `TopLevelFlag` on `tcPragExpr` in TcIface. + -} lintUnfolding :: DynFlags diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 6d04171..b41c948 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -647,7 +647,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, ifIdDetails = details, ifIdInfo = info}) = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details - ; info <- tcIdInfo ignore_prags name ty info + ; info <- tcIdInfo ignore_prags TopLevel name ty info ; return (AnId (mkGlobalId details name ty info)) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, @@ -1461,7 +1461,7 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) = do { name <- newIfaceName (mkVarOccFS fs) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} - name ty' info + NotTopLevel name ty' info ; let id = mkLocalIdOrCoVarWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs @@ -1482,7 +1482,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) tc_pair (IfLetBndr _ _ info _, rhs) id = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} - (idName id) (idType id) info + NotTopLevel (idName id) (idType id) info ; return (setIdInfo id id_info, rhs') } tcIfaceExpr (IfaceTick tickish expr) = do @@ -1573,8 +1573,8 @@ tcIdDetails _ (IfRecSelId tc naughty) tyThingPatSyn (AConLike (PatSynCon ps)) = ps tyThingPatSyn _ = panic "tcIdDetails: expecting patsyn" -tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo -tcIdInfo ignore_prags name ty info = do +tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo +tcIdInfo ignore_prags toplvl name ty info = do lcl_env <- getLclEnv -- Set the CgInfo to something sensible but uninformative before -- we start; default assumption is that it has CAFs @@ -1595,7 +1595,7 @@ tcIdInfo ignore_prags name ty info = do -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) - = do { unf <- tcUnfolding name ty info if_unf + = do { unf <- tcUnfolding toplvl name ty info if_unf ; let info1 | lb = info `setOccInfo` strongLoopBreaker | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } @@ -1604,10 +1604,10 @@ tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing -tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding -tcUnfolding name _ info (IfCoreUnfold stable if_expr) +tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding +tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags - ; mb_expr <- tcPragExpr name if_expr + ; mb_expr <- tcPragExpr toplvl name if_expr ; let unf_src | stable = InlineStable | otherwise = InlineRhs ; return $ case mb_expr of @@ -1620,21 +1620,21 @@ tcUnfolding name _ info (IfCoreUnfold stable if_expr) where -- Strictness should occur before unfolding! strict_sig = strictnessInfo info -tcUnfolding name _ _ (IfCompulsory if_expr) - = do { mb_expr <- tcPragExpr name if_expr +tcUnfolding toplvl name _ _ (IfCompulsory if_expr) + = do { mb_expr <- tcPragExpr toplvl name if_expr ; return (case mb_expr of Nothing -> NoUnfolding Just expr -> mkCompulsoryUnfolding expr) } -tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr) - = do { mb_expr <- tcPragExpr name if_expr +tcUnfolding toplvl name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr) + = do { mb_expr <- tcPragExpr toplvl name if_expr ; return (case mb_expr of Nothing -> NoUnfolding Just expr -> mkCoreUnfolding InlineStable True expr guidance )} where guidance = UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok } -tcUnfolding name dfun_ty _ (IfDFunUnfold bs ops) +tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops) = bindIfaceBndrs bs $ \ bs' -> do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops ; return (case mb_ops1 of @@ -1649,13 +1649,14 @@ For unfoldings we try to do the job lazily, so that we never type check an unfolding that isn't going to be looked at. -} -tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr) -tcPragExpr name expr +tcPragExpr :: TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr) +tcPragExpr toplvl name expr = forkM_maybe doc $ do core_expr' <- tcIfaceExpr expr - -- Check for type consistency in the unfolding - whenGOptM Opt_DoCoreLinting $ do + -- Check for type consistency in the unfolding + -- See Note [Linting Unfoldings from Interfaces] + when (isTopLevel toplvl) $ whenGOptM Opt_DoCoreLinting $ do in_scope <- get_in_scope dflags <- getDynFlags case lintUnfolding dflags noSrcLoc in_scope core_expr' of From git at git.haskell.org Fri Jan 5 21:16:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:25 +0000 (UTC) Subject: [commit: ghc] wip/T14068: If there is a artificial no-inline-pragma, do not bother creating an unfolding (87d95e8) Message-ID: <20180105211625.B0C003A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/87d95e8220def32cdf96a377ff0d514a43589a2c/ghc >--------------------------------------------------------------- commit 87d95e8220def32cdf96a377ff0d514a43589a2c Author: Joachim Breitner Date: Mon Nov 6 15:14:11 2017 -0500 If there is a artificial no-inline-pragma, do not bother creating an unfolding >--------------------------------------------------------------- 87d95e8220def32cdf96a377ff0d514a43589a2c compiler/basicTypes/BasicTypes.hs | 8 +++++++- compiler/simplCore/Simplify.hs | 4 +++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index a866153..3e5fbfe 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -88,7 +88,7 @@ module BasicTypes( InlineSpec(..), noUserInlineSpec, InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma, - isDefaultInlinePragma, + isDefaultInlinePragma, isNeverInlinePragma, isInlinePragma, isInlinablePragma, isAnyInlinePragma, inlinePragmaSpec, inlinePragmaSat, inlinePragmaActivation, inlinePragmaRuleMatchInfo, @@ -1352,6 +1352,12 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation , inl_inline = inline }) = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info +isNeverInlinePragma :: InlinePragma -> Bool +isNeverInlinePragma (InlinePragma { inl_act = activation + , inl_rule = match_info + , inl_inline = inline }) + = noUserInlineSpec inline && isNeverActive activation && isFunLike match_info + isInlinePragma :: InlinePragma -> Bool isInlinePragma prag = case inl_inline prag of Inline -> True diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 532b7ee..b576e8a 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -41,7 +41,7 @@ import CoreOpt ( pushCoTyArg, pushCoValArg import Rules ( mkRuleInfo, lookupRule, getRules ) import Demand ( mkClosedStrictSig, topDmd, exnRes ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, - RecFlag(..), Arity ) + RecFlag(..), Arity, isNeverInlinePragma ) import MonadUtils ( mapAccumLM, liftIO ) import Maybes ( orElse ) import Control.Monad @@ -3263,6 +3263,8 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs unf = simplStableUnfolding env top_lvl cont_mb id unf | isExitJoinId id = return noUnfolding -- see Note [Do not inline exit join points] + | isNeverInlinePragma (idInlinePragma id) + = return noUnfolding -- Do not bother creating one if we never inline anyways | otherwise = mkLetUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs From git at git.haskell.org Fri Jan 5 21:16:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:28 +0000 (UTC) Subject: [commit: ghc] wip/T14068: simplTopBinds: Call maybeLoopify before simplRecBndrs (507c35f) Message-ID: <20180105211628.E5F2E3A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/507c35f9d900a38aeaf9a0b48c764ffad84c5b72/ghc >--------------------------------------------------------------- commit 507c35f9d900a38aeaf9a0b48c764ffad84c5b72 Author: Joachim Breitner Date: Wed Nov 1 13:05:59 2017 -0400 simplTopBinds: Call maybeLoopify before simplRecBndrs so that the post-loopified binder ends up in the SimplEnv >--------------------------------------------------------------- 507c35f9d900a38aeaf9a0b48c764ffad84c5b72 compiler/simplCore/Simplify.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 6e75a80..532b7ee 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -129,11 +129,12 @@ simplTopBinds env0 binds0 -- anything into scope, then we don't get a complaint about that. -- It's rather as if the top-level binders were imported. -- See note [Glomming] in OccurAnal. - ; env1 <- simplRecBndrs env0 (bindersOfBinds binds0) - ; (floats, env2) <- simpl_binds env1 binds0 + ; env1 <- simplRecBndrs env0 (bindersOfBinds binds1) + ; (floats, env2) <- simpl_binds env1 binds1 ; freeTick SimplifierDone ; return (floats, env2) } where + binds1 = [ maybeLoopify bind `orElse` bind | bind <- binds0 ] -- We need to track the zapped top-level binders, because -- they should have their fragile IdInfo zapped (notably occurrence info) -- That's why we run down binds and bndrs' simultaneously. @@ -144,10 +145,6 @@ simplTopBinds env0 binds0 ; (floats, env2) <- simpl_binds env1 binds ; return (float `addFloats` floats, env2) } - simpl_bind env bind | Just bind' <- maybeLoopify bind - = do -- update the env, as maybeLoopify changes the id info - env1 <- simplRecBndrs env (bindersOf bind') - simpl_bind env1 bind' simpl_bind env (Rec pairs) = simplRecBind env TopLevel Nothing pairs simpl_bind env (NonRec b r) = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) ; simplRecOrTopPair env' TopLevel From git at git.haskell.org Fri Jan 5 21:16:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:31 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Implement loopification for local bindings (#14068) (da52dbb) Message-ID: <20180105211631.C1DD43A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/da52dbbcd28b19dded0c04f3a5a15ba10ca1a037/ghc >--------------------------------------------------------------- commit da52dbbcd28b19dded0c04f3a5a15ba10ca1a037 Author: Joachim Breitner Date: Tue Aug 1 09:47:49 2017 -0400 Implement loopification for local bindings (#14068) This is a relatively prelimary version. I am sure there is a huge number of invariants that this breaks, and conditions that I am not checking etc. I do not even know if the simplifier is the right place to implement this. But it works in this simple case: module T14068 where foo p f k = let bar a = if p a then bar (f a) else a in k bar so we can iterate from here. The IdInfo of a loopified binder stays with the outer binder, e.g. RULES should stay unaffected. The local binder gets localised. During loopification, we zap occurrence info on the lambda binders If we have letrec f x[dead] = … f () … in g f loopification turns that into let f x = joinrec f x[dead] = … f () … in jump j x in g f Note that the parameter x of f is no longer dead! Disable test case for #4030 and #5644 With loopification, T4030 always goes into an infinite loop. Not nice when running the test suite. Also, with loopification, T5644 no longer runs out of heap, so it does not trigger the out-of-heap exception that the test case was testing. Mark `eqString` as `NOINLINE` so that the built-in rule can still match. This will be a problem in general: With loopification, recursive functions can now inline (yay!) but many people out there probably rely on the fact that recursive functions cannot inline (ouch). Hopefully the recent warnings in GHC made them fix this before loopification reaches them. Do not inline showWord mostly because otherwise the test setup of #7014 fails. (The test checks for the absence of certain primops in the code, but inlining showWords adds many of these.) Make the test case for #T5949 a little less bogus by actually using the result of `e`. I *believe* it still tests what we want to test, and now we get proper results with loopification. I am not so worried about the regression in the case of an unused result of `e`. >--------------------------------------------------------------- da52dbbcd28b19dded0c04f3a5a15ba10ca1a037 compiler/basicTypes/BasicTypes.hs | 28 +++++++++++++----- compiler/basicTypes/IdInfo.hs | 4 +-- compiler/coreSyn/CoreOpt.hs | 45 ++++++++++++++++++++++++----- compiler/simplCore/OccurAnal.hs | 29 ++++++++++++++++--- compiler/simplCore/Simplify.hs | 28 +++++++++++++++++- compiler/types/Type.hs | 40 +++++++++++++------------ testsuite/tests/concurrent/should_run/all.T | 4 ++- testsuite/tests/perf/should_run/T5949.hs | 2 +- testsuite/tests/rts/T5644/ManyQueue.hs | 0 testsuite/tests/rts/T5644/all.T | 4 ++- 10 files changed, 141 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc da52dbbcd28b19dded0c04f3a5a15ba10ca1a037 From git at git.haskell.org Fri Jan 5 21:16:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:34 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Prevent inlining of loopified programs (b4ab3a5) Message-ID: <20180105211634.8D6713A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/b4ab3a5f1fa051be9c5689f7ecef16458b2d700d/ghc >--------------------------------------------------------------- commit b4ab3a5f1fa051be9c5689f7ecef16458b2d700d Author: Joachim Breitner Date: Fri Aug 4 15:34:11 2017 -0400 Prevent inlining of loopified programs Previously, a recursive function is not inlineable. After loopification, it turns into a non-recursive function, and suddenly it is. While this is in general desirable, it has many knock-on effects, which makes it hard to evaluate and debug loopification. Therefore, this commit (tries to) prevent this inlining. When this results in no unfixable regressions, then we can tackle the next step. It is surprisingly hard to reliably prevent inlining, it seems, so I have been playing whack-a-mole a bit: * simpl_binds has two copies of the ids around, one in the env and one in the AST. If maybeLoopify changes only one of them, then things go wrong. Worked-around that for now, but probably not ideal. TODO: Apply maybeLoopify before entering simplTopBinds * Also, worker-wrapper needs to preserve the no-inlining better. >--------------------------------------------------------------- b4ab3a5f1fa051be9c5689f7ecef16458b2d700d compiler/coreSyn/CoreOpt.hs | 8 +++++++- compiler/simplCore/Simplify.hs | 4 +++- compiler/stranal/WorkWrap.hs | 1 + 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 605a679..550a0a7 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -673,8 +673,14 @@ loopificationJoinPointBinding_maybe bndr rhs zapFragileIdInfo $ localiseId $ bndr + -- RULES etc stay with bindr' - bndr' = zapIdTailCallInfo bndr + -- Also, previously, the function was recursive, and hence not inlineable. + -- To tread with caution, let's keep it this way + bndr' = (`setIdUnfolding` noUnfolding) $ + (`setInlinePragma` neverInlinePragma) $ + zapIdTailCallInfo $ + bndr in Just (bndr', join_bndr, mkLams bndrs body) | otherwise diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 7eaf96a..6e75a80 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -145,7 +145,9 @@ simplTopBinds env0 binds0 ; return (float `addFloats` floats, env2) } simpl_bind env bind | Just bind' <- maybeLoopify bind - = simpl_bind env bind' + = do -- update the env, as maybeLoopify changes the id info + env1 <- simplRecBndrs env (bindersOf bind') + simpl_bind env1 bind' simpl_bind env (Rec pairs) = simplRecBind env TopLevel Nothing pairs simpl_bind env (NonRec b r) = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) ; simplRecOrTopPair env' TopLevel diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index ac8798e..49045d9 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -479,6 +479,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs work_act = case work_inline of -- See Note [Activation for workers] NoInline -> inl_act inl_prag + NoUserInline | isNeverActive (inl_act inl_prag) -> inl_act inl_prag _ -> wrap_act work_prag = InlinePragma { inl_src = SourceText "{-# INLINE" , inl_inline = work_inline From git at git.haskell.org Fri Jan 5 21:16:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Jan 2018 21:16:37 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Revert "If there is a artificial no-inline-pragma, do not bother creating an unfolding" (f04fdcb) Message-ID: <20180105211637.69D473A5F7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/f04fdcbc51fffa36619157defb105dae461da4b7/ghc >--------------------------------------------------------------- commit f04fdcbc51fffa36619157defb105dae461da4b7 Author: Joachim Breitner Date: Tue Nov 7 17:48:42 2017 -0500 Revert "If there is a artificial no-inline-pragma, do not bother creating an unfolding" This reverts commit 1d811710f9681693f3dcdd647a1231dcebc8bce1. >--------------------------------------------------------------- f04fdcbc51fffa36619157defb105dae461da4b7 compiler/basicTypes/BasicTypes.hs | 8 +------- compiler/simplCore/Simplify.hs | 4 +--- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 3e5fbfe..a866153 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -88,7 +88,7 @@ module BasicTypes( InlineSpec(..), noUserInlineSpec, InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma, - isDefaultInlinePragma, isNeverInlinePragma, + isDefaultInlinePragma, isInlinePragma, isInlinablePragma, isAnyInlinePragma, inlinePragmaSpec, inlinePragmaSat, inlinePragmaActivation, inlinePragmaRuleMatchInfo, @@ -1352,12 +1352,6 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation , inl_inline = inline }) = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info -isNeverInlinePragma :: InlinePragma -> Bool -isNeverInlinePragma (InlinePragma { inl_act = activation - , inl_rule = match_info - , inl_inline = inline }) - = noUserInlineSpec inline && isNeverActive activation && isFunLike match_info - isInlinePragma :: InlinePragma -> Bool isInlinePragma prag = case inl_inline prag of Inline -> True diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index b576e8a..532b7ee 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -41,7 +41,7 @@ import CoreOpt ( pushCoTyArg, pushCoValArg import Rules ( mkRuleInfo, lookupRule, getRules ) import Demand ( mkClosedStrictSig, topDmd, exnRes ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, - RecFlag(..), Arity, isNeverInlinePragma ) + RecFlag(..), Arity ) import MonadUtils ( mapAccumLM, liftIO ) import Maybes ( orElse ) import Control.Monad @@ -3263,8 +3263,6 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs unf = simplStableUnfolding env top_lvl cont_mb id unf | isExitJoinId id = return noUnfolding -- see Note [Do not inline exit join points] - | isNeverInlinePragma (idInlinePragma id) - = return noUnfolding -- Do not bother creating one if we never inline anyways | otherwise = mkLetUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs From git at git.haskell.org Mon Jan 8 05:06:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Jan 2018 05:06:34 +0000 (UTC) Subject: [commit: ghc] master: Make the Div and Mod type families `infixl 7` (303106d) Message-ID: <20180108050634.30AE93A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/303106d55d75a9c796e58867cb541ad136bb217f/ghc >--------------------------------------------------------------- commit 303106d55d75a9c796e58867cb541ad136bb217f Author: Ryan Scott Date: Sun Jan 7 13:05:13 2018 -0500 Make the Div and Mod type families `infixl 7` Commit fa8035e3ee83aff5a20fc5e7e2697bac1686d6a6 added `Div` and `Mod` type families to `GHC.TypeNats`. However, they did not add the corresponding fixities! Currently, we have that both `div` and `mod` (at the value level) are `infixl 7`, so we should adopt the same fixities for the type-level `Div` and `Mod` as well. Test Plan: It compiles Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14640 Differential Revision: https://phabricator.haskell.org/D4291 >--------------------------------------------------------------- 303106d55d75a9c796e58867cb541ad136bb217f libraries/base/GHC/TypeNats.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/TypeNats.hs b/libraries/base/GHC/TypeNats.hs index a5ee0fc..c9055dd 100644 --- a/libraries/base/GHC/TypeNats.hs +++ b/libraries/base/GHC/TypeNats.hs @@ -99,7 +99,7 @@ instance Read SomeNat where infix 4 <=?, <= infixl 6 +, - -infixl 7 * +infixl 7 *, `Div`, `Mod` infixr 8 ^ -- | Comparison of type-level naturals, as a constraint. From git at git.haskell.org Mon Jan 8 08:41:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Jan 2018 08:41:58 +0000 (UTC) Subject: [commit: ghc] master: Improve accuracy of get/setAllocationCounter (a1a689d) Message-ID: <20180108084158.873833A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1a689dda48113f3735834350fb562bb1927a633/ghc >--------------------------------------------------------------- commit a1a689dda48113f3735834350fb562bb1927a633 Author: Simon Marlow Date: Fri Jan 5 16:12:49 2018 +0000 Improve accuracy of get/setAllocationCounter Summary: get/setAllocationCounter didn't take into account allocations in the current block. This was known at the time, but it turns out to be important to have more accuracy when using these in a fine-grained way. Test Plan: New unit test to test incrementally larger allocaitons. Before I got results like this: ``` +0 +0 +0 +0 +0 +4096 +0 +0 +0 +0 +0 +4064 +0 +0 +4088 +4056 +0 +0 +0 +4088 +4096 +4056 +4096 ``` Notice how the results aren't always monotonically increasing. After this patch: ``` +344 +416 +488 +560 +632 +704 +776 +848 +920 +992 +1064 +1136 +1208 +1280 +1352 +1424 +1496 +1568 +1640 +1712 +1784 +1856 +1928 +2000 +2072 +2144 ``` Reviewers: niteria, bgamari, hvr, erikd Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4288 >--------------------------------------------------------------- a1a689dda48113f3735834350fb562bb1927a633 compiler/codeGen/StgCmmForeign.hs | 4 ++-- compiler/prelude/primops.txt.pp | 14 ++++++++++++++ includes/rts/Threads.h | 2 -- includes/stg/MiscClosures.h | 3 +++ libraries/base/GHC/Conc/Sync.hs | 21 +++++---------------- rts/PrimOps.cmm | 20 ++++++++++++++++++++ rts/RtsSymbols.c | 4 ++-- rts/Threads.c | 13 +------------ testsuite/tests/rts/all.T | 7 +++++++ testsuite/tests/rts/alloccounter1.hs | 19 +++++++++++++++++++ .../tests/rts/alloccounter1.stdout | 0 11 files changed, 73 insertions(+), 34 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a1a689dda48113f3735834350fb562bb1927a633 From git at git.haskell.org Mon Jan 8 14:55:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Jan 2018 14:55:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Make the Div and Mod type families `infixl 7` (fdfaa56) Message-ID: <20180108145511.890403A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/fdfaa56b04b2cefb86e4dc557b1d163fd2e062dc/ghc >--------------------------------------------------------------- commit fdfaa56b04b2cefb86e4dc557b1d163fd2e062dc Author: Ryan Scott Date: Sun Jan 7 13:05:13 2018 -0500 Make the Div and Mod type families `infixl 7` Commit fa8035e3ee83aff5a20fc5e7e2697bac1686d6a6 added `Div` and `Mod` type families to `GHC.TypeNats`. However, they did not add the corresponding fixities! Currently, we have that both `div` and `mod` (at the value level) are `infixl 7`, so we should adopt the same fixities for the type-level `Div` and `Mod` as well. Test Plan: It compiles Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14640 Differential Revision: https://phabricator.haskell.org/D4291 (cherry picked from commit 303106d55d75a9c796e58867cb541ad136bb217f) >--------------------------------------------------------------- fdfaa56b04b2cefb86e4dc557b1d163fd2e062dc libraries/base/GHC/TypeNats.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/TypeNats.hs b/libraries/base/GHC/TypeNats.hs index a5ee0fc..c9055dd 100644 --- a/libraries/base/GHC/TypeNats.hs +++ b/libraries/base/GHC/TypeNats.hs @@ -99,7 +99,7 @@ instance Read SomeNat where infix 4 <=?, <= infixl 6 +, - -infixl 7 * +infixl 7 *, `Div`, `Mod` infixr 8 ^ -- | Comparison of type-level naturals, as a constraint. From git at git.haskell.org Mon Jan 8 17:34:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Jan 2018 17:34:03 +0000 (UTC) Subject: [commit: ghc] master: Export typeNat{Div; Mod; Log}TyCon from TcTypeNats (fb78b0d) Message-ID: <20180108173403.A66DE3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb78b0d22635b1d7ae68385c648b8c407f5562c2/ghc >--------------------------------------------------------------- commit fb78b0d22635b1d7ae68385c648b8c407f5562c2 Author: Christiaan Baaij Date: Mon Jan 8 12:26:54 2018 -0500 Export typeNat{Div;Mod;Log}TyCon from TcTypeNats Summary: To be in line with the other typeNatTyCons Reviewers: bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14632 Differential Revision: https://phabricator.haskell.org/D4284 >--------------------------------------------------------------- fb78b0d22635b1d7ae68385c648b8c407f5562c2 compiler/typecheck/TcTypeNats.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs index 04b51a4..78e0b96 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/typecheck/TcTypeNats.hs @@ -10,6 +10,9 @@ module TcTypeNats , typeNatExpTyCon , typeNatLeqTyCon , typeNatSubTyCon + , typeNatDivTyCon + , typeNatModTyCon + , typeNatLogTyCon , typeNatCmpTyCon , typeSymbolCmpTyCon , typeSymbolAppendTyCon From git at git.haskell.org Tue Jan 9 02:40:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:04 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds `smp` flag to rts.cabal. (4430839) Message-ID: <20180109024004.929B13A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/44308391234a6cd20692243ab0b783a28fa88f94/ghc >--------------------------------------------------------------- commit 44308391234a6cd20692243ab0b783a28fa88f94 Author: Moritz Angermann Date: Sat Nov 25 20:49:56 2017 +0800 Adds `smp` flag to rts.cabal. >--------------------------------------------------------------- 44308391234a6cd20692243ab0b783a28fa88f94 rts/rts.cabal.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 71aef3d..b33a5f4 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -24,6 +24,8 @@ flag 64bit default: @Cabal64bit@ flag leading-underscore default: @CabalLeadingUnderscore@ +flag smp + default: True library -- rts is a wired in package and @@ -72,6 +74,8 @@ library if flag(libdw) -- for backtraces extra-libraries: elf dw + if !flag(smp) + cpp-options: -DNOSMP include-dirs: build ../includes includes includes/dist-derivedconstants/header @FFIIncludeDir@ From git at git.haskell.org Tue Jan 9 02:40:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:10 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: no tbaa (36d1a1b) Message-ID: <20180109024010.A81213A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/36d1a1b35e1a09c8830333c2d4a99c3685e3858d/ghc >--------------------------------------------------------------- commit 36d1a1b35e1a09c8830333c2d4a99c3685e3858d Author: Moritz Angermann Date: Sat Dec 2 14:09:03 2017 +0800 no tbaa >--------------------------------------------------------------- 36d1a1b35e1a09c8830333c2d4a99c3685e3858d compiler/main/DriverPipeline.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 269017c..035fb17 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -812,8 +812,8 @@ fastLlvmPipeline dflags llvmOptions :: DynFlags -> [(String, String)] -- ^ pairs of (opt, llc) arguments llvmOptions dflags = - [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] - ++ [("-relocation-model=" ++ rmodel +-- [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] + [("-relocation-model=" ++ rmodel ,"-relocation-model=" ++ rmodel) | not (null rmodel)] ++ [("-stack-alignment=" ++ (show align) ,"-stack-alignment=" ++ (show align)) | align > 0 ] From git at git.haskell.org Tue Jan 9 02:40:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:13 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Use packed structs. (b4fbdb7) Message-ID: <20180109024013.6D6D53A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/b4fbdb70048e9e3cd93c78939ffdf297e69f79ae/ghc >--------------------------------------------------------------- commit b4fbdb70048e9e3cd93c78939ffdf297e69f79ae Author: Moritz Angermann Date: Sun Dec 3 20:28:55 2017 +0800 Use packed structs. GHC computes offsets into structs, and we do not use getElementPointer. If we had used gep, we could use unpacked structs as well. >--------------------------------------------------------------- b4fbdb70048e9e3cd93c78939ffdf297e69f79ae compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs index c1c9e8c..09ffd99 100644 --- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs +++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs @@ -299,7 +299,7 @@ llvmCodeGen' prc@(CmmProc{}) = Right $ do case mb_info of Nothing -> EDSL.ghcdefT (pure link) lbl sig body Just (Statics _ statics) - -> do prefixData <- EDSL.struct =<< mapM genData statics + -> do prefixData <- EDSL.packedStruct =<< mapM genData statics EDSL.ghcdefT (pure $ EDSL.withPrefixData prefixData . link) lbl sig body -- llvmCodeGen' _ = panic "LlvmCodeGen': unhandled raw cmm group" @@ -427,7 +427,7 @@ genStatics s@(Statics l statics) = do let link | externallyVisibleCLabel l = Val.external -- External | otherwise = Val.private -- Internal - struct <- EDSL.struct body + struct <- EDSL.packedStruct body -- make statics mutable. -- E.g. -- x :: T From git at git.haskell.org Tue Jan 9 02:40:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:07 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds test (68a8567) Message-ID: <20180109024007.E0FD13A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/68a85678ef9998c09d58626d4b220f290e10ad0d/ghc >--------------------------------------------------------------- commit 68a85678ef9998c09d58626d4b220f290e10ad0d Author: Moritz Angermann Date: Thu Sep 21 22:07:44 2017 +0800 Adds test >--------------------------------------------------------------- 68a85678ef9998c09d58626d4b220f290e10ad0d testsuite/tests/codeGen/should_run/T14251.hs | 22 ++++++++++++++++++++++ testsuite/tests/codeGen/should_run/T14251.stdout | 1 + testsuite/tests/codeGen/should_run/all.T | 1 + 3 files changed, 24 insertions(+) diff --git a/testsuite/tests/codeGen/should_run/T14251.hs b/testsuite/tests/codeGen/should_run/T14251.hs new file mode 100644 index 0000000..6f552e1 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} +module Main where + +-- A minor modification from T8064.hs. +-- +-- The key here is that we ensure that +-- subsequently passed floats do not +-- accidentally end up in previous +-- registers. +-- + +import GHC.Exts + +{-# NOINLINE f #-} +f :: (Int# -> Float# -> Double# -> Float# -> Double# -> String) -> String +f g = g 3# 4.0# 5.0## 6.0# 6.9## ++ " World!" + +{-# NOINLINE q #-} +q :: Int# -> Float# -> Double# -> Float# -> Double# -> String +q i j k l m = "Hello " ++ show (F# l) ++ " " ++ show (D# m) + +main = putStrLn (f $ q) diff --git a/testsuite/tests/codeGen/should_run/T14251.stdout b/testsuite/tests/codeGen/should_run/T14251.stdout new file mode 100644 index 0000000..8ec577b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.stdout @@ -0,0 +1 @@ +Hello 6.0 6.9 World! diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 214a9d5..8f33044 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -163,3 +163,4 @@ test('T13825-unit', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) +test('T14251', normal, compile_and_run, ['-O2']) From git at git.haskell.org Tue Jan 9 02:40:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:18 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds `-llvmng` (80d90c5) Message-ID: <20180109024018.AC5733A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/80d90c54071c1ab8e7127aa8c29d48cb94febbb9/ghc >--------------------------------------------------------------- commit 80d90c54071c1ab8e7127aa8c29d48cb94febbb9 Author: Moritz Angermann Date: Mon Jul 31 15:18:49 2017 +0800 Adds `-llvmng` >--------------------------------------------------------------- 80d90c54071c1ab8e7127aa8c29d48cb94febbb9 .gitmodules | 12 +- compiler/cmm/CmmSwitch.hs | 1 + compiler/codeGen/StgCmmPrim.hs | 3 +- compiler/ghc.cabal.in | 8 +- compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 1788 ++++++++++++++++++++ compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs | 83 + compiler/main/CodeOutput.hs | 10 + compiler/main/DriverPipeline.hs | 5 +- compiler/main/DynFlags.hs | 12 +- compiler/typecheck/TcForeign.hs | 4 +- ghc.mk | 8 + libraries/base/tests/all.T | 2 +- libraries/data-bitcode | 1 + libraries/data-bitcode-edsl | 1 + libraries/data-bitcode-llvm | 1 + mk/build.mk.sample | 13 +- mk/flavours/{prof.mk => prof-llvmng.mk} | 6 +- mk/flavours/{quick-cross.mk => quick-cross-ng.mk} | 4 +- mk/flavours/{quick.mk => quick-llvmng.mk} | 4 +- packages | 3 + testsuite/config/ghc | 16 +- 21 files changed, 1963 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 80d90c54071c1ab8e7127aa8c29d48cb94febbb9 From git at git.haskell.org Tue Jan 9 02:40:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:22 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` (fafbdbf) Message-ID: <20180109024022.B14D93A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/fafbdbf84be5d376e9f84266a19282b23d83f24c/ghc >--------------------------------------------------------------- commit fafbdbf84be5d376e9f84266a19282b23d83f24c Author: Moritz Angermann Date: Sat Nov 25 15:10:52 2017 +0800 Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` This is done for consistency. We usually call the package file the same name the folder has. The move into `utils` is done so that we can move the library into `libraries/iserv` and the proxy into `utils/iserv-proxy` and then break the `iserv.cabal` apart. This will make building the cross compiler with TH simpler, because we can build the library and proxy as separate packages. >--------------------------------------------------------------- fafbdbf84be5d376e9f84266a19282b23d83f24c ghc.mk | 13 +-- {iserv => libraries/libiserv}/Makefile | 0 {iserv => libraries/libiserv}/cbits/iservmain.c | 0 libraries/libiserv/ghc.mk | 5 + libraries/libiserv/libiserv.cabal | 39 +++++++ {iserv => libraries/libiserv}/proxy-src/Remote.hs | 0 {iserv => libraries/libiserv}/src/GHCi/Utils.hsc | 0 {iserv => libraries/libiserv}/src/Lib.hs | 0 {iserv => libraries/libiserv}/src/Main.hs | 0 .../libiserv}/src/Remote/Message.hs | 0 {iserv => libraries/libiserv}/src/Remote/Slave.hs | 0 {iserv => utils/iserv-proxy}/Makefile | 0 utils/iserv-proxy/ghc.mk | 113 +++++++++++++++++++++ .../iserv-proxy/iserv-proxy.cabal | 70 +------------ {iserv => utils/iserv-proxy}/proxy-src/Remote.hs | 0 {iserv => utils/iserv}/Makefile | 0 {iserv => utils/iserv}/cbits/iservmain.c | 0 {iserv => utils/iserv}/ghc.mk | 66 ++++++------ utils/iserv/iserv.cabal | 44 ++++++++ {iserv => utils/iserv}/src/Main.hs | 0 20 files changed, 245 insertions(+), 105 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fafbdbf84be5d376e9f84266a19282b23d83f24c From git at git.haskell.org Tue Jan 9 02:40:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:28 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Update iserv-proxy (2e91fb2) Message-ID: <20180109024028.513183A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/2e91fb26dcf03ae6a7ba6c8d457fcba53ca97a0c/ghc >--------------------------------------------------------------- commit 2e91fb26dcf03ae6a7ba6c8d457fcba53ca97a0c Author: Moritz Angermann Date: Sun Nov 26 17:08:08 2017 +0800 Update iserv-proxy >--------------------------------------------------------------- 2e91fb26dcf03ae6a7ba6c8d457fcba53ca97a0c utils/iserv-proxy/iserv-proxy.cabal | 2 +- utils/iserv-proxy/{proxy-src/Remote.hs => src/Main.hs} | 0 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal index 12a801a..e5cfd99 100644 --- a/utils/iserv-proxy/iserv-proxy.cabal +++ b/utils/iserv-proxy/iserv-proxy.cabal @@ -63,7 +63,7 @@ cabal-version: >=1.10 Executable iserv-proxy Default-Language: Haskell2010 - Main-Is: Remote.hs + Main-Is: Main.hs Hs-Source-Dirs: src Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, diff --git a/utils/iserv-proxy/proxy-src/Remote.hs b/utils/iserv-proxy/src/Main.hs similarity index 100% rename from utils/iserv-proxy/proxy-src/Remote.hs rename to utils/iserv-proxy/src/Main.hs From git at git.haskell.org Tue Jan 9 02:40:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:31 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds distrib/Makefile from @alpmestan (ba302ba) Message-ID: <20180109024031.869ED3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/ba302ba1d317d18f87a29978345566d1d891845f/ghc >--------------------------------------------------------------- commit ba302ba1d317d18f87a29978345566d1d891845f Author: Moritz Angermann Date: Fri Dec 8 12:58:53 2017 +0800 Adds distrib/Makefile from @alpmestan >--------------------------------------------------------------- ba302ba1d317d18f87a29978345566d1d891845f distrib/Makefile | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/distrib/Makefile b/distrib/Makefile new file mode 100644 index 0000000..e806ff8 --- /dev/null +++ b/distrib/Makefile @@ -0,0 +1,34 @@ +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + +ProjectVersion:=$(shell bin/ghc --numeric-version) + +include mk/install.mk + +define GHC_WRAPPER +#!/bin/sh +exec "$(libdir)/bin/ghc" -B"$(libdir)" $${1+"$$@"} +endef + +export GHC_WRAPPER + +.PHONY: default +default: + @echo 'Run "make install" to install' + @false + +.PHONY: install +install: + @cp settings lib/ + @echo $(prefix) $(bindir) $(libdir) + @mkdir -p $(prefix) $(libdir) $(bindir) + @cp -R lib/* $(libdir)/ + # cp the rest to $(prefix) ? or maybe handle $(datadir) etc too? + @if [ "$(bindir)" = "$(prefix)/bin" ] || [ "$(libdir)" != "$(prefix)/lib" ]; then \ + echo "custom bindir or libdir"; \ + mkdir -p $(libdir)/bin; \ + cp bin/* $(libdir)/bin/; \ + echo "$$GHC_WRAPPER" > $(bindir)/ghc; \ + fi + @echo "ghc available at $(bindir)/ghc" + @echo done From git at git.haskell.org Tue Jan 9 02:40:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:25 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: adds -latomic to. ghc-prim (80b2749) Message-ID: <20180109024025.80EE93A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/80b27492a245adf47fc5ff28e15ef44afb2b30f1/ghc >--------------------------------------------------------------- commit 80b27492a245adf47fc5ff28e15ef44afb2b30f1 Author: Moritz Angermann Date: Mon Dec 4 10:56:13 2017 +0800 adds -latomic to. ghc-prim >--------------------------------------------------------------- 80b27492a245adf47fc5ff28e15ef44afb2b30f1 libraries/ghc-prim/ghc-prim.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index e99686a..bad1889 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -66,6 +66,9 @@ Library -- on Windows. Required because of mingw32. extra-libraries: user32, mingw32, mingwex + if os(linux) + extra-libraries: atomic + c-sources: cbits/atomic.c cbits/bswap.c From git at git.haskell.org Tue Jan 9 02:40:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:40 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump submodules (60d67d0) Message-ID: <20180109024040.2A0FF3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/60d67d0039972a9270b75481af551e769f3948a9/ghc >--------------------------------------------------------------- commit 60d67d0039972a9270b75481af551e769f3948a9 Author: Moritz Angermann Date: Fri Dec 8 13:16:48 2017 +0800 bump submodules >--------------------------------------------------------------- 60d67d0039972a9270b75481af551e769f3948a9 libraries/Cabal | 2 +- libraries/data-bitcode | 2 +- libraries/data-bitcode-edsl | 2 +- libraries/data-bitcode-llvm | 2 +- utils/hsc2hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 3f20e1f..652289a 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 3f20e1faf9bc86ecb154ccf3e8b913bff14b9264 +Subproject commit 652289ad9d9fb53a96cf227c1d47bdfd248103fe diff --git a/libraries/data-bitcode b/libraries/data-bitcode index c9818de..b4cdbc1 160000 --- a/libraries/data-bitcode +++ b/libraries/data-bitcode @@ -1 +1 @@ -Subproject commit c9818debd3dae774967c0507882b6b3bec7f0ee4 +Subproject commit b4cdbc17e77771c1c3c833625b92776aa5bc854b diff --git a/libraries/data-bitcode-edsl b/libraries/data-bitcode-edsl index bc2e3e0..3b11b02 160000 --- a/libraries/data-bitcode-edsl +++ b/libraries/data-bitcode-edsl @@ -1 +1 @@ -Subproject commit bc2e3e0a8bfc438ae3ee6ebe5feaa37920e78e43 +Subproject commit 3b11b02c138f672590a026c29af6f87432f17c11 diff --git a/libraries/data-bitcode-llvm b/libraries/data-bitcode-llvm index d03a9b5..b717895 160000 --- a/libraries/data-bitcode-llvm +++ b/libraries/data-bitcode-llvm @@ -1 +1 @@ -Subproject commit d03a9b5c90787910242e8a295f6201d71c6d3a9a +Subproject commit b717895d5e1add7f908fe09b528c7524511ec6f5 diff --git a/utils/hsc2hs b/utils/hsc2hs index 9483ad1..738f366 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 9483ad10064fbbb97ab525280623826b1ef63959 +Subproject commit 738f3666c878ee9e79c3d5e819ef8b3460288edf From git at git.haskell.org Tue Jan 9 02:40:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:42 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds x86_64 android layout (a6f589d) Message-ID: <20180109024042.E771B3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/a6f589d63fecf1b59c1fc945f39d1fe8434963f3/ghc >--------------------------------------------------------------- commit a6f589d63fecf1b59c1fc945f39d1fe8434963f3 Author: Moritz Angermann Date: Sun Dec 10 07:36:20 2017 +0800 Adds x86_64 android layout >--------------------------------------------------------------- a6f589d63fecf1b59c1fc945f39d1fe8434963f3 llvm-targets | 1 + utils/llvm-targets/gen-data-layout.sh | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/llvm-targets b/llvm-targets index 3c9da1e..6dd5a60 100644 --- a/llvm-targets +++ b/llvm-targets @@ -11,6 +11,7 @@ ,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("x86_64-unknown-linux", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("x86_64-unknown-linux-android", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "+sse4.2 +popcnt")) ,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("arm-unknown-nto-qnx-eabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align")) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index 6f2aafc..05ab085 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -20,7 +20,7 @@ WINDOWS_x86="i386-unknown-windows i686-unknown-windows x86_64-unknown-windows" LINUX_ARM="arm-unknown-linux-gnueabihf armv6-unknown-linux-gnueabihf armv7-unknown-linux-gnueabihf aarch64-unknown-linux-gnu aarch64-unknown-linux armv7a-unknown-linux-gnueabi" LINUX_x86="i386-unknown-linux-gnu i386-unknown-linux x86_64-unknown-linux-gnu x86_64-unknown-linux" -ANDROID="armv7-unknown-linux-androideabi aarch64-unknown-linux-android" +ANDROID="x86_64-unknown-linux-android armv7-unknown-linux-androideabi aarch64-unknown-linux-android" QNX="arm-unknown-nto-qnx-eabi" MACOS="i386-apple-darwin x86_64-apple-darwin" IOS="armv7-apple-ios arm64-apple-ios i386-apple-ios x86_64-apple-ios" From git at git.haskell.org Tue Jan 9 02:40:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:34 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: replace git subtree with submodule. (e71ca91) Message-ID: <20180109024034.4E06D3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/e71ca915e2f7e1ce9e25d819a011e5b8c7d3a5c3/ghc >--------------------------------------------------------------- commit e71ca915e2f7e1ce9e25d819a011e5b8c7d3a5c3 Author: Moritz Angermann Date: Fri Dec 8 13:12:09 2017 +0800 replace git subtree with submodule. >--------------------------------------------------------------- e71ca915e2f7e1ce9e25d819a011e5b8c7d3a5c3 .gitmodules | 3 +++ hadrian | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 8c4b070..3fbbecc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -138,3 +138,6 @@ [submodule "libraries/data-bitcode-edsl"] path = libraries/data-bitcode-edsl url = https://github.com/angerman/data-bitcode-edsl.git +[submodule "hadrian"] + path = hadrian + url = https://github.com/snowleopard/hadrian.git diff --git a/hadrian b/hadrian index 86216e2..323212d 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 86216e249f307a778bef3755afb7474910bc60cc +Subproject commit 323212d071d02e9435fb2c1eb3c47edd13cba195 From git at git.haskell.org Tue Jan 9 02:40:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:46 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng's head updated: Adds x86_64 android layout (a6f589d) Message-ID: <20180109024046.093B13A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/angerman/llvmng' now includes: ee2acdf Bump version to 8.4 351c460 Rip out hadrian subtree 2278c4c Add hadrian as a submodule 56fbfb3 Always use the safe open() call ce8d8c0 rts: Don't default to single capability when profiled 6fd8629 Allow users to ignore optimization changes c384029 Only look for locales of the form LL.VV c01e413 Improve Control.Monad.guard and Control.Monad.MonadPlus docs cc034b3 Fix #14135 by validity checking matches fdccc66 users-guide: Consistently document LLVM version requirement 15b2b95 users-guide: Fix various bits of markup af117d9 users-guide: Remove release notes for 8.2 6b96ac4 Sync up ghc-prim changelog from GHC 8.2 branch 504b706 Sync `ghc-prim` changelog from GHC 8.2, again f3f60b0 MkIface: Ensure syntactic compatibility with ghc 8.0.1 7fd99ed relnotes: Note GCC compatibility constraint 93e6ddd relnotes: Remove note about -split-sections on Windows c6cf13c Bump Cabal submodule 1779e3b Fix #14618 by applying a subst in deeplyInstantiate 2fc621d Make System.IO.openTempFile thread-safe on Windows ec6af9c Fix #14608 by restoring an unboxed tuple check fdfaa56 Make the Div and Mod type families `infixl 7` 80d90c5 Adds `-llvmng` b4fbdb7 Use packed structs. 36d1a1b no tbaa 68a8567 Adds test 4430839 Adds `smp` flag to rts.cabal. fafbdbf Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` 2e91fb2 Update iserv-proxy 80b2749 adds -latomic to. ghc-prim ba302ba Adds distrib/Makefile from @alpmestan e71ca91 replace git subtree with submodule. 855c9a7 Add network submodule. 60d67d0 bump submodules a6f589d Adds x86_64 android layout From git at git.haskell.org Tue Jan 9 02:40:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 02:40:37 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Add network submodule. (855c9a7) Message-ID: <20180109024037.1A96E3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/855c9a7d1ead44d33a85939d133ba10153be97f9/ghc >--------------------------------------------------------------- commit 855c9a7d1ead44d33a85939d133ba10153be97f9 Author: Moritz Angermann Date: Mon Nov 27 11:44:46 2017 +0800 Add network submodule. >--------------------------------------------------------------- 855c9a7d1ead44d33a85939d133ba10153be97f9 .gitmodules | 3 +++ libraries/network | 1 + 2 files changed, 4 insertions(+) diff --git a/.gitmodules b/.gitmodules index 3fbbecc..8a330d6 100644 --- a/.gitmodules +++ b/.gitmodules @@ -141,3 +141,6 @@ [submodule "hadrian"] path = hadrian url = https://github.com/snowleopard/hadrian.git +[submodule "libraries/network"] + path = libraries/network + url = https://github.com/haskell/network.git diff --git a/libraries/network b/libraries/network new file mode 160000 index 0000000..fe70032 --- /dev/null +++ b/libraries/network @@ -0,0 +1 @@ +Subproject commit fe7003293c9a08497a9df6cc18bb3868c96bda8f From git at git.haskell.org Tue Jan 9 08:52:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Jan 2018 08:52:56 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump versions. 8.3 -> 8.4 (9824f6e) Message-ID: <20180109085256.6B3093A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/9824f6e47371536fcf71078334b82c94fc92a111/ghc >--------------------------------------------------------------- commit 9824f6e47371536fcf71078334b82c94fc92a111 Author: Moritz Angermann Date: Tue Jan 9 11:06:33 2018 +0800 bump versions. 8.3 -> 8.4 >--------------------------------------------------------------- 9824f6e47371536fcf71078334b82c94fc92a111 libraries/libiserv/libiserv.cabal | 4 ++-- utils/iserv-proxy/iserv-proxy.cabal | 4 ++-- utils/iserv/iserv.cabal | 6 +++--- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index 8a3557d..3a5368e 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -1,5 +1,5 @@ Name: libiserv -Version: 8.3 +Version: 8.4 Copyright: XXX License: BSD3 -- XXX License-File: LICENSE @@ -25,7 +25,7 @@ Library bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3 + ghci == 8.4.* if flag(network) Exposed-Modules: Remote.Message , Remote.Slave diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal index e5cfd99..fa25c77 100644 --- a/utils/iserv-proxy/iserv-proxy.cabal +++ b/utils/iserv-proxy/iserv-proxy.cabal @@ -1,5 +1,5 @@ Name: iserv-proxy -Version: 8.3 +Version: 8.4 Copyright: XXX License: BSD3 -- XXX License-File: LICENSE @@ -75,4 +75,4 @@ Executable iserv-proxy directory >= 1.3 && < 1.4, network >= 2.6, filepath >= 1.4 && < 1.5, - libiserv == 8.3 + libiserv == 8.4 diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal index 217c5dd..f2a0a41 100644 --- a/utils/iserv/iserv.cabal +++ b/utils/iserv/iserv.cabal @@ -1,5 +1,5 @@ Name: iserv -Version: 8.3 +Version: 8.4 Copyright: XXX License: BSD3 -- XXX License-File: LICENSE @@ -35,8 +35,8 @@ Executable iserv bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3, - libiserv == 8.3 + ghci == 8.4.*, + libiserv == 8.4 if os(windows) Cpp-Options: -DWINDOWS From git at git.haskell.org Wed Jan 10 08:20:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Jan 2018 08:20:58 +0000 (UTC) Subject: [commit: ghc] master: Fix two more bugs in partial signatures (1577908) Message-ID: <20180110082058.35AA73A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1577908f2a9db0fcf6f749d40dd75481015f5497/ghc >--------------------------------------------------------------- commit 1577908f2a9db0fcf6f749d40dd75481015f5497 Author: Simon Peyton Jones Date: Tue Jan 9 16:20:46 2018 +0000 Fix two more bugs in partial signatures These were shown up by Trac #14643 Bug 1: if we had a single partial signature for two functions f, g :: forall a. _ -> a then we made two different SigTvs but with the sane Name. This was jolly confusing and ultimately led to deeply bogus results with Any's appearing in the resulting program. Yikes. Fix: clone the quantified variables in TcSigs.tcInstSig (as indeed its name suggests). Bug 2: we were not eliminating duplicate/superclass constraints in the partial signatures of a mutually recursive group. Easy to fix: we are already doing dup/superclass elim in TcSimplify.decideQuantification. So we move the partial-sig constraints there too. >--------------------------------------------------------------- 1577908f2a9db0fcf6f749d40dd75481015f5497 compiler/typecheck/TcHsType.hs | 10 ++--- compiler/typecheck/TcMType.hs | 34 +++++++++------- compiler/typecheck/TcSigs.hs | 24 ++++++++++-- compiler/typecheck/TcSimplify.hs | 45 +++++++++++++--------- .../tests/partial-sigs/should_compile/T14643.hs | 9 +++++ .../partial-sigs/should_compile/T14643.stderr | 8 ++++ .../tests/partial-sigs/should_compile/T14643a.hs | 9 +++++ .../partial-sigs/should_compile/T14643a.stderr | 8 ++++ testsuite/tests/partial-sigs/should_compile/all.T | 7 +++- .../tests/partial-sigs/should_fail/T14040a.stderr | 2 +- testsuite/tests/partial-sigs/should_fail/all.T | 2 +- 11 files changed, 113 insertions(+), 45 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1577908f2a9db0fcf6f749d40dd75481015f5497 From git at git.haskell.org Wed Jan 10 08:21:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Jan 2018 08:21:01 +0000 (UTC) Subject: [commit: ghc] master: Small local refactoring (448685c) Message-ID: <20180110082101.03BD13A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/448685c352542155f2e2361776c3b7f5e2a051ca/ghc >--------------------------------------------------------------- commit 448685c352542155f2e2361776c3b7f5e2a051ca Author: Simon Peyton Jones Date: Tue Jan 9 16:18:37 2018 +0000 Small local refactoring >--------------------------------------------------------------- 448685c352542155f2e2361776c3b7f5e2a051ca compiler/typecheck/TcHsType.hs | 37 ++++++++++++------------------------- 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 49d488a..52183a8 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1684,32 +1684,19 @@ tcExplicitTKBndrsX new_tv orig_hs_tvs thing_inside ; return (result, bound_tvs `unionVarSet` mkVarSet tvs) } where - go [] thing = thing [] - go (L _ hs_tv : hs_tvs) thing - = do { tv <- tcHsTyVarBndr new_tv hs_tv - ; tcExtendTyVarEnv [tv] $ - go hs_tvs $ \ tvs -> - thing (tv : tvs) } - -tcHsTyVarBndr :: (Name -> Kind -> TcM TyVar) - -> HsTyVarBndr GhcRn -> TcM TcTyVar --- Return a SkolemTv TcTyVar, initialised with a kind variable. --- Typically the Kind inside the HsTyVarBndr will be a tyvar --- with a mutable kind in it. --- NB: These variables must not be in scope. This function --- is not appropriate for use with associated types, for example. --- --- Returned TcTyVar has the same name; no cloning --- --- See also Note [Associated type tyvar names] in Class --- -tcHsTyVarBndr new_tv (UserTyVar (L _ name)) - = do { kind <- newMetaKindVar - ; new_tv name kind } + go [] thing = thing [] + go (L _ hs_tv : hs_tvs) thing = do { tv <- tc_hs_tv hs_tv + ; tcExtendTyVarEnv [tv] $ + go hs_tvs $ \ tvs -> + thing (tv : tvs) } + + tc_hs_tv (UserTyVar (L _ name)) + = do { kind <- newMetaKindVar + ; new_tv name kind } -tcHsTyVarBndr new_tv (KindedTyVar (L _ name) kind) - = do { kind <- tcLHsKindSig kind - ; new_tv name kind } + tc_hs_tv (KindedTyVar (L _ name) kind) + = do { kind <- tcLHsKindSig kind + ; new_tv name kind } newWildTyVar :: Name -> TcM TcTyVar -- ^ New unification variable for a wildcard From git at git.haskell.org Wed Jan 10 08:21:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Jan 2018 08:21:03 +0000 (UTC) Subject: [commit: ghc] master: Remove a bogus warning (30b1fe2) Message-ID: <20180110082103.D97F93A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30b1fe2f305097955870ada93700eb149a05b4ef/ghc >--------------------------------------------------------------- commit 30b1fe2f305097955870ada93700eb149a05b4ef Author: Simon Peyton Jones Date: Tue Jan 9 13:51:40 2018 +0000 Remove a bogus warning The new comment explains why this warning can legitimately fire, so I've removed it entirely. Lint will cath any bad cases. >--------------------------------------------------------------- 30b1fe2f305097955870ada93700eb149a05b4ef compiler/simplCore/OccurAnal.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 2be47fb..bcc8410 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2169,7 +2169,12 @@ markJoinOneShots mb_join_arity bndrs Just n -> go n bndrs where go 0 bndrs = bndrs - go _ [] = WARN( True, ppr mb_join_arity <+> ppr bndrs ) [] + go _ [] = [] -- This can legitimately happen. + -- e.g. let j = case ... in j True + -- This will become an arity-1 join point after the + -- simplifier has eta-expanded it; but it may not have + -- enough lambdas /yet/. (Lint checks that JoinIds do + -- have enough lambdas.) go n (b:bs) = b' : go (n-1) bs where b' | isId b = setOneShotLambda b From git at git.haskell.org Wed Jan 10 08:21:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Jan 2018 08:21:10 +0000 (UTC) Subject: [commit: ghc] master: preInlineUnconditionally is ok for INLINEABLE (1c1e46c) Message-ID: <20180110082110.012F63A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c1e46c1292f4ac69275770ed588401535abec45/ghc >--------------------------------------------------------------- commit 1c1e46c1292f4ac69275770ed588401535abec45 Author: Simon Peyton Jones Date: Tue Jan 9 16:11:44 2018 +0000 preInlineUnconditionally is ok for INLINEABLE When debugging Trac #14650, I found a place where we had let {-# INLINEABLE f #-} f = BIG in f 7 but 'f' wasn't getting inlined at its unique call site. There's a good reason for that with INLINE things, which should only inline when saturated, but not for INILNEABLE things. This patch narrows the case where preInlineUnconditionally gives up. It significantly shortens (and improves) the code for #14650. >--------------------------------------------------------------- 1c1e46c1292f4ac69275770ed588401535abec45 compiler/simplCore/SimplUtils.hs | 54 ++++++++++++++++++++++++++-------------- compiler/simplCore/Simplify.hs | 17 ++++++------- 2 files changed, 43 insertions(+), 28 deletions(-) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index dfe8b62..d86adbb 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1082,6 +1082,11 @@ want PreInlineUnconditionally to second-guess it. A live example is Trac #3736. c.f. Note [Stable unfoldings and postInlineUnconditionally] +NB: if the pragama is INLINEABLE, then we don't want to behave int +this special way -- an INLINEABLE pragam just says to GHC "inline this +if you like". But if there is a unique occurrence, we want to inline +the stable unfolding, not the RHS. + Note [Top-level bottoming Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Don't inline top-level Ids that are bottoming, even if they are used just @@ -1095,33 +1100,44 @@ is a term (not a coercion) so we can't necessarily inline the latter in the former. -} -preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool +preInlineUnconditionally + :: SimplEnv -> TopLevelFlag -> InId + -> InExpr -> StaticEnv -- These two go together + -> Maybe SimplEnv -- Returned env has extended substitution -- Precondition: rhs satisfies the let/app invariant -- See Note [CoreSyn let/app invariant] in CoreSyn -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings -preInlineUnconditionally env top_lvl bndr rhs - | not pre_inline_unconditionally = False - | not active = False - | isStableUnfolding (idUnfolding bndr) = False -- Note [Stable unfoldings and preInlineUnconditionally] - | isTopLevel top_lvl && isBottomingId bndr = False -- Note [Top-level bottoming Ids] - | isCoVar bndr = False -- Note [Do not inline CoVars unconditionally] - | isExitJoinId bndr = False - | otherwise = case idOccInfo bndr of - IAmDead -> True -- Happens in ((\x.1) v) - occ at OneOcc { occ_one_br = True } - -> try_once (occ_in_lam occ) - (occ_int_cxt occ) - _ -> False +preInlineUnconditionally env top_lvl bndr rhs rhs_env + | not pre_inline_unconditionally = Nothing + | not active = Nothing + | isTopLevel top_lvl && isBottomingId bndr = Nothing -- Note [Top-level bottoming Ids] + | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] + | isExitJoinId bndr = Nothing + | not (one_occ (idOccInfo bndr)) = Nothing + | not (isStableUnfolding unf) = Just (extend_subst_with rhs) + + -- Note [Stable unfoldings and preInlineUnconditionally] + | isInlinablePragma inline_prag + , Just inl <- maybeUnfoldingTemplate unf = Just (extend_subst_with inl) + | otherwise = Nothing where + unf = idUnfolding bndr + extend_subst_with inl_rhs = extendIdSubst env bndr (mkContEx rhs_env inl_rhs) + + one_occ IAmDead = True -- Happens in ((\x.1) v) + one_occ (OneOcc { occ_one_br = True -- One textual occurrence + , occ_in_lam = in_lam + , occ_int_cxt = int_cxt }) + | not in_lam = isNotTopLevel top_lvl || early_phase + | otherwise = int_cxt && canInlineInLam rhs + one_occ _ = False + pre_inline_unconditionally = gopt Opt_SimplPreInlining (seDynFlags env) mode = getMode env - active = isActive (sm_phase mode) act + active = isActive (sm_phase mode) (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] - act = idInlineActivation bndr - try_once in_lam int_cxt -- There's one textual occurrence - | not in_lam = isNotTopLevel top_lvl || early_phase - | otherwise = int_cxt && canInlineInLam rhs + inline_prag = idInlinePragma bndr -- Be very careful before inlining inside a lambda, because (a) we must not -- invalidate occurrence information, and (b) we want to avoid pushing a diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 3f60257..b123055 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -196,11 +196,10 @@ simplRecOrTopPair :: SimplEnv -> SimplM (SimplFloats, SimplEnv) simplRecOrTopPair env top_lvl is_rec mb_cont old_bndr new_bndr rhs - | preInlineUnconditionally env top_lvl old_bndr rhs + | Just env' <- preInlineUnconditionally env top_lvl old_bndr rhs env = trace_bind "pre-inline-uncond" $ do { tick (PreInlineUnconditionally old_bndr) - ; return ( emptyFloats env - , extendIdSubst env old_bndr (mkContEx env rhs)) } + ; return ( emptyFloats env, env' ) } | Just cont <- mb_cont = ASSERT( isNotTopLevel top_lvl && isJoinId new_bndr ) @@ -1368,11 +1367,11 @@ simplNonRecE :: SimplEnv -- the call to simplLam in simplExprF (Lam ...) simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont - | ASSERT( isId bndr && not (isJoinId bndr) ) - preInlineUnconditionally env NotTopLevel bndr rhs + | ASSERT( isId bndr && not (isJoinId bndr) ) True + , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se = do { tick (PreInlineUnconditionally bndr) ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont } + simplLam env' bndrs body cont } -- Deal with strict bindings | isStrictId bndr -- Includes coercions @@ -1461,10 +1460,10 @@ simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) simplNonRecJoinPoint env bndr rhs body cont - | ASSERT( isJoinId bndr ) - preInlineUnconditionally env NotTopLevel bndr rhs + | ASSERT( isJoinId bndr ) True + , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env = do { tick (PreInlineUnconditionally bndr) - ; simplExprF (extendIdSubst env bndr (mkContEx env rhs)) body cont } + ; simplExprF env' body cont } | otherwise = wrapJoinCont env cont $ \ env cont -> From git at git.haskell.org Wed Jan 10 08:21:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Jan 2018 08:21:07 +0000 (UTC) Subject: [commit: ghc] master: Fix join-point decision (66ff794) Message-ID: <20180110082107.2821F3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/66ff794fedf6e81e727dc8f651e63afe6f2a874b/ghc >--------------------------------------------------------------- commit 66ff794fedf6e81e727dc8f651e63afe6f2a874b Author: Simon Peyton Jones Date: Tue Jan 9 13:53:09 2018 +0000 Fix join-point decision This patch moves the "ok_unfolding" test from CoreOpt.joinPointBinding_maybe to OccurAnal.decideJoinPointHood Previously the occurrence analyser was deciding to make something a join point, but the simplifier was reversing that decision, which made the decision about /other/ bindings invalid. Fixes Trac #14650. >--------------------------------------------------------------- 66ff794fedf6e81e727dc8f651e63afe6f2a874b compiler/coreSyn/CoreOpt.hs | 44 +------------ compiler/simplCore/OccurAnal.hs | 68 +++++++++++++++---- testsuite/tests/simplCore/should_compile/T14650.hs | 76 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 4 files changed, 136 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 66ff794fedf6e81e727dc8f651e63afe6f2a874b From git at git.haskell.org Wed Jan 10 13:51:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Jan 2018 13:51:21 +0000 (UTC) Subject: [commit: ghc] master: Lift constructor tag allocation out of a loop (dbdf77d) Message-ID: <20180110135121.F18D13A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbdf77d92c9cd0bbb269137de0bf8754573cdc1e/ghc >--------------------------------------------------------------- commit dbdf77d92c9cd0bbb269137de0bf8754573cdc1e Author: Bartosz Nitka Date: Fri Jan 5 15:20:05 2018 +0000 Lift constructor tag allocation out of a loop Before this change, for each constructor that we want to allocate a tag for we would traverse a list of all the constructors in a datatype to determine which tag a constructor should get. This is obviously quadratic and for datatypes with 10k constructors it actually makes a big difference. This change implements the plan outlined by @simonpj in https://mail.haskell.org/pipermail/ghc-devs/2017-October/014974.html which is basically about using a map and constructing it outside the loop. One place where things got a bit awkward was TysWiredIn.hs, it would have been possible to just assign the tags by hand, but that seemed error-prone to me, so I decided to go through a map there as well. Test Plan: ./validate On a file with 10k constructors Before: 8,130,522,344 bytes allocated in the heap Total time 3.682s ( 3.920s elapsed) After: 4,133,478,744 bytes allocated in the heap Total time 2.509s ( 2.750s elapsed) Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: goldfire, rwbarton, thomie, simonmar, carter, simonpj GHC Trac Issues: #14657 Differential Revision: https://phabricator.haskell.org/D4289 >--------------------------------------------------------------- dbdf77d92c9cd0bbb269137de0bf8754573cdc1e compiler/basicTypes/DataCon.hs | 5 ++--- compiler/iface/BuildTyCl.hs | 13 +++++++++--- compiler/iface/TcIface.hs | 5 ++++- compiler/prelude/TysWiredIn.hs | 10 ++++++++- compiler/typecheck/TcTyClsDecls.hs | 13 +++++++----- compiler/types/TyCon.hs | 25 ++++++++++++++++++++++- compiler/vectorise/Vectorise/Generic/PData.hs | 4 ++++ compiler/vectorise/Vectorise/Type/TyConDecl.hs | 2 ++ testsuite/tests/perf/compiler/all.T | 12 +++++++++++ testsuite/tests/perf/compiler/genManyConstructors | 25 +++++++++++++++++++++++ 10 files changed, 100 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dbdf77d92c9cd0bbb269137de0bf8754573cdc1e From git at git.haskell.org Wed Jan 10 16:49:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Jan 2018 16:49:15 +0000 (UTC) Subject: [commit: ghc] master: Fix previous patch (f3f90a0) Message-ID: <20180110164915.B3F5F3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3f90a079179e085295ee7edd2dda6505799370c/ghc >--------------------------------------------------------------- commit f3f90a079179e085295ee7edd2dda6505799370c Author: Simon Peyton Jones Date: Wed Jan 10 16:46:55 2018 +0000 Fix previous patch This recent patch commit 1577908f2a9db0fcf6f749d40dd75481015f5497 Author: Simon Peyton Jones Date: Tue Jan 9 16:20:46 2018 +0000 Fix two more bugs in partial signatures These were shown up by Trac #14643 failed validation for typecheck/should_run/T10846 (Reported in Trac #14658.) The fix is simple. >--------------------------------------------------------------- f3f90a079179e085295ee7edd2dda6505799370c compiler/typecheck/TcSimplify.hs | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 0048c09..72c9af9 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -878,20 +878,25 @@ decideQuantification infer_mode rhs_tclvl name_taus psigs candidates -- predicates to actually quantify over -- NB: decideQuantifiedTyVars turned some meta tyvars -- into quantified skolems, so we have to zonk again - ; let psig_theta = concatMap sig_inst_theta psigs - ; all_candidates <- TcM.zonkTcTypes (psig_theta ++ candidates) - ; let theta = pickQuantifiablePreds (mkVarSet qtvs) $ - mkMinimalBySCs id $ -- See Note [Minimize by Superclasses] - all_candidates + ; candidates <- TcM.zonkTcTypes candidates + ; psig_theta <- TcM.zonkTcTypes (concatMap sig_inst_theta psigs) + ; let quantifiable_candidates + = pickQuantifiablePreds (mkVarSet qtvs) candidates + -- NB: do /not/ run pickQuantifieablePreds over psig_theta, + -- because we always want to quantify over psig_theta, and not + -- drop any of them; e.g. CallStack constraints. c.f Trac #14658 + + theta = mkMinimalBySCs id $ -- See Note [Minimize by Superclasses] + (psig_theta ++ quantifiable_candidates) ; traceTc "decideQuantification" - (vcat [ text "infer_mode:" <+> ppr infer_mode - , text "candidates:" <+> ppr candidates - , text "all_candidates:" <+> ppr all_candidates - , text "mono_tvs:" <+> ppr mono_tvs - , text "co_vars:" <+> ppr co_vars - , text "qtvs:" <+> ppr qtvs - , text "theta:" <+> ppr theta ]) + (vcat [ text "infer_mode:" <+> ppr infer_mode + , text "candidates:" <+> ppr candidates + , text "psig_theta:" <+> ppr psig_theta + , text "mono_tvs:" <+> ppr mono_tvs + , text "co_vars:" <+> ppr co_vars + , text "qtvs:" <+> ppr qtvs + , text "theta:" <+> ppr theta ]) ; return (qtvs, theta, co_vars) } ------------------ From git at git.haskell.org Thu Jan 11 00:47:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 00:47:07 +0000 (UTC) Subject: [commit: ghc] branch 'wip/better-machine-readable-stats' created Message-ID: <20180111004707.6E6063A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/better-machine-readable-stats Referencing: 88b3c6005f2c2a3bde3fff7f2ebc828a135fedd7 From git at git.haskell.org Thu Jan 11 00:47:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 00:47:10 +0000 (UTC) Subject: [commit: ghc] wip/better-machine-readable-stats: [rts] Adjust whitehole_spin (88b3c60) Message-ID: <20180111004710.3EE3A3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/better-machine-readable-stats Link : http://ghc.haskell.org/trac/ghc/changeset/88b3c6005f2c2a3bde3fff7f2ebc828a135fedd7/ghc >--------------------------------------------------------------- commit 88b3c6005f2c2a3bde3fff7f2ebc828a135fedd7 Author: Douglas Wilson Date: Thu Jan 11 13:39:20 2018 +1300 [rts] Adjust whitehole_spin Rename to whitehole_gc_spin, in preparation for adding stats for the whitehole busy-loop in SMPClosureOps. Make whitehole_gc_spin volatile, and move it to be defined and statically initialised in GC.c. This saves some #ifs, and I'm pretty sure it should be volatile. >--------------------------------------------------------------- 88b3c6005f2c2a3bde3fff7f2ebc828a135fedd7 rts/Stats.c | 4 ++-- rts/sm/Evac.c | 7 ++----- rts/sm/GC.c | 4 ++++ rts/sm/GC.h | 2 +- rts/sm/Storage.c | 4 ---- 5 files changed, 9 insertions(+), 12 deletions(-) diff --git a/rts/Stats.c b/rts/Stats.c index fa85878..c5d154f 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -16,7 +16,7 @@ #include "Profiling.h" #include "GetTime.h" #include "sm/Storage.h" -#include "sm/GC.h" // gc_alloc_block_sync, whitehole_spin +#include "sm/GC.h" // gc_alloc_block_sync, whitehole_gc_spin #include "sm/GCThread.h" #include "sm/BlockAlloc.h" @@ -769,7 +769,7 @@ stat_exit (void) uint32_t g; statsPrintf("gc_alloc_block_sync: %"FMT_Word64"\n", gc_alloc_block_sync.spin); - statsPrintf("whitehole_spin: %"FMT_Word64"\n", whitehole_spin); + statsPrintf("whitehole_gc_spin: %"FMT_Word64"\n", whitehole_gc_spin); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { statsPrintf("gen[%d].sync: %"FMT_Word64"\n", g, generations[g].sync.spin); } diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index 526f063..738e3e4 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -28,10 +28,6 @@ #include "CNF.h" #include "Scav.h" -#if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC) -StgWord64 whitehole_spin = 0; -#endif - #if defined(THREADED_RTS) && !defined(PARALLEL_GC) #define evacuate(p) evacuate1(p) #define evacuate_BLACKHOLE(p) evacuate_BLACKHOLE1(p) @@ -197,8 +193,9 @@ spin: info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info); if (info == (W_)&stg_WHITEHOLE_info) { #if defined(PROF_SPIN) - whitehole_spin++; + whitehole_gc_spin++; #endif + busy_wait_nop(); goto spin; } if (IS_FORWARDING_PTR(info)) { diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 4dbc5e0..c5ab7a8 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -133,6 +133,10 @@ uint32_t n_gc_threads; // For stats: static long copied; // *words* copied & scavenged during this GC +#if defined(PROF_SPIN) && defined(THREADED_RTS) +volatile StgWord64 whitehole_gc_spin = 0; +#endif + bool work_stealing; uint32_t static_flag = STATIC_FLAG_B; diff --git a/rts/sm/GC.h b/rts/sm/GC.h index c6b0c13..78f0549 100644 --- a/rts/sm/GC.h +++ b/rts/sm/GC.h @@ -46,7 +46,7 @@ extern uint32_t mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS, mutlist_OTHERS, #endif #if defined(PROF_SPIN) && defined(THREADED_RTS) -extern StgWord64 whitehole_spin; +extern volatile StgWord64 whitehole_gc_spin; #endif void gcWorkerThread (Capability *cap); diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index e801c34..c4dbdc2 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -197,11 +197,7 @@ initStorage (void) #if defined(THREADED_RTS) initSpinLock(&gc_alloc_block_sync); -#if defined(PROF_SPIN) - whitehole_spin = 0; #endif -#endif - N = 0; for (n = 0; n < n_numa_nodes; n++) { From git at git.haskell.org Thu Jan 11 02:03:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 02:03:55 +0000 (UTC) Subject: [commit: ghc] wip/better-machine-readable-stats: [rts] Adjust whitehole_spin (502ec29) Message-ID: <20180111020355.F36473A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/better-machine-readable-stats Link : http://ghc.haskell.org/trac/ghc/changeset/502ec29e64f0ec5b54ee4051b9b25c859fb66e74/ghc >--------------------------------------------------------------- commit 502ec29e64f0ec5b54ee4051b9b25c859fb66e74 Author: Douglas Wilson Date: Thu Jan 11 13:39:20 2018 +1300 [rts] Adjust whitehole_spin Summary: Rename to whitehole_gc_spin, in preparation for adding stats for the whitehole busy-loop in SMPClosureOps. Make whitehole_gc_spin volatile, and move it to be defined and statically initialised in GC.c. This saves some #ifs, and I'm pretty sure it should be volatile. Test Plan: ./validate Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4300 >--------------------------------------------------------------- 502ec29e64f0ec5b54ee4051b9b25c859fb66e74 rts/Stats.c | 5 +++-- rts/sm/Evac.c | 7 ++----- rts/sm/GC.c | 4 ++++ rts/sm/GC.h | 2 +- rts/sm/Storage.c | 4 ---- 5 files changed, 10 insertions(+), 12 deletions(-) diff --git a/rts/Stats.c b/rts/Stats.c index fa85878..26bdac0 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -16,7 +16,7 @@ #include "Profiling.h" #include "GetTime.h" #include "sm/Storage.h" -#include "sm/GC.h" // gc_alloc_block_sync, whitehole_spin +#include "sm/GC.h" // gc_alloc_block_sync, whitehole_gc_spin #include "sm/GCThread.h" #include "sm/BlockAlloc.h" @@ -769,7 +769,8 @@ stat_exit (void) uint32_t g; statsPrintf("gc_alloc_block_sync: %"FMT_Word64"\n", gc_alloc_block_sync.spin); - statsPrintf("whitehole_spin: %"FMT_Word64"\n", whitehole_spin); + statsPrintf("whitehole_gc_spin: %"FMT_Word64"\n" + , whitehole_gc_spin); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { statsPrintf("gen[%d].sync: %"FMT_Word64"\n", g, generations[g].sync.spin); } diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index 526f063..738e3e4 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -28,10 +28,6 @@ #include "CNF.h" #include "Scav.h" -#if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC) -StgWord64 whitehole_spin = 0; -#endif - #if defined(THREADED_RTS) && !defined(PARALLEL_GC) #define evacuate(p) evacuate1(p) #define evacuate_BLACKHOLE(p) evacuate_BLACKHOLE1(p) @@ -197,8 +193,9 @@ spin: info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info); if (info == (W_)&stg_WHITEHOLE_info) { #if defined(PROF_SPIN) - whitehole_spin++; + whitehole_gc_spin++; #endif + busy_wait_nop(); goto spin; } if (IS_FORWARDING_PTR(info)) { diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 4dbc5e0..c5ab7a8 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -133,6 +133,10 @@ uint32_t n_gc_threads; // For stats: static long copied; // *words* copied & scavenged during this GC +#if defined(PROF_SPIN) && defined(THREADED_RTS) +volatile StgWord64 whitehole_gc_spin = 0; +#endif + bool work_stealing; uint32_t static_flag = STATIC_FLAG_B; diff --git a/rts/sm/GC.h b/rts/sm/GC.h index c6b0c13..78f0549 100644 --- a/rts/sm/GC.h +++ b/rts/sm/GC.h @@ -46,7 +46,7 @@ extern uint32_t mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS, mutlist_OTHERS, #endif #if defined(PROF_SPIN) && defined(THREADED_RTS) -extern StgWord64 whitehole_spin; +extern volatile StgWord64 whitehole_gc_spin; #endif void gcWorkerThread (Capability *cap); diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index e801c34..c4dbdc2 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -197,11 +197,7 @@ initStorage (void) #if defined(THREADED_RTS) initSpinLock(&gc_alloc_block_sync); -#if defined(PROF_SPIN) - whitehole_spin = 0; #endif -#endif - N = 0; for (n = 0; n < n_numa_nodes; n++) { From git at git.haskell.org Thu Jan 11 02:04:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 02:04:01 +0000 (UTC) Subject: [commit: ghc] wip/better-machine-readable-stats: [rts] Add spin and yield counters for reallyLockClosure and waitForGcThreads (854f886) Message-ID: <20180111020401.95D043A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/better-machine-readable-stats Link : http://ghc.haskell.org/trac/ghc/changeset/854f8865b7bf42070d7e12d4646c35a75c6c4b97/ghc >--------------------------------------------------------------- commit 854f8865b7bf42070d7e12d4646c35a75c6c4b97 Author: Douglas Wilson Date: Thu Jan 11 14:17:46 2018 +1300 [rts] Add spin and yield counters for reallyLockClosure and waitForGcThreads Summary: Also add busy_wait_nops in these loops. The loop in StgMiscClosures.cmm doesn't use the counters yet, I need help with the cmm. Test Plan: ./validate Check it builds with #define PROF_SPIN removed from includes/rts/Config.h Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4302 >--------------------------------------------------------------- 854f8865b7bf42070d7e12d4646c35a75c6c4b97 rts/SMPClosureOps.h | 12 ++++++++++++ rts/Stats.c | 17 +++++++++++++++++ rts/StgMiscClosures.cmm | 7 +++++++ rts/sm/GC.c | 14 ++++++++++++++ rts/sm/GC.h | 2 ++ 5 files changed, 52 insertions(+) diff --git a/rts/SMPClosureOps.h b/rts/SMPClosureOps.h index 4ea1c55..fa6fe01 100644 --- a/rts/SMPClosureOps.h +++ b/rts/SMPClosureOps.h @@ -38,6 +38,11 @@ EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info); #if defined(THREADED_RTS) +#if defined(PROF_SPIN) +extern volatile StgWord64 whitehole_lock_closure_spin; +extern volatile StgWord64 whitehole_lock_closure_yield; +#endif + /* ----------------------------------------------------------------------------- * Locking/unlocking closures * @@ -56,7 +61,14 @@ EXTERN_INLINE StgInfoTable *reallyLockClosure(StgClosure *p) do { info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info); if (info != (W_)&stg_WHITEHOLE_info) return (StgInfoTable *)info; +#if defined(PROF_SPIN) + atomic_inc(&whitehole_lock_closure_spin, 1); +#endif + busy_wait_nop(); } while (++i < SPIN_COUNT); +#if defined(PROF_SPIN) + atomic_inc(&whitehole_lock_closure_spin, 1); +#endif yieldThread(); } while (1); } diff --git a/rts/Stats.c b/rts/Stats.c index 07cad3f..341db7e 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -43,6 +43,13 @@ static Time HCe_start_time, HCe_tot_time = 0; // heap census prof elap time #define PROF_VAL(x) 0 #endif +// TODO REVIEWERS: This seems a bit of an odd place to do this, where would be +// better? +#if defined(PROF_SPIN) +volatile StgWord64 whitehole_lock_closure_spin = 0; +volatile StgWord64 whitehole_lock_closure_yield = 0; +#endif + // // All the stats! // @@ -780,6 +787,16 @@ stat_exit (void) , col_width[0], "whitehole_gc" , col_width[1], whitehole_gc_spin , col_width[2], (StgWord64)0); + statsPrintf("%*s" "%*" FMT_Word64 "%*" FMT_Word64 "\n" + , col_width[0], "whitehole_lock_closure" + , col_width[1], whitehole_lock_closure_spin + , col_width[2], whitehole_lock_closure_yield); + // waitForGcThreads isn't really spin-locking(see the function) + // but these numbers still seem useful. + statsPrintf("%*s" "%*" FMT_Word64 "%*" FMT_Word64 "\n" + , col_width[0], "waitForGcThread" + , col_width[1], waitForGcThreads_spin + , col_width[2], waitForGcThreads_yield); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { int prefix_length = 0; diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index 361989d..2f0d61a 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -375,11 +375,18 @@ loop: // spin until the WHITEHOLE is updated info = StgHeader_info(node); if (info == stg_WHITEHOLE_info) { + // TODO REVIEWERS: I think these atomic_incs and the busy_wait_nop + // should happen, but I don't know how to write it in cmm. I think this + // code is only for the bytecode interpreter? + + // atomic_inc(&whitehole_lock_closure_spin, 1); i = i + 1; if (i == SPIN_COUNT) { i = 0; + // atomic_inc(&whitehole_lock_closure_yield, 1); ccall yieldThread(); } + // busy_wait_nop(); goto loop; } jump %ENTRY_CODE(info) (node); diff --git a/rts/sm/GC.c b/rts/sm/GC.c index c5ab7a8..1ab9652 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -134,6 +134,9 @@ uint32_t n_gc_threads; static long copied; // *words* copied & scavenged during this GC #if defined(PROF_SPIN) && defined(THREADED_RTS) +// spin and yield counts for the quasi-SpinLock in waitForGcThreads +volatile StgWord64 waitForGcThreads_spin = 0; +volatile StgWord64 waitForGcThreads_yield = 0; volatile StgWord64 whitehole_gc_spin = 0; #endif @@ -1154,6 +1157,9 @@ waitForGcThreads (Capability *cap USED_IF_THREADS, bool idle_cap[]) } } if (!retry) break; +#if defined(PROF_SPIN) + waitForGcThreads_yield++; +#endif yieldThread(); } @@ -1164,6 +1170,14 @@ waitForGcThreads (Capability *cap USED_IF_THREADS, bool idle_cap[]) rtsConfig.longGCSync(cap->no, t2 - t0); t1 = t2; } +#if defined(PROF_SPIN) + // This is a bit strange, we'll get more yields than spins. + // I guess that means it's not a spin-lock at all, but these + // numbers are still useful (I think). + if (retry) { + waitForGcThreads_spin++; + } +#endif } if (RtsFlags.GcFlags.longGCSync != 0 && diff --git a/rts/sm/GC.h b/rts/sm/GC.h index 78f0549..7fce87e 100644 --- a/rts/sm/GC.h +++ b/rts/sm/GC.h @@ -47,6 +47,8 @@ extern uint32_t mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS, mutlist_OTHERS, #if defined(PROF_SPIN) && defined(THREADED_RTS) extern volatile StgWord64 whitehole_gc_spin; +extern volatile StgWord64 waitForGcThreads_spin; +extern volatile StgWord64 waitForGcThreads_yield; #endif void gcWorkerThread (Capability *cap); From git at git.haskell.org Thu Jan 11 02:03:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 02:03:58 +0000 (UTC) Subject: [commit: ghc] wip/better-machine-readable-stats: [rts] Count yieldThread() calls in spin-locks, and show them in stats. (7e4b859) Message-ID: <20180111020358.C66C73A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/better-machine-readable-stats Link : http://ghc.haskell.org/trac/ghc/changeset/7e4b859edfd1abf742d5742436a13b9dba4b3270/ghc >--------------------------------------------------------------- commit 7e4b859edfd1abf742d5742436a13b9dba4b3270 Author: Douglas Wilson Date: Thu Jan 11 14:00:34 2018 +1300 [rts] Count yieldThread() calls in spin-locks, and show them in stats. Summary: The stats output for spin-locks is somewhat different. old: gc_alloc_block_sync: 0 whitehole_gc_spin: 0 gen[0].sync: 0 gen[1].sync: 0 new: Spins Yields gc_alloc_block_sync 0 0 whitehole_gc 0 0 gen[0].sync 0 0 gen[1].sync 0 0 Test Plan: ./validate Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #3553, #9221 Differential Revision: https://phabricator.haskell.org/D4301 >--------------------------------------------------------------- 7e4b859edfd1abf742d5742436a13b9dba4b3270 includes/rts/SpinLock.h | 5 ++++- rts/Stats.c | 28 ++++++++++++++++++++++++---- 2 files changed, 28 insertions(+), 5 deletions(-) diff --git a/includes/rts/SpinLock.h b/includes/rts/SpinLock.h index 6530a3a..1dca02f 100644 --- a/includes/rts/SpinLock.h +++ b/includes/rts/SpinLock.h @@ -27,7 +27,8 @@ typedef struct SpinLock_ { StgWord lock; - StgWord64 spin; // DEBUG version counts how much it spins + StgWord64 spin; // incremented every time we spin in ACQUIRE_SPIN_LOCK + StgWord64 yield; // incremented every time we yield in ACQUIRE_SPIN_LOCK } SpinLock; #else typedef StgWord SpinLock; @@ -49,6 +50,7 @@ INLINE_HEADER void ACQUIRE_SPIN_LOCK(SpinLock * p) p->spin++; busy_wait_nop(); } + p->yield++; yieldThread(); } while (1); } @@ -66,6 +68,7 @@ INLINE_HEADER void initSpinLock(SpinLock * p) write_barrier(); p->lock = 1; p->spin = 0; + p->yield = 0; } #else diff --git a/rts/Stats.c b/rts/Stats.c index 26bdac0..07cad3f 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -767,13 +767,33 @@ stat_exit (void) #if defined(THREADED_RTS) && defined(PROF_SPIN) { uint32_t g; + const int32_t col_width[] = {-20, 10, 10}; + statsPrintf("%*s" "%*s" "%*s" "\n" + , col_width[0], "" + , col_width[1], "Spins" + , col_width[2], "Yields"); + statsPrintf("%*s" "%*" FMT_Word64 "%*" FMT_Word64 "\n" + , col_width[0], "gc_alloc_block_sync" + , col_width[1], gc_alloc_block_sync.spin + , col_width[2], gc_alloc_block_sync.yield); + statsPrintf("%*s" "%*" FMT_Word64 "%*" FMT_Word64 "\n" + , col_width[0], "whitehole_gc" + , col_width[1], whitehole_gc_spin + , col_width[2], (StgWord64)0); - statsPrintf("gc_alloc_block_sync: %"FMT_Word64"\n", gc_alloc_block_sync.spin); - statsPrintf("whitehole_gc_spin: %"FMT_Word64"\n" - , whitehole_gc_spin); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - statsPrintf("gen[%d].sync: %"FMT_Word64"\n", g, generations[g].sync.spin); + int prefix_length = 0; + statsPrintf("gen[%" FMT_Word32 "%n", g, &prefix_length); + int suffix_length = col_width[0] + prefix_length; + suffix_length = + suffix_length > 0 ? col_width[0] : suffix_length; + + statsPrintf("%*s" "%*" FMT_Word64 "%*" FMT_Word64 "\n" + , suffix_length, "].sync" + , col_width[1], generations[g].sync.spin + , col_width[2], generations[g].sync.yield); } + } #endif } From git at git.haskell.org Thu Jan 11 06:27:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 06:27:54 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: an attempt to add assert code (failed, for now) (65d5f38) Message-ID: <20180111062754.61D323A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/65d5f383e04692e06431f7cc43b1cc1dca40ee9c/ghc >--------------------------------------------------------------- commit 65d5f383e04692e06431f7cc43b1cc1dca40ee9c Author: Gabor Greif Date: Wed Jan 10 22:41:24 2018 +0100 WIP: an attempt to add assert code (failed, for now) >--------------------------------------------------------------- 65d5f383e04692e06431f7cc43b1cc1dca40ee9c compiler/codeGen/StgCmmClosure.hs | 20 ++++++++++++++------ compiler/codeGen/StgCmmExpr.hs | 7 +++++++ rts/Apply.cmm | 9 +++++++++ 3 files changed, 30 insertions(+), 6 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index ef03eee..a52707c 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, RecordWildCards, LambdaCase #-} +{-# LANGUAGE CPP, RecordWildCards, LambdaCase, PatternSynonyms #-} ----------------------------------------------------------------------------- -- @@ -30,7 +30,7 @@ module StgCmmClosure ( maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable, -- * Used by other modules - CgLoc(..), SelfLoopInfo, CallMethod(..), + CgLoc(..), SelfLoopInfo, CallMethod(.., ReturnIt), nodeMustPointToIt, isKnownFun, funTag, tagForArity, getCallMethod, -- * ClosureInfo @@ -526,12 +526,15 @@ Known fun (>1 arg), fvs & yes & yes & registers & node When black-holing, single-entry closures could also be entered via node (rather than directly) to catch double-entry. -} +pattern ReturnIt :: CallMethod +pattern ReturnIt = ReturnIt' False + data CallMethod = EnterIt -- No args, not a function | JumpToIt BlockId [LocalReg] -- A join point or a header of a local loop - | ReturnIt -- It's a value (function, unboxed value, + | ReturnIt' Bool -- It's a value (function, unboxed value, -- or constructor), so just return it. | SlowCall -- Unknown fun, or known fun with @@ -626,15 +629,20 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function + getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id , OtherCon _ <- idUnfolding id , let str = occNameString (nameOccName name) - , take 4 str == "wild" || take 2 str == "ds" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True - , take 4 str == "wild" || take 2 str == "ds" - = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already + , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + -- , take 4 str == "wild" || (take 2 str == "ds" && str /= "ds1" && str /= "ds2") + -- , take 4 str == "wild" || (str == "ds" || str == "ds1" || str == "ds2" || str == "ds3") -- CRASH + -- , take 4 str == "wild" || (str == "ds2" || str == "ds3") -- CRASH + -- , take 4 str == "wild" || (str == "ds3") -- CRASH: FastString + , take 4 str == "wild" || (str == "ds2") + = pprTrace "####getCallMethod" (ppr id) ReturnIt' True -- seems to come from case, must be (tagged) WHNF already diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935..32b9ccf 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -31,6 +31,7 @@ import StgCmmClosure import StgSyn +import Module (rtsUnitId) import MkGraph import BlockId import Cmm @@ -743,6 +744,12 @@ cgIdApp fun_id args = do | otherwise -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged? + ReturnIt' True -- TODO: add assertion + -> ASSERT( null args ) ASSERT( not (isVoidTy (idType fun_id)) ) + do emitRtsCall rtsUnitId + (fsLit "checkTagged") [(fun, AddrHint)] False + emitReturn [fun] + EnterIt -> ASSERT( null args ) -- Discarding arguments emitEnter fun diff --git a/rts/Apply.cmm b/rts/Apply.cmm index 15d8250..dde6f41 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -12,6 +12,15 @@ #include "Cmm.h" +checkTagged ( P_ obj ) +{ + if (GETTAG(obj)==0) { + ccall debugBelch("NOT TAGGED! "); + } + return(); +} + + /* ---------------------------------------------------------------------------- * Evaluate a closure and return it. * From git at git.haskell.org Thu Jan 11 06:27:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 06:27:57 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: add taggedness assert when optimizing (4a741e0) Message-ID: <20180111062757.2C7A43A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/4a741e0a4c6cf3a1b7517bc34be12396dc91f7fb/ghc >--------------------------------------------------------------- commit 4a741e0a4c6cf3a1b7517bc34be12396dc91f7fb Author: Gabor Greif Date: Thu Jan 11 07:27:14 2018 +0100 WIP: add taggedness assert when optimizing >--------------------------------------------------------------- 4a741e0a4c6cf3a1b7517bc34be12396dc91f7fb compiler/codeGen/StgCmmClosure.hs | 23 ++--------------------- compiler/codeGen/StgCmmExpr.hs | 8 +++++++- 2 files changed, 9 insertions(+), 22 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index a52707c..f33a9f3 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -632,31 +632,12 @@ getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) - -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id , OtherCon _ <- idUnfolding id , let str = occNameString (nameOccName name) - , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True - -- , take 4 str == "wild" || (take 2 str == "ds" && str /= "ds1" && str /= "ds2") - -- , take 4 str == "wild" || (str == "ds" || str == "ds1" || str == "ds2" || str == "ds3") -- CRASH - -- , take 4 str == "wild" || (str == "ds2" || str == "ds3") -- CRASH - -- , take 4 str == "wild" || (str == "ds3") -- CRASH: FastString + -- , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True , take 4 str == "wild" || (str == "ds2") - = pprTrace "####getCallMethod" (ppr id) ReturnIt' True -- seems to come from case, must be (tagged) WHNF already + = pprTrace "####getCallMethod" (ppr id) ReturnIt' (str == "ds2") -- seems to come from case, must be (tagged) WHNF already - - - -{- - , head str /= '$' - -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ text str $$ ppr (idUnfolding id)) True --} -{- -getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info - | occNameString (nameOccName name) == "wild" -- TODO: make this robust - = ReturnIt -- seems to come from case, must be (tagged) WHNF already --} getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) EnterIt -- Not a function diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 32b9ccf..2a63f96 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -746,8 +746,14 @@ cgIdApp fun_id args = do ReturnIt' True -- TODO: add assertion -> ASSERT( null args ) ASSERT( not (isVoidTy (idType fun_id)) ) - do emitRtsCall rtsUnitId + do lgood <- newBlockId + lcall <- newBlockId + emit $ mkCbranch (cmmIsTagged dflags fun) + lgood lcall Nothing + emitLabel lcall + emitRtsCall rtsUnitId (fsLit "checkTagged") [(fun, AddrHint)] False + emitLabel lgood emitReturn [fun] EnterIt -> ASSERT( null args ) -- Discarding arguments From git at git.haskell.org Thu Jan 11 08:10:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 08:10:59 +0000 (UTC) Subject: [commit: ghc] wip/better-machine-readable-stats: [rts] [WIP] [RFC] Add all information from '+RTS -s' to '+RTS -t --machine-readable' (9982e81) Message-ID: <20180111081059.BE70C3A5F9@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/better-machine-readable-stats Link : http://ghc.haskell.org/trac/ghc/changeset/9982e8169201331e690df42d0b251827ac32c03b/ghc >--------------------------------------------------------------- commit 9982e8169201331e690df42d0b251827ac32c03b Author: Douglas Wilson Date: Thu Jan 11 16:58:20 2018 +1300 [rts] [WIP] [RFC] Add all information from '+RTS -s' to '+RTS -t --machine-readable' Summary: This is a rough draft to see if this is likely to be mergable. Example of the new output: ``` ["bytes_allocated", "13563288") ,"num_GCs", "13") ,"average_bytes_used", "461388") ,"num_byte_usage_samples", "673072") ,"num_byte_usage_samples", "2") ,"peak_megabytes_allocated", "7") ,"init_cpu_seconds", "0.002") ,"init_wall_seconds", "0.001") ,"mut_cpu_seconds", "0.007") ,"mut_wall_seconds", "0.006") ,"GC_cpu_seconds", "0.046") ,"GC_wall_seconds", "0.012") ,"copied_bytes", "2482464") ,"max_slop_bytes", "84688") ,"fragmentation_megabytes", "0") ,"gc-0-collections", "11") ,"gc-0-par_collections", "11") ,"gc-0-cpu_time_seconds", "0.00856") ,"gc-0-wall_time_seconds", "0.00214") ,"gc-0-avg_pause", "0.00019") ,"gc-0-max_pause", "0.00047") ,"gc-1-collections", "2") ,"gc-1-par_collections", "1") ,"gc-1-cpu_time_seconds", "0.03787") ,"gc-1-wall_time_seconds", "0.00999") ,"gc-1-avg_pause", "0.00499") ,"gc-1-max_pause", "0.00929") ,"work_balance", "7.78722") ,"task_count", "10") ,"bound_tasks_count", "1") ,"peak_worker_count", "9") ,"worker_count", "9") ,"n_capabilities", "4") ,"sparks_count", "0") ,"sparks_converted", "0") ,"sparks_overflowed", "0") ,"sparks_dud", "0") ,"sparks_garbage_collected", "0") ,"sparks_fizzled", "0") ,"alloc_rate", "1821930646") ,"productivity_user_percent", "14.26508") ,"productivity_elapsed_percent", "36.28410") ,"gc_alloc_block_sync.spin", "55") ,"gc_alloc_block_sync.yield", "0") ,"whitehole_gc.spin", "0") ,"whitehole_gc.yield", "0") ,"whitehole_lock_closure_spin", "0") ,"whitehole_lock_closure_yield", "0") ,"waitForGcThreads_spin", "123") ,"waitForGcThreads_yield", "1270") ,"gc_sync-0-spin", "0") ,"gc_sync-0-yield", "0") ,"gc_sync-1-spin", "1") ,"gc_sync-1-yield", "0") ] ``` # Please enter the commit message for your changes. Lines starting Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4303 >--------------------------------------------------------------- 9982e8169201331e690df42d0b251827ac32c03b rts/Stats.c | 243 ++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 164 insertions(+), 79 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9982e8169201331e690df42d0b251827ac32c03b From git at git.haskell.org Thu Jan 11 16:15:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 16:15:24 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: barf, don't just belch (e4228c9) Message-ID: <20180111161524.11ADE3A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/e4228c9f150d0d7bb417c755b00a41075222892c/ghc >--------------------------------------------------------------- commit e4228c9f150d0d7bb417c755b00a41075222892c Author: Gabor Greif Date: Thu Jan 11 12:11:52 2018 +0100 WIP: barf, don't just belch >--------------------------------------------------------------- e4228c9f150d0d7bb417c755b00a41075222892c rts/Apply.cmm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Apply.cmm b/rts/Apply.cmm index dde6f41..7bbf610 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -15,7 +15,7 @@ checkTagged ( P_ obj ) { if (GETTAG(obj)==0) { - ccall debugBelch("NOT TAGGED! "); + ccall barf("NOT TAGGED! ") never returns; } return(); } From git at git.haskell.org Thu Jan 11 22:18:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Jan 2018 22:18:40 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: to confirm my suspicion, remove the bangs (1d24430) Message-ID: <20180111221840.D96D73A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/1d24430515f5357295ceb10ef4b85e357aaf7487/ghc >--------------------------------------------------------------- commit 1d24430515f5357295ceb10ef4b85e357aaf7487 Author: Gabor Greif Date: Thu Jan 11 23:18:24 2018 +0100 WIP: to confirm my suspicion, remove the bangs I'll back this out later >--------------------------------------------------------------- 1d24430515f5357295ceb10ef4b85e357aaf7487 compiler/basicTypes/Name.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 637fc69..75f835b 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -108,9 +108,9 @@ import Data.Data -- that thing originated. data Name = Name { n_sort :: NameSort, -- What sort of name it is - n_occ :: !OccName, -- Its occurrence name + n_occ :: OccName, -- Its occurrence name n_uniq :: {-# UNPACK #-} !Unique, - n_loc :: !SrcSpan -- Definition site + n_loc :: SrcSpan -- Definition site } -- NOTE: we make the n_loc field strict to eliminate some potential From git at git.haskell.org Fri Jan 12 14:42:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 14:42:26 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: some more de-strictifying (57a57f2) Message-ID: <20180112144226.E46943A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/57a57f2f8cef2ea67588edd1f09f73981e86c889/ghc >--------------------------------------------------------------- commit 57a57f2f8cef2ea67588edd1f09f73981e86c889 Author: Gabor Greif Date: Fri Jan 12 15:41:40 2018 +0100 WIP: some more de-strictifying >--------------------------------------------------------------- 57a57f2f8cef2ea67588edd1f09f73981e86c889 compiler/codeGen/StgCmmClosure.hs | 2 +- compiler/utils/Outputable.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index f33a9f3..e319548 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -762,7 +762,7 @@ data ClosureInfo -- code for ticky and profiling, and we could pass the information -- around separately, but it doesn't do much harm to keep it here. - closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon + closureLFInfo :: LambdaFormInfo, -- NOTE: not an LFCon -- this tells us about what the closure contains: it's right-hand-side. -- the rest is just an unpacked CmmInfoTable. diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 3050fa1..d9580a8 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -321,7 +321,7 @@ code (either C or assembly), or generating interface files. newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc } data SDocContext = SDC - { sdocStyle :: !PprStyle + { sdocStyle :: PprStyle , sdocLastColour :: !Col.PprColour -- ^ The most recently used colour. This allows nesting colours. , sdocDynFlags :: !DynFlags From git at git.haskell.org Fri Jan 12 20:48:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 20:48:36 +0000 (UTC) Subject: [commit: ghc] master: KQueue: Fix write notification requests being ignored... (6c3eafb) Message-ID: <20180112204836.D1FD03A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c3eafb35eb7c664963d08a5904faf8c6471218e/ghc >--------------------------------------------------------------- commit 6c3eafb35eb7c664963d08a5904faf8c6471218e Author: Matthias Treydte Date: Mon Jan 8 10:33:37 2018 -0500 KQueue: Fix write notification requests being ignored... when read notifications are requested, too (#13903) Signed-off-by: Matthias Treydte KQueue: Drop Bits/FiniteBits instances for Filter as they are really constants whose bits should not be fiddled with Signed-off-by: Matthias Treydte Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: gridaphobe, kazu_yamamoto, rwbarton, thomie GHC Trac Issues: #13903 Differential Revision: https://phabricator.haskell.org/D3692 >--------------------------------------------------------------- 6c3eafb35eb7c664963d08a5904faf8c6471218e libraries/base/GHC/Event/KQueue.hsc | 46 +++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc index e9c8419..59b5ce1 100644 --- a/libraries/base/GHC/Event/KQueue.hsc +++ b/libraries/base/GHC/Event/KQueue.hsc @@ -28,11 +28,13 @@ available = False import Data.Bits (Bits(..), FiniteBits(..)) import Data.Int +import Data.Maybe ( catMaybes ) import Data.Word (Word16, Word32) import Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL, eNOTSUP, getErrno, throwErrno) import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Array (withArrayLen) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (Storable(..)) import GHC.Base @@ -85,23 +87,20 @@ delete kq = do return () modifyFd :: KQueue -> Fd -> E.Event -> E.Event -> IO Bool -modifyFd kq fd oevt nevt - | nevt == mempty = do - let !ev = event fd (toFilter oevt) flagDelete noteEOF - kqueueControl (kqueueFd kq) ev - | otherwise = do - let !ev = event fd (toFilter nevt) flagAdd noteEOF - kqueueControl (kqueueFd kq) ev - -toFilter :: E.Event -> Filter -toFilter evt - | evt `E.eventIs` E.evtRead = filterRead - | otherwise = filterWrite +modifyFd kq fd oevt nevt = kqueueControl (kqueueFd kq) evs + where + evs + | nevt == mempty = toEvents fd (toFilter oevt) flagDelete noteEOF + | otherwise = toEvents fd (toFilter nevt) flagAdd noteEOF + +toFilter :: E.Event -> [Filter] +toFilter e = catMaybes [ check E.evtRead filterRead, check E.evtWrite filterWrite ] + where + check e' f = if e `E.eventIs` e' then Just f else Nothing modifyFdOnce :: KQueue -> Fd -> E.Event -> IO Bool -modifyFdOnce kq fd evt = do - let !ev = event fd (toFilter evt) (flagAdd .|. flagOneshot) noteEOF - kqueueControl (kqueueFd kq) ev +modifyFdOnce kq fd evt = + kqueueControl (kqueueFd kq) (toEvents fd (toFilter evt) (flagAdd .|. flagOneshot) noteEOF) poll :: KQueue -> Maybe Timeout @@ -140,8 +139,8 @@ data Event = KEvent { , udata :: {-# UNPACK #-} !(Ptr ()) } deriving Show -event :: Fd -> Filter -> Flag -> FFlag -> Event -event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr +toEvents :: Fd -> [Filter] -> Flag -> FFlag -> [Event] +toEvents fd flts flag fflag = map (\filt -> KEvent (fromIntegral fd) filt flag fflag 0 nullPtr) flts -- | @since 4.3.1.0 instance Storable Event where @@ -192,7 +191,7 @@ newtype Filter = Filter Int32 #else newtype Filter = Filter Int16 #endif - deriving (Bits, FiniteBits, Eq, Num, Show, Storable) + deriving (Eq, Num, Show, Storable) filterRead :: Filter filterRead = Filter (#const EVFILT_READ) @@ -222,11 +221,11 @@ instance Storable TimeSpec where kqueue :: IO KQueueFd kqueue = KQueueFd `fmap` throwErrnoIfMinus1 "kqueue" c_kqueue -kqueueControl :: KQueueFd -> Event -> IO Bool -kqueueControl kfd ev = +kqueueControl :: KQueueFd -> [Event] -> IO Bool +kqueueControl kfd evts = withTimeSpec (TimeSpec 0 0) $ \tp -> - withEvent ev $ \evp -> do - res <- kevent False kfd evp 1 nullPtr 0 tp + withArrayLen evts $ \evlen evp -> do + res <- kevent False kfd evp evlen nullPtr 0 tp if res == -1 then do err <- getErrno @@ -255,9 +254,6 @@ kevent safe k chs chlen evs evlen ts | safe = c_kevent k chs (fromIntegral chlen) evs (fromIntegral evlen) ts | otherwise = c_kevent_unsafe k chs (fromIntegral chlen) evs (fromIntegral evlen) ts -withEvent :: Event -> (Ptr Event -> IO a) -> IO a -withEvent ev f = alloca $ \ptr -> poke ptr ev >> f ptr - withTimeSpec :: TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a withTimeSpec ts f | tv_sec ts < 0 = f nullPtr From git at git.haskell.org Fri Jan 12 20:48:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 20:48:34 +0000 (UTC) Subject: [commit: ghc] master: Fix mistaken merge (b2f10d8) Message-ID: <20180112204834.093013A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b2f10d8981bebe44f1ab39e417818dfa2d50639d/ghc >--------------------------------------------------------------- commit b2f10d8981bebe44f1ab39e417818dfa2d50639d Author: Ben Gamari Date: Fri Jan 12 15:03:11 2018 -0500 Fix mistaken merge When merging D4259 I had to resort to manual merge due to some conflicts that arc couldn't sort out. Unfortunately in the process I merged the wrong version of the patch. Fix this. Thanks to @ntc2 for the great documentation and noticing my mistake. >--------------------------------------------------------------- b2f10d8981bebe44f1ab39e417818dfa2d50639d libraries/base/Control/Monad.hs | 37 +++++++++++++++---------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index d9bfdeb..09066c7 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -156,33 +156,26 @@ f >=> g = \x -> f x >>= g -- -- ==== __Examples__ -- --- Simple network servers can be created by writing a function to --- handle a single client connection and then using 'forever' to --- accept client connections and fork threads to handle them. +-- A common use of 'forever' is to process input from network sockets, +-- 'System.IO.Handle's, and channels +-- (e.g. 'Control.Concurrent.MVar.MVar' and +-- 'Control.Concurrent.Chan.Chan'). -- --- For example, here is a [TCP echo --- server](https://en.wikipedia.org/wiki/Echo_Protocol) implemented --- with 'forever': +-- For example, here is how we might implement an [echo +-- server](https://en.wikipedia.org/wiki/Echo_Protocol), using +-- 'forever' both to listen for client connections on a network socket +-- and to echo client input on client connection handles: -- -- @ --- import "Control.Concurrent" ( 'Control.Concurrent.forkFinally' ) --- import "Control.Monad" ( 'forever' ) --- import Network ( PortID(..), accept, listenOn ) --- import "System.IO" ( 'System.IO.hClose', 'System.IO.hGetLine', 'System.IO.hPutStrLn' ) --- --- main :: IO () --- main = do --- sock <- listenOn (PortNumber 7) --- 'forever' $ do --- (handle, _, _) <- accept sock --- echo handle \`forkFinally\` const (hClose handle) +-- echoServer :: Socket -> IO () +-- echoServer socket = 'forever' $ do +-- client <- accept socket +-- 'Control.Concurrent.forkFinally' (echo client) (\\_ -> hClose client) -- where --- echo handle = 'forever' $ --- hGetLine handle >>= hPutStrLn handle +-- echo :: Handle -> IO () +-- echo client = 'forever' $ +-- hGetLine client >>= hPutStrLn client -- @ --- --- The @Network@ module is provided by the [network --- package](https://hackage.haskell.org/package/network). forever :: (Applicative f) => f a -> f b {-# INLINE forever #-} forever a = let a' = a *> a' in a' From git at git.haskell.org Fri Jan 12 21:42:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 21:42:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Export typeNat{Div; Mod; Log}TyCon from TcTypeNats (273131d) Message-ID: <20180112214228.ADB773A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/273131dfd83ef4f8b6722526dbc9be3215815af4/ghc >--------------------------------------------------------------- commit 273131dfd83ef4f8b6722526dbc9be3215815af4 Author: Christiaan Baaij Date: Mon Jan 8 12:26:54 2018 -0500 Export typeNat{Div;Mod;Log}TyCon from TcTypeNats Summary: To be in line with the other typeNatTyCons Reviewers: bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14632 Differential Revision: https://phabricator.haskell.org/D4284 (cherry picked from commit fb78b0d22635b1d7ae68385c648b8c407f5562c2) >--------------------------------------------------------------- 273131dfd83ef4f8b6722526dbc9be3215815af4 compiler/typecheck/TcTypeNats.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs index 051f998..da9b8df 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/typecheck/TcTypeNats.hs @@ -10,6 +10,9 @@ module TcTypeNats , typeNatExpTyCon , typeNatLeqTyCon , typeNatSubTyCon + , typeNatDivTyCon + , typeNatModTyCon + , typeNatLogTyCon , typeNatCmpTyCon , typeSymbolCmpTyCon , typeSymbolAppendTyCon From git at git.haskell.org Fri Jan 12 21:42:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 21:42:32 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14578 by checking isCompoundHsType in more places (e32f582) Message-ID: <20180112214232.852463A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/e32f582783086595bc3d69a35d19a59707e2831d/ghc >--------------------------------------------------------------- commit e32f582783086595bc3d69a35d19a59707e2831d Author: Ryan Scott Date: Wed Dec 20 19:25:18 2017 -0500 Fix #14578 by checking isCompoundHsType in more places Summary: The `HsType` pretty-printer does not automatically insert parentheses where necessary for type applications, so a function `isCompoundHsType` was created in D4056 towards this purpose. However, it was not used in as many places as it ought to be, resulting in #14578. Test Plan: make test TEST=T14578 Reviewers: alanz, bgamari, simonpj Reviewed By: alanz, simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14578 Differential Revision: https://phabricator.haskell.org/D4266 (cherry picked from commit 1bd91a7ac60eba3b0c019e2228f4b2b07f8cd5ad) >--------------------------------------------------------------- e32f582783086595bc3d69a35d19a59707e2831d compiler/hsSyn/HsTypes.hs | 12 ++- compiler/hsSyn/HsUtils.hs | 8 +- testsuite/tests/deriving/should_compile/T14578.hs | 15 +++ .../tests/deriving/should_compile/T14578.stderr | 115 +++++++++++++++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 5 files changed, 145 insertions(+), 6 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e32f582783086595bc3d69a35d19a59707e2831d From git at git.haskell.org Fri Jan 12 21:42:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 21:42:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Make typeToLHsType produce kind signatures for tycon applications (ebf8e07) Message-ID: <20180112214235.E1D933A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/ebf8e07629a3adeddd9267579524c28951d83a7e/ghc >--------------------------------------------------------------- commit ebf8e07629a3adeddd9267579524c28951d83a7e Author: Ryan Scott Date: Wed Jan 3 20:11:31 2018 -0500 Make typeToLHsType produce kind signatures for tycon applications Summary: `GeneralizedNewtypeDeriving` generates calls to `coerce` which take visible type arguments. These types must be produced by way of `typeToLHsType`, which converts a `Type` to an `LHsType`. However, `typeToLHsType` was leaving off important kind information when a `Type` contained a poly-kinded tycon application, leading to incorrectly generated code in #14579. This fixes the issue by tweaking `typeToLHsType` to generate explicit kind signatures for tycon applications. This makes the generated code noisier, but at least the program from #14579 now works correctly. Test Plan: make test TEST=T14579 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14579 Differential Revision: https://phabricator.haskell.org/D4264 (cherry picked from commit 649e777211fe08432900093002547d7358f92d82) >--------------------------------------------------------------- ebf8e07629a3adeddd9267579524c28951d83a7e compiler/hsSyn/HsUtils.hs | 60 +++++++++++++++++++++- .../tests/deriving/should_compile/T14578.stderr | 21 +++++--- testsuite/tests/deriving/should_compile/T14579.hs | 12 +++++ testsuite/tests/deriving/should_compile/all.T | 1 + 4 files changed, 85 insertions(+), 9 deletions(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index db4507b..0d14478 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -123,6 +123,7 @@ import Util import Bag import Outputable import Constants +import TyCon import Data.Either import Data.Function @@ -642,9 +643,15 @@ typeToLHsType ty go (AppTy t1 t2) = nlHsAppTy (go t1) (go t2) go (LitTy (NumTyLit n)) = noLoc $ HsTyLit (HsNumTy noSourceText n) go (LitTy (StrTyLit s)) = noLoc $ HsTyLit (HsStrTy noSourceText s) - go (TyConApp tc args) = nlHsTyConApp (getRdrName tc) (map go args') + go ty@(TyConApp tc args) + | any isInvisibleTyConBinder (tyConBinders tc) + -- We must produce an explicit kind signature here to make certain + -- programs kind-check. See Note [Kind signatures in typeToLHsType]. + = noLoc $ HsKindSig lhs_ty (go (typeKind ty)) + | otherwise = lhs_ty where - args' = filterOutInvisibleTypes tc args + lhs_ty = nlHsTyConApp (getRdrName tc) (map go args') + args' = filterOutInvisibleTypes tc args go (CastTy ty _) = go ty go (CoercionTy co) = pprPanic "toLHsSigWcType" (ppr co) @@ -655,6 +662,55 @@ typeToLHsType ty go_tv tv = noLoc $ KindedTyVar (noLoc (getRdrName tv)) (go (tyVarKind tv)) +{- +Note [Kind signatures in typeToLHsType] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are types that typeToLHsType can produce which require explicit kind +signatures in order to kind-check. Here is an example from Trac #14579: + + newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a) deriving Eq + newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a)) deriving Eq + +The derived Eq instance for Glurp (without any kind signatures) would be: + + instance Eq a => Eq (Glurp a) where + (==) = coerce @(Wat 'Proxy -> Wat 'Proxy -> Bool) + @(Glurp a -> Glurp a -> Bool) + (==) + +(Where the visible type applications use types produced by typeToLHsType.) + +The type 'Proxy has an underspecified kind, so we must ensure that +typeToLHsType ascribes it with its kind: ('Proxy :: Proxy a). + +We must be careful not to produce too many kind signatures, or else +typeToLHsType can produce noisy types like +('Proxy :: Proxy (a :: (Type :: Type))). In pursuit of this goal, we adopt the +following criterion for choosing when to annotate types with kinds: + +* If there is a tycon application with any invisible arguments, annotate + the tycon application with its kind. + +Why is this the right criterion? The problem we encountered earlier was the +result of an invisible argument (the `a` in ('Proxy :: Proxy a)) being +underspecified, so producing a kind signature for 'Proxy will catch this. +If there are no invisible arguments, then there is nothing to do, so we can +avoid polluting the result type with redundant noise. + +What about a more complicated tycon, such as this? + + T :: forall {j} (a :: j). a -> Type + +Unlike in the previous 'Proxy example, annotating an application of `T` to an +argument (e.g., annotating T ty to obtain (T ty :: Type)) will not fix +its invisible argument `j`. But because we apply this strategy recursively, +`j` will be fixed because the kind of `ty` will be fixed! That is to say, +something to the effect of (T (ty :: j) :: Type) will be produced. + +This strategy certainly isn't foolproof, as tycons that contain type families +in their kind might break down. But we'd likely need visible kind application +to make those work. +-} {- ********************************************************************* * * diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr index e4230ad..63375ae 100644 --- a/testsuite/tests/deriving/should_compile/T14578.stderr +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -73,15 +73,20 @@ Derived class instances: GHC.Base.Semigroup (T14578.Wat f g a) where (GHC.Base.<>) = GHC.Prim.coerce - @(T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + @(T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.<>) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) - -> T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) GHC.Base.sconcat GHC.Base.stimes @@ -89,8 +94,10 @@ Derived class instances: @(forall (b :: TYPE GHC.Types.LiftedRep). GHC.Real.Integral b => b - -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(forall (b :: TYPE GHC.Types.LiftedRep). GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a) GHC.Base.stimes diff --git a/testsuite/tests/deriving/should_compile/T14579.hs b/testsuite/tests/deriving/should_compile/T14579.hs new file mode 100644 index 0000000..1945244 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14579.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeInType #-} +module T14579 where + +import Data.Kind +import Data.Proxy + +newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a) + deriving Eq + +newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a)) + deriving Eq diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index af9a577..8752bbd 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -99,3 +99,4 @@ test('T14094', normal, compile, ['']) test('T14339', normal, compile, ['']) test('T14331', normal, compile, ['']) test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) +test('T14579', normal, compile, ['']) From git at git.haskell.org Fri Jan 12 21:42:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 21:42:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: KQueue: Fix write notification requests being ignored... (d87bb65) Message-ID: <20180112214238.9C2003A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/d87bb656ad49ce591f71d6516b575e0c3e109a49/ghc >--------------------------------------------------------------- commit d87bb656ad49ce591f71d6516b575e0c3e109a49 Author: Matthias Treydte Date: Mon Jan 8 10:33:37 2018 -0500 KQueue: Fix write notification requests being ignored... when read notifications are requested, too (#13903) Signed-off-by: Matthias Treydte KQueue: Drop Bits/FiniteBits instances for Filter as they are really constants whose bits should not be fiddled with Signed-off-by: Matthias Treydte Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: gridaphobe, kazu_yamamoto, rwbarton, thomie GHC Trac Issues: #13903 Differential Revision: https://phabricator.haskell.org/D3692 (cherry picked from commit 6c3eafb35eb7c664963d08a5904faf8c6471218e) >--------------------------------------------------------------- d87bb656ad49ce591f71d6516b575e0c3e109a49 libraries/base/GHC/Event/KQueue.hsc | 46 +++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc index e9c8419..59b5ce1 100644 --- a/libraries/base/GHC/Event/KQueue.hsc +++ b/libraries/base/GHC/Event/KQueue.hsc @@ -28,11 +28,13 @@ available = False import Data.Bits (Bits(..), FiniteBits(..)) import Data.Int +import Data.Maybe ( catMaybes ) import Data.Word (Word16, Word32) import Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL, eNOTSUP, getErrno, throwErrno) import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Array (withArrayLen) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (Storable(..)) import GHC.Base @@ -85,23 +87,20 @@ delete kq = do return () modifyFd :: KQueue -> Fd -> E.Event -> E.Event -> IO Bool -modifyFd kq fd oevt nevt - | nevt == mempty = do - let !ev = event fd (toFilter oevt) flagDelete noteEOF - kqueueControl (kqueueFd kq) ev - | otherwise = do - let !ev = event fd (toFilter nevt) flagAdd noteEOF - kqueueControl (kqueueFd kq) ev - -toFilter :: E.Event -> Filter -toFilter evt - | evt `E.eventIs` E.evtRead = filterRead - | otherwise = filterWrite +modifyFd kq fd oevt nevt = kqueueControl (kqueueFd kq) evs + where + evs + | nevt == mempty = toEvents fd (toFilter oevt) flagDelete noteEOF + | otherwise = toEvents fd (toFilter nevt) flagAdd noteEOF + +toFilter :: E.Event -> [Filter] +toFilter e = catMaybes [ check E.evtRead filterRead, check E.evtWrite filterWrite ] + where + check e' f = if e `E.eventIs` e' then Just f else Nothing modifyFdOnce :: KQueue -> Fd -> E.Event -> IO Bool -modifyFdOnce kq fd evt = do - let !ev = event fd (toFilter evt) (flagAdd .|. flagOneshot) noteEOF - kqueueControl (kqueueFd kq) ev +modifyFdOnce kq fd evt = + kqueueControl (kqueueFd kq) (toEvents fd (toFilter evt) (flagAdd .|. flagOneshot) noteEOF) poll :: KQueue -> Maybe Timeout @@ -140,8 +139,8 @@ data Event = KEvent { , udata :: {-# UNPACK #-} !(Ptr ()) } deriving Show -event :: Fd -> Filter -> Flag -> FFlag -> Event -event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr +toEvents :: Fd -> [Filter] -> Flag -> FFlag -> [Event] +toEvents fd flts flag fflag = map (\filt -> KEvent (fromIntegral fd) filt flag fflag 0 nullPtr) flts -- | @since 4.3.1.0 instance Storable Event where @@ -192,7 +191,7 @@ newtype Filter = Filter Int32 #else newtype Filter = Filter Int16 #endif - deriving (Bits, FiniteBits, Eq, Num, Show, Storable) + deriving (Eq, Num, Show, Storable) filterRead :: Filter filterRead = Filter (#const EVFILT_READ) @@ -222,11 +221,11 @@ instance Storable TimeSpec where kqueue :: IO KQueueFd kqueue = KQueueFd `fmap` throwErrnoIfMinus1 "kqueue" c_kqueue -kqueueControl :: KQueueFd -> Event -> IO Bool -kqueueControl kfd ev = +kqueueControl :: KQueueFd -> [Event] -> IO Bool +kqueueControl kfd evts = withTimeSpec (TimeSpec 0 0) $ \tp -> - withEvent ev $ \evp -> do - res <- kevent False kfd evp 1 nullPtr 0 tp + withArrayLen evts $ \evlen evp -> do + res <- kevent False kfd evp evlen nullPtr 0 tp if res == -1 then do err <- getErrno @@ -255,9 +254,6 @@ kevent safe k chs chlen evs evlen ts | safe = c_kevent k chs (fromIntegral chlen) evs (fromIntegral evlen) ts | otherwise = c_kevent_unsafe k chs (fromIntegral chlen) evs (fromIntegral evlen) ts -withEvent :: Event -> (Ptr Event -> IO a) -> IO a -withEvent ev f = alloca $ \ptr -> poke ptr ev >> f ptr - withTimeSpec :: TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a withTimeSpec ts f | tv_sec ts < 0 = f nullPtr From git at git.haskell.org Fri Jan 12 22:13:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Jan 2018 22:13:45 +0000 (UTC) Subject: [commit: ghc] master: Support constructor Haddocks in more places (e20046a) Message-ID: <20180112221345.A40833A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e20046a0c4a552c5037797cf720fb34877bc2d21/ghc >--------------------------------------------------------------- commit e20046a0c4a552c5037797cf720fb34877bc2d21 Author: Alec Theriault Date: Fri Jan 12 16:45:48 2018 -0500 Support constructor Haddocks in more places This adds support for adding Haddocks on individual non-record fields of regular (and GADT) constructors. The following now parses just fine with `-haddock` enabled: data Foo = Baz -- ^ doc on the `Baz` constructor Int -- ^ doc on the `Int` field of `Baz` String -- ^ doc on the `String` field of `Baz` | Int -- ^ doc on the `Int` field of the `:*` constructor :* -- ^ doc on the `:*` constructor String -- ^ doc on the `String` field of the `:*` constructor | Boa -- ^ doc on the `Boa` record constructor { y :: () } The change is backwards compatible: if there is only one doc and it occurs on the last field, it is lifted to apply to the whole constructor (as before). Reviewers: bgamari, alanz Subscribers: rwbarton, thomie, mpickering, carter Differential Revision: https://phabricator.haskell.org/D4292 >--------------------------------------------------------------- e20046a0c4a552c5037797cf720fb34877bc2d21 compiler/parser/Parser.y | 49 ++++++++----- compiler/parser/RdrHsSyn.hs | 83 ++++++++++++++++++---- testsuite/tests/ghc-api/annotations/T10255.stdout | 1 - testsuite/tests/ghc-api/annotations/T10268.stdout | 1 + testsuite/tests/ghc-api/annotations/T10278.stdout | 5 +- testsuite/tests/ghc-api/annotations/T10312.stdout | 6 +- testsuite/tests/ghc-api/annotations/T10354.stdout | 4 ++ testsuite/tests/ghc-api/annotations/T10399.stdout | 3 - testsuite/tests/ghc-api/annotations/T10598.stdout | 1 + testsuite/tests/ghc-api/annotations/T11018.stdout | 8 ++- testsuite/tests/ghc-api/annotations/T12417.stdout | 2 + .../tests/ghc-api/annotations/boolFormula.stdout | 22 ++++++ .../tests/ghc-api/annotations/exampleTest.stdout | 1 - .../tests/ghc-api/annotations/listcomps.stdout | 2 + .../tests/ghc-api/annotations/parseTree.stdout | 2 - .../haddock/should_compile_flag_haddock/all.T | 3 + .../should_compile_flag_haddock/haddockA035.hs | 9 +++ .../should_compile_flag_haddock/haddockA035.stderr | 9 +++ .../should_compile_flag_haddock/haddockA036.hs | 19 +++++ .../should_compile_flag_haddock/haddockA036.stderr | 12 ++++ .../should_compile_flag_haddock/haddockA037.hs | 10 +++ .../should_compile_flag_haddock/haddockA037.stderr | 7 ++ .../haddock/should_compile_noflag_haddock/all.T | 3 + .../should_compile_noflag_haddock/haddockC035.hs | 9 +++ .../should_compile_noflag_haddock/haddockC036.hs | 19 +++++ .../should_compile_noflag_haddock/haddockC037.hs | 10 +++ 26 files changed, 258 insertions(+), 42 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e20046a0c4a552c5037797cf720fb34877bc2d21 From git at git.haskell.org Sat Jan 13 04:29:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Jan 2018 04:29:57 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: implement the runtime assert (1ddeb6c) Message-ID: <20180113042957.289923A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/1ddeb6c376172173436b37e9def6c0c1cb4062bf/ghc >--------------------------------------------------------------- commit 1ddeb6c376172173436b37e9def6c0c1cb4062bf Author: Gabor Greif Date: Sat Jan 13 05:29:24 2018 +0100 WIP: implement the runtime assert >--------------------------------------------------------------- 1ddeb6c376172173436b37e9def6c0c1cb4062bf compiler/codeGen/StgCmmCon.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index a38f7bc..d9832c7 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -33,6 +33,7 @@ import StgCmmProf ( curCCS ) import CmmExpr import CLabel import MkGraph +import BlockId import SMRep import CostCentre import Module @@ -243,6 +244,7 @@ buildDynCon' dflags _ binder actually_bound ccs con args ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info use_cc blame_cc args_w_offsets + ; mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) ; return (mkRhsInit dflags reg lf_info hp_plus_n) } where use_cc -- cost-centre to stick in the object @@ -251,6 +253,18 @@ buildDynCon' dflags _ binder actually_bound ccs con args blame_cc = use_cc -- cost-centre on which to blame the alloc (same) + checkTagOnPtr base ((_,offset), bang) | isBanged bang = do + lgood <- newBlockId + lcall <- newBlockId + let p = CmmLoad (cmmOffsetB dflags base offset) (bWord dflags) + emit $ mkCbranch (cmmIsTagged dflags p) + lgood lcall Nothing + emitLabel lcall + emitRtsCall rtsUnitId + (fsLit "checkTagged") [(p, AddrHint)] False + emitLabel lgood + checkTagOnPtr _ _ = pure () + --------------------------------------------------------------- -- Binding constructor arguments From git at git.haskell.org Sat Jan 13 13:11:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Jan 2018 13:11:02 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: require tagged only when algebraic (45fcc6c) Message-ID: <20180113131102.DB1363A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/45fcc6c3623c01ed29b1aa0838527943a329f05b/ghc >--------------------------------------------------------------- commit 45fcc6c3623c01ed29b1aa0838527943a329f05b Author: Gabor Greif Date: Sat Jan 13 14:10:24 2018 +0100 WIP: require tagged only when algebraic >--------------------------------------------------------------- 45fcc6c3623c01ed29b1aa0838527943a329f05b compiler/codeGen/StgCmmCon.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index d9832c7..fe85f05 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -30,6 +30,7 @@ import StgCmmUtils import StgCmmClosure import StgCmmProf ( curCCS ) +import TyCon import CmmExpr import CLabel import MkGraph @@ -244,7 +245,8 @@ buildDynCon' dflags _ binder actually_bound ccs con args ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info use_cc blame_cc args_w_offsets - ; mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) + ; when (isDataTyCon $ dataConTyCon con) + $ mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) ; return (mkRhsInit dflags reg lf_info hp_plus_n) } where use_cc -- cost-centre to stick in the object From git at git.haskell.org Sat Jan 13 22:48:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Jan 2018 22:48:48 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: actuall look at the type of the constr field (c0347ca) Message-ID: <20180113224848.85E543A5FA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/c0347ca0b02be0a7faaeb9ef0c15292268025483/ghc >--------------------------------------------------------------- commit c0347ca0b02be0a7faaeb9ef0c15292268025483 Author: Gabor Greif Date: Sat Jan 13 23:47:37 2018 +0100 WIP: actuall look at the type of the constr field >--------------------------------------------------------------- c0347ca0b02be0a7faaeb9ef0c15292268025483 compiler/codeGen/StgCmmCon.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index fe85f05..a00081c 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -30,7 +30,8 @@ import StgCmmUtils import StgCmmClosure import StgCmmProf ( curCCS ) -import TyCon +import TyCon -- NOT NEEDED +import Type (isAlgType) import CmmExpr import CLabel import MkGraph @@ -255,13 +256,15 @@ buildDynCon' dflags _ binder actually_bound ccs con args blame_cc = use_cc -- cost-centre on which to blame the alloc (same) - checkTagOnPtr base ((_,offset), bang) | isBanged bang = do - lgood <- newBlockId + checkTagOnPtr base (((NonVoid (StgVarArg var)),offset), bang) + | isBanged bang + , isAlgType (let ty = idType var in pprTrace "checkTagOnPtrTy" (ppr ty) ty) + = do lgood <- newBlockId lcall <- newBlockId let p = CmmLoad (cmmOffsetB dflags base offset) (bWord dflags) emit $ mkCbranch (cmmIsTagged dflags p) lgood lcall Nothing - emitLabel lcall + pprTrace "checkTagOnPtr" (ppr con $$ ppr (dataConRepType con)) emitLabel lcall emitRtsCall rtsUnitId (fsLit "checkTagged") [(p, AddrHint)] False emitLabel lgood From git at git.haskell.org Sun Jan 14 22:07:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:07:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Check for bogus quantified tyvars in partial type sigs (87e517c) Message-ID: <20180114220740.771BE3A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/87e517c1ca29606ce0dd2d7624f525f08f383283/ghc >--------------------------------------------------------------- commit 87e517c1ca29606ce0dd2d7624f525f08f383283 Author: Simon Peyton Jones Date: Wed Dec 20 15:41:02 2017 +0000 Check for bogus quantified tyvars in partial type sigs This fixes Trac #14479. Not difficult. See Note [Quantification and partial signatures] Wrinkle 4, in TcSimplify. (cherry picked from commit 72938f5890dac81afad52bf58175c1e29ffbc6dd) >--------------------------------------------------------------- 87e517c1ca29606ce0dd2d7624f525f08f383283 compiler/typecheck/TcBinds.hs | 54 ++++++++++------- compiler/typecheck/TcSimplify.hs | 69 ++++++++++++++-------- testsuite/tests/partial-sigs/should_fail/T14479.hs | 9 +++ .../tests/partial-sigs/should_fail/T14479.stderr | 10 ++++ testsuite/tests/partial-sigs/should_fail/all.T | 1 + 5 files changed, 96 insertions(+), 47 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 87e517c1ca29606ce0dd2d7624f525f08f383283 From git at git.haskell.org Sun Jan 14 22:07:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:07:44 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix SigTvs at the kind level (40a31b3) Message-ID: <20180114220744.65F623A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/40a31b386a893f06667229e5ecf985de6cf87633/ghc >--------------------------------------------------------------- commit 40a31b386a893f06667229e5ecf985de6cf87633 Author: Simon Peyton Jones Date: Mon Dec 11 15:53:32 2017 +0000 Fix SigTvs at the kind level This patch fixes two bugs in the treatment of SigTvs at the kind level: - We should always generalise them, never default them (Trac #14555, #14563) - We should check if they get unified with each other (Trac #11203) Both are described in TcHsType Note [Kind generalisation and SigTvs] (cherry picked from commit 8361b2c5a9f7a00f0024f44a43b851998ae41e33) >--------------------------------------------------------------- 40a31b386a893f06667229e5ecf985de6cf87633 compiler/typecheck/TcBinds.hs | 20 +++--- compiler/typecheck/TcHsType.hs | 76 +++++++++++++++++----- compiler/typecheck/TcMType.hs | 30 ++++++--- compiler/typecheck/TcSimplify.hs | 3 + compiler/typecheck/TcTyClsDecls.hs | 76 ++++++++++++++++++---- compiler/typecheck/TcType.hs | 18 ++++- compiler/types/TyCon.hs | 56 ++-------------- .../tests/polykinds/{SigTvKinds2.hs => T11203.hs} | 4 +- testsuite/tests/polykinds/T11203.stderr | 4 ++ testsuite/tests/polykinds/T11821a.stderr | 4 ++ testsuite/tests/polykinds/T14555.hs | 12 ++++ testsuite/tests/polykinds/T14555.stderr | 6 ++ testsuite/tests/polykinds/T14563.hs | 9 +++ testsuite/tests/polykinds/T14563.stderr | 7 ++ testsuite/tests/polykinds/all.T | 6 +- 15 files changed, 228 insertions(+), 103 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 40a31b386a893f06667229e5ecf985de6cf87633 From git at git.haskell.org Sun Jan 14 22:07:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:07:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Refactor kcHsTyVarBndrs (dfe049f) Message-ID: <20180114220747.85E3D3A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/dfe049fd04b900edba923af2dbca3ee81ff594ce/ghc >--------------------------------------------------------------- commit dfe049fd04b900edba923af2dbca3ee81ff594ce Author: Simon Peyton Jones Date: Thu Dec 7 14:31:53 2017 +0000 Refactor kcHsTyVarBndrs This refactoring * Renames kcHsTyVarBndrs to kcLHsQTyVars, which is more truthful. It is only used in getInitialKind. * Pulls out bind_telescope from that function, and calls it kcLHsTyVarBndrs, again to reflect its argument * Uses the new kcLHsTyVarBndrs in kcConDecl, where the old function was wild overkill. There should not be any change in behaviour (cherry picked from commit de2044098ae96245aa741fe1b47a06a996a1c725) >--------------------------------------------------------------- dfe049fd04b900edba923af2dbca3ee81ff594ce compiler/typecheck/TcHsType.hs | 146 ++++++++++++++++++++----------------- compiler/typecheck/TcTyClsDecls.hs | 14 ++-- 2 files changed, 86 insertions(+), 74 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dfe049fd04b900edba923af2dbca3ee81ff594ce From git at git.haskell.org Sun Jan 14 22:07:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:07:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Refactor coercion holes (b586f77) Message-ID: <20180114220750.779503A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/b586f77b3384ce4d38e83205e7c0355c9b626b0a/ghc >--------------------------------------------------------------- commit b586f77b3384ce4d38e83205e7c0355c9b626b0a Author: Simon Peyton Jones Date: Thu Dec 21 13:31:13 2017 +0000 Refactor coercion holes In fixing Trac #14584 I found that it would be /much/ more convenient if a "hole" in a coercion (much like a unification variable in a type) acutally had a CoVar associated with it rather than just a Unique. Then I can ask what the free variables of a coercion is, and get a set of CoVars including those as-yet-un-filled in holes. Once that is done, it makes no sense to stuff coercion holes inside UnivCo. They were there before so we could know the kind and role of a "hole" coercion, but once there is a CoVar we can get that info from the CoVar. So I removed HoleProv from UnivCoProvenance and added HoleCo to Coercion. In summary: * Add HoleCo to Coercion and remove HoleProv from UnivCoProvanance * Similarly in IfaceCoercion * Make CoercionHole have a CoVar in it, not a Unique * Make tyCoVarsOfCo return the free coercion-hole variables as well as the ordinary free CoVars. Similarly, remember to zonk the CoVar in a CoercionHole We could go further, and remove CoercionHole as a distinct type altogther, just collapsing it into HoleCo. But I have not done that yet. (cherry picked from commit a492af06d3264530d134584f22ffb726a16c78ec) >--------------------------------------------------------------- b586f77b3384ce4d38e83205e7c0355c9b626b0a compiler/backpack/RnModIface.hs | 1 + compiler/coreSyn/CoreFVs.hs | 2 +- compiler/coreSyn/CoreLint.hs | 7 ++- compiler/iface/IfaceSyn.hs | 5 +- compiler/iface/IfaceType.hs | 56 ++++++++++----------- compiler/iface/TcIface.hs | 5 +- compiler/iface/ToIface.hs | 5 +- compiler/typecheck/TcCanonical.hs | 2 +- compiler/typecheck/TcEnv.hs | 16 ++++-- compiler/typecheck/TcErrors.hs | 6 +-- compiler/typecheck/TcHsSyn.hs | 30 +++++------- compiler/typecheck/TcInteract.hs | 6 +-- compiler/typecheck/TcMType.hs | 75 +++++++++++++++------------- compiler/typecheck/TcPluginM.hs | 4 +- compiler/typecheck/TcRnTypes.hs | 25 ++++++---- compiler/typecheck/TcSMonad.hs | 4 +- compiler/typecheck/TcTyDecls.hs | 2 +- compiler/typecheck/TcType.hs | 14 +++--- compiler/typecheck/TcUnify.hs | 19 +++++--- compiler/typecheck/TcValidity.hs | 4 +- compiler/types/Coercion.hs | 42 +++++++--------- compiler/types/FamInstEnv.hs | 2 +- compiler/types/OptCoercion.hs | 7 +-- compiler/types/TyCoRep.hs | 84 +++++++++++++++++++------------- compiler/types/Type.hs | 19 ++++---- testsuite/tests/polykinds/T11821a.stderr | 2 +- testsuite/tests/polykinds/T14563.stderr | 4 +- 27 files changed, 237 insertions(+), 211 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b586f77b3384ce4d38e83205e7c0355c9b626b0a From git at git.haskell.org Sun Jan 14 22:07:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:07:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix floating of equalities (594879d) Message-ID: <20180114220754.9035F3A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/594879dcb2fd5421d5f6ce5341442de32a4aac0a/ghc >--------------------------------------------------------------- commit 594879dcb2fd5421d5f6ce5341442de32a4aac0a Author: Simon Peyton Jones Date: Thu Dec 21 14:13:54 2017 +0000 Fix floating of equalities This rather subtle patch fixes Trac #14584. The problem was that we'd allowed a coercion, bound in a nested scope, to escape into an outer scope. The main changes are * TcSimplify.floatEqualities takes more care when floating equalities to make sure we don't float one out that mentions a locally-bound coercion. See Note [What prevents a constraint from floating] * TcSimplify.emitResidualConstraints (which emits the residual constraints in simplifyInfer) now avoids burying the constraints for escaping CoVars inside the implication constraint. * Since I had do to this stuff with CoVars, I moved the fancy footwork about not quantifying over CoVars from TcMType.quantifyTyVars to its caller TcSimplify.decideQuantifiedTyVars. I think its other callers don't need to worry about all this CoVar stuff. This turned out to be surprisigly tricky, and took me a solid day to get right. I think the result is reasonably neat, though, and well documented with Notes. (cherry picked from commit f5cf9d1a1b198edc929e1fa96c6d841d182fe766) >--------------------------------------------------------------- 594879dcb2fd5421d5f6ce5341442de32a4aac0a compiler/typecheck/TcInteract.hs | 3 +- compiler/typecheck/TcMType.hs | 19 +- compiler/typecheck/TcSMonad.hs | 7 +- compiler/typecheck/TcSimplify.hs | 294 ++++++++++++++------- .../tests/indexed-types/should_fail/T13877.stderr | 10 +- testsuite/tests/partial-sigs/should_fail/T14584.hs | 56 ++++ .../tests/partial-sigs/should_fail/T14584.stderr | 21 ++ .../tests/partial-sigs/should_fail/T14584a.hs | 16 ++ .../tests/partial-sigs/should_fail/T14584a.stderr | 24 ++ testsuite/tests/partial-sigs/should_fail/all.T | 2 + .../tests/typecheck/should_fail/VtaFail.stderr | 6 - 11 files changed, 341 insertions(+), 117 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 594879dcb2fd5421d5f6ce5341442de32a4aac0a From git at git.haskell.org Sun Jan 14 22:07:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:07:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix previous patch (8553593) Message-ID: <20180114220757.5B5E93A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/8553593731872dc9d33edca3afc9088d40fe75ed/ghc >--------------------------------------------------------------- commit 8553593731872dc9d33edca3afc9088d40fe75ed Author: Simon Peyton Jones Date: Wed Jan 10 16:46:55 2018 +0000 Fix previous patch This recent patch commit 1577908f2a9db0fcf6f749d40dd75481015f5497 Author: Simon Peyton Jones Date: Tue Jan 9 16:20:46 2018 +0000 Fix two more bugs in partial signatures These were shown up by Trac #14643 failed validation for typecheck/should_run/T10846 (Reported in Trac #14658.) The fix is simple. (cherry picked from commit f3f90a079179e085295ee7edd2dda6505799370c) >--------------------------------------------------------------- 8553593731872dc9d33edca3afc9088d40fe75ed compiler/typecheck/TcSimplify.hs | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index e4590db..aa6a26c 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -878,20 +878,25 @@ decideQuantification infer_mode rhs_tclvl name_taus psigs candidates -- predicates to actually quantify over -- NB: decideQuantifiedTyVars turned some meta tyvars -- into quantified skolems, so we have to zonk again - ; let psig_theta = concatMap sig_inst_theta psigs - ; all_candidates <- TcM.zonkTcTypes (psig_theta ++ candidates) - ; let theta = pickQuantifiablePreds (mkVarSet qtvs) $ - mkMinimalBySCs id $ -- See Note [Minimize by Superclasses] - all_candidates + ; candidates <- TcM.zonkTcTypes candidates + ; psig_theta <- TcM.zonkTcTypes (concatMap sig_inst_theta psigs) + ; let quantifiable_candidates + = pickQuantifiablePreds (mkVarSet qtvs) candidates + -- NB: do /not/ run pickQuantifieablePreds over psig_theta, + -- because we always want to quantify over psig_theta, and not + -- drop any of them; e.g. CallStack constraints. c.f Trac #14658 + + theta = mkMinimalBySCs id $ -- See Note [Minimize by Superclasses] + (psig_theta ++ quantifiable_candidates) ; traceTc "decideQuantification" - (vcat [ text "infer_mode:" <+> ppr infer_mode - , text "candidates:" <+> ppr candidates - , text "all_candidates:" <+> ppr all_candidates - , text "mono_tvs:" <+> ppr mono_tvs - , text "co_vars:" <+> ppr co_vars - , text "qtvs:" <+> ppr qtvs - , text "theta:" <+> ppr theta ]) + (vcat [ text "infer_mode:" <+> ppr infer_mode + , text "candidates:" <+> ppr candidates + , text "psig_theta:" <+> ppr psig_theta + , text "mono_tvs:" <+> ppr mono_tvs + , text "co_vars:" <+> ppr co_vars + , text "qtvs:" <+> ppr qtvs + , text "theta:" <+> ppr theta ]) ; return (qtvs, theta, co_vars) } ------------------ From git at git.haskell.org Sun Jan 14 22:08:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:08:01 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix two more bugs in partial signatures (3d2664e) Message-ID: <20180114220801.49D0B3A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/3d2664e4d97fde24f4a70d3fd106618d41c55776/ghc >--------------------------------------------------------------- commit 3d2664e4d97fde24f4a70d3fd106618d41c55776 Author: Simon Peyton Jones Date: Tue Jan 9 16:20:46 2018 +0000 Fix two more bugs in partial signatures These were shown up by Trac #14643 Bug 1: if we had a single partial signature for two functions f, g :: forall a. _ -> a then we made two different SigTvs but with the sane Name. This was jolly confusing and ultimately led to deeply bogus results with Any's appearing in the resulting program. Yikes. Fix: clone the quantified variables in TcSigs.tcInstSig (as indeed its name suggests). Bug 2: we were not eliminating duplicate/superclass constraints in the partial signatures of a mutually recursive group. Easy to fix: we are already doing dup/superclass elim in TcSimplify.decideQuantification. So we move the partial-sig constraints there too. (cherry picked from commit 1577908f2a9db0fcf6f749d40dd75481015f5497) >--------------------------------------------------------------- 3d2664e4d97fde24f4a70d3fd106618d41c55776 compiler/typecheck/TcHsType.hs | 10 ++--- compiler/typecheck/TcMType.hs | 34 +++++++++------- compiler/typecheck/TcSigs.hs | 24 ++++++++++-- compiler/typecheck/TcSimplify.hs | 45 +++++++++++++--------- .../tests/partial-sigs/should_compile/T14643.hs | 9 +++++ .../partial-sigs/should_compile/T14643.stderr | 8 ++++ .../tests/partial-sigs/should_compile/T14643a.hs | 9 +++++ .../partial-sigs/should_compile/T14643a.stderr | 8 ++++ testsuite/tests/partial-sigs/should_compile/all.T | 7 +++- .../tests/partial-sigs/should_fail/T14040a.stderr | 2 +- testsuite/tests/partial-sigs/should_fail/all.T | 2 +- 11 files changed, 113 insertions(+), 45 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3d2664e4d97fde24f4a70d3fd106618d41c55776 From git at git.haskell.org Sun Jan 14 22:08:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:08:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Simplify HsPatSynDetails (7c69f11) Message-ID: <20180114220804.2D4C63A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/7c69f1117695c7db1c10b1103995cc0111a4d8fb/ghc >--------------------------------------------------------------- commit 7c69f1117695c7db1c10b1103995cc0111a4d8fb Author: Simon Peyton Jones Date: Wed Dec 20 15:36:49 2017 +0000 Simplify HsPatSynDetails This is a pure refactoring. Use HsConDetails to implement HsPatSynDetails, instead of defining a whole new data type. Less code, fewer types, all good. (cherry picked from commit 584cbd4a19887497776ce1f61c15df652b8b2ea4) >--------------------------------------------------------------- 7c69f1117695c7db1c10b1103995cc0111a4d8fb compiler/deSugar/DsMeta.hs | 18 +++++++------- compiler/hsSyn/Convert.hs | 6 ++--- compiler/hsSyn/HsBinds.hs | 53 ++++-------------------------------------- compiler/hsSyn/HsUtils.hs | 2 +- compiler/parser/Parser.y | 6 ++--- compiler/rename/RnBinds.hs | 14 +++++------ compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 18 ++++++++++---- compiler/typecheck/TcPatSyn.hs | 17 +++++++------- 9 files changed, 50 insertions(+), 86 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7c69f1117695c7db1c10b1103995cc0111a4d8fb From git at git.haskell.org Sun Jan 14 22:08:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:08:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Drop dead Given bindings in setImplicationStatus (5124b04) Message-ID: <20180114220811.3E6C03A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/5124b04f10adfee6390f435a493984f2b45062d0/ghc >--------------------------------------------------------------- commit 5124b04f10adfee6390f435a493984f2b45062d0 Author: Simon Peyton Jones Date: Thu Jan 4 12:32:13 2018 +0000 Drop dead Given bindings in setImplicationStatus Trac #13032 pointed out that we sometimes generate unused bindings for Givens, and (worse still) we can't always discard them later (we don't drop a case binding unless we can prove that the scrutinee is non-bottom. It looks as if this may be a major reason for the performace problems in #14338 (see comment:29). This patch fixes the problem at source, by pruning away all the dead Givens. See Note [Delete dead Given evidence bindings] Remarkably, compiler allocation falls by 23% in perf/compiler/T12227! I have not confirmed whether this change actualy helps with (cherry picked from commit 954cbc7c106a20639960f55ebb85c5c972652d41) >--------------------------------------------------------------- 5124b04f10adfee6390f435a493984f2b45062d0 compiler/basicTypes/VarEnv.hs | 5 +- compiler/typecheck/TcEvidence.hs | 7 +- compiler/typecheck/TcInstDcls.hs | 33 ++- compiler/typecheck/TcRnMonad.hs | 6 +- compiler/typecheck/TcRnTypes.hs | 46 +++- compiler/typecheck/TcSMonad.hs | 36 ++- compiler/typecheck/TcSimplify.hs | 247 ++++++++++++--------- compiler/typecheck/TcUnify.hs | 17 +- .../indexed-types/should_compile/T7837.stderr | 1 - testsuite/tests/perf/compiler/all.T | 3 +- .../tests/simplCore/should_compile/T4398.stderr | 18 +- testsuite/tests/typecheck/should_compile/T13032.hs | 12 + .../tests/typecheck/should_compile/T13032.stderr | 20 ++ testsuite/tests/typecheck/should_compile/all.T | 1 + 14 files changed, 270 insertions(+), 182 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5124b04f10adfee6390f435a493984f2b45062d0 From git at git.haskell.org Sun Jan 14 22:08:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Jan 2018 22:08:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Add regression test for #14040 (0d40693) Message-ID: <20180114220807.691873A5FD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/0d40693654678e6a8ce8a63d198420c88e11dcff/ghc >--------------------------------------------------------------- commit 0d40693654678e6a8ce8a63d198420c88e11dcff Author: Ryan Scott Date: Tue Dec 12 10:16:39 2017 -0500 Add regression test for #14040 This adds a regression test for the original program in #14040. This does not fix #14040 entirely, though, as the program in https://ghc.haskell.org/trac/ghc/ticket/14040#comment:2 still panics, so there is more work to be done there. (cherry picked from commit be1ca0e439e9d26107c7d82fe6e78b64ee6320a9) >--------------------------------------------------------------- 0d40693654678e6a8ce8a63d198420c88e11dcff .../tests/partial-sigs/should_fail/T14040a.hs | 34 +++++++++++++++ .../tests/partial-sigs/should_fail/T14040a.stderr | 48 ++++++++++++++++++++++ testsuite/tests/partial-sigs/should_fail/all.T | 1 + 3 files changed, 83 insertions(+) diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.hs b/testsuite/tests/partial-sigs/should_fail/T14040a.hs new file mode 100644 index 0000000..382e218 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14040a.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module T14040a where + +import Data.Kind + +data family Sing (a :: k) + +data WeirdList :: Type -> Type where + WeirdNil :: WeirdList a + WeirdCons :: a -> WeirdList (WeirdList a) -> WeirdList a + +data instance Sing (z :: WeirdList a) where + SWeirdNil :: Sing WeirdNil + SWeirdCons :: Sing w -> Sing wws -> Sing (WeirdCons w wws) + +elimWeirdList :: forall (a :: Type) (wl :: WeirdList a) + (p :: forall (x :: Type). x -> WeirdList x -> Type). + Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs + -> p _ (WeirdCons x xs)) + -> p _ wl +elimWeirdList SWeirdNil pWeirdNil _ = pWeirdNil +elimWeirdList (SWeirdCons (x :: Sing (x :: z)) + (xs :: Sing (xs :: WeirdList (WeirdList z)))) + pWeirdNil pWeirdCons + = pWeirdCons @z @x @xs x xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.stderr b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr new file mode 100644 index 0000000..b4f0e26 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr @@ -0,0 +1,48 @@ + +T14040a.hs:21:18: error: + • The kind of variable ‘wl1’, namely ‘WeirdList a1’, + depends on variable ‘a1’ from an inner scope + Perhaps bind ‘wl1’ sometime after binding ‘a1’ + • In the type signature: + elimWeirdList :: forall (a :: Type) + (wl :: WeirdList a) + (p :: forall (x :: Type). x -> WeirdList x -> Type). + Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)) + -> p _ wl + +T14040a.hs:34:8: error: + • Cannot apply expression of type ‘Sing wl + -> (forall y. p x0 w0 'WeirdNil) + -> (forall z1 (x :: z1) (xs :: WeirdList (WeirdList z1)). + Sing x + -> Sing xs + -> p (WeirdList z1) w1 xs + -> p z1 w2 ('WeirdCons x xs)) + -> p a w3 wl’ + to a visible type argument ‘(WeirdList z)’ + • In the sixth argument of ‘pWeirdCons’, namely + ‘(elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons)’ + In the expression: + pWeirdCons + @z + @x + @xs + x + xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) + In an equation for ‘elimWeirdList’: + elimWeirdList + (SWeirdCons (x :: Sing (x :: z)) + (xs :: Sing (xs :: WeirdList (WeirdList z)))) + pWeirdNil + pWeirdCons + = pWeirdCons + @z + @x + @xs + x + xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T index 36ea6cb..b974ce8 100644 --- a/testsuite/tests/partial-sigs/should_fail/all.T +++ b/testsuite/tests/partial-sigs/should_fail/all.T @@ -64,6 +64,7 @@ test('PatBind3', normal, compile_fail, ['']) test('T12039', normal, compile_fail, ['']) test('T12634', normal, compile_fail, ['']) test('T12732', normal, compile_fail, ['-fobject-code -fdefer-typed-holes']) +test('T14040a', normal, compile_fail, ['']) test('T14449', normal, compile_fail, ['']) test('T14479', normal, compile_fail, ['']) test('T14584', normal, compile, ['']) From git at git.haskell.org Mon Jan 15 06:56:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 06:56:10 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: checkpoint (2905cfb) Message-ID: <20180115065610.807BA3A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/2905cfb4bf665a69aa3b1ea619b3b428ed64d6e8/ghc >--------------------------------------------------------------- commit 2905cfb4bf665a69aa3b1ea619b3b428ed64d6e8 Author: Gabor Greif Date: Mon Jan 15 07:55:52 2018 +0100 WIP: checkpoint >--------------------------------------------------------------- 2905cfb4bf665a69aa3b1ea619b3b428ed64d6e8 compiler/codeGen/StgCmmCon.hs | 5 +++-- compiler/utils/Outputable.hs | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index a00081c..bc3d69c 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -258,8 +258,9 @@ buildDynCon' dflags _ binder actually_bound ccs con args checkTagOnPtr base (((NonVoid (StgVarArg var)),offset), bang) | isBanged bang - , isAlgType (let ty = idType var in pprTrace "checkTagOnPtrTy" (ppr ty) ty) - = do lgood <- newBlockId + , let ty = idType var + , isAlgType ty + = do lgood <- pprTrace "checkTagOnPtr#Ty" (ppr ty) newBlockId lcall <- newBlockId let p = CmmLoad (cmmOffsetB dflags base offset) (bWord dflags) emit $ mkCbranch (cmmIsTagged dflags p) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index d9580a8..3050fa1 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -321,7 +321,7 @@ code (either C or assembly), or generating interface files. newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc } data SDocContext = SDC - { sdocStyle :: PprStyle + { sdocStyle :: !PprStyle , sdocLastColour :: !Col.PprColour -- ^ The most recently used colour. This allows nesting colours. , sdocDynFlags :: !DynFlags From git at git.haskell.org Mon Jan 15 17:10:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 17:10:23 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix join-point decision (20afdaa) Message-ID: <20180115171023.6DC963A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/20afdaa75e269697c2f9608e6d29f720a6387d01/ghc >--------------------------------------------------------------- commit 20afdaa75e269697c2f9608e6d29f720a6387d01 Author: Simon Peyton Jones Date: Tue Jan 9 13:53:09 2018 +0000 Fix join-point decision This patch moves the "ok_unfolding" test from CoreOpt.joinPointBinding_maybe to OccurAnal.decideJoinPointHood Previously the occurrence analyser was deciding to make something a join point, but the simplifier was reversing that decision, which made the decision about /other/ bindings invalid. Fixes Trac #14650. (cherry picked from commit 66ff794fedf6e81e727dc8f651e63afe6f2a874b) >--------------------------------------------------------------- 20afdaa75e269697c2f9608e6d29f720a6387d01 compiler/coreSyn/CoreOpt.hs | 44 +------------ compiler/simplCore/OccurAnal.hs | 68 +++++++++++++++---- testsuite/tests/simplCore/should_compile/T14650.hs | 76 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 4 files changed, 136 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 20afdaa75e269697c2f9608e6d29f720a6387d01 From git at git.haskell.org Mon Jan 15 17:13:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 17:13:00 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: focus on SDC for now (248f045) Message-ID: <20180115171300.7A8E73A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/248f045ec243058ad4b3bbafe0ddb1de03021fca/ghc >--------------------------------------------------------------- commit 248f045ec243058ad4b3bbafe0ddb1de03021fca Author: Gabor Greif Date: Mon Jan 15 18:12:12 2018 +0100 WIP: focus on SDC for now >--------------------------------------------------------------- 248f045ec243058ad4b3bbafe0ddb1de03021fca compiler/codeGen/StgCmmCon.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index bc3d69c..6415370 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -32,6 +32,8 @@ import StgCmmProf ( curCCS ) import TyCon -- NOT NEEDED import Type (isAlgType) +import Name (getName, nameOccName) +import OccName (occNameString) import CmmExpr import CLabel import MkGraph @@ -246,7 +248,8 @@ buildDynCon' dflags _ binder actually_bound ccs con args ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info use_cc blame_cc args_w_offsets - ; when (isDataTyCon $ dataConTyCon con) + ; let conname = occNameString $ nameOccName $ getName $ con -- occNameFS $ getOccName $ getName $ con + ; when (conname == "SDC" && (isDataTyCon $ dataConTyCon con)) $ mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) ; return (mkRhsInit dflags reg lf_info hp_plus_n) } where From git at git.haskell.org Mon Jan 15 19:22:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:14 +0000 (UTC) Subject: [commit: ghc] master: Rename -frule-check to -drule-check and document (d1ac1c3) Message-ID: <20180115192214.7B7F73A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1ac1c337c5d200fe8a885b42d334c74fb083c2e/ghc >--------------------------------------------------------------- commit d1ac1c337c5d200fe8a885b42d334c74fb083c2e Author: Matthew Pickering Date: Mon Jan 15 12:37:51 2018 -0500 Rename -frule-check to -drule-check and document Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4256 >--------------------------------------------------------------- d1ac1c337c5d200fe8a885b42d334c74fb083c2e compiler/main/DynFlags.hs | 2 +- docs/users_guide/debugging.rst | 13 +++++++++++++ testsuite/tests/driver/T9776.stderr | 2 +- testsuite/tests/driver/all.T | 2 +- 4 files changed, 16 insertions(+), 3 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4b95bfa..0c8222f 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3300,7 +3300,7 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { liberateCaseThreshold = Just n })) , make_ord_flag defFlag "fno-liberate-case-threshold" (noArg (\d -> d { liberateCaseThreshold = Nothing })) - , make_ord_flag defFlag "frule-check" + , make_ord_flag defFlag "drule-check" (sepArg (\s d -> d { ruleCheck = Just s })) , make_ord_flag defFlag "freduction-depth" (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index efa6e28..3997919 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -270,6 +270,19 @@ subexpression elimination pass. Dumps detailed information about all rules that fired in this module +.. ghc-flag:: -drule-check=⟨str⟩ + :shortdesc: Dump information about potential rule application + :type: dynamic + + This flag is useful for debugging why a rule you expect to be firing isn't. + + Rules are filtered by the user provided string, a rule is kept if a prefix + of its name matches the string. + The pass then checks whether any of these rules could apply to + the program but which didn't file for some reason. For example, specifying + ``-drule-check=SPEC`` will check whether there are any applications which + might be subject to a rule created by specialisation. + .. ghc-flag:: -ddump-vect :shortdesc: Dump vectoriser input and output :type: dynamic diff --git a/testsuite/tests/driver/T9776.stderr b/testsuite/tests/driver/T9776.stderr index 328a105..0281a2d 100644 --- a/testsuite/tests/driver/T9776.stderr +++ b/testsuite/tests/driver/T9776.stderr @@ -1,2 +1,2 @@ -ghc-stage2: on the commandline: missing argument for flag: -frule-check +ghc-stage2: on the commandline: missing argument for flag: -drule-check Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index a63513a..976a316 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -214,7 +214,7 @@ test('write_interface_oneshot', [extra_files(['A011.hs'])], run_command, test('write_interface_make', [extra_files(['A011.hs'])], run_command, ['$MAKE -s --no-print-directory write_interface_make']) -test('T9776', normal, compile_fail, ['-frule-check']) +test('T9776', normal, compile_fail, ['-drule-check']) test('T9938', [], run_command, ['$MAKE -s --no-print-directory T9938']) From git at git.haskell.org Mon Jan 15 19:22:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:17 +0000 (UTC) Subject: [commit: ghc] master: Fix regression on i386 due to get/setAllocationCounter change (a770226) Message-ID: <20180115192217.BEDCE3A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a770226e03f09b767fdb4ce826162a5c0f29ec29/ghc >--------------------------------------------------------------- commit a770226e03f09b767fdb4ce826162a5c0f29ec29 Author: Ben Gamari Date: Mon Jan 15 13:01:59 2018 -0500 Fix regression on i386 due to get/setAllocationCounter change Reviewers: simonmar, erikd Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4312 >--------------------------------------------------------------- a770226e03f09b767fdb4ce826162a5c0f29ec29 rts/PrimOps.cmm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 1caa0c3..42001d1 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -2499,7 +2499,7 @@ stg_traceMarkerzh ( W_ msg ) stg_getThreadAllocationCounterzh () { // Account for the allocation in the current block - W_ offset; + I64 offset; offset = Hp - bdescr_start(CurrentNursery); return (StgTSO_alloc_limit(CurrentTSO) - offset); } @@ -2510,7 +2510,7 @@ stg_setThreadAllocationCounterzh ( I64 counter ) // getThreadAllocationCounter#, so we have to offset any existing // allocation here. See also openNursery/closeNursery in // compiler/codeGen/StgCmmForeign.hs. - W_ offset; + I64 offset; offset = Hp - bdescr_start(CurrentNursery); StgTSO_alloc_limit(CurrentTSO) = counter + offset; return (); From git at git.haskell.org Mon Jan 15 19:22:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:20 +0000 (UTC) Subject: [commit: ghc] master: Add flag -fno-it (41afbb3) Message-ID: <20180115192220.E4E573A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/41afbb3f20f3d84abacb37afcc5aa64b24c22da8/ghc >--------------------------------------------------------------- commit 41afbb3f20f3d84abacb37afcc5aa64b24c22da8 Author: Matthew Pickering Date: Mon Jan 15 13:51:38 2018 -0500 Add flag -fno-it This flag stops ghci creating the special variable `it` after evaluating an expression. This stops ghci leaking as much memory when evaluating expressions. See #14336 Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14336 Differential Revision: https://phabricator.haskell.org/D4299 >--------------------------------------------------------------- 41afbb3f20f3d84abacb37afcc5aa64b24c22da8 compiler/main/DynFlags.hs | 2 ++ compiler/typecheck/TcRnDriver.hs | 68 +++++++++++++++++++++++++++++++++------- docs/users_guide/ghci.rst | 14 +++++++++ 3 files changed, 73 insertions(+), 11 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0c8222f..ef4e2f8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -522,6 +522,7 @@ data GeneralFlag | Opt_GhciSandbox | Opt_GhciHistory | Opt_LocalGhciHistory + | Opt_NoIt | Opt_HelpfulErrors | Opt_DeferTypeErrors | Opt_DeferTypedHoles @@ -3824,6 +3825,7 @@ fFlagsDeps = [ flagSpec "gen-manifest" Opt_GenManifest, flagSpec "ghci-history" Opt_GhciHistory, flagGhciSpec "local-ghci-history" Opt_LocalGhciHistory, + flagGhciSpec "no-it" Opt_NoIt, flagSpec "ghci-sandbox" Opt_GhciSandbox, flagSpec "helpful-errors" Opt_HelpfulErrors, flagSpec "hpc" Opt_Hpc, diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 9fbe053..85535e1 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2010,17 +2010,23 @@ tcUserStmt (L loc (BodyStmt expr _ _ _)) (mkRnSyntaxExpr thenIOName) noSyntaxExpr placeHolderType - -- The plans are: - -- A. [it <- e; print it] but not if it::() - -- B. [it <- e] - -- C. [let it = e; print it] - -- - -- Ensure that type errors don't get deferred when type checking the - -- naked expression. Deferring type errors here is unhelpful because the - -- expression gets evaluated right away anyway. It also would potentially - -- emit two redundant type-error warnings, one from each plan. - ; plan <- unsetGOptM Opt_DeferTypeErrors $ - unsetGOptM Opt_DeferTypedHoles $ runPlans [ + -- NewA + no_it_a = L loc $ BodyStmt (nlHsApps bindIOName + [rn_expr , nlHsVar interPrintName]) + (mkRnSyntaxExpr thenIOName) + noSyntaxExpr placeHolderType + + no_it_b = L loc $ BodyStmt (rn_expr) + (mkRnSyntaxExpr thenIOName) + noSyntaxExpr placeHolderType + + no_it_c = L loc $ BodyStmt (nlHsApp (nlHsVar interPrintName) rn_expr) + (mkRnSyntaxExpr thenIOName) + noSyntaxExpr placeHolderType + + -- See Note [GHCi Plans] + + it_plans = [ -- Plan A do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it] ; it_ty <- zonkTcType (idType it_id) @@ -2039,6 +2045,25 @@ tcUserStmt (L loc (BodyStmt expr _ _ _)) --- checkNoErrs defeats the error recovery of let-bindings ; tcGhciStmts [let_stmt, print_it] } ] + -- Plans where we don't bind "it" + no_it_plans = [ + tcGhciStmts [no_it_a] , + tcGhciStmts [no_it_b] , + tcGhciStmts [no_it_c] ] + + + -- Ensure that type errors don't get deferred when type checking the + -- naked expression. Deferring type errors here is unhelpful because the + -- expression gets evaluated right away anyway. It also would potentially + -- emit two redundant type-error warnings, one from each plan. + ; generate_it <- goptM Opt_NoIt + ; plan <- unsetGOptM Opt_DeferTypeErrors $ + unsetGOptM Opt_DeferTypedHoles $ + runPlans $ if generate_it + then no_it_plans + else it_plans + + ; fix_env <- getFixityEnv ; return (plan, fix_env) } @@ -2080,6 +2105,27 @@ tcUserStmt rdr_stmt@(L loc _) (mkRnSyntaxExpr thenIOName) noSyntaxExpr placeHolderType +{- +Note [GHCi Plans] + +When a user types an expression in the repl we try to print it in three different +ways. Also, depending on whether -fno-it is set, we bind a variable called `it` +which can be used to refer to the result of the expression subsequently in the repl. + +The normal plans are : + A. [it <- e; print e] but not if it::() + B. [it <- e] + C. [let it = e; print it] + +When -fno-it is set, the plans are: + A. [e >>= print] + B. [e] + C. [let it = e in print it] + +The reason for -fno-it is explained in #14336. `it` can lead to the repl +leaking memory as it is repeatedly queried. +-} + -- | Typecheck the statements given and then return the results of the -- statement in the form 'IO [()]'. tcGhciStmts :: [GhciLStmt GhcRn] -> TcM PlanResult diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst index eae98f7..f5dcfe3 100644 --- a/docs/users_guide/ghci.rst +++ b/docs/users_guide/ghci.rst @@ -1027,6 +1027,20 @@ The corresponding translation for an IO-typed ``e`` is Note that ``it`` is shadowed by the new value each time you evaluate a new expression, and the old value of ``it`` is lost. +In order to stop the value ``it`` being bound on each command, the flag +:ghc-flag:`-fno-it` can be set. The ``it`` variable can be the source +of space leaks due to how shadowed declarations are handled by +GHCi (see :ref:`ghci-decls`). + +.. ghc-flag:: -fno-it + :shortdesc: No longer set the special variable ``it``. + :type: dynamic + :reverse: -fno-no-it + :category: + + When this flag is set, the variable ``it`` will no longer be set + to the result of the previously evaluated expression. + .. _extended-default-rules: Type defaulting in GHCi From git at git.haskell.org Mon Jan 15 19:22:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:24 +0000 (UTC) Subject: [commit: ghc] master: Remove executable filename check on windows (1bf70b2) Message-ID: <20180115192224.62DA33A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1bf70b2041dc2b7c89565fcb46cad8f151f96790/ghc >--------------------------------------------------------------- commit 1bf70b2041dc2b7c89565fcb46cad8f151f96790 Author: klebinger.andreas at gmx.at Date: Mon Jan 15 13:52:15 2018 -0500 Remove executable filename check on windows On Windows GHC enforces currently that the real executable is named ghc.exe/ghc-stage[123].exe. I don't see a good reason why this is neccessary. This patch removes this restriction and fixes #14652 Test Plan: ci Reviewers: bgamari, Phyx Reviewed By: Phyx Subscribers: Phyx, rwbarton, thomie, carter GHC Trac Issues: #14652 Differential Revision: https://phabricator.haskell.org/D4296 >--------------------------------------------------------------- 1bf70b2041dc2b7c89565fcb46cad8f151f96790 compiler/main/SysTools/BaseDir.hs | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index 343be82..2c264b8 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -34,7 +34,6 @@ import qualified System.Win32.Types as Win32 #else import qualified System.Win32.Info as Win32 #endif -import Data.Char import Exception import Foreign import Foreign.C.String @@ -111,7 +110,7 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. _ | ret < size -> do path <- peekCWString buf real <- getFinalPath path -- try to resolve symlinks paths - let libdir = (rootDir . sanitize . maybe path id) real + let libdir = (buildLibDir . sanitize . maybe path id) real exists <- doesDirectoryExist libdir if exists then return $ Just libdir @@ -126,19 +125,11 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. then drop 4 s else s - rootDir s = case splitFileName $ normalise s of - (d, ghc_exe) - | lower ghc_exe `elem` ["ghc.exe", - "ghc-stage1.exe", - "ghc-stage2.exe", - "ghc-stage3.exe"] -> - case splitFileName $ takeDirectory d of - -- ghc is in $topdir/bin/ghc.exe - (d', _) -> takeDirectory d' "lib" - _ -> fail s + buildLibDir :: FilePath -> FilePath + buildLibDir s = + (takeDirectory . takeDirectory . normalise $ s) "lib" fail s = panic ("can't decompose ghc.exe path: " ++ show s) - lower = map toLower foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 From git at git.haskell.org Mon Jan 15 19:22:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:27 +0000 (UTC) Subject: [commit: ghc] master: CoreLint: typo in a comment (78306b5) Message-ID: <20180115192227.987D13A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78306b5396c77519318a409ff9514c48eeb52c63/ghc >--------------------------------------------------------------- commit 78306b5396c77519318a409ff9514c48eeb52c63 Author: Ömer Sinan Ağacan Date: Mon Jan 15 13:51:02 2018 -0500 CoreLint: typo in a comment Reviewers: bgamari, goldfire Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4308 >--------------------------------------------------------------- 78306b5396c77519318a409ff9514c48eeb52c63 compiler/coreSyn/CoreLint.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 17fa980..e866f0d 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -202,8 +202,8 @@ points but not the RHSes of value bindings (thunks and functions). ************************************************************************ These functions are not CoreM monad stuff, but they probably ought to -be, and it makes a conveneint place. place for them. They print out -stuff before and after core passes, and do Core Lint when necessary. +be, and it makes a convenient place for them. They print out stuff +before and after core passes, and do Core Lint when necessary. -} endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM () From git at git.haskell.org Mon Jan 15 19:22:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:30 +0000 (UTC) Subject: [commit: ghc] master: Fix hashbang of gen-data-layout (9f7edb9) Message-ID: <20180115192230.95D943A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f7edb95663d53a3544dcf27fe9c36b395818dfa/ghc >--------------------------------------------------------------- commit 9f7edb95663d53a3544dcf27fe9c36b395818dfa Author: Ben Gamari Date: Mon Jan 15 13:50:35 2018 -0500 Fix hashbang of gen-data-layout Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4313 >--------------------------------------------------------------- 9f7edb95663d53a3544dcf27fe9c36b395818dfa utils/llvm-targets/gen-data-layout.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index 6f2aafc..834a978 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash # # llvm-target generator # From git at git.haskell.org Mon Jan 15 19:22:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:34 +0000 (UTC) Subject: [commit: ghc] master: Tweak link order slightly to prefer user shared libs before system ones. (3d17f1f) Message-ID: <20180115192234.3A2173A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3d17f1f10fc00540ac052f2fd03182906aa47e35/ghc >--------------------------------------------------------------- commit 3d17f1f10fc00540ac052f2fd03182906aa47e35 Author: Tamar Christina Date: Mon Jan 15 12:38:45 2018 -0500 Tweak link order slightly to prefer user shared libs before system ones. We currently always prefer shared libraries before import libraries and static libraries. This is because they're faster to load. The problem is when shared library are installed in the Windows directory. These would supersede any user specified ones. This is bad because e.g. Windows now ships icuuc, but an old version. If you try to use -licuuc then it would pick the Windows one instead of your user specified one. This patch slighly tweaks the ordering so user paths get prefered. Test Plan: ./validate Reviewers: RyanGlScott, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14456 Differential Revision: https://phabricator.haskell.org/D4274 >--------------------------------------------------------------- 3d17f1f10fc00540ac052f2fd03182906aa47e35 compiler/ghci/Linker.hs | 48 ++++++++++++++++++++++++++++++---------- docs/users_guide/8.6.1-notes.rst | 4 ++++ 2 files changed, 40 insertions(+), 12 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index ecd9cbd..3775d58 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -336,6 +336,11 @@ linkCmdLineLibs' hsc_env pls = -- See Note [Fork/Exec Windows] gcc_paths <- getGCCPaths dflags os + maybePutStrLn dflags "Search directories (user):" + maybePutStr dflags (unlines $ map (" "++) lib_paths_base) + maybePutStrLn dflags "Search directories (gcc):" + maybePutStr dflags (unlines $ map (" "++) gcc_paths) + libspecs <- mapM (locateLib hsc_env False lib_paths_base gcc_paths) minus_ls @@ -1340,21 +1345,35 @@ locateLib :: HscEnv -> Bool -> [FilePath] -> [FilePath] -> String locateLib hsc_env is_hs lib_dirs gcc_dirs lib | not is_hs -- For non-Haskell libraries (e.g. gmp, iconv): - -- first look in library-dirs for a dynamic library (libfoo.so) + -- first look in library-dirs for a dynamic library (on User paths only) + -- (libfoo.so) + -- then try looking for import libraries on Windows (on User paths only) + -- (.dll.a, .lib) + -- first look in library-dirs for a dynamic library (on GCC paths only) + -- (libfoo.so) + -- then check for system dynamic libraries (e.g. kernel32.dll on windows) + -- then try looking for import libraries on Windows (on GCC paths only) + -- (.dll.a, .lib) -- then look in library-dirs for a static library (libfoo.a) -- then look in library-dirs and inplace GCC for a dynamic library (libfoo.so) - -- then check for system dynamic libraries (e.g. kernel32.dll on windows) -- then try looking for import libraries on Windows (.dll.a, .lib) -- then look in library-dirs and inplace GCC for a static library (libfoo.a) -- then try "gcc --print-file-name" to search gcc's search path -- for a dynamic library (#5289) -- otherwise, assume loadDLL can find it -- - = findDll `orElse` - findSysDll `orElse` - tryImpLib `orElse` - findArchive `orElse` - tryGcc `orElse` + -- The logic is a bit complicated, but the rationale behind it is that + -- loading a shared library for us is O(1) while loading an archive is + -- O(n). Loading an import library is also O(n) so in general we prefer + -- shared libraries because they are simpler and faster. + -- + = findDll user `orElse` + tryImpLib user `orElse` + findDll gcc `orElse` + findSysDll `orElse` + tryImpLib gcc `orElse` + findArchive `orElse` + tryGcc `orElse` assumeDll | loading_dynamic_hs_libs -- search for .so libraries first. @@ -1375,12 +1394,15 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib where dflags = hsc_dflags hsc_env - dirs = lib_dirs ++ gcc_dirs + dirs = lib_dirs ++ gcc_dirs + gcc = False + user = True obj_file = lib <.> "o" dyn_obj_file = lib <.> "dyn_o" arch_files = [ "lib" ++ lib ++ lib_tag <.> "a" , lib <.> "a" -- native code has no lib_tag + , "lib" ++ lib, lib ] lib_tag = if is_hs && loading_profiled_hs_libs then "_p" else "" @@ -1405,7 +1427,8 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib findArchive = let local name = liftM (fmap Archive) $ findFile dirs name in apply (map local arch_files) findHSDll = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file - findDll = liftM (fmap DLLPath) $ findFile dirs dyn_lib_file + findDll re = let dirs' = if re == user then lib_dirs else gcc_dirs + in liftM (fmap DLLPath) $ findFile dirs' dyn_lib_file findSysDll = fmap (fmap $ DLL . dropExtension . takeFileName) $ findSystemLibrary hsc_env so_name tryGcc = let search = searchForLibUsingGcc dflags @@ -1415,10 +1438,11 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib gcc name = liftM (fmap Archive) $ search name lib_dirs files = import_libs ++ arch_files in apply $ short : full : map gcc files - tryImpLib = case os of + tryImpLib re = case os of OSMinGW32 -> - let implib name = liftM (fmap Archive) $ - findFile dirs name + let dirs' = if re == user then lib_dirs else gcc_dirs + implib name = liftM (fmap Archive) $ + findFile dirs' name in apply (map implib import_libs) _ -> return Nothing diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index ad5c5af..d2d5172 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -30,6 +30,10 @@ Compiler Runtime system ~~~~~~~~~~~~~~ +- The GHC runtime linker now prefers user shared libraries above system ones. + When extra search directories are specified these are searched before anything + else. This fixes `iuuc` on Windows given the proper search directories (e.g + `-L/mingw64/lib`). Template Haskell ~~~~~~~~~~~~~~~~ From git at git.haskell.org Mon Jan 15 19:22:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:39 +0000 (UTC) Subject: [commit: ghc] master: Support LIBRARY_PATH and LD_LIBRARY_PATH in rts (87917a5) Message-ID: <20180115192239.233963A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/87917a594f37b70810013168a5df64d630620724/ghc >--------------------------------------------------------------- commit 87917a594f37b70810013168a5df64d630620724 Author: Ben Gamari Date: Mon Jan 15 12:40:22 2018 -0500 Support LIBRARY_PATH and LD_LIBRARY_PATH in rts `LIBRARY_PATH` is used to find libraries and other link artifacts while `LD_LIBRARY_PATH` is used to find shared libraries by the loader. Due to an implementation detail on Windows, using `LIBRARY_PATH` will automatically add the path of any library found to the loader's path. So in that case `LD_LIBRARY_PATH` won't be needed. Test Plan: ./validate along with T14611 which has been made Windows only due to linux using the system linker/loader by default. So I feel a testcase there is unwarranted as the support is indirect via glibc. Reviewers: hvr, bgamari, erikd, simonmar, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14611 Differential Revision: https://phabricator.haskell.org/D4275 >--------------------------------------------------------------- 87917a594f37b70810013168a5df64d630620724 compiler/ghci/Linker.hs | 37 ++++++++++++++++++---- docs/users_guide/8.6.1-notes.rst | 7 ++-- docs/users_guide/ghci.rst | 21 +++++++++--- testsuite/tests/rts/{T12771 => T14611}/Makefile | 4 +-- .../bkprun02.stdout => rts/T14611/T14611.stdout} | 0 testsuite/tests/rts/{T12771 => T14611}/all.T | 4 +-- testsuite/tests/rts/{T12771 => T14611}/foo.c | 0 testsuite/tests/rts/{T12771 => T14611}/foo_dll.c | 0 testsuite/tests/rts/{T12771 => T14611}/main.hs | 0 9 files changed, 56 insertions(+), 17 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 87917a594f37b70810013168a5df64d630620724 From git at git.haskell.org Mon Jan 15 19:22:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:42 +0000 (UTC) Subject: [commit: ghc] master: Kill off irrefutable pattern errors (492e604) Message-ID: <20180115192242.0E60E3A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/492e6044577519b59f390008362de98e9517e04d/ghc >--------------------------------------------------------------- commit 492e6044577519b59f390008362de98e9517e04d Author: David Feuer Date: Mon Jan 15 12:38:29 2018 -0500 Kill off irrefutable pattern errors Distinguishing between "refutable" and "irrefutable" patterns (as described by the Haskell Report) in incomplete pattern errors was more confusing than helpful. Remove references to irrefutable patterns. Reviewers: hvr, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14569 Differential Revision: https://phabricator.haskell.org/D4261 >--------------------------------------------------------------- 492e6044577519b59f390008362de98e9517e04d compiler/coreSyn/MkCore.hs | 9 +++------ compiler/deSugar/DsUtils.hs | 2 +- compiler/prelude/PrelNames.hs | 3 +-- libraries/base/Control/Exception/Base.hs | 5 ++--- testsuite/tests/deSugar/should_fail/DsStrictFail.stderr | 2 +- testsuite/tests/deSugar/should_run/dsrun008.stderr | 2 +- testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr | 2 +- 7 files changed, 10 insertions(+), 15 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 72b6abf..3e5d8cd 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -43,7 +43,7 @@ module MkCore ( -- * Error Ids mkRuntimeErrorApp, mkImpossibleExpr, mkAbsentErrorApp, errorIds, - rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID, + rEC_CON_ERROR_ID, rUNTIME_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, pAT_ERROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID, tYPE_ERROR_ID, @@ -695,7 +695,6 @@ templates, but we don't ever expect to generate code for it. errorIds :: [Id] errorIds = [ rUNTIME_ERROR_ID, - iRREFUT_PAT_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, pAT_ERROR_ID, @@ -706,14 +705,13 @@ errorIds ] recSelErrorName, runtimeErrorName, absentErrorName :: Name -irrefutPatErrorName, recConErrorName, patErrorName :: Name +recConErrorName, patErrorName :: Name nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name typeErrorName :: Name recSelErrorName = err_nm "recSelError" recSelErrorIdKey rEC_SEL_ERROR_ID absentErrorName = err_nm "absentError" absentErrorIdKey aBSENT_ERROR_ID runtimeErrorName = err_nm "runtimeError" runtimeErrorIdKey rUNTIME_ERROR_ID -irrefutPatErrorName = err_nm "irrefutPatError" irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID recConErrorName = err_nm "recConError" recConErrorIdKey rEC_CON_ERROR_ID patErrorName = err_nm "patError" patErrorIdKey pAT_ERROR_ID typeErrorName = err_nm "typeError" typeErrorIdKey tYPE_ERROR_ID @@ -726,12 +724,11 @@ nonExhaustiveGuardsErrorName = err_nm "nonExhaustiveGuardsError" err_nm :: String -> Unique -> Id -> Name err_nm str uniq id = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit str) uniq id -rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, iRREFUT_PAT_ERROR_ID, rEC_CON_ERROR_ID :: Id +rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, rEC_CON_ERROR_ID :: Id pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id tYPE_ERROR_ID, aBSENT_ERROR_ID :: Id rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName -iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName pAT_ERROR_ID = mkRuntimeErrorId patErrorName nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index 3748193..f4d669c 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -760,7 +760,7 @@ mkSelectorBinds ticks pat val_expr | otherwise -- General case (C) = do { tuple_var <- newSysLocalDs tuple_ty - ; error_expr <- mkErrorAppDs iRREFUT_PAT_ERROR_ID tuple_ty (ppr pat') + ; error_expr <- mkErrorAppDs pAT_ERROR_ID tuple_ty (ppr pat') ; tuple_expr <- matchSimply val_expr PatBindRhs pat local_tuple error_expr ; let mk_tup_bind tick binder diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index d5fc5b3..df13eaa 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -2073,7 +2073,7 @@ typeLitNatDataConKey = mkPreludeDataConUnique 108 wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey, buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey, - seqIdKey, irrefutPatErrorIdKey, eqStringIdKey, + seqIdKey, eqStringIdKey, noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey, realWorldPrimIdKey, recConErrorIdKey, @@ -2090,7 +2090,6 @@ errorIdKey = mkPreludeMiscIdUnique 5 foldrIdKey = mkPreludeMiscIdUnique 6 recSelErrorIdKey = mkPreludeMiscIdUnique 7 seqIdKey = mkPreludeMiscIdUnique 8 -irrefutPatErrorIdKey = mkPreludeMiscIdUnique 9 eqStringIdKey = mkPreludeMiscIdUnique 10 noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 11 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 12 diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index d443159..e675e0c 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -93,7 +93,7 @@ module Control.Exception.Base ( finally, -- * Calls for GHC runtime - recSelError, recConError, irrefutPatError, runtimeError, + recSelError, recConError, runtimeError, nonExhaustiveGuardsError, patError, noMethodBindingError, absentError, typeError, nonTermination, nestedAtomically, @@ -375,7 +375,7 @@ instance Exception NestedAtomically ----- -recSelError, recConError, irrefutPatError, runtimeError, +recSelError, recConError, runtimeError, nonExhaustiveGuardsError, patError, noMethodBindingError, absentError, typeError :: Addr# -> a -- All take a UTF8-encoded C string @@ -386,7 +386,6 @@ runtimeError s = errorWithoutStackTrace (unpackCStringUtf8# s) absentError s = errorWithoutStackTrace ("Oops! Entered absent arg " ++ unpackCStringUtf8# s) nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in")) -irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern")) recConError s = throw (RecConError (untangle s "Missing field in record construction")) noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation")) patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in")) diff --git a/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr b/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr index c7135b2..a863168 100644 --- a/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr +++ b/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr @@ -1,2 +1,2 @@ -DsStrictFail: DsStrictFail.hs:4:12-23: Irrefutable pattern failed for pattern False +DsStrictFail: DsStrictFail.hs:4:12-23: Non-exhaustive patterns in False diff --git a/testsuite/tests/deSugar/should_run/dsrun008.stderr b/testsuite/tests/deSugar/should_run/dsrun008.stderr index ff7de05..cef2458 100644 --- a/testsuite/tests/deSugar/should_run/dsrun008.stderr +++ b/testsuite/tests/deSugar/should_run/dsrun008.stderr @@ -1,2 +1,2 @@ -dsrun008: dsrun008.hs:2:15-42: Irrefutable pattern failed for pattern (2, x) +dsrun008: dsrun008.hs:2:15-42: Non-exhaustive patterns in (2, x) diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr index 5aed2c5..9434e29 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr @@ -1,2 +1,2 @@ -SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Just p' +SafeLang15: SafeLang15.hs:22:9-37: Non-exhaustive patterns in Just p' From git at git.haskell.org Mon Jan 15 19:22:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:45 +0000 (UTC) Subject: [commit: ghc] master: Fix hash in haddock of ghc-prim. (2feed11) Message-ID: <20180115192245.1DACC3A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2feed118413944cae8a4eed17365f40521f470db/ghc >--------------------------------------------------------------- commit 2feed118413944cae8a4eed17365f40521f470db Author: HE, Tao Date: Mon Jan 15 13:51:15 2018 -0500 Fix hash in haddock of ghc-prim. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14653 Differential Revision: https://phabricator.haskell.org/D4305 >--------------------------------------------------------------- 2feed118413944cae8a4eed17365f40521f470db compiler/prelude/primops.txt.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index e958baf..93482df 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2621,7 +2621,7 @@ section "Unsafe pointer equality" primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp a -> a -> Int# - { Returns 1# if the given pointers are equal and 0# otherwise. } + { Returns {\texttt 1\#} if the given pointers are equal and {\texttt 0\#} otherwise. } with can_fail = True -- See Note [reallyUnsafePtrEquality#] From git at git.haskell.org Mon Jan 15 19:22:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:50 +0000 (UTC) Subject: [commit: ghc] master: Parenthesize forall-type args in cvtTypeKind (f380115) Message-ID: <20180115192250.0500C3A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f380115cd834ffbe51aca60f5476a51b94cdd413/ghc >--------------------------------------------------------------- commit f380115cd834ffbe51aca60f5476a51b94cdd413 Author: Ryan Scott Date: Mon Jan 15 13:51:55 2018 -0500 Parenthesize forall-type args in cvtTypeKind Trac #14646 happened because we forgot to parenthesize `forall` types to the left of an arrow. This simple patch fixes that. Test Plan: make test TEST=T14646 Reviewers: alanz, goldfire, bgamari Reviewed By: alanz Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14646 Differential Revision: https://phabricator.haskell.org/D4298 >--------------------------------------------------------------- f380115cd834ffbe51aca60f5476a51b94cdd413 compiler/hsSyn/Convert.hs | 9 +++++---- testsuite/tests/th/T14646.hs | 6 ++++++ testsuite/tests/th/T14646.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 18 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index de72878..e8c7f0d 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1219,10 +1219,11 @@ cvtTypeKind ty_str ty tys' ArrowT | [x',y'] <- tys' -> do - case x' of - (L _ HsFunTy{}) -> do { x'' <- returnL (HsParTy x') - ; returnL (HsFunTy x'' y') } - _ -> returnL (HsFunTy x' y') + x'' <- case x' of + L _ HsFunTy{} -> returnL (HsParTy x') + L _ HsForAllTy{} -> returnL (HsParTy x') -- #14646 + _ -> return x' + returnL (HsFunTy x'' y') | otherwise -> mk_apps (HsTyVar NotPromoted (noLoc (getRdrName funTyCon))) tys' diff --git a/testsuite/tests/th/T14646.hs b/testsuite/tests/th/T14646.hs new file mode 100644 index 0000000..c858723 --- /dev/null +++ b/testsuite/tests/th/T14646.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module T14646 where + +$([d| f :: (forall a. a) -> Int + f _ = undefined |]) diff --git a/testsuite/tests/th/T14646.stderr b/testsuite/tests/th/T14646.stderr new file mode 100644 index 0000000..869cf6f --- /dev/null +++ b/testsuite/tests/th/T14646.stderr @@ -0,0 +1,6 @@ +T14646.hs:(5,3)-(6,24): Splicing declarations + [d| f :: (forall a. a) -> Int + f _ = undefined |] + ======> + f :: (forall a. a) -> Int + f _ = undefined diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 0ad178e..1fae4c6 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -397,3 +397,4 @@ test('T13887', normal, compile_and_run, ['-v0']) test('T13968', normal, compile_fail, ['-v0']) test('T14204', normal, compile_fail, ['-v0']) test('T14060', normal, compile_and_run, ['-v0']) +test('T14646', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Mon Jan 15 19:22:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:52 +0000 (UTC) Subject: [commit: ghc] master: Simplify guard in createSwitchPlan. (bc383f2) Message-ID: <20180115192252.E9D693A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bc383f20ce29c5059d8c9c322246ac38bfb0c2a8/ghc >--------------------------------------------------------------- commit bc383f20ce29c5059d8c9c322246ac38bfb0c2a8 Author: klebinger.andreas at gmx.at Date: Mon Jan 15 13:52:33 2018 -0500 Simplify guard in createSwitchPlan. Given that we have two unique keys (guaranteed by Map) checking that `|range| == 1` is faster. The fact that `x1 == lo` and `x2 == hi` is guaranteed by mkSwitchTargets which removes values outside of the range. Test Plan: ci Reviewers: bgamari, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4295 >--------------------------------------------------------------- bc383f20ce29c5059d8c9c322246ac38bfb0c2a8 compiler/cmm/CmmSwitch.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/compiler/cmm/CmmSwitch.hs b/compiler/cmm/CmmSwitch.hs index 02a581b..3edfe5c 100644 --- a/compiler/cmm/CmmSwitch.hs +++ b/compiler/cmm/CmmSwitch.hs @@ -266,12 +266,11 @@ createSwitchPlan :: SwitchTargets -> SwitchPlan createSwitchPlan (SwitchTargets _signed _range (Just defLabel) m) | [(x, l)] <- M.toList m = IfEqual x l (Unconditionally defLabel) --- And another common case, matching booleans +-- And another common case, matching "booleans" createSwitchPlan (SwitchTargets _signed (lo,hi) Nothing m) - | [(x1, l1), (x2,l2)] <- M.toAscList m - , x1 == lo - , x2 == hi - , x1 + 1 == x2 + | [(x1, l1), (_x2,l2)] <- M.toAscList m + --Checking If |range| = 2 is enough if we have two unique literals + , hi - lo == 1 = IfEqual x1 l1 (Unconditionally l2) createSwitchPlan (SwitchTargets signed range mbdef m) = -- pprTrace "createSwitchPlan" (text (show ids) $$ text (show (range,m)) $$ text (show pieces) $$ text (show flatPlan) $$ text (show plan)) $ From git at git.haskell.org Mon Jan 15 19:22:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 19:22:56 +0000 (UTC) Subject: [commit: ghc] master: configure: Various cleanups (8de8930) Message-ID: <20180115192256.AD0543A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8de8930520dce26ffa4fa1e67a977213de667e16/ghc >--------------------------------------------------------------- commit 8de8930520dce26ffa4fa1e67a977213de667e16 Author: John Ericson Date: Mon Jan 15 13:53:08 2018 -0500 configure: Various cleanups Substitute RanlibCmd for consistency, and other configure cleanups that should have no effect The other commands are so substituted. Maybe we don't need ranlib at all, and the configure snippet can be removed all together, but that can always be done later. Reviewers: bgamari, hvr, angerman Reviewed By: bgamari, angerman Subscribers: rwbarton, thomie, erikd, carter Differential Revision: https://phabricator.haskell.org/D4286 >--------------------------------------------------------------- 8de8930520dce26ffa4fa1e67a977213de667e16 configure.ac | 19 ++++++++--------- distrib/configure.ac.in | 57 +++++++++++++++++++++++++------------------------ 2 files changed, 38 insertions(+), 38 deletions(-) diff --git a/configure.ac b/configure.ac index 6733385..216a97f 100644 --- a/configure.ac +++ b/configure.ac @@ -538,7 +538,7 @@ FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) -dnl ** Choose a linker +dnl ** Which ld to use dnl -------------------------------------------------------------- FIND_LD([$target],[GccUseLdOpt]) CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" @@ -547,6 +547,11 @@ LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) +FP_PROG_LD_IS_GNU +FP_PROG_LD_BUILD_ID +FP_PROG_LD_NO_COMPACT_UNWIND +FP_PROG_LD_FILELIST + dnl ** Which nm to use? dnl -------------------------------------------------------------- if test "$HostOS" != "mingw32"; then @@ -603,7 +608,7 @@ if test "$RANLIB" = ":"; then AC_MSG_ERROR([cannot find ranlib in your PATH]) fi RanlibCmd="$RANLIB" -RANLIB="$RanlibCmd" +AC_SUBST([RanlibCmd]) dnl ** which strip to use? dnl -------------------------------------------------------------- @@ -624,7 +629,6 @@ then else AC_CHECK_TARGET_TOOL([LIBTOOL], [libtool]) LibtoolCmd="$LIBTOOL" - LIBTOOL="$LibtoolCmd" fi AC_SUBST([LibtoolCmd]) @@ -708,23 +712,18 @@ FP_GCC_VERSION dnl ** See whether gcc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +FP_GCC_EXTRA_FLAGS + dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) # Stage 3 won't be supported by cross-compilation -FP_GCC_EXTRA_FLAGS - # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 509e74e..95ad198 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -84,11 +84,39 @@ dnl ** Which gcc to use? dnl -------------------------------------------------------------- AC_PROG_CC([gcc clang]) +dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) +AC_PROG_CPP + # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) +dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) +FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) + +dnl ** Which ld to use? +dnl -------------------------------------------------------------- +FIND_LD([$target],[GccUseLdOpt]) +CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" +CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" +LdCmd="$LD" +CFLAGS="$CFLAGS $GccUseLdOpt" +AC_SUBST([LdCmd]) + +FP_PROG_LD_IS_GNU +FP_PROG_LD_BUILD_ID +FP_PROG_LD_NO_COMPACT_UNWIND +FP_PROG_LD_FILELIST + +dnl ** which strip to use? +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([STRIP], [strip]) +StripCmd="$STRIP" +AC_SUBST([StripCmd]) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -107,18 +135,11 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) +dnl ** Check gcc version and flags we need to pass it ** FP_GCC_VERSION FP_GCC_SUPPORTS_NO_PIE -AC_PROG_CPP - -dnl ** Check gcc version and flags we need to pass it ** FP_GCC_EXTRA_FLAGS -FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) -dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -138,20 +159,6 @@ AC_SUBST(CONF_CPP_OPTS_STAGE0) AC_SUBST(CONF_CPP_OPTS_STAGE1) AC_SUBST(CONF_CPP_OPTS_STAGE2) -dnl ** Which ld to use? -dnl -------------------------------------------------------------- -FIND_LD([$target],[GccUseLdOpt]) -CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" -CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" -CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) - -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - dnl ** Set up the variables for the platform in the settings file. dnl May need to use gcc to find platform details. dnl -------------------------------------------------------------- @@ -178,12 +185,6 @@ dnl ** how to invoke `ar' and `ranlib' FP_PROG_AR_SUPPORTS_ATFILE FP_PROG_AR_NEEDS_RANLIB -dnl ** which strip to use? -dnl -------------------------------------------------------------- -AC_CHECK_TARGET_TOOL([STRIP], [strip]) -StripCmd="$STRIP" -AC_SUBST([StripCmd]) - dnl ** Have libdw? dnl -------------------------------------------------------------- dnl Check for a usable version of libdw/elfutils From git at git.haskell.org Mon Jan 15 20:36:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Jan 2018 20:36:26 +0000 (UTC) Subject: [commit: ghc] master: Fix quadratic behavior of prepareAlts (cf2c029) Message-ID: <20180115203626.5CE373A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf2c029ccdb967441c85ffb66073974fbdb20c20/ghc >--------------------------------------------------------------- commit cf2c029ccdb967441c85ffb66073974fbdb20c20 Author: Bartosz Nitka Date: Sat Jan 13 02:02:22 2018 +0000 Fix quadratic behavior of prepareAlts Summary: This code is quadratic and a simple test case I used managed to tickle it. The example (same one as #14667) looks like this: ``` module A10000 where data A = A | A00001 | A00002 ... | A10000 f :: A -> Int f A00001 = 19900001 f A00002 = 19900002 ... f A10000 = 19910000 ``` Applied on top of a fix for #14667, it gives a 30% compile time improvement. Test Plan: ./validate Reviewers: simonpj, bgamari Subscribers: rwbarton, thomie, simonmar, carter Differential Revision: https://phabricator.haskell.org/D4307 >--------------------------------------------------------------- cf2c029ccdb967441c85ffb66073974fbdb20c20 compiler/coreSyn/CoreUtils.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index fbe7ebd..5e32dc6 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -94,6 +94,8 @@ import Data.Function ( on ) import Data.List import Data.Ord ( comparing ) import OrdList +import qualified Data.Set as Set +import UniqSet {- ************************************************************************ @@ -629,13 +631,15 @@ filterAlts _tycon inst_tys imposs_cons alts trimmed_alts = filterOut (impossible_alt inst_tys) alts_wo_default - imposs_deflt_cons = nub (imposs_cons ++ alt_cons) + imposs_cons_set = Set.fromList imposs_cons + imposs_deflt_cons = + imposs_cons ++ filterOut (`Set.member` imposs_cons_set) alt_cons -- "imposs_deflt_cons" are handled -- EITHER by the context, -- OR by a non-DEFAULT branch in this case expression. impossible_alt :: [Type] -> (AltCon, a, b) -> Bool - impossible_alt _ (con, _, _) | con `elem` imposs_cons = True + impossible_alt _ (con, _, _) | con `Set.member` imposs_cons_set = True impossible_alt inst_tys (DataAlt con, _, _) = dataConCannotMatch inst_tys con impossible_alt _ _ = False @@ -652,8 +656,11 @@ refineDefaultAlt us tycon tys imposs_deflt_cons all_alts -- case x of { DEFAULT -> e } -- and we don't want to fill in a default for them! , Just all_cons <- tyConDataCons_maybe tycon - , let imposs_data_cons = [con | DataAlt con <- imposs_deflt_cons] -- We now know it's a data type - impossible con = con `elem` imposs_data_cons || dataConCannotMatch tys con + , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons] + -- We now know it's a data type, so we can use + -- UniqSet rather than Set (more efficient) + impossible con = con `elementOfUniqSet` imposs_data_cons + || dataConCannotMatch tys con = case filterOut impossible all_cons of -- Eliminate the default alternative -- altogether if it can't match: From git at git.haskell.org Tue Jan 16 17:34:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Jan 2018 17:34:57 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: Simon's tentative patch for #14677 (3fdf567) Message-ID: <20180116173457.CE8153A8DF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/3fdf567a48958eefdb690d7d0cd81a3bf876483f/ghc >--------------------------------------------------------------- commit 3fdf567a48958eefdb690d7d0cd81a3bf876483f Author: Gabor Greif Date: Tue Jan 16 18:34:36 2018 +0100 WIP: Simon's tentative patch for #14677 >--------------------------------------------------------------- 3fdf567a48958eefdb690d7d0cd81a3bf876483f compiler/codeGen/StgCmmClosure.hs | 8 ++++++++ compiler/coreSyn/CoreOpt.hs | 20 +++++++++++++++++++- compiler/prelude/PrelRules.hs | 5 ++--- 3 files changed, 29 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index e319548..31fc592 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,6 +68,8 @@ module StgCmmClosure ( import GhcPrelude +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import CoreSyn (isEvaldUnfolding, Unfolding(..)) import SMRep @@ -327,6 +329,11 @@ mkLFImported id -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor + | isValueUnfolding unf + , Just expr <- maybeUnfoldingTemplate unf + , Just con <- exprIsSatConApp_maybe expr + = LFCon con + | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") @@ -334,6 +341,7 @@ mkLFImported id = mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id + unf = realIdUnfolding id ------------- mkLFStringLit :: LambdaFormInfo diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 4240647..83b6a65 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -12,7 +12,8 @@ module CoreOpt ( joinPointBinding_maybe, joinPointBindings_maybe, -- ** Predicates on expressions - exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, + exprIsConApp_maybe, exprIsLiteral_maybe, + exprIsLambda_maybe, exprIsSatConApp_maybe, -- ** Coercions and casts pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo @@ -831,6 +832,23 @@ exprIsConApp_maybe (in_scope, id_unf) expr extend (Right s) v e = Right (extendSubst s v e) +exprIsSatConApp_maybe :: CoreExpr -> Maybe DataCon +-- Returns (Just dc) for a saturated application of dc +-- Simpler than exprIsConApp_maybe +exprIsSatConApp_maybe e = go 0 e + where + go :: Arity -> CoreExpr -> Maybe DataCon + go n_val_args (Var v) + | Just dc <- isDataConWorkId_maybe v + , dataConRepArity dc == n_val_args + = Just dc + go n_val_args (App f a) + | isTypeArg a = go n_val_args f + | otherwise = go (n_val_args + 1) f + go n_val_args (Cast e _) = go n_val_args e + go n_val_args (Tick _ e) = go n_val_args e + go _ _ = Nothing + -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion -> Maybe (DataCon, [Type], [CoreExpr]) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index db79589..384a580 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -33,7 +33,7 @@ import CoreSyn import MkCore import Id import Literal -import CoreOpt ( exprIsLiteral_maybe ) +import CoreOpt ( exprIsLiteral_maybe, exprIsSatConApp_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim @@ -916,8 +916,7 @@ dataToTagRule = a `mplus` b b = do dflags <- getDynFlags [_, val_arg] <- getArgs - in_scope <- getInScopeEnv - (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg + dc <- liftMaybe $ exprIsSatConApp_maybe val_arg ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return () return $ mkIntVal dflags (toInteger (dataConTagZ dc)) From git at git.haskell.org Wed Jan 17 12:55:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 12:55:42 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: be less chatty (9412f0e) Message-ID: <20180117125542.D39DB3A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/9412f0e6d4f79aac61462f3c580af0ecbe61378c/ghc >--------------------------------------------------------------- commit 9412f0e6d4f79aac61462f3c580af0ecbe61378c Author: Gabor Greif Date: Wed Jan 17 13:50:59 2018 +0100 WIP: be less chatty >--------------------------------------------------------------- 9412f0e6d4f79aac61462f3c580af0ecbe61378c compiler/codeGen/StgCmmClosure.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 31fc592..6a3b174 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -643,8 +643,9 @@ getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info , OtherCon _ <- idUnfolding id , let str = occNameString (nameOccName name) -- , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True - , take 4 str == "wild" || (str == "ds2") - = pprTrace "####getCallMethod" (ppr id) ReturnIt' (str == "ds2") -- seems to come from case, must be (tagged) WHNF already + , let interesting = str == "ds2" + , take 4 str == "wild" || interesting + = (if interesting then pprTrace "####getCallMethod" (ppr id) else GhcPrelude.id) ReturnIt' (str == "ds2") -- seems to come from case, must be (tagged) WHNF already getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) From git at git.haskell.org Wed Jan 17 12:55:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 12:55:45 +0000 (UTC) Subject: [commit: ghc] wip/T14626: don't optimise libs for now (62d96cd) Message-ID: <20180117125545.94ECC3A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/62d96cd6257162bf4d6cfc77c6b6efa3465f76b6/ghc >--------------------------------------------------------------- commit 62d96cd6257162bf4d6cfc77c6b6efa3465f76b6 Author: Gabor Greif Date: Wed Jan 17 13:54:58 2018 +0100 don't optimise libs for now >--------------------------------------------------------------- 62d96cd6257162bf4d6cfc77c6b6efa3465f76b6 mk/flavours/validate.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/flavours/validate.mk b/mk/flavours/validate.mk index 2ff7c20..cd90b96 100644 --- a/mk/flavours/validate.mk +++ b/mk/flavours/validate.mk @@ -2,7 +2,7 @@ SRC_HC_OPTS = -O0 -H64m SRC_HC_OPTS_STAGE1 = -fllvm-fill-undef-with-garbage # See Trac 11487 GhcStage1HcOpts = -O -DDEBUG GhcStage2HcOpts = -O -dcore-lint -dno-debug-output -GhcLibHcOpts = -O -dcore-lint -dno-debug-output +GhcLibHcOpts = -O0 -dcore-lint -dno-debug-output BUILD_PROF_LIBS = NO SplitObjs = NO SplitSections = NO From git at git.haskell.org Wed Jan 17 13:24:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 13:24:22 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (c65104e) Message-ID: <20180117132422.ADCB53A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c65104e1a6875f7879db87877848cc35363c1bf3/ghc >--------------------------------------------------------------- commit c65104e1a6875f7879db87877848cc35363c1bf3 Author: Gabor Greif Date: Wed Jan 17 14:05:48 2018 +0100 Typos in comments >--------------------------------------------------------------- c65104e1a6875f7879db87877848cc35363c1bf3 compiler/basicTypes/RdrName.hs | 2 +- compiler/codeGen/StgCmmHeap.hs | 2 +- compiler/coreSyn/MkCore.hs | 2 +- compiler/deSugar/Desugar.hs | 4 ++-- compiler/iface/BinIface.hs | 2 +- compiler/main/TidyPgm.hs | 2 +- compiler/simplCore/CallArity.hs | 2 +- compiler/simplCore/OccurAnal.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcSimplify.hs | 2 +- mk/warnings.mk | 4 ++-- 12 files changed, 14 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c65104e1a6875f7879db87877848cc35363c1bf3 From git at git.haskell.org Wed Jan 17 13:48:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 13:48:19 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14677' created Message-ID: <20180117134819.513793A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14677 Referencing: f2df56094420c8f8cb033b96b73ac3636b315c8e From git at git.haskell.org Wed Jan 17 13:48:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 13:48:22 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: triggering CI for Simon's patch (f2df560) Message-ID: <20180117134822.2369F3A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/f2df56094420c8f8cb033b96b73ac3636b315c8e/ghc >--------------------------------------------------------------- commit f2df56094420c8f8cb033b96b73ac3636b315c8e Author: Gabor Greif Date: Wed Jan 17 14:47:00 2018 +0100 WIP: triggering CI for Simon's patch >--------------------------------------------------------------- f2df56094420c8f8cb033b96b73ac3636b315c8e compiler/codeGen/StgCmmClosure.hs | 8 ++++++++ compiler/coreSyn/CoreOpt.hs | 20 +++++++++++++++++++- compiler/prelude/PrelRules.hs | 5 ++--- 3 files changed, 29 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1da1f70..1736bba 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,6 +68,8 @@ module StgCmmClosure ( import GhcPrelude +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import SMRep import Cmm @@ -326,6 +328,11 @@ mkLFImported id -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor + | isValueUnfolding unf + , Just expr <- maybeUnfoldingTemplate unf + , Just con <- exprIsSatConApp_maybe expr + = LFCon con + | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") @@ -333,6 +340,7 @@ mkLFImported id = mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id + unf = realIdUnfolding id ------------- mkLFStringLit :: LambdaFormInfo diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 0f35e8f..f144e06 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -12,7 +12,8 @@ module CoreOpt ( joinPointBinding_maybe, joinPointBindings_maybe, -- ** Predicates on expressions - exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, + exprIsConApp_maybe, exprIsLiteral_maybe, + exprIsLambda_maybe, exprIsSatConApp_maybe, -- ** Coercions and casts pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo @@ -791,6 +792,23 @@ exprIsConApp_maybe (in_scope, id_unf) expr extend (Right s) v e = Right (extendSubst s v e) +exprIsSatConApp_maybe :: CoreExpr -> Maybe DataCon +-- Returns (Just dc) for a saturated application of dc +-- Simpler than exprIsConApp_maybe +exprIsSatConApp_maybe e = go 0 e + where + go :: Arity -> CoreExpr -> Maybe DataCon + go n_val_args (Var v) + | Just dc <- isDataConWorkId_maybe v + , dataConRepArity dc == n_val_args + = Just dc + go n_val_args (App f a) + | isTypeArg a = go n_val_args f + | otherwise = go (n_val_args + 1) f + go n_val_args (Cast e _) = go n_val_args e + go n_val_args (Tick _ e) = go n_val_args e + go _ _ = Nothing + -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion -> Maybe (DataCon, [Type], [CoreExpr]) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index db79589..384a580 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -33,7 +33,7 @@ import CoreSyn import MkCore import Id import Literal -import CoreOpt ( exprIsLiteral_maybe ) +import CoreOpt ( exprIsLiteral_maybe, exprIsSatConApp_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim @@ -916,8 +916,7 @@ dataToTagRule = a `mplus` b b = do dflags <- getDynFlags [_, val_arg] <- getArgs - in_scope <- getInScopeEnv - (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg + dc <- liftMaybe $ exprIsSatConApp_maybe val_arg ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return () return $ mkIntVal dflags (toInteger (dataConTagZ dc)) From git at git.haskell.org Wed Jan 17 17:05:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 17:05:16 +0000 (UTC) Subject: [commit: ghc] wip/T14626: Typos in comments (d4b9b5a) Message-ID: <20180117170516.819C33A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/d4b9b5a51e0448fafd72e90ec1508cda8936760b/ghc >--------------------------------------------------------------- commit d4b9b5a51e0448fafd72e90ec1508cda8936760b Author: Gabor Greif Date: Wed Jan 17 14:05:48 2018 +0100 Typos in comments >--------------------------------------------------------------- d4b9b5a51e0448fafd72e90ec1508cda8936760b compiler/basicTypes/RdrName.hs | 2 +- compiler/codeGen/StgCmmHeap.hs | 2 +- compiler/coreSyn/MkCore.hs | 2 +- compiler/deSugar/Desugar.hs | 4 ++-- compiler/iface/BinIface.hs | 2 +- compiler/main/TidyPgm.hs | 2 +- compiler/simplCore/CallArity.hs | 2 +- compiler/simplCore/OccurAnal.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcSimplify.hs | 2 +- mk/warnings.mk | 4 ++-- 12 files changed, 14 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d4b9b5a51e0448fafd72e90ec1508cda8936760b From git at git.haskell.org Wed Jan 17 17:05:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 17:05:22 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: elim warning to make Travis happy (db068cd) Message-ID: <20180117170522.1DC3D3A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/db068cd98b0d2766f9b140dbb04051f4579861f3/ghc >--------------------------------------------------------------- commit db068cd98b0d2766f9b140dbb04051f4579861f3 Author: Gabor Greif Date: Wed Jan 17 18:04:16 2018 +0100 WIP: elim warning to make Travis happy >--------------------------------------------------------------- db068cd98b0d2766f9b140dbb04051f4579861f3 compiler/prelude/PrelRules.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 384a580..3e9899f 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -41,7 +41,6 @@ import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon , unwrapNewTyCon_maybe, tyConDataCons ) import DataCon ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId ) import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) -import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) import PrelNames @@ -695,9 +694,6 @@ removeOp32 = do getArgs :: RuleM [CoreExpr] getArgs = RuleM $ \_ _ args -> Just args -getInScopeEnv :: RuleM InScopeEnv -getInScopeEnv = RuleM $ \_ iu _ -> Just iu - -- return the n-th argument of this rule, if it is a literal -- argument indices start from 0 getLiteral :: Int -> RuleM Literal From git at git.haskell.org Wed Jan 17 17:05:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 17:05:19 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: makefile foolings (8704322) Message-ID: <20180117170519.472803A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/87043223a4a6b895557ec1234eabd63ecc78c8df/ghc >--------------------------------------------------------------- commit 87043223a4a6b895557ec1234eabd63ecc78c8df Author: Gabor Greif Date: Wed Jan 17 14:45:15 2018 +0100 WIP: makefile foolings >--------------------------------------------------------------- 87043223a4a6b895557ec1234eabd63ecc78c8df testsuite/tests/codeGen/should_compile/Makefile | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile index eaad461..50d3f0e 100644 --- a/testsuite/tests/codeGen/should_compile/Makefile +++ b/testsuite/tests/codeGen/should_compile/Makefile @@ -6,14 +6,19 @@ T2578: '$(TEST_HC)' $(TEST_HC_OPTS) --make T2578 -fforce-recomp -v0 T14626: + echo == PREP == '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-uniques T14626.hs | grep case + echo == /PREP == + echo echo == CMM == - # we don't want to see re-tagging, like: R1 = R1 & (-8); + # we don't want to see re-tagging, like: R1 = R1 & (-8); - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm -dsuppress-uniques -fforce-recomp T14626.hs | grep 'R1 = R1 & (-[48])' echo == /CMM == + printf "hey\nkdfsf\nzzz\nzzz\nzzz\nusduzsd\n" | sed -e '/kdf/,/uzs/!d' + - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm -dsuppress-uniques -fforce-recomp T13861a.hs # | sed -e '/T14626.consonant_entry/, debug: - # Without optimisations, we should get annotations for basically + # Without optimisations, we should get annotations for basically # all expressions in the example program. echo == Dbg == '$(TEST_HC)' $(TEST_HC_OPTS) debug -fforce-recomp -g -ddump-cmm-verbose \ From git at git.haskell.org Wed Jan 17 22:24:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 22:24:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Backport D4008 and D4286 to 8.2 (2fc8ce5) Message-ID: <20180117222408.6E1AA3A8E5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/2fc8ce5f0c8c81771c26266ac0b150ca9b75c5f3/ghc >--------------------------------------------------------------- commit 2fc8ce5f0c8c81771c26266ac0b150ca9b75c5f3 Author: John Ericson Date: Wed Jan 17 16:08:11 2018 -0500 Backport D4008 and D4286 to 8.2 Reviewers: hvr, bgamari, angerman Subscribers: rwbarton, thomie, erikd, carter Differential Revision: https://phabricator.haskell.org/D4287 >--------------------------------------------------------------- 2fc8ce5f0c8c81771c26266ac0b150ca9b75c5f3 configure.ac | 25 ++++++++++++++---------- distrib/configure.ac.in | 51 ++++++++++++++++++++++++++++--------------------- mk/config.mk.in | 2 +- 3 files changed, 45 insertions(+), 33 deletions(-) diff --git a/configure.ac b/configure.ac index 09e5554..846f559 100644 --- a/configure.ac +++ b/configure.ac @@ -495,7 +495,7 @@ FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) -dnl ** Choose a linker +dnl ** Which ld to use dnl -------------------------------------------------------------- FIND_LD([$target],[GccUseLdOpt]) CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" @@ -504,6 +504,11 @@ LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) +FP_PROG_LD_IS_GNU +FP_PROG_LD_BUILD_ID +FP_PROG_LD_NO_COMPACT_UNWIND +FP_PROG_LD_FILELIST + dnl ** Which nm to use? dnl -------------------------------------------------------------- FP_ARG_WITH_PATH_GNU_PROG([NM], [nm], [nm]) @@ -553,7 +558,13 @@ dnl ** Which ranlib to use? dnl -------------------------------------------------------------- FP_ARG_WITH_PATH_GNU_PROG([RANLIB], [ranlib], [ranlib]) RanlibCmd="$RANLIB" -RANLIB="$RanlibCmd" +AC_SUBST([RanlibCmd]) + +dnl ** Which strip to use? +dnl -------------------------------------------------------------- +FP_ARG_WITH_PATH_GNU_PROG([STRIP], [strip], [strip]) +StripCmd="$STRIP" +AC_SUBST([StripCmd]) # Note: we may not have objdump on OS X, and we only need it on Windows (for DLL checks) @@ -637,24 +648,18 @@ FP_GCC_VERSION dnl ** See whether gcc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +FP_GCC_EXTRA_FLAGS + dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) # Stage 3 won't be supported by cross-compilation -FP_GCC_EXTRA_FLAGS - # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 1f47ff1..aab9b1d 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -75,11 +75,39 @@ dnl ** Which gcc to use? dnl -------------------------------------------------------------- AC_PROG_CC([gcc clang]) +dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) +AC_PROG_CPP + # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) +dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) +FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) + +dnl ** Which ld to use? +dnl -------------------------------------------------------------- +FIND_LD([$target],[GccUseLdOpt]) +CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" +CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" +LdCmd="$LD" +CFLAGS="$CFLAGS $GccUseLdOpt" +AC_SUBST([LdCmd]) + +FP_PROG_LD_IS_GNU +FP_PROG_LD_BUILD_ID +FP_PROG_LD_NO_COMPACT_UNWIND +FP_PROG_LD_FILELIST + +dnl ** Which strip to use? +dnl -------------------------------------------------------------- +FP_ARG_WITH_PATH_GNU_PROG([STRIP], [strip], [strip]) +StripCmd="$STRIP" +AC_SUBST([StripCmd]) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -98,18 +126,11 @@ FIND_LLVM_PROG([OPT], [opt], [opt], [$LlvmVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) +dnl ** Check gcc version and flags we need to pass it ** FP_GCC_VERSION FP_GCC_SUPPORTS_NO_PIE -AC_PROG_CPP - -dnl ** Check gcc version and flags we need to pass it ** FP_GCC_EXTRA_FLAGS -FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) -dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -129,20 +150,6 @@ AC_SUBST(CONF_CPP_OPTS_STAGE0) AC_SUBST(CONF_CPP_OPTS_STAGE1) AC_SUBST(CONF_CPP_OPTS_STAGE2) -dnl ** Which ld to use? -dnl -------------------------------------------------------------- -FIND_LD([$target],[GccUseLdOpt]) -CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" -CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" -CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) - -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - dnl ** Set up the variables for the platform in the settings file. dnl May need to use gcc to find platform details. dnl -------------------------------------------------------------- diff --git a/mk/config.mk.in b/mk/config.mk.in index 4e61eea..fcbc32d 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -785,7 +785,7 @@ else ifeq "$(TARGETPLATFORM)" "arm-unknown-linux" # The hack of using `:` to disable stripping is implemented by ghc-cabal. STRIP_CMD = : else -STRIP_CMD = strip +STRIP_CMD = @StripCmd@ endif PATCH_CMD = @PatchCmd@ TAR_CMD = @TarCmd@ From git at git.haskell.org Wed Jan 17 23:42:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 23:42:17 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Parenthesize forall-type args in cvtTypeKind (b92fb51) Message-ID: <20180117234217.E4EE03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/b92fb5150bdc6a0a090ecba2927c14e19005116e/ghc >--------------------------------------------------------------- commit b92fb5150bdc6a0a090ecba2927c14e19005116e Author: Ryan Scott Date: Mon Jan 15 13:51:55 2018 -0500 Parenthesize forall-type args in cvtTypeKind Trac #14646 happened because we forgot to parenthesize `forall` types to the left of an arrow. This simple patch fixes that. Test Plan: make test TEST=T14646 Reviewers: alanz, goldfire, bgamari Reviewed By: alanz Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14646 Differential Revision: https://phabricator.haskell.org/D4298 (cherry picked from commit f380115cd834ffbe51aca60f5476a51b94cdd413) >--------------------------------------------------------------- b92fb5150bdc6a0a090ecba2927c14e19005116e compiler/hsSyn/Convert.hs | 9 +++++---- testsuite/tests/th/T14646.hs | 6 ++++++ testsuite/tests/th/T14646.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 18 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index b032538..aea37c9 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1221,10 +1221,11 @@ cvtTypeKind ty_str ty tys' ArrowT | [x',y'] <- tys' -> do - case x' of - (L _ HsFunTy{}) -> do { x'' <- returnL (HsParTy x') - ; returnL (HsFunTy x'' y') } - _ -> returnL (HsFunTy x' y') + x'' <- case x' of + L _ HsFunTy{} -> returnL (HsParTy x') + L _ HsForAllTy{} -> returnL (HsParTy x') -- #14646 + _ -> return x' + returnL (HsFunTy x'' y') | otherwise -> mk_apps (HsTyVar NotPromoted (noLoc (getRdrName funTyCon))) tys' diff --git a/testsuite/tests/th/T14646.hs b/testsuite/tests/th/T14646.hs new file mode 100644 index 0000000..c858723 --- /dev/null +++ b/testsuite/tests/th/T14646.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module T14646 where + +$([d| f :: (forall a. a) -> Int + f _ = undefined |]) diff --git a/testsuite/tests/th/T14646.stderr b/testsuite/tests/th/T14646.stderr new file mode 100644 index 0000000..869cf6f --- /dev/null +++ b/testsuite/tests/th/T14646.stderr @@ -0,0 +1,6 @@ +T14646.hs:(5,3)-(6,24): Splicing declarations + [d| f :: (forall a. a) -> Int + f _ = undefined |] + ======> + f :: (forall a. a) -> Int + f _ = undefined diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 0ad178e..1fae4c6 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -397,3 +397,4 @@ test('T13887', normal, compile_and_run, ['-v0']) test('T13968', normal, compile_fail, ['-v0']) test('T14204', normal, compile_fail, ['-v0']) test('T14060', normal, compile_and_run, ['-v0']) +test('T14646', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Wed Jan 17 23:42:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 23:42:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Blackholes can be large objects (#14497) (3e3a096) Message-ID: <20180117234224.081553A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/3e3a096885c0fcd0703edbeffb4e47f5cbd8f4cc/ghc >--------------------------------------------------------------- commit 3e3a096885c0fcd0703edbeffb4e47f5cbd8f4cc Author: Simon Marlow Date: Mon Dec 18 11:23:16 2017 -0500 Blackholes can be large objects (#14497) Test Plan: validate Reviewers: bgamari, niteria, erikd, dfeuer Reviewed By: dfeuer Subscribers: Yuras, dfeuer, rwbarton, thomie, carter GHC Trac Issues: #14497 Differential Revision: https://phabricator.haskell.org/D4254 (cherry picked from commit fb1f0a46983a887057de647eaaae9e83b5ebebd1) >--------------------------------------------------------------- 3e3a096885c0fcd0703edbeffb4e47f5cbd8f4cc rts/sm/Evac.c | 13 ++++++++++--- testsuite/tests/rts/T14497.hs | 13 +++++++++++++ .../IOError002.stdout => testsuite/tests/rts/T14497.stdout | 0 testsuite/tests/rts/all.T | 1 + 4 files changed, 24 insertions(+), 3 deletions(-) diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index fb1af0f..526f063 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -898,9 +898,16 @@ evacuate_BLACKHOLE(StgClosure **p) bd = Bdescr((P_)q); - // blackholes can't be in a compact, or large - ASSERT((bd->flags & (BF_COMPACT | BF_LARGE)) == 0); - + // blackholes can't be in a compact + ASSERT((bd->flags & BF_COMPACT) == 0); + + // blackholes *can* be in a large object: when raiseAsync() creates an + // AP_STACK the payload might be large enough to create a large object. + // See #14497. + if (bd->flags & BF_LARGE) { + evacuate_large((P_)q); + return; + } if (bd->flags & BF_EVACUATED) { if (bd->gen_no < gct->evac_gen_no) { gct->failed_to_evac = true; diff --git a/testsuite/tests/rts/T14497.hs b/testsuite/tests/rts/T14497.hs new file mode 100644 index 0000000..b6473f7 --- /dev/null +++ b/testsuite/tests/rts/T14497.hs @@ -0,0 +1,13 @@ +module Main (main) where + +import System.Timeout + +fuc :: Integer -> Integer +fuc 0 = 1 +fuc n = n * fuc (n - 1) + +main :: IO () +main = do + let x = fuc 30000 + timeout 1000 (print x) + print (x > 0) diff --git a/libraries/base/tests/IO/IOError002.stdout b/testsuite/tests/rts/T14497.stdout similarity index 100% copy from libraries/base/tests/IO/IOError002.stdout copy to testsuite/tests/rts/T14497.stdout diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index d5eaa76..7c5b9c7 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -381,3 +381,4 @@ test('T12497', [ unless(opsys('mingw32'), skip) test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13894', normal, compile_and_run, ['']) +test('T14497', normal, compile_and_run, ['-O']) From git at git.haskell.org Wed Jan 17 23:42:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Jan 2018 23:42:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: configure: Various cleanups (be8d667) Message-ID: <20180117234220.A9EFF3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/be8d6675ef4f5fa4dca8684071fc74a17695df69/ghc >--------------------------------------------------------------- commit be8d6675ef4f5fa4dca8684071fc74a17695df69 Author: John Ericson Date: Mon Jan 15 13:53:08 2018 -0500 configure: Various cleanups Substitute RanlibCmd for consistency, and other configure cleanups that should have no effect The other commands are so substituted. Maybe we don't need ranlib at all, and the configure snippet can be removed all together, but that can always be done later. Reviewers: bgamari, hvr, angerman Reviewed By: bgamari, angerman Subscribers: rwbarton, thomie, erikd, carter Differential Revision: https://phabricator.haskell.org/D4286 (cherry picked from commit 8de8930520dce26ffa4fa1e67a977213de667e16) >--------------------------------------------------------------- be8d6675ef4f5fa4dca8684071fc74a17695df69 configure.ac | 19 ++++++++--------- distrib/configure.ac.in | 57 +++++++++++++++++++++++++------------------------ 2 files changed, 38 insertions(+), 38 deletions(-) diff --git a/configure.ac b/configure.ac index 01496b1..a2c0a3c 100644 --- a/configure.ac +++ b/configure.ac @@ -538,7 +538,7 @@ FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) -dnl ** Choose a linker +dnl ** Which ld to use dnl -------------------------------------------------------------- FIND_LD([$target],[GccUseLdOpt]) CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" @@ -547,6 +547,11 @@ LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) +FP_PROG_LD_IS_GNU +FP_PROG_LD_BUILD_ID +FP_PROG_LD_NO_COMPACT_UNWIND +FP_PROG_LD_FILELIST + dnl ** Which nm to use? dnl -------------------------------------------------------------- if test "$HostOS" != "mingw32"; then @@ -603,7 +608,7 @@ if test "$RANLIB" = ":"; then AC_MSG_ERROR([cannot find ranlib in your PATH]) fi RanlibCmd="$RANLIB" -RANLIB="$RanlibCmd" +AC_SUBST([RanlibCmd]) dnl ** which strip to use? dnl -------------------------------------------------------------- @@ -624,7 +629,6 @@ then else AC_CHECK_TARGET_TOOL([LIBTOOL], [libtool]) LibtoolCmd="$LIBTOOL" - LIBTOOL="$LibtoolCmd" fi AC_SUBST([LibtoolCmd]) @@ -708,23 +712,18 @@ FP_GCC_VERSION dnl ** See whether gcc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +FP_GCC_EXTRA_FLAGS + dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) # Stage 3 won't be supported by cross-compilation -FP_GCC_EXTRA_FLAGS - # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 509e74e..95ad198 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -84,11 +84,39 @@ dnl ** Which gcc to use? dnl -------------------------------------------------------------- AC_PROG_CC([gcc clang]) +dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) +AC_PROG_CPP + # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) +dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) +FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) + +dnl ** Which ld to use? +dnl -------------------------------------------------------------- +FIND_LD([$target],[GccUseLdOpt]) +CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" +CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" +LdCmd="$LD" +CFLAGS="$CFLAGS $GccUseLdOpt" +AC_SUBST([LdCmd]) + +FP_PROG_LD_IS_GNU +FP_PROG_LD_BUILD_ID +FP_PROG_LD_NO_COMPACT_UNWIND +FP_PROG_LD_FILELIST + +dnl ** which strip to use? +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([STRIP], [strip]) +StripCmd="$STRIP" +AC_SUBST([StripCmd]) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -107,18 +135,11 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) +dnl ** Check gcc version and flags we need to pass it ** FP_GCC_VERSION FP_GCC_SUPPORTS_NO_PIE -AC_PROG_CPP - -dnl ** Check gcc version and flags we need to pass it ** FP_GCC_EXTRA_FLAGS -FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) -dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -138,20 +159,6 @@ AC_SUBST(CONF_CPP_OPTS_STAGE0) AC_SUBST(CONF_CPP_OPTS_STAGE1) AC_SUBST(CONF_CPP_OPTS_STAGE2) -dnl ** Which ld to use? -dnl -------------------------------------------------------------- -FIND_LD([$target],[GccUseLdOpt]) -CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" -CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" -CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) - -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - dnl ** Set up the variables for the platform in the settings file. dnl May need to use gcc to find platform details. dnl -------------------------------------------------------------- @@ -178,12 +185,6 @@ dnl ** how to invoke `ar' and `ranlib' FP_PROG_AR_SUPPORTS_ATFILE FP_PROG_AR_NEEDS_RANLIB -dnl ** which strip to use? -dnl -------------------------------------------------------------- -AC_CHECK_TARGET_TOOL([STRIP], [strip]) -StripCmd="$STRIP" -AC_SUBST([StripCmd]) - dnl ** Have libdw? dnl -------------------------------------------------------------- dnl Check for a usable version of libdw/elfutils From git at git.haskell.org Thu Jan 18 15:31:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 15:31:39 +0000 (UTC) Subject: [commit: ghc] master: Revert "Fix regression on i386 due to get/setAllocationCounter change" (8bb150d) Message-ID: <20180118153139.65F093A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8bb150df9e5e711d67f9800c0d694ecf457cd8f5/ghc >--------------------------------------------------------------- commit 8bb150df9e5e711d67f9800c0d694ecf457cd8f5 Author: Ben Gamari Date: Thu Jan 18 00:50:05 2018 -0500 Revert "Fix regression on i386 due to get/setAllocationCounter change" This reverts commit a770226e03f09b767fdb4ce826162a5c0f29ec29. >--------------------------------------------------------------- 8bb150df9e5e711d67f9800c0d694ecf457cd8f5 rts/PrimOps.cmm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 42001d1..1caa0c3 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -2499,7 +2499,7 @@ stg_traceMarkerzh ( W_ msg ) stg_getThreadAllocationCounterzh () { // Account for the allocation in the current block - I64 offset; + W_ offset; offset = Hp - bdescr_start(CurrentNursery); return (StgTSO_alloc_limit(CurrentTSO) - offset); } @@ -2510,7 +2510,7 @@ stg_setThreadAllocationCounterzh ( I64 counter ) // getThreadAllocationCounter#, so we have to offset any existing // allocation here. See also openNursery/closeNursery in // compiler/codeGen/StgCmmForeign.hs. - I64 offset; + W_ offset; offset = Hp - bdescr_start(CurrentNursery); StgTSO_alloc_limit(CurrentTSO) = counter + offset; return (); From git at git.haskell.org Thu Jan 18 15:31:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 15:31:42 +0000 (UTC) Subject: [commit: ghc] master: Revert "Improve accuracy of get/setAllocationCounter" (e1d4140) Message-ID: <20180118153142.3CAC73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1d4140be4d2a1508015093b69e1ef53516e1eb6/ghc >--------------------------------------------------------------- commit e1d4140be4d2a1508015093b69e1ef53516e1eb6 Author: Ben Gamari Date: Thu Jan 18 00:50:31 2018 -0500 Revert "Improve accuracy of get/setAllocationCounter" This reverts commit a1a689dda48113f3735834350fb562bb1927a633. >--------------------------------------------------------------- e1d4140be4d2a1508015093b69e1ef53516e1eb6 compiler/codeGen/StgCmmForeign.hs | 4 ++-- compiler/prelude/primops.txt.pp | 14 -------------- includes/rts/Threads.h | 2 ++ includes/stg/MiscClosures.h | 3 --- libraries/base/GHC/Conc/Sync.hs | 21 ++++++++++++++++----- rts/PrimOps.cmm | 20 -------------------- rts/RtsSymbols.c | 4 ++-- rts/Threads.c | 13 ++++++++++++- testsuite/tests/rts/all.T | 7 ------- testsuite/tests/rts/alloccounter1.hs | 19 ------------------- testsuite/tests/rts/alloccounter1.stdout | 1 - 11 files changed, 34 insertions(+), 74 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e1d4140be4d2a1508015093b69e1ef53516e1eb6 From git at git.haskell.org Thu Jan 18 15:31:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 15:31:36 +0000 (UTC) Subject: [commit: ghc] master: Inform hole substitutions of typeclass constraints (fixes #14273). (1e14fd3) Message-ID: <20180118153136.9740C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1e14fd3ecfd468c3beddb2e5f992c358e1a798de/ghc >--------------------------------------------------------------- commit 1e14fd3ecfd468c3beddb2e5f992c358e1a798de Author: Matthías Páll Gissurarson Date: Thu Jan 18 00:49:38 2018 -0500 Inform hole substitutions of typeclass constraints (fixes #14273). This implements SPJ's suggestion on the ticket (#14273). We find the relevant constraints (ones that whose free unification variables are all mentioned in the type of the hole), and then clone the free unification variables of the hole and the relevant constraints. We then add a subsumption constraints and run the simplifier, and then check whether all the constraints were solved. Reviewers: bgamari Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14273 Differential Revision: https://phabricator.haskell.org/D4315 >--------------------------------------------------------------- 1e14fd3ecfd468c3beddb2e5f992c358e1a798de compiler/typecheck/TcErrors.hs | 271 ++++++++----- compiler/typecheck/TcRnTypes.hs | 13 +- compiler/typecheck/TcSimplify.hs | 16 +- compiler/typecheck/TcSimplify.hs-boot | 6 +- testsuite/tests/ghci/scripts/T8353.stderr | 5 + testsuite/tests/th/T10267.stderr | 5 + testsuite/tests/th/all.T | 2 +- .../tests/typecheck/should_compile/T13050.stderr | 6 + testsuite/tests/typecheck/should_compile/T14273.hs | 13 + .../tests/typecheck/should_compile/T14273.stderr | 80 ++++ .../tests/typecheck/should_compile/T14590.stderr | 10 + .../tests/typecheck/should_compile/T9497a.stderr | 1 + testsuite/tests/typecheck/should_compile/all.T | 2 + .../should_compile/hole_constraints.stderr | 8 +- .../tests/typecheck/should_compile/holes.stderr | 448 ++++++++++++++++++++- .../tests/typecheck/should_compile/holes2.stderr | 24 +- .../tests/typecheck/should_compile/holes3.stderr | 448 ++++++++++++++++++++- .../should_compile/valid_substitutions.hs | 22 +- .../should_compile/valid_substitutions.stderr | 237 ++++++++++- .../valid_substitutions_interactions.hs | 15 + .../valid_substitutions_interactions.stderr | 18 + .../tests/typecheck/should_fail/T9497d.stderr | 1 + .../tests/typecheck/should_run/T9497a-run.stderr | 1 + .../tests/typecheck/should_run/T9497b-run.stderr | 1 + .../tests/typecheck/should_run/T9497c-run.stderr | 1 + 25 files changed, 1499 insertions(+), 155 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1e14fd3ecfd468c3beddb2e5f992c358e1a798de From git at git.haskell.org Thu Jan 18 15:31:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 15:31:32 +0000 (UTC) Subject: [commit: ghc] master: Fix references to cminusminus.org (6b1ff00) Message-ID: <20180118153132.44ABD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b1ff0098e7595d5f3b8e6ad7c5d8e4104b02445/ghc >--------------------------------------------------------------- commit 6b1ff0098e7595d5f3b8e6ad7c5d8e4104b02445 Author: Ben Gamari Date: Wed Jan 17 19:58:41 2018 -0500 Fix references to cminusminus.org Reviewers: simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14665 Differential Revision: https://phabricator.haskell.org/D4311 >--------------------------------------------------------------- 6b1ff0098e7595d5f3b8e6ad7c5d8e4104b02445 compiler/cmm/PprCmm.hs | 4 ++-- compiler/cmm/PprCmmDecl.hs | 4 ++-- compiler/cmm/PprCmmExpr.hs | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index 6769fc0..3e63127 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -15,8 +15,8 @@ -- -- As such, this should be a well-defined syntax: we want it to look nice. -- Thus, we try wherever possible to use syntax defined in [1], --- "The C-- Reference Manual", http://www.cminusminus.org/. We differ --- slightly, in some cases. For one, we use I8 .. I64 for types, rather +-- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We +-- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather -- than C--'s bits8 .. bits64. -- -- We try to ensure that all information available in the abstract diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs index 968e872..9b3cecc 100644 --- a/compiler/cmm/PprCmmDecl.hs +++ b/compiler/cmm/PprCmmDecl.hs @@ -15,8 +15,8 @@ -- -- As such, this should be a well-defined syntax: we want it to look nice. -- Thus, we try wherever possible to use syntax defined in [1], --- "The C-- Reference Manual", http://www.cminusminus.org/. We differ --- slightly, in some cases. For one, we use I8 .. I64 for types, rather +-- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We +-- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather -- than C--'s bits8 .. bits64. -- -- We try to ensure that all information available in the abstract diff --git a/compiler/cmm/PprCmmExpr.hs b/compiler/cmm/PprCmmExpr.hs index 9e91a74..fa1124c 100644 --- a/compiler/cmm/PprCmmExpr.hs +++ b/compiler/cmm/PprCmmExpr.hs @@ -13,8 +13,8 @@ -- -- As such, this should be a well-defined syntax: we want it to look nice. -- Thus, we try wherever possible to use syntax defined in [1], --- "The C-- Reference Manual", http://www.cminusminus.org/. We differ --- slightly, in some cases. For one, we use I8 .. I64 for types, rather +-- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We +-- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather -- than C--'s bits8 .. bits64. -- -- We try to ensure that all information available in the abstract From git at git.haskell.org Thu Jan 18 18:02:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:02:59 +0000 (UTC) Subject: [commit: ghc] master: cmm: Include braces on default branch as required by the parser (3335811) Message-ID: <20180118180259.A530A3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/33358113175a66f8bfecd13f979aa7508e667271/ghc >--------------------------------------------------------------- commit 33358113175a66f8bfecd13f979aa7508e667271 Author: klebinger.andreas at gmx.at Date: Thu Jan 18 11:05:40 2018 -0500 cmm: Include braces on default branch as required by the parser Test Plan: Looking at cmm-dump Reviewers: bgamari, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4293 >--------------------------------------------------------------- 33358113175a66f8bfecd13f979aa7508e667271 compiler/cmm/PprCmm.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index 3e63127..6a93ea8 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -252,8 +252,8 @@ pprNode node = pp_node <+> pp_debug , ppr l <> semi ] def | Just l <- mbdef = hsep - [ text "default: goto" - , ppr l <> semi + [ text "default:" + , braces (text "goto" <+> ppr l <> semi) ] | otherwise = empty From git at git.haskell.org Thu Jan 18 18:03:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:03:02 +0000 (UTC) Subject: [commit: ghc] master: Remove unused extern cost centre collection (2a78cf7) Message-ID: <20180118180302.790C53A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2a78cf773cb447ac91c4a23d7e921e091e499134/ghc >--------------------------------------------------------------- commit 2a78cf773cb447ac91c4a23d7e921e091e499134 Author: Ömer Sinan Ağacan Date: Thu Jan 18 11:06:30 2018 -0500 Remove unused extern cost centre collection Reviewers: bgamari, simonmar Reviewed By: simonmar Subscribers: alexbiehl, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4309 >--------------------------------------------------------------- 2a78cf773cb447ac91c4a23d7e921e091e499134 compiler/codeGen/StgCmmProf.hs | 2 +- compiler/profiling/CostCentre.hs | 1 - compiler/profiling/ProfInit.hs | 2 +- compiler/profiling/SCCfinal.hs | 25 +++++++++++-------------- compiler/simplStg/SimplStg.hs | 2 +- 5 files changed, 14 insertions(+), 18 deletions(-) diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index a91c4c0..e5e1379 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -209,7 +209,7 @@ ifProfilingL dflags xs initCostCentres :: CollectedCCs -> FCode () -- Emit the declarations -initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs) +initCostCentres (local_CCs, singleton_CCSs) = do dflags <- getDynFlags when (gopt Opt_SccProfilingOn dflags) $ do mapM_ emitCostCentreDecl local_CCs diff --git a/compiler/profiling/CostCentre.hs b/compiler/profiling/CostCentre.hs index d1452ad..f89654d 100644 --- a/compiler/profiling/CostCentre.hs +++ b/compiler/profiling/CostCentre.hs @@ -182,7 +182,6 @@ data CostCentreStack -- code for a module. type CollectedCCs = ( [CostCentre] -- local cost-centres that need to be decl'd - , [CostCentre] -- "extern" cost-centres , [CostCentreStack] -- pre-defined "singleton" cost centre stacks ) diff --git a/compiler/profiling/ProfInit.hs b/compiler/profiling/ProfInit.hs index 557bdf0..931299a 100644 --- a/compiler/profiling/ProfInit.hs +++ b/compiler/profiling/ProfInit.hs @@ -23,7 +23,7 @@ import Module -- module; profilingInitCode :: Module -> CollectedCCs -> SDoc -profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs) +profilingInitCode this_mod (local_CCs, singleton_CCSs) = sdocWithDynFlags $ \dflags -> if not (gopt Opt_SccProfilingOn dflags) then empty diff --git a/compiler/profiling/SCCfinal.hs b/compiler/profiling/SCCfinal.hs index 4c582f4..8a2513f 100644 --- a/compiler/profiling/SCCfinal.hs +++ b/compiler/profiling/SCCfinal.hs @@ -30,7 +30,6 @@ import Id import Name import Module import UniqSupply ( UniqSupply ) -import ListSetOps ( removeDups ) import Outputable import DynFlags import CoreSyn ( Tickish(..) ) @@ -49,7 +48,7 @@ stgMassageForProfiling stgMassageForProfiling dflags mod_name _us stg_binds = let - ((local_ccs, extern_ccs, cc_stacks), + ((local_ccs, cc_stacks), stg_binds2) = initMM mod_name (do_top_bindings stg_binds) @@ -58,11 +57,9 @@ stgMassageForProfiling dflags mod_name _us stg_binds then ([],[]) -- don't need "all CAFs" CC else ([all_cafs_cc], [all_cafs_ccs]) - local_ccs_no_dups = fst (removeDups cmpCostCentre local_ccs) - extern_ccs_no_dups = fst (removeDups cmpCostCentre extern_ccs) + local_ccs_no_dups = nubSort local_ccs in ((fixed_ccs ++ local_ccs_no_dups, - extern_ccs_no_dups, fixed_cc_stacks ++ cc_stacks), stg_binds2) where @@ -248,7 +245,7 @@ initMM :: Module -- module name, which we may consult -> MassageM a -> (CollectedCCs, a) -initMM mod_name (MassageM m) = m mod_name ([],[],[]) +initMM mod_name (MassageM m) = m mod_name ([],[]) thenMM :: MassageM a -> (a -> MassageM b) -> MassageM b thenMM_ :: MassageM a -> (MassageM b) -> MassageM b @@ -264,11 +261,11 @@ thenMM_ expr cont = MassageM $ \mod ccs -> collectCC :: CostCentre -> MassageM () collectCC cc - = MassageM $ \mod_name (local_ccs, extern_ccs, ccss) + = MassageM $ \mod_name (local_ccs, ccss) -> if (cc `ccFromThisModule` mod_name) then - ((cc : local_ccs, extern_ccs, ccss), ()) - else -- must declare it "extern" - ((local_ccs, cc : extern_ccs, ccss), ()) + ((cc : local_ccs, ccss), ()) + else + ((local_ccs, ccss), ()) -- Version of collectCC used when we definitely want to declare this -- CC as local, even if its module name is not the same as the current @@ -276,12 +273,12 @@ collectCC cc -- test prof001,prof002. collectNewCC :: CostCentre -> MassageM () collectNewCC cc - = MassageM $ \_mod_name (local_ccs, extern_ccs, ccss) - -> ((cc : local_ccs, extern_ccs, ccss), ()) + = MassageM $ \_mod_name (local_ccs, ccss) + -> ((cc : local_ccs, ccss), ()) collectCCS :: CostCentreStack -> MassageM () collectCCS ccs - = MassageM $ \_mod_name (local_ccs, extern_ccs, ccss) + = MassageM $ \_mod_name (local_ccs, ccss) -> ASSERT(not (noCCSAttached ccs)) - ((local_ccs, extern_ccs, ccs : ccss), ()) + ((local_ccs, ccs : ccss), ()) diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index ad714ea..2af53e4 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -43,7 +43,7 @@ stg2stg dflags module_name binds (putLogMsg dflags NoReason SevDump noSrcSpan (defaultDumpStyle dflags) (text "VERBOSE STG-TO-STG:")) - ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds + ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[]) binds -- Do the main business! ; let (us0, us1) = splitUniqSupply us' From git at git.haskell.org Thu Jan 18 18:03:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:03:06 +0000 (UTC) Subject: [commit: ghc] master: Fix #14681 and #14682 with precision-aimed parentheses (575c009) Message-ID: <20180118180306.C042F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/575c009d9e4b25384ef984c09b2c54f909693e93/ghc >--------------------------------------------------------------- commit 575c009d9e4b25384ef984c09b2c54f909693e93 Author: Ryan Scott Date: Thu Jan 18 11:06:42 2018 -0500 Fix #14681 and #14682 with precision-aimed parentheses It turns out that `Convert` was recklessly leaving off parentheses in two places: * Negative numeric literals * Patterns in lambda position This patch fixes it by adding three new functions, `isCompoundHsLit`, `isCompoundHsOverLit`, and `isCompoundPat`, and using them in the right places in `Convert`. While I was in town, I also sprinkled `isCompoundPat` among some `Pat`-constructing functions in `HsUtils` to help avoid the likelihood of this problem happening in other places. One of these places is in `TcGenDeriv`, and sprinkling `isCompountPat` there fixes #14682 Test Plan: make test TEST="T14681 T14682" Reviewers: alanz, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14681, #14682 Differential Revision: https://phabricator.haskell.org/D4323 >--------------------------------------------------------------- 575c009d9e4b25384ef984c09b2c54f909693e93 compiler/hsSyn/Convert.hs | 17 +- compiler/hsSyn/HsLit.hs | 26 +++ compiler/hsSyn/HsPat.hs | 55 ++++++ compiler/hsSyn/HsTypes.hs | 5 +- compiler/hsSyn/HsUtils.hs | 9 +- compiler/typecheck/TcGenDeriv.hs | 6 +- testsuite/tests/deriving/should_compile/T14682.hs | 10 ++ .../tests/deriving/should_compile/T14682.stderr | 194 +++++++++++++++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + testsuite/tests/th/T14681.hs | 9 + testsuite/tests/th/T14681.stderr | 11 ++ testsuite/tests/th/all.T | 1 + 12 files changed, 334 insertions(+), 10 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 575c009d9e4b25384ef984c09b2c54f909693e93 From git at git.haskell.org Thu Jan 18 18:08:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:01 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Add text dependency (b041a02) Message-ID: <20180118180801.351463A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/b041a02fc2bed34dd38100e4212bce8fa2f0022e/ghc >--------------------------------------------------------------- commit b041a02fc2bed34dd38100e4212bce8fa2f0022e Author: Ben Gamari Date: Thu Jun 22 11:59:32 2017 -0400 Add text dependency >--------------------------------------------------------------- b041a02fc2bed34dd38100e4212bce8fa2f0022e .gitmodules | 4 ++++ compiler/ghc.cabal.in | 1 + compiler/main/HscMain.hs | 1 + ghc/Main.hs | 1 + ghc/ghc-bin.cabal.in | 1 + 5 files changed, 8 insertions(+) diff --git a/.gitmodules b/.gitmodules index 2125a92..c456904 100644 --- a/.gitmodules +++ b/.gitmodules @@ -6,6 +6,10 @@ path = libraries/bytestring url = ../packages/bytestring.git ignore = untracked +[submodule "libraries/text"] + path = libraries/text + url = https://github.com/bollu/text.git + ignore = untracked [submodule "libraries/Cabal"] path = libraries/Cabal url = ../packages/Cabal.git diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 1e3447b..4149375 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -62,6 +62,7 @@ Library template-haskell == 2.13.*, hpc == 0.6.*, transformers == 0.5.*, + text == 1.2.*, ghc-boot == @ProjectVersionMunged@, ghc-boot-th == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 975c96f..47f8e81 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -170,6 +170,7 @@ import qualified Data.Map as Map import qualified Data.Set as S import Data.Set (Set) +import qualified Data.Text as DontUseText #include "HsVersions.h" diff --git a/ghc/Main.hs b/ghc/Main.hs index b720dea..b1697fd 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -73,6 +73,7 @@ import Control.Monad import Data.Char import Data.List import Data.Maybe +import qualified Data.Text as DontUseText ----------------------------------------------------------------------------- -- ToDo: diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index c94c6f8..631eb81 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -34,6 +34,7 @@ Executable ghc directory >= 1 && < 1.4, process >= 1 && < 1.7, filepath >= 1 && < 1.5, + text == 1.2.*, ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ From git at git.haskell.org Thu Jan 18 18:08:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:04 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Hack: Produce latin1 asm output (55a1d46) Message-ID: <20180118180804.079C23A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/55a1d46a07c871efb802af80ce0e63a8923ff05d/ghc >--------------------------------------------------------------- commit 55a1d46a07c871efb802af80ce0e63a8923ff05d Author: Ben Gamari Date: Fri Jul 21 14:28:57 2017 -0400 Hack: Produce latin1 asm output >--------------------------------------------------------------- 55a1d46a07c871efb802af80ce0e63a8923ff05d compiler/nativeGen/AsmCodeGen.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index b91181c..0468135 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -100,7 +100,7 @@ import Data.Maybe import Data.Ord ( comparing ) import Control.Exception import Control.Monad -import System.IO (Handle) +import System.IO {- The native-code generator has machine-independent and @@ -332,6 +332,7 @@ nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr) -> IO UniqSupply nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms = do + hSetEncoding h latin1 let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty (ngs, us') <- cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmms ngs0 From git at git.haskell.org Thu Jan 18 18:08:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:06 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Try something (317c9f8) Message-ID: <20180118180806.C4AA83A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/317c9f82b2b8cf8bf2b33860f67102e7bb5495ea/ghc >--------------------------------------------------------------- commit 317c9f82b2b8cf8bf2b33860f67102e7bb5495ea Author: Ben Gamari Date: Sat Jun 24 13:01:37 2017 -0400 Try something >--------------------------------------------------------------- 317c9f82b2b8cf8bf2b33860f67102e7bb5495ea compiler/utils/Pretty.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index a611b78..4d6796d 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -1009,10 +1009,10 @@ renderStyle s d = TL.unpack $ renderLazy (layoutPretty (styleToLayoutOptions s) printDoc :: Mode -> Int -> Handle -> Doc a -> IO () -- printDoc adds a newline to the end -printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc <> hardline) +printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc) printDoc_ :: Mode -> Int -> Handle -> Doc a -> IO () -printDoc_ mode pprCols hdl doc = TL.hPutStr hdl (renderLazy $ layoutPretty (mkLayoutOptions mode pprCols) doc) where +printDoc_ mode pprCols hdl doc = TL.hPutStrLn hdl (renderLazy $ layoutPretty (mkLayoutOptions mode pprCols) doc) where mkLayoutOptions :: Mode -> Int -> LayoutOptions -- Note that this should technically be 1.5 as per the old implementation. -- I have no idea why that is. From git at git.haskell.org Thu Jan 18 18:08:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:15 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: llvmGen: Fix another (788523b) Message-ID: <20180118180815.302233A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/788523b70dc5a3d46626a005a297c211f562a5c2/ghc >--------------------------------------------------------------- commit 788523b70dc5a3d46626a005a297c211f562a5c2 Author: Ben Gamari Date: Fri Jul 21 00:18:20 2017 -0400 llvmGen: Fix another >--------------------------------------------------------------- 788523b70dc5a3d46626a005a297c211f562a5c2 compiler/llvmGen/LlvmCodeGen.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index 8a06436..54fdcd7 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -25,7 +25,6 @@ import Hoopl.Block import Hoopl.Collections import PprCmm -import BufWrite import DynFlags import ErrUtils import FastString From git at git.haskell.org Thu Jan 18 18:08:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:12 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Add pretty-printer dependency (522080a) Message-ID: <20180118180812.63F493A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/522080a7b42defe2e8672a0c737b3f329ffed682/ghc >--------------------------------------------------------------- commit 522080a7b42defe2e8672a0c737b3f329ffed682 Author: Ben Gamari Date: Sat Jun 24 10:05:14 2017 -0400 Add pretty-printer dependency >--------------------------------------------------------------- 522080a7b42defe2e8672a0c737b3f329ffed682 .gitmodules | 3 +++ compiler/ghc.cabal.in | 1 + ghc.mk | 3 ++- ghc/ghc-bin.cabal.in | 1 + libraries/prettyprinter-core | 1 + packages | 1 + 6 files changed, 9 insertions(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index c456904..49e5ab9 100644 --- a/.gitmodules +++ b/.gitmodules @@ -136,3 +136,6 @@ [submodule "hadrian"] path = hadrian url = ../hadrian.git +[submodule "libraries/prettyprinter-core"] + path = libraries/prettyprinter-core + url = https://github.com/bollu/prettyprinter-core.git diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 4149375..ad0b20c 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -63,6 +63,7 @@ Library hpc == 0.6.*, transformers == 0.5.*, text == 1.2.*, + prettyprinter == 1.1.*, ghc-boot == @ProjectVersionMunged@, ghc-boot-th == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ diff --git a/ghc.mk b/ghc.mk index 38c165d..3b6c19b 100644 --- a/ghc.mk +++ b/ghc.mk @@ -420,7 +420,7 @@ else # CLEANING # programs such as GHC and ghc-pkg, that we do not assume the stage0 # compiler already has installed (or up-to-date enough). -PACKAGES_STAGE0 = binary text transformers mtl parsec Cabal/Cabal hpc ghc-boot-th ghc-boot template-haskell ghci +PACKAGES_STAGE0 = binary text transformers mtl parsec Cabal/Cabal hpc ghc-boot-th ghc-boot template-haskell ghci prettyprinter-core ifeq "$(Windows_Host)" "NO" PACKAGES_STAGE0 += terminfo endif @@ -459,6 +459,7 @@ PACKAGES_STAGE1 += ghc-boot-th PACKAGES_STAGE1 += ghc-boot PACKAGES_STAGE1 += template-haskell PACKAGES_STAGE1 += ghc-compact +PACKAGES_STAGE1 += prettyprinter-core ifeq "$(HADDOCK_DOCS)" "YES" PACKAGES_STAGE1 += xhtml diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 631eb81..7bc3b01 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -35,6 +35,7 @@ Executable ghc process >= 1 && < 1.7, filepath >= 1 && < 1.5, text == 1.2.*, + prettyprinter == 1.1.*, ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ diff --git a/libraries/prettyprinter-core b/libraries/prettyprinter-core new file mode 160000 index 0000000..8697cc9 --- /dev/null +++ b/libraries/prettyprinter-core @@ -0,0 +1 @@ +Subproject commit 8697cc9cfe6937d6479396a96c600a4b6d556ab5 diff --git a/packages b/packages index 69aed70..fbc24bb 100644 --- a/packages +++ b/packages @@ -41,6 +41,7 @@ ghc-tarballs windows ghc-tarballs.git - libffi-tarballs - - - utils/hsc2hs - - ssh://git at github.com/haskell/hsc2hs.git utils/haddock - - ssh://git at github.com/haskell/haddock.git +libraries/prettyprinter-core - - https://github.com/bollu/prettyprinter-core.git libraries/array - - - libraries/binary - - https://github.com/kolmodin/binary.git libraries/bytestring - - https://github.com/haskell/bytestring.git From git at git.haskell.org Thu Jan 18 18:08:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:09 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: nativeGen: Clean up warning (7a570aa) Message-ID: <20180118180809.8D1FF3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/7a570aad3535256cbba09e16a2e9b59d017565fe/ghc >--------------------------------------------------------------- commit 7a570aad3535256cbba09e16a2e9b59d017565fe Author: Ben Gamari Date: Fri Jul 21 00:17:27 2017 -0400 nativeGen: Clean up warning >--------------------------------------------------------------- 7a570aad3535256cbba09e16a2e9b59d017565fe compiler/nativeGen/AsmCodeGen.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 85cc2ba..b91181c 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -100,7 +100,6 @@ import Data.Maybe import Data.Ord ( comparing ) import Control.Exception import Control.Monad -import System.IO import System.IO (Handle) {- From git at git.haskell.org Thu Jan 18 18:08:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:18 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Use prettyprinter (948c1e0) Message-ID: <20180118180818.1638B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/948c1e0e62796d1e69e0cb0c755c9bfd645db0ea/ghc >--------------------------------------------------------------- commit 948c1e0e62796d1e69e0cb0c755c9bfd645db0ea Author: Ben Gamari Date: Sat Jun 24 10:05:38 2017 -0400 Use prettyprinter >--------------------------------------------------------------- 948c1e0e62796d1e69e0cb0c755c9bfd645db0ea compiler/llvmGen/LlvmCodeGen.hs | 4 +- compiler/llvmGen/LlvmCodeGen/Base.hs | 6 +- compiler/main/HscMain.hs | 2 + compiler/nativeGen/AsmCodeGen.hs | 23 ++--- compiler/utils/Outputable.hs | 18 ++-- compiler/utils/Pretty.hs | 185 ++++++++++++++++++++++++++++++++--- ghc/Main.hs | 1 + 7 files changed, 203 insertions(+), 36 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 948c1e0e62796d1e69e0cb0c755c9bfd645db0ea From git at git.haskell.org Thu Jan 18 18:08:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:26 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Fix errant newlines (31d8e71) Message-ID: <20180118180826.7FBC33A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/31d8e717dffb61e225ca61e8a6453b2db4171b5b/ghc >--------------------------------------------------------------- commit 31d8e717dffb61e225ca61e8a6453b2db4171b5b Author: Ben Gamari Date: Sat Jun 24 12:40:35 2017 -0400 Fix errant newlines >--------------------------------------------------------------- 31d8e717dffb61e225ca61e8a6453b2db4171b5b compiler/utils/Pretty.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index bfc8bb2..a611b78 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -124,6 +124,7 @@ import GHC.Ptr ( Ptr(..) ) import qualified Data.Text as T import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL import Data.Text.Prettyprint.Doc -- PI = PrettyprinterInternal @@ -1011,7 +1012,7 @@ printDoc :: Mode -> Int -> Handle -> Doc a -> IO () printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc <> hardline) printDoc_ :: Mode -> Int -> Handle -> Doc a -> IO () -printDoc_ mode pprCols hdl doc = renderIO hdl (layoutPretty (mkLayoutOptions mode pprCols) doc) where +printDoc_ mode pprCols hdl doc = TL.hPutStr hdl (renderLazy $ layoutPretty (mkLayoutOptions mode pprCols) doc) where mkLayoutOptions :: Mode -> Int -> LayoutOptions -- Note that this should technically be 1.5 as per the old implementation. -- I have no idea why that is. From git at git.haskell.org Thu Jan 18 18:08:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:23 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Never tick primitive string literals (024eed4) Message-ID: <20180118180823.B00313A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/024eed43a32d9d661e50c4ebe7e2b50e4884e910/ghc >--------------------------------------------------------------- commit 024eed43a32d9d661e50c4ebe7e2b50e4884e910 Author: Ben Gamari Date: Fri Jul 21 01:23:26 2017 -0400 Never tick primitive string literals Summary: This is a more aggressive approach to the problem initially solved in f5b275a239d2554c4da0b7621211642bf3b10650, where top-level primitive string literals were being wrapped by ticks. This breaks the Core invariant descirbed in Note [CoreSyn top-level string literals]. However, the previous approach was incomplete and left several places where inappropriate ticks could sneak in. This commit kills the problem at the source: we simply never tick any primitive string literal expression. The assumption here is that these expressions are destined for the top-level, where they cannot be ticked, anyways. So even if they haven't been floated out yet there is no reason to tick them. This partially reverts commit f5b275a239d2554c4da0b7621211642bf3b10650. Test Plan: Validate with `-g` Reviewers: scpmw, simonmar, dfeuer, simonpj, austin Subscribers: dfeuer, simonmar, thomie Differential Revision: https://phabricator.haskell.org/D3063 >--------------------------------------------------------------- 024eed43a32d9d661e50c4ebe7e2b50e4884e910 compiler/coreSyn/CoreSyn.hs | 2 ++ compiler/coreSyn/CoreUtils.hs | 5 +++++ compiler/simplCore/FloatOut.hs | 32 ++++++++++++-------------------- compiler/simplCore/Simplify.hs | 8 +------- 4 files changed, 20 insertions(+), 27 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 27a4c99..e45abc7 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -405,6 +405,8 @@ It is important to note that top-level primitive string literals cannot be wrapped in Ticks, as is otherwise done with lifted bindings. CoreToStg expects to see just a plain (Lit (MachStr ...)) expression on the RHS of primitive string bindings; anything else and things break. CoreLint checks this invariant. +To ensure that ticks don't sneak in CoreUtils.mkTick refuses to wrap any +primitive string expression with a tick. Also see Note [Compilation plan for top-level string literals]. diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 5e32dc6..6a0f18d 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -305,6 +305,11 @@ mkTick t orig_expr = mkTick' id id orig_expr -> CoreExpr mkTick' top rest expr = case expr of + -- Never tick primitive string literals. These should ultimately float up to + -- the top-level where they must be unadorned. See Note + -- [CoreSyn top-level string literals] for details. + _ | exprIsLiteralString expr -> expr + -- Cost centre ticks should never be reordered relative to each -- other. Therefore we can stop whenever two collide. Tick t2 e diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs index a8223b4..6cb21f9 100644 --- a/compiler/simplCore/FloatOut.hs +++ b/compiler/simplCore/FloatOut.hs @@ -23,7 +23,6 @@ import DynFlags import ErrUtils ( dumpIfSet_dyn ) import Id ( Id, idArity, idType, isBottomingId, isJoinId, isJoinId_maybe ) -import BasicTypes ( TopLevelFlag(..), isTopLevel ) import SetLevels import UniqSupply ( UniqSupply ) import Bag @@ -737,26 +736,19 @@ atJoinCeiling (fs, floats, expr') wrapTick :: Tickish Id -> FloatBinds -> FloatBinds wrapTick t (FB tops ceils defns) - = FB (mapBag (wrap_bind TopLevel) tops) - (wrap_defns NotTopLevel ceils) - (M.map (M.map (wrap_defns NotTopLevel)) defns) + = FB (mapBag wrap_bind tops) (wrap_defns ceils) + (M.map (M.map wrap_defns) defns) where - wrap_defns toplvl = mapBag (wrap_one toplvl) - - wrap_bind toplvl (NonRec binder rhs) = NonRec binder (maybe_tick toplvl rhs) - wrap_bind toplvl (Rec pairs) = Rec (mapSnd (maybe_tick toplvl) pairs) - - wrap_one toplvl (FloatLet bind) = FloatLet (wrap_bind toplvl bind) - wrap_one toplvl (FloatCase e b c bs) = FloatCase (maybe_tick toplvl e) b c bs - - maybe_tick :: TopLevelFlag -> CoreExpr -> CoreExpr - maybe_tick toplvl e - -- We must take care not to tick top-level literal - -- strings as this violated the Core invariants. See Note [CoreSyn - -- top-level string literals]. - | isTopLevel toplvl && exprIsLiteralString e = e - | exprIsHNF e = tickHNFArgs t e - | otherwise = mkTick t e + wrap_defns = mapBag wrap_one + + wrap_bind (NonRec binder rhs) = NonRec binder (maybe_tick rhs) + wrap_bind (Rec pairs) = Rec (mapSnd maybe_tick pairs) + + wrap_one (FloatLet bind) = FloatLet (wrap_bind bind) + wrap_one (FloatCase e b c bs) = FloatCase (maybe_tick e) b c bs + + maybe_tick e | exprIsHNF e = tickHNFArgs t e + | otherwise = mkTick t e -- we don't need to wrap a tick around an HNF when we float it -- outside a tick: that is an invariant of the tick semantics -- Conversely, inlining of HNFs inside an SCC is allowed, and diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index b123055..53e3a21 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -440,13 +440,7 @@ prepareRhs mode top_lvl occ _ rhs0 -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; let tickIt (id, expr) - -- we have to take care not to tick top-level literal - -- strings. See Note [CoreSyn top-level string literals]. - | isTopLevel top_lvl && exprIsLiteralString expr - = (id, expr) - | otherwise - = (id, mkTick (mkNoCount t) expr) + ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt ; return (is_exp, floats', Tick t rhs') } From git at git.haskell.org Thu Jan 18 18:08:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:32 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Debugging ghc-pkg (2752fdd) Message-ID: <20180118180832.204623A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/2752fdd67a9804ca31c4682f858073e33cf2763d/ghc >--------------------------------------------------------------- commit 2752fdd67a9804ca31c4682f858073e33cf2763d Author: Ben Gamari Date: Fri Jul 21 00:11:14 2017 -0400 Debugging ghc-pkg >--------------------------------------------------------------- 2752fdd67a9804ca31c4682f858073e33cf2763d libraries/ghc-boot/GHC/PackageDb.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs index e2e4694..acd5098 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/PackageDb.hs @@ -362,7 +362,7 @@ getHeader :: Get (Word32, Word32) getHeader = do magic <- getByteString (BS.length headerMagic) when (magic /= headerMagic) $ - fail "not a ghc-pkg db file, wrong file magic number" + fail $ "not a ghc-pkg db file, wrong file magic number (saw "++show magic++", expected "++show headerMagic++")" majorVersion <- get :: Get Word32 -- The major version is for incompatible changes From git at git.haskell.org Thu Jan 18 18:08:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:37 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Fix hang (3295971) Message-ID: <20180118180837.A7DD53A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/32959719cbe6f9ca3dbbc02ab5f7002a37e4c57b/ghc >--------------------------------------------------------------- commit 32959719cbe6f9ca3dbbc02ab5f7002a37e4c57b Author: Ben Gamari Date: Wed Sep 13 17:01:48 2017 -0400 Fix hang >--------------------------------------------------------------- 32959719cbe6f9ca3dbbc02ab5f7002a37e4c57b compiler/utils/Outputable.hs | 6 +++--- compiler/utils/Pretty.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index e89a4ce..5eba739 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -706,9 +706,9 @@ fsep ds = SDoc $ \sty -> Pretty.fsep [runSDoc d sty | d <- ds] fcat ds = SDoc $ \sty -> Pretty.fcat [runSDoc d sty | d <- ds] hang :: SDoc -- ^ The header - -> Int -- ^ Amount to indent the hung body - -> SDoc -- ^ The hung body, indented and placed below the header - -> SDoc + -> Int -- ^ Amount to indent the hung body + -> SDoc -- ^ The hung body, indented and placed below the header + -> SDoc hang d1 n d2 = SDoc $ \sty -> Pretty.hang (runSDoc d1 sty) n (runSDoc d2 sty) -- | This behaves like 'hang', but does not indent the second document diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 87c9fc9..ef6085d 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -394,7 +394,7 @@ isEmpty _ = False -- | @hang d1 n d2 = sep [d1, nest n d2]@ hang :: Doc a -> Int -> Doc a -> Doc a -hang d1 n d2 = sep [d1, nest n d2] +hang d1 n d2 = nest n (sep [d1, d2]) From git at git.haskell.org Thu Jan 18 18:08:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:20 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: llvmGen: Clean up warning (39c6d40) Message-ID: <20180118180820.D412F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/39c6d40d5a242b1f88fd861e8a12b870b69e3f42/ghc >--------------------------------------------------------------- commit 39c6d40d5a242b1f88fd861e8a12b870b69e3f42 Author: Ben Gamari Date: Fri Jul 21 00:16:34 2017 -0400 llvmGen: Clean up warning >--------------------------------------------------------------- 39c6d40d5a242b1f88fd861e8a12b870b69e3f42 compiler/llvmGen/LlvmCodeGen/Base.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 9e07979..c1977dc 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -51,7 +51,6 @@ import Outputable as Outp import Platform import UniqFM import Unique -import BufWrite ( BufHandle ) import System.IO (Handle) import UniqSet import UniqSupply From git at git.haskell.org Thu Jan 18 18:08:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:29 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Port to prettyprinter proper (7d9329e) Message-ID: <20180118180829.4E8333A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/7d9329e4a4f2cd2f76386a129823de79892b9718/ghc >--------------------------------------------------------------- commit 7d9329e4a4f2cd2f76386a129823de79892b9718 Author: Ben Gamari Date: Tue Sep 12 06:32:10 2017 -0400 Port to prettyprinter proper >--------------------------------------------------------------- 7d9329e4a4f2cd2f76386a129823de79892b9718 .gitmodules | 3 +++ ghc.mk | 7 +++++-- libraries/prettyprinter | 1 + packages | 2 +- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 49e5ab9..cfb1791 100644 --- a/.gitmodules +++ b/.gitmodules @@ -139,3 +139,6 @@ [submodule "libraries/prettyprinter-core"] path = libraries/prettyprinter-core url = https://github.com/bollu/prettyprinter-core.git +[submodule "libraries/prettyprinter"] + path = libraries/prettyprinter + url = git at github.com:quchen/prettyprinter.git diff --git a/ghc.mk b/ghc.mk index 3b6c19b..1a0c96b 100644 --- a/ghc.mk +++ b/ghc.mk @@ -420,7 +420,10 @@ else # CLEANING # programs such as GHC and ghc-pkg, that we do not assume the stage0 # compiler already has installed (or up-to-date enough). -PACKAGES_STAGE0 = binary text transformers mtl parsec Cabal/Cabal hpc ghc-boot-th ghc-boot template-haskell ghci prettyprinter-core +PACKAGES_STAGE0 = \ + binary text transformers mtl parsec Cabal/Cabal hpc ghc-boot-th ghc-boot template-haskell ghci \ + prettyprinter/prettyprinter + ifeq "$(Windows_Host)" "NO" PACKAGES_STAGE0 += terminfo endif @@ -459,7 +462,7 @@ PACKAGES_STAGE1 += ghc-boot-th PACKAGES_STAGE1 += ghc-boot PACKAGES_STAGE1 += template-haskell PACKAGES_STAGE1 += ghc-compact -PACKAGES_STAGE1 += prettyprinter-core +PACKAGES_STAGE1 += prettyprinter/prettyprinter ifeq "$(HADDOCK_DOCS)" "YES" PACKAGES_STAGE1 += xhtml diff --git a/libraries/prettyprinter b/libraries/prettyprinter new file mode 160000 index 0000000..973be20 --- /dev/null +++ b/libraries/prettyprinter @@ -0,0 +1 @@ +Subproject commit 973be208c28f0ec34c9cf7874bea9718996db776 diff --git a/packages b/packages index fbc24bb..846e475 100644 --- a/packages +++ b/packages @@ -41,7 +41,7 @@ ghc-tarballs windows ghc-tarballs.git - libffi-tarballs - - - utils/hsc2hs - - ssh://git at github.com/haskell/hsc2hs.git utils/haddock - - ssh://git at github.com/haskell/haddock.git -libraries/prettyprinter-core - - https://github.com/bollu/prettyprinter-core.git +libraries/prettyprinter/prettyprinter - - https://github.com/quchen/prettyprinter.git libraries/array - - - libraries/binary - - https://github.com/kolmodin/binary.git libraries/bytestring - - https://github.com/haskell/bytestring.git From git at git.haskell.org Thu Jan 18 18:08:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:34 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: More warning cleanups (8abc89f) Message-ID: <20180118180834.E18063A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/8abc89f8a62e6aa0293ec4b87af353bf5c21de4d/ghc >--------------------------------------------------------------- commit 8abc89f8a62e6aa0293ec4b87af353bf5c21de4d Author: Ben Gamari Date: Wed Sep 13 08:39:25 2017 -0400 More warning cleanups >--------------------------------------------------------------- 8abc89f8a62e6aa0293ec4b87af353bf5c21de4d compiler/utils/Outputable.hs | 1 - compiler/utils/Pretty.hs | 7 +------ 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index d6d221f..e89a4ce 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -95,7 +95,6 @@ import {-# SOURCE #-} DynFlags( DynFlags, hasPprDebug, hasNoDebugOutput, import {-# SOURCE #-} Module( UnitId, Module, ModuleName, moduleName ) import {-# SOURCE #-} OccName( OccName ) -import BufWrite (BufHandle) import FastString import qualified Pretty import Util diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 4d6796d..87c9fc9 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -113,14 +113,9 @@ module Pretty ( import GhcPrelude hiding (error) -import BufWrite import FastString -import Panic import System.IO - ---for a RULES -import GHC.Base ( unpackCString# ) -import GHC.Ptr ( Ptr(..) ) +import Prelude hiding (error) import qualified Data.Text as T import qualified Data.Text.Lazy as TL From git at git.haskell.org Thu Jan 18 18:08:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:43 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Use hardlineCollapse (19ee8ab) Message-ID: <20180118180843.3FB483A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/19ee8ab4935cae4d9806c30f6cd581360e63042d/ghc >--------------------------------------------------------------- commit 19ee8ab4935cae4d9806c30f6cd581360e63042d Author: Ben Gamari Date: Wed Sep 13 17:02:27 2017 -0400 Use hardlineCollapse >--------------------------------------------------------------- 19ee8ab4935cae4d9806c30f6cd581360e63042d compiler/utils/Pretty.hs | 2 +- libraries/prettyprinter | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index ef6085d..d876972 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -216,7 +216,7 @@ infixl 6 <+> infixl 5 $$, $+$ -} ($+$) :: Doc a -> Doc a -> Doc a -($+$) a b = vsep [a, b] +($+$) a b = a <> hardlineCollapse 1 <> b ($$) :: Doc a -> Doc a -> Doc a ($$) = ($+$) diff --git a/libraries/prettyprinter b/libraries/prettyprinter index 973be20..5c92fd0 160000 --- a/libraries/prettyprinter +++ b/libraries/prettyprinter @@ -1 +1 @@ -Subproject commit 973be208c28f0ec34c9cf7874bea9718996db776 +Subproject commit 5c92fd07537bb7070fcb560f671d4c7bb3aa7aad From git at git.haskell.org Thu Jan 18 18:08:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:40 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Various cleanups (53efa28) Message-ID: <20180118180840.745483A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/53efa284f6bb5b5835d76faeb54c9ae74b267296/ghc >--------------------------------------------------------------- commit 53efa284f6bb5b5835d76faeb54c9ae74b267296 Author: Ben Gamari Date: Tue Sep 12 06:45:44 2017 -0400 Various cleanups >--------------------------------------------------------------- 53efa284f6bb5b5835d76faeb54c9ae74b267296 .gitmodules | 3 --- ghc/Main.hs | 2 -- ghc/ghc-bin.cabal.in | 2 -- libraries/xhtml | 2 +- 4 files changed, 1 insertion(+), 8 deletions(-) diff --git a/.gitmodules b/.gitmodules index cfb1791..8dd0f77 100644 --- a/.gitmodules +++ b/.gitmodules @@ -136,9 +136,6 @@ [submodule "hadrian"] path = hadrian url = ../hadrian.git -[submodule "libraries/prettyprinter-core"] - path = libraries/prettyprinter-core - url = https://github.com/bollu/prettyprinter-core.git [submodule "libraries/prettyprinter"] path = libraries/prettyprinter url = git at github.com:quchen/prettyprinter.git diff --git a/ghc/Main.hs b/ghc/Main.hs index 9df91b7..b720dea 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -73,8 +73,6 @@ import Control.Monad import Data.Char import Data.List import Data.Maybe -import qualified Data.Text as DontUseText -import qualified Data.Text.Prettyprint.Doc as DontUsePrettyPrint ----------------------------------------------------------------------------- -- ToDo: diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 7bc3b01..c94c6f8 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -34,8 +34,6 @@ Executable ghc directory >= 1 && < 1.4, process >= 1 && < 1.7, filepath >= 1 && < 1.5, - text == 1.2.*, - prettyprinter == 1.1.*, ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ diff --git a/libraries/xhtml b/libraries/xhtml index c5c623e..6358594 160000 --- a/libraries/xhtml +++ b/libraries/xhtml @@ -1 +1 @@ -Subproject commit c5c623e497f13ec187e0d228e0e8a3d9ee39a715 +Subproject commit 6358594eb5139f6760e2ada72718d69fed5a1015 From git at git.haskell.org Thu Jan 18 18:08:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:46 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: More cleanups (9b39652) Message-ID: <20180118180846.1E3A13A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/9b3965237c22cb65a8f3d023ab9e1f22a86224b8/ghc >--------------------------------------------------------------- commit 9b3965237c22cb65a8f3d023ab9e1f22a86224b8 Author: Ben Gamari Date: Wed Sep 13 17:02:36 2017 -0400 More cleanups >--------------------------------------------------------------- 9b3965237c22cb65a8f3d023ab9e1f22a86224b8 compiler/utils/Pretty.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index d876972..a085e11 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -121,10 +121,9 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL -import Data.Text.Prettyprint.Doc --- PI = PrettyprinterInternal -import Data.Text.Prettyprint.Doc.Internal as PI - +import Data.Text.Prettyprint.Doc hiding (vcat) +import qualified Data.Text.Prettyprint.Doc as P +import qualified Data.Text.Prettyprint.Doc.Internal as PI import Data.Text.Prettyprint.Doc.Render.Text import GHC.Float (float2Double) @@ -221,6 +220,8 @@ infixl 5 $$, $+$ ($$) :: Doc a -> Doc a -> Doc a ($$) = ($+$) +vcat :: [Doc a] -> Doc a +vcat = foldr ($$) mempty -- --------------------------------------------------------------------------- -- The Doc data type From git at git.haskell.org Thu Jan 18 18:08:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 18:08:50 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter's head updated: More cleanups (9b39652) Message-ID: <20180118180850.E8BD93A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/prettyprinter' now includes: fe35b85 Add testcase for #14186 fe04f37 Allow CSE'ing of work-wrapped bindings (#14186) 0ebc8dc Add a test for #14140 9ff9c35 Check if -XStaticPointers is enabled when renaming static expressions dafa012 Add regression test for #14209 b890e88 rts: Print message before SIGUSR2 backtrace d645e44 DriverMkDepend: Kill redundant import f8e383f Clarify Data.Data documentation 91262e7 Use ar for -staticlib e62391a [RTS] Harden against buffer overflow cbd4911 Make IntPtr and WordPtr as instance of Data.Data typeclass, fix #13115 8ff11c4 Fix @since annotations in GHC.Stats 6139f7f Add non-ASCII isLetter True example 2fe6f6b Option "-ddump-rn-ast" dumps imports and exports too f9bf621 Better document TypeRep patterns 4be195e Simplify Data.Type.Equality.== 4e22220 Clarify seq documentation 4cead3c rts: Add regsterCc(s)List to RTS symbols list 10a1a47 Model divergence of retry# as ThrowsExn, not Diverges 959a623 No need to check ambiguity for visible type args ab2d3d5 More refinements to debugPprType 3a27e34 Fix subtle bug in TcTyClsDecls.mkGADTVars 8bf865d Tidying could cause ill-kinded types 0390e4a Refactor to eliminate FamTyConShape a38acda Refactor tcInferApps 9218ea6 Interim fix for a nasty type-matching bug 9e46167 Remove unused variable binding b6b56dd [RTS] Make -po work 93da9f9 Add test for Trac #14232 3b68687 Test #14038 in dependent/should_compile/T14038 c813d8c Regression test for #12742 b977630 Test #12938 in indexed-types/should_compile/T12938 04bb873 Fix #13407 by suppressing invisibles better. ecb316c nativeGen: A few strictness fixes 58f1f73 Bump primitive submodule 3edbf5c testsuite: Fix dependence on grep behavior in T8129 89c8d4d Fix #13909 by tweaking an error message. e5beb6e Make rejigConRes do kind substitutions fa626f3 Fix #13929 by adding another levity polymorphism check 86e1db7 Test #13938, with expect_broken 8f99cd6 Fix #13963. 7b8827a Bump submodule nofib (Semigroup now required) f043cd5 Fix name of note 4340165 Ignore untracked in text, parsec and mtl submodules [skip ci] 9e227bb Fix missing fields warnings in empty record construction, fix #13870 f4d50a0 Fix #14228 by marking SumPats as non-irrefutable 2bfba9e base: Fix mixed tabs/spaces indentation in inputReady.c 9498c50 Renamer now preserves location for IEThingWith list items 47a9ec7 Remove dead function TcUnify.wrapFunResCoercion b099171 base: Enable TypeInType in Data.Type.Equality 4ec4ca9 base: Add missing MonadFail instance for strict ST 60a3f11 Fix pointer tagging mistake a83f17e base: Fix missing import of Control.Monad.Fail 2258a29 testsuite: Fix MonadFail test output for new ST instance cdaf5f2 [RTS] Add getObjectLoadStatus 120c568 Allow opt+llc from LLVM5 10ca801 Generalise constraint on `instance Monoid (Maybe a)` to Semigroup a2f004b Remove redundant/obsolete CPP usage 1db0f4a Fix unused-given-constraint bug 6252292 rts/RetainerProfile: Adding missing closure types to isRetainer 8b007ab nativeGen: Consistently use blockLbl to generate CLabels from BlockIds 12a92fe OccurAnal: Ensure SourceNotes don't interfere with join-point analysis f63bc73 compiler: introduce custom "GhcPrelude" Prelude 7c7914d Fix Windows build regression due to GhcPrelude change 28a115e base: fdReady(): Improve accuracy and simplify code. c2a1fa7 base: Fix fdReady() potentially running forever on Windows. 826c3b1 base: Fix fdReady() potentially running forever for Windows Char devices. 66240c9 base: Fix fdReady() returning immediately for pipes on Windows. 11c478b rts: Update comment about FreeBSD's unsigned FD_SETSIZE b7f2d12 rts: Fix typo in comment ba4dcc7 base: Make it less likely for fdReady() to fail on Windows sockets. 022455f base: Add more detail to FD_SETSIZE related error message bbb8cb9 users-guide: Mention changes necessary due to #13391 3198956 Factor mkCoreApp and mkCoreApps 7920a7d cmm/CBE: Collapse blocks equivalent up to alpha renaming of local registers 0aba999 Restore function powModSecInteger 11d9615 Make zipWith and zipWith3 inlinable. 02ff705 Add 'stm' package to the global package database d7705f2 aclocal.m4: call cygpath on mingw32 only ced2cb5 Typofixes (visiblity -> visibility) 283eb1a Initial CircleCI support. cc6be3a Typeable: Allow App to match arrow types 9e46d88 Typeable: Generalize kind of represented type 72b00c3 Identify fields by selector when type-checking (fixes #13644) acd346e testsuite: Add testcase for #14253 d86b237 testsuite: Add unboxed sum to T13929 58a7062 base: Add changelog entry for withTypeable generalization 063e0b4 Bump base to 4.11.0.0 1c92083 Also show types that subsume a hole as valid substitutions for that hole. ddb38b5 testsuite: Bump allocations of T12150 9aa7389 cmm/CBE: Use foldLocalRegsDefd feac0a3 Reexport Semigroup's <> operator from Prelude (#14191) 760b9a3 rts: Set unwind information for remaining stack frames a9d417d rts: Set unwind information for catch_frame 1755869 Implement TH addCorePlugin. d7b8da1 Fix broken LLVM code gen 5a8b843 Remove 'stm' from EXTRA_PACKAGES set 2f10438 Fix build with GhcWithInterpreter=NO 65943a3 Bump haskeline submodule c2373b7 Additional LLVM_TARGET logic. d559612 Fix AsmTempLabel d7b260f [Semigroup] fix genapply 9c7d065 Revert "Typeable: Allow App to match arrow types" b3ae47c don't allow AsmTempLabel in UNREG mode (Trac #14264) 3c74a51 Deal with large extra-contraints wildcards 7721e8e Make pprQuotedList use fsep not hsep 3b4833a Comments only 1b476ab Improve type-error reporting abed9bf Fix solving of implicit parameter constraints 0e60cc1 Document how GHC disambiguates between multiple COMPLETE sets 3804a7e Bump template-haskell to 2.13.0.0 2b2595e Ensure text mode when calling debug functions c839c57 Fix the searching of target AR tool abca29f Adds mingw64 to the valid GHC OSs. 6de1a5a Document Typeable's treatment of kind polymorphic tycons d07b8c7 Include original process name in worker thread name (#14153) 9acbeb5 integer-gmp: Fix style d11611f Add NOINLINE pragma to builtinRules 9738e8b Use SIGQUIT for DWARF backtraces instead of SIGUSR2 49c1a20 configure: Catch case where LLVM tools can't be found 65f7d87 configure: Don't hard-code strip tool 2f8e6e7 testsuite: Expect T13168 to be broken on Windows 7446c7f A bunch of typofixes c41ccbf Omit Typeable from the "naturally coherent" list 6e7c09d StgCmmMonad: Remove unnecessary use of unboxed tuples 6246407 primops: Add some notes regarding the meaning of the "type" field 1d1b991 rts: Inform kernel that we won't need reserved address space 57372a7 PrelRules: Handle Int left shifts of more than word-size bits 0ffa396 testsuite: Add test for #14272 f9f1e38 TcInteract: Remove redundant import of Typeable 3ec579d Release console for ghci wrapper 8c23b54 Rules: Show the binder type in the unbound template binder error 7fb89e8 rts: Silence missing __noreturn__ warning 1825cbd Switch VEH to VCH and allow disabling of SEH completely. 8f468fe base: fdReady(): Add note about O_NONBLOCK requirement 018c40f desugar: Catch levity polymorphism in unboxed sum expressions 30a1eee rts: Throw proper HeapOverflow exception on allocating large array 47888fd Revert "Switch VEH to VCH and allow disabling of SEH completely." 1421d87 Switch VEH to VCH and allow disabling of SEH completely. 07ddeaf GHC_LLVM_TARGET: Keep android OS 60b0645 llvm-targets: drop soft-float 4364f1e Typofixes 1e9f90a Move check-ppr and check-api-annotations to testsuite/utils 9bf6310 Add TODO about getMonotonicNSec() wrapping that can no longer happen. dddef31 fdReady(): Fix some C -Wconversion warnings. 03009aa base: fdReady(): Ensure and doc that return values are always -1/0/1 a10729f configure: Make sure we try all possible linkers 5935acd mkDataConRep: fix bug in strictness signature (#14290) 7aa000b Fix #13391 by checking for kind-GADTs 464396d Fix Raspberry Pi target name 9c05fc4 user-guide: Document -Weverything 626f045 Document a law for TH's Lift class effcd56 Don't use "character" in haddocks of Char c15c427 iserv: Don't build vanilla iserv unless vanilla libraries are built e515c7f Allow libffi snapshots e299121 Bump submodule nofib again (Semigroup now required) 00ff023 Travis: Install texinfo 11a59de CircleCI: Install texinfo 0e96812 Pretty-printer missing parens for infix class declaration c0e6c73 Rewrite boot in Python e30d9ca rel-notes: Mention libffi packaging change e462b65 Bump libffi-tarballs submodule d5e60de user-guide: Fix :since: annotation of -pie and add documentation for -fPIE d0c5d8d No libffi docs a4ee289 Adds x86 NONE relocation type a1fc7ce Comments only a8fde18 Fix bug in the short-cut solver b1e0c65 Make GHC.IO.Buffer.summaryBuffer strict dbbee1b Fix nasty bug in w/w for absence analysis cb76754 Suppress error cascade in record fields a02039c Add regression test for #9725 a36eea1 Revert installing texinfo in CI systems 55001c0 Sync base/changelog.md ec9ac20 Add ability to produce crash dumps on Windows 8d64745 Optimize linker by minimizing calls to tryGCC to avoid fork/exec overhead. ef26182 Track the order of user-written tyvars in DataCon fa8035e Implement Div, Mod, and Log for type-level nats. 377d5a2 base: Add missing @since annotations in GHC.TypeNats de1b802 genapply: Explicitly specify arguments f3f624a Include libraries which fill holes as deps when linking. 4899a86 Don't pass HscEnv to functions in the Hsc monad 361af62 base: Remove deprecated Chan combinators 3201d85 user-guide: Mention COMPLETE pragma in release notes 3030eee rts: Print newline after "Stack trace:" on barf 7109fa8 configure: Accept *-msys as a Windows OS in a triple d8d87fa Remove m_type from Match (#14313) 429fafb Add regression test for #14326 f6bca0c Testsuite update following d8d87fa 341d3a7 Incorporate changes from #11721 into Template Haskell f1d2db6 Fix #14320 by looking through HsParTy in more places f337a20 Simply Data instance context for AmbiguousFieldOcc e51e565 Split SysTools up some 7720c29 Tidy up some convoluted "child/parent" code ab1a7583 Typos in comments only 461c831 Minor refactoring c81f66c Fix over-eager error suppression in TcErrors 79ae03a Change "cobox" to "co" in debug output 3e44562 Delete two unused functions f20cf98 Remove wc_insol from WantedConstraints 9c3f731 Fix #10816 by renaming FixitySigs more consistently 6869864 Pretty-printing of derived multi-parameter classes omits parentheses 4bb54a4 Avoid creating dependent types in FloatOut 13fdca3 Add a missing zonk in TcDerivInfer.simplifyDeriv 82b77ec Do not quantify over deriving clauses 15aefb4 Add missing T14325.stderr fb050a3 Do not bind coercion variables in SpecConstr rules 3de788c Re-apply "Typeable: Allow App to match arrow types" 2be55b8 Delete obsolete docs on GADT interacton with TypeApplications 4a677f7 Remove section about ApplicativeDo & existentials (#13875) 8adb84f Fix calculation in threadStackOverflow afac6b1 Fix typo 6aa6a86 Fix typo add85cc Fix panic for `ByteArray#` arguments in CApiFFI foreign imports e3ba26f Implement new `compareByteArrays#` primop 5984a69 Override default `clearBit` method impl for `Natural` 843772b Enable testing 'Natural' type in TEST=arith011 6cc232a Implement {set,clear,complement}BitBigNat primitives 71a4235 configure: Fix CC version check on Apple compilers fd8b044 Levity polymorphic Backpack. 5dab544 FreeBSD dtrace probe support 7e790b3 rts: Label all threads created by the RTS 8536b7f users-guide: Rework and finish debug flag documentation d7f4f41 users guide: Eliminate redundant :category: tags in debugging.rst c5da84d users-guide: Fix various warnings a69fa54 rts/posix: Ensure that memory commit succeeds d6c33da RtClosureInspect: Fix inspecting Char# on 64-bit big-endian 366182a ghci: Include "Rts.h" before using TABLES_NEXT_TO_CODE 9e3add9 Flags.hsc: Peek a CBool (Word8), not a Bool (Int32) aa98268 updateThunk: indirectee can be tagged 21b7057 users-guide: Clarify -ddump-asm-regalloc-stages documentation 6cb4642 Bump ghc-prim to 0.5.2.0 and update changelog ed48d13 Simplify, no functionality change 2f43615 Fix grammaros in comments 317aa96 Improve user’s guide around deriving 74cd1be Don't deeply expand insolubles 5a66d57 Better solving for representational equalities aba7786 Typofix in comment 870020e whitespace only 20ae22b Accept test output for #14350 e023e78 Disable -XRebindableSyntax when running internal GHCi expressions 101a8c7 Error when deriving instances in hs-boot files 8846a7f Fix #14369 by making injectivity warnings finer-grained de8752e Export injectiveVarsOf{Binder,Type} from TyCoRep 7ac22b7 User's guide: Fix the category of some flags 3befc1a Bump arcanist-external-json-linter submodule 1ba2851 Expose monotonic time from GHC.Event.Clock 13758c6 Added a test for 'timeout' to be accurate. 098dc97 Give a reference to Foreign.Concurrent. b6204f7 Untag the potential AP_STACK in stg_getApStackValzh 2ca8cf6 Add Functor Bag instance afc04b2 Outputable: Add pprTraceException c1efc6e Comments and white space 3acd616 Improve kick-out in the constraint solver e375bd3 Update record-wildcard docs 99c61e2 Add stack traces on crashes on Windows bb537b2 nofib submodule: Fix a problem with fasta-c.c 1e24a24 submodule nofib: Add digits-of-e1.faststdout 052ec24 submodule nofib: Add digits-of-e2.faststdout b10a768 Comments only d1eaead Temporary fix to Trac #14380 671b1ed User’s guide: Properly link to RTS flag -V 8843a39 Include usg_file_hash in ghc --show-iface output 3825b7e Remove the 'legroom' part of the timeout-accurate-pure test. b62097d Windows: Bump to GCC 7.2 for GHC 8.4 e888a1f Revert "Windows: Bump to GCC 7.2 for GHC 8.4" 561bdca Update Win32 version for GHC 8.4. f744261 ghc-cabal: Inline removed function from Cabal. 2e16a57 Revert "ghc-cabal: Inline removed function ..." b1ad0bb Revert "Update Win32 version for GHC 8.4." 61f1b46 Make language extensions their own category in the documentation bf83435 typecheck: Clarify errors mentioned in #14385 bd53b48 Add info about Github pull requests. 2a4c24e Make layLeft and reduceDoc stricter (#7258) 980e127 Windows: Update the mirror script to generate hashes and use mirror fallback 1c15d8e Fix space leak in BinIface.getSymbolTable df63668 Performance improvements linear regAlloc (#7258) f7f270e Implement `-Wpartial-fields` warning (#7169) 821adee Fix a bug in 'alexInputPrevChar' 2c23fff user-guide: Clarify default optimization flags 4c06ccb base: Enable listToMaybe to fuse via foldr/build dbd81f7 Factor out readField (#14364) d91a6b6 Declare upstram repo location for hsc2hs 160a491 users-guide: Disable index node generation 9ae24bb configure: Add Alpine Linux to checkVendor a10c2e6 Don't use $SHELL in wrapper scripts 355318c Add more pprTrace to SpecConstr (debug only) 7d7d94f Fix an exponential-blowup case in SpecConstr 41f9055 ApplicativeDo: handle BodyStmt (#12143) acd355a relnotes: Fix a few minor formatting issues faf60e8 Make tagForCon non-linear 922db3d Manual: The -ddump-cmm-* flags had a wrong spelling in the manual 97ca0d2 simplNonRecJoinPoint: Handle Shadowing correctly 0e953da Implement a dedicated exitfication pass #14152 3b784d4 base: Implement file locking in terms of POSIX locks cecd2f2 Add -falignment-sanitization flag 7673561 Turn `compareByteArrays#` out-of-line primop into inline primop 85aa1f4 Fix #14390 by making toIfaceTyCon aware of equality cca2d6b Allow packing constructor fields 82bad1a A bit more tc-tracing 1b115b1 Fix typo in accessor name ec356e8 Typofix in panic 1569668 Typofixes in comments 53700a9 minor wordsmithing 201b5aa Catch a few more typos in comments 609f284 Add Note [Setting the right in-scope set] af0aea9 core-spec: Add join points to formalism 29ae833 Tidy up IfaceEqualityTyCon 1317ba6 Implement the EmptyDataDeriving proposal 1130c67 PPC NCG: Impl branch prediction, atomic ops. b0b80e9 Implement the basics of hex floating point literals e0df569 Use proper Unique for Name b938576 Add custom exception for fixIO 36f0cb7 TcRnDriver: Bracket family instance consistency output in -ddump-rn-trace cbd6a4d Introduce -dsuppress-stg-free-vars flag bd765f4 Fix atomicread/write operations d9b6015 Revert "Move check-ppr and check-api-annotations to testsuite/utils" 51321cf rts/PrimOps.cmm: add declaration for heapOverflow closure 4353756 CmmSink: Use a IntSet instead of a list 15f788f llvmGen: Pass vector arguments in vector registers by default eb37132 Bump haddock submodule 3c8e55c Name TypeRep constructor fields 19ca2ca Deserialize all function TypeReps 5d48f7c Fix documentation and comment issues df479f7 change example from msum to mfilter 436b3ef Clean up comments about match algorithm a bit. f6521e6 testsuite: Bump metrics of haddock.Cabal 4dfb790 rts/win32: Emit exception handler output to stderr 6f990c5 cmm/CBE: Fix comparison between blocks of different lengths a27056f cmm/CBE: Fix a few more zip uses 2ded536 Typo in glasgow_exts.rst 35642f4 Update ErrorCall documentation for the location argument 8613e61 DynFlags: Introduce -show-mods-loaded flag 59de290 Update autoconf test for gcc to require 4.7 and up 66b5b3e Specialise lcm :: Word -> Word -> Word (trac#14424) 275ac8e base: Add examples to Bifunctor documentation 7b0b9f6 Squashed 'hadrian/' content from commit 438dc57 5cee480 Merge commit '7b0b9f603bb1215e2b7af23c2404d637b95a4988' as 'hadrian' 0ff152c WIP on combining Step 1 and 3 of Trees That Grow 7d6fa32 Set up Linux, OSX and FreeBSD on CircleCI. b0cabc9 Set up AppVeyor, Windows CI. 6f665cc Sdist -> bindist -> tests 07e0d0d Revert "Sdist -> bindist -> tests" ed18f47 Factor out builds into steps. Address ghc/ghc#83 comments. ae7c33f testsuite: Bump haddock.compiler allocations 7d34f69 relnotes: Clarify a few things c1bc923 relnotes: Note enabling of -fllvm-pass-vectorse-in-regs 93b4820 Revert "WIP on combining Step 1 and 3 of Trees That Grow" 9f8dde0 Update link to Haskeline user preferences bf9ba7b base: Escape \ in CallStack example 14d885e Merge remote-tracking branch 'github/pr/83' 21970de Imrpove comments about equality types 30058b0 Fix another dark corner in the shortcut solver 2c2f3ce Minimise provided dictionaries in pattern synonyms fe6848f Fix in-scope set in simplifier 438dd1c WIP on Doing a combined Step 1 and 3 for Trees That Grow 803ed03 Invoke lintUnfolding only on top-level unfoldings (#14430) 6bd352a Remove left-overs from compareByteArray# inline conversion 10ff3e3 testsuite: Fix output of T14394 bdd2d28 Update Win32 version for GHC 8.4. 9773053 Merge initial Hadrian snapshot ce9a677 base: Add test for #14425 c59d6da base: Normalize style of approxRational 5834da4 base: Fix #14425 0656cb4 Update comment in GHC.Real (trac#14432) 6b52b4c Remove unreliable Core Lint empty case checks e6b13c9 testsuite: Add test for #5889 75291ab Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` f8e7fec Fix PPC NCG after blockID patch 5229c43 Squashed 'hadrian/' changes from 438dc576e7..5ebb69ae1e 506ba62 Merge commit '5229c43ccf77bcbffeced01dccb27398d017fa34' f11f252 Windows: Bump to GCC 7.2 for GHC 8.4 ba2ae2c Adds cmm-sources to base 426af53 Use LICENSE instead of ../LICENSE in the compiler.cabal file 5f158bc circleci: Bump down thread count 86c50a1 Declare proper spec version in `base.cabal` e3ec2e7 WIP on combined Step 1 and 3 for Trees That Grow, HsExpr 0a85190 Fix a TyVar bug in the flattener f570000 A bit more tc-tracing 47ad657 TTG3 Combined Step 1 and 3 for Trees That Grow f5dc8cc Add new mbmi and mbmi2 compiler flags 6dfe982 StaticPointers: Clarify documentation 5dea62f Adds rts/rts.cabal.in file 8b1020e RTS: Disable warnings in ffi.h ea26162 CLabel: Clean up unused label types 1aba27a CLabels: Remove CaseLabel 383016b Add dump flag for timing output d9f0c24 rts: Fix gc timing d0a641a Allow the rts lib to be called rts-1.0 3bed4aa Cabalify all the things e14945c Adjust AltCon Ord instance to match Core linter requirements. ec080ea users_guide: Fix "CancelSynchronousIo" casing c1fcd9b Squashed 'hadrian/' changes from 5ebb69a..fa3771f 07ac921 Pull recent Hadrian changes from upstream 2f46387 Detect overly long GC sync 2da7813 Document -ddump-timings c729734 configure: Fix incorrect quoting 12a7444 Adds -ghc-version flag to ghc. 835d8dd GHC.Prim use virtual-modules bb11a2d Relocatable GHC 74070bb Fix rts.cabal.in 912a72d Fix T4437 b8e324a base: Make documentation of atomically more accurate 7d16d8a Fix #elfi -> #elif; unbreak -Werror. ca3700a Rename ghc-version -> ghcversion-file 606bbc3 Stop generating make files when using hadrian. e66913d Bump hsc2hs submodule 25f36bd Bump haddock submodule ddded7e ghc-pkg: Add missing newlines to usage message 1b1ba9d rel-notes: Fix up formatting in release notes d213ee8 CircleCI: Disable artifact collection on OS X 66d1799 configure: Fix ar probed flags 0b20d9c base: Document GHC.Stack.CCS internals 314bc31 Revert "trees that grow" work 90a819b CircleCI: Add webhook for Harbormaster builds 2ca2259 Update ANNOUNCE 763ecac rts: Move libdwPrintBacktrace to public interface f376eba rts: Fix inconsistencies in how retainer and heap censuses are timed. 63e4ac3 Add warn-missing-export-lists 8a8a79a Update leftover reference to refer to [FunBind vs PatBind] dad9864 Remove hadrian sub-dir from .gitignore 0db4627 Test Trac #14488 bb2a08e testsuite: Add test for #14257 23116df cmm: Optimise remainders by powers of two eb5a40c base: Remove redundant subtraction in (^) and stimes 7a73a1c Bump stm submodule 2d1c671 ErrUtils: Refactor dump file logic c11f145 ErrUtils: Ensure timing dumps are always output on one line 360d740 Squashed 'hadrian/' changes from fa3771fe6b..4499b294e4 abdb555 Update Hadrian 341013e Revert "Add new mbmi and mbmi2 compiler flags" 5fdb858 Fix README 33cbc9f CircleCI: Perform nightly validation of unregisterised build 866f669 CircleCI: Try validating LLVM as well e2cc106 circleci: Build with Hadrian ad57e28 CircleCI: Install lbzip2 and patch 5e35627 rts/Printer: add closure name entries for small arrays (Fixes #14513) 30aa643 SysTools: Expand occurrences of $topdir anywhere in a Settings path 69cd1e9 SysTools: Split up TopDir logic into new module 599243e DynFlags: Expand $topdir in --info output 99089fc users-guide: Fix :default: placement f209e66 base: fdReady(): Fix timeouts > ~49 days overflowing. Fixes #14262. a1950e6 CircleCI: Reenable artifact collection on Darwin 471d677 Don't complain about UNPACK in -fno-code. 6282366 Follow symlinks in the Win32 code for System.Environment.getExecutablePath b241d6d Add obvious Outputable Integer instance. f713be7 RtsFlags: allow +RTS -K0 00b96b2 boot: Eliminate superfluous output 4efe5fe Check quantification for partial type signatues df1a0c0 typecheck: Consistently use pretty quotes in error messages eb86e86 Don't call alex for Cabal lib during GHC build e4dc2cd relnotes: Rework treatment of included package list 54fda25 base: Rip out old RTS statistics interface 17e71c1 CLabel.labelType: Make catch-all case explicit 048a913 cmm: Use LocalBlockLabel instead of AsmTempLabel to represent blocks 16dd532 CLabel: Refactor pprDynamicLinkerAsmLabel 55e621c nativeGen: Use plusUFMList instead of foldr 7dc82d6 nativeGen: Use foldl' instead of foldl 66c1c8e CLabel: More specific debug output from CLabel d3b80c7 Cmm: Add missing cases for BlockInfoTable 030d9d4 CLabel: A bit of documentation 4c65867 CircleCI: Disallow hscolour 1.24.3 3c0ffd1 CircleCI: Freeze all packages at fixed index state 5b3f33b Minor tweaks to codegens.rst b6428af Comments only: Trac #14511 b6a2691 Bump unix submodule f246d35 Darwin: Set deployment target d672b7f Darwin: Use gmp from homebrew 6998772 Make use of boot TyThings during typechecking. e1fb283 Handle CPP properly in Backpack 12efb23 Add trace injection bc761ad Cache TypeRep kinds aggressively 1acb922 Make the Con and Con' patterns produce evidence cfea745 template-haskell: Rip out FamFlavour 595f60f Fix ghc_packages d6fccfb Bump version to 8.5 30d6373 rts: fix filename case for mingw32 target 1ecbe9c utils/hsc2hs: update submodule 5f332e1 Forward-port changes from GHC 8.2 branch fa29df0 Refactor ConDecl: Trac #14529 e4a1f03 Revert accidental hsc2hs submodule downgrade de20440 Refactor kcHsTyVarBndrs 800009d Improve LiberateCase 5695f46 Occurrrence analysis improvements for NOINLINE functions 7733e44 Rip out hadrian subtree 4335c07 Add hadrian as a submodule 716acbb Improved panic message for zonkTcTyVarToTyVar 8b36ed1 Build only well-kinded types in type checker 8361b2c Fix SigTvs at the kind level abd5db6 Only look for locales of the form LL.VV 21be5bd Fixed misprint 'aqcuired' 6847c6b Improve Control.Monad.guard and Control.Monad.MonadPlus docs 00d7132 Add information about irrefutable pattern Syntax to XStrict. 21cdfe5 Add NOINLINE pragma to hPutStr' 4bfff7a rts: Don't default to single capability when profiled cafe983 Always use the safe open() call 708ed9c Allow users to ignore optimization changes 430d1f6 fdReady: Use C99 bools / CBool in signature 9d29925 base: fdReady(): Return only after sycall returns after `msecs` have passed be1ca0e Add regression test for #14040 a106a20 Minor refactor of TcExpr.tcApp e40db7b Detect levity-polymorphic uses of unsafeCoerce# 321b420 Tidy up of wired-in names aef4dee Add missing stderr for Trac #14561 63e968a Re-centre perf for T5321Fun 0a12d92 Further improvements to well-kinded types 6eb3257 Typofix in comment 6f6d105 Add test for Trac #14580 b1ea047 Fix an outright bug in the unflattener fa1afcd Better tc-trace messages eeb36eb typos in local var 16c7d9d Fix #14135 by validity checking matches d4c8d89 users-guide: Consistently document LLVM version requirement 4a331e6 users-guide: Fix various bits of markup 6814945 Fix tcDataKindSig 3910d3e Add some commentary re: fix to #11203 23b5b80 Add missing case to HsExpr.isMonadFailStmtContext 1e64fc8 Tiny refactor: use mkTyVarNamePairs f1fe5b4 Fix scoping of pattern-synonym existentials fb1f0a4 Blackholes can be large objects (#14497) 0302439 testsuite: Exit with non-zero exit code when tests fail 8c9906c testsuite: Semigroup/Monoid compat for T3001-2 244d144 Typos in comments a100763 Get rid of some stuttering in comments and docs 10ed319 Stop runRW# being magic ff1544d Rmove a call to mkStatePrimTy 71f96bb Sync up ghc-prim changelog from GHC 8.2 branch 1bd91a7 Fix #14578 by checking isCompoundHsType in more places 9caf40e Fix #14588 by checking for more bang patterns 9cb289a Remove hack put in place for #12512 b6304f8 Document ScopedTypeVariables' interaction with nested foralls 4d41e92 Improve treatment of sectioned holes 584cbd4 Simplify HsPatSynDetails 72938f5 Check for bogus quantified tyvars in partial type sigs a492af0 Refactor coercion holes f5cf9d1 Fix floating of equalities bcb519c Typos in comments 05551d0 Comments only [skip ci] fc257e4 Sync `ghc-prim` changelog from GHC 8.2 c88564d MkIface: Ensure syntactic compatibility with ghc 8.0.1 6549706 relnotes: Fix typo in pattern synonym example e237e1f Bump Cabal submodule d7d0aa3 Add GHC 8.6.1 release notes 02aaeab aclocal.m4: add minimal support for nios2 architecture e19b646 Compute InScopeSet in substInteractiveContext 722a658 Fix #14618 by applying a subst in deeplyInstantiate f2db228 Typos in comments [ci skip] 862c59e Rewrite Note [The polymorphism rule of join points] a2e9549 users-guide: Fix markup b31c721 Fix sign error in kelvinToC. 12f5c00 Prevent "C--" translating to "C–" in the User's Guide. 69f1e49 Reformat Control.Monad.mfilter docs a67c264 Add example to Control.Monad.join docs 4887c30 Improve Control.Monad docs 27b7b4d Windows: fix all failing tests. 46287af Make System.IO.openTempFile thread-safe on Windows ecff651 Fix #14608 by restoring an unboxed tuple check 3382ade Rename HEq_sc and Coercible_sc to heq_sel and coercible_sel 2c7b183 Comments only 83b96a4 More informative pretty-printing for phantom coercions f3a0fe2 Comments about join point types 1e12783 Tiny refactor around fillInferResult 3bf910d Small refactoring in Coercion 112266c White space only 9e5535c Fix OptCoercion bd438b2 Get evaluated-ness right in the back end 298ec78 No deferred type errors under a forall 7a25659 Typos in comments 649e777 Make typeToLHsType produce kind signatures for tycon applications 6c34824 Cache the number of data cons in DataTyCon and SumTyCon 954cbc7 Drop dead Given bindings in setImplicationStatus e2998d7 Stop double-stacktrace in ASSERT failures 86ea3b1 comments only 307d1df Fix deep, dark corner of pattern synonyms c732711 Improve pretty-printing for pattern synonyms 40cbab9 Fix another obscure pattern-synonym crash 303106d Make the Div and Mod type families `infixl 7` a1a689d Improve accuracy of get/setAllocationCounter fb78b0d Export typeNat{Div;Mod;Log}TyCon from TcTypeNats 30b1fe2 Remove a bogus warning 66ff794 Fix join-point decision 1c1e46c preInlineUnconditionally is ok for INLINEABLE 448685c Small local refactoring 1577908 Fix two more bugs in partial signatures dbdf77d Lift constructor tag allocation out of a loop f3f90a0 Fix previous patch 6c3eafb KQueue: Fix write notification requests being ignored... b2f10d8 Fix mistaken merge e20046a Support constructor Haddocks in more places a770226 Fix regression on i386 due to get/setAllocationCounter change d1ac1c3 Rename -frule-check to -drule-check and document 492e604 Kill off irrefutable pattern errors 3d17f1f Tweak link order slightly to prefer user shared libs before system ones. 87917a5 Support LIBRARY_PATH and LD_LIBRARY_PATH in rts 9f7edb9 Fix hashbang of gen-data-layout 78306b5 CoreLint: typo in a comment 2feed11 Fix hash in haddock of ghc-prim. 41afbb3 Add flag -fno-it f380115 Parenthesize forall-type args in cvtTypeKind 1bf70b2 Remove executable filename check on windows bc383f2 Simplify guard in createSwitchPlan. 8de8930 configure: Various cleanups cf2c029 Fix quadratic behavior of prepareAlts c65104e Typos in comments 6b1ff00 Fix references to cminusminus.org 1e14fd3 Inform hole substitutions of typeclass constraints (fixes #14273). 8bb150d Revert "Fix regression on i386 due to get/setAllocationCounter change" e1d4140 Revert "Improve accuracy of get/setAllocationCounter" 3335811 cmm: Include braces on default branch as required by the parser 2a78cf7 Remove unused extern cost centre collection 575c009 Fix #14681 and #14682 with precision-aimed parentheses b041a02 Add text dependency 522080a Add pretty-printer dependency 948c1e0 Use prettyprinter 31d8e71 Fix errant newlines 317c9f8 Try something 2752fdd Debugging ghc-pkg 39c6d40 llvmGen: Clean up warning 7a570aa nativeGen: Clean up warning 788523b llvmGen: Fix another 024eed4 Never tick primitive string literals 55a1d46 Hack: Produce latin1 asm output 7d9329e Port to prettyprinter proper 53efa28 Various cleanups 8abc89f More warning cleanups 3295971 Fix hang 19ee8ab Use hardlineCollapse 9b39652 More cleanups From git at git.haskell.org Thu Jan 18 19:20:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 19:20:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Improve treatment of sectioned holes (da83722) Message-ID: <20180118192043.A23D43A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/da83722c503a2f032bf21b386b8021c0794d4176/ghc >--------------------------------------------------------------- commit da83722c503a2f032bf21b386b8021c0794d4176 Author: Ryan Scott Date: Wed Dec 20 19:25:53 2017 -0500 Improve treatment of sectioned holes Previously, GHC was pretty-printing left-section holes incorrectly and not parsing right-sectioned holes at all. This patch fixes both problems. Test Plan: make test TEST=T14590 Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, mpickering, carter GHC Trac Issues: #14590 Differential Revision: https://phabricator.haskell.org/D4273 (cherry picked from commit 4d41e9212d1fdf109f2d0174d204644446f5874c) >--------------------------------------------------------------- da83722c503a2f032bf21b386b8021c0794d4176 compiler/hsSyn/HsExpr.hs | 4 + compiler/parser/Parser.y | 10 +- testsuite/tests/typecheck/should_compile/T14590.hs | 7 + .../tests/typecheck/should_compile/T14590.stderr | 264 +++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 283 insertions(+), 3 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc da83722c503a2f032bf21b386b8021c0794d4176 From git at git.haskell.org Thu Jan 18 19:20:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 19:20:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix hash in haddock of ghc-prim. (f28645c) Message-ID: <20180118192046.6539C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/f28645c04958a2e2ab61239db70478d9dcce6ba6/ghc >--------------------------------------------------------------- commit f28645c04958a2e2ab61239db70478d9dcce6ba6 Author: HE, Tao Date: Mon Jan 15 13:51:15 2018 -0500 Fix hash in haddock of ghc-prim. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14653 Differential Revision: https://phabricator.haskell.org/D4305 (cherry picked from commit 2feed118413944cae8a4eed17365f40521f470db) >--------------------------------------------------------------- f28645c04958a2e2ab61239db70478d9dcce6ba6 compiler/prelude/primops.txt.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index d6c06b1..38617b5 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2621,7 +2621,7 @@ section "Unsafe pointer equality" primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp a -> a -> Int# - { Returns 1# if the given pointers are equal and 0# otherwise. } + { Returns {\texttt 1\#} if the given pointers are equal and {\texttt 0\#} otherwise. } with can_fail = True -- See Note [reallyUnsafePtrEquality#] From git at git.haskell.org Thu Jan 18 19:20:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 19:20:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Inform hole substitutions of typeclass constraints (fixes #14273). (96b52e6) Message-ID: <20180118192050.B701F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/96b52e63b850f8072b905ca232b5644efc011b37/ghc >--------------------------------------------------------------- commit 96b52e63b850f8072b905ca232b5644efc011b37 Author: Matthías Páll Gissurarson Date: Thu Jan 18 00:49:38 2018 -0500 Inform hole substitutions of typeclass constraints (fixes #14273). This implements SPJ's suggestion on the ticket (#14273). We find the relevant constraints (ones that whose free unification variables are all mentioned in the type of the hole), and then clone the free unification variables of the hole and the relevant constraints. We then add a subsumption constraints and run the simplifier, and then check whether all the constraints were solved. Reviewers: bgamari Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14273 Differential Revision: https://phabricator.haskell.org/D4315 (cherry picked from commit 1e14fd3ecfd468c3beddb2e5f992c358e1a798de) >--------------------------------------------------------------- 96b52e63b850f8072b905ca232b5644efc011b37 compiler/typecheck/TcErrors.hs | 271 ++++++++----- compiler/typecheck/TcRnTypes.hs | 13 +- compiler/typecheck/TcSimplify.hs | 16 +- compiler/typecheck/TcSimplify.hs-boot | 6 +- testsuite/tests/ghci/scripts/T8353.stderr | 5 + testsuite/tests/th/T10267.stderr | 5 + testsuite/tests/th/all.T | 2 +- .../tests/typecheck/should_compile/T13050.stderr | 6 + testsuite/tests/typecheck/should_compile/T14273.hs | 13 + .../tests/typecheck/should_compile/T14273.stderr | 80 ++++ .../tests/typecheck/should_compile/T14590.stderr | 10 + .../tests/typecheck/should_compile/T9497a.stderr | 1 + testsuite/tests/typecheck/should_compile/all.T | 1 + .../should_compile/hole_constraints.stderr | 8 +- .../tests/typecheck/should_compile/holes.stderr | 448 ++++++++++++++++++++- .../tests/typecheck/should_compile/holes2.stderr | 24 +- .../tests/typecheck/should_compile/holes3.stderr | 448 ++++++++++++++++++++- .../should_compile/valid_substitutions.hs | 22 +- .../should_compile/valid_substitutions.stderr | 237 ++++++++++- .../valid_substitutions_interactions.hs | 15 + .../valid_substitutions_interactions.stderr | 18 + .../tests/typecheck/should_fail/T9497d.stderr | 1 + .../tests/typecheck/should_run/T9497a-run.stderr | 1 + .../tests/typecheck/should_run/T9497b-run.stderr | 1 + .../tests/typecheck/should_run/T9497c-run.stderr | 1 + 25 files changed, 1498 insertions(+), 155 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 96b52e63b850f8072b905ca232b5644efc011b37 From git at git.haskell.org Thu Jan 18 19:20:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 19:20:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Remove executable filename check on windows (4eccca7) Message-ID: <20180118192053.827833A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/4eccca7e298c08a35f099bd146aedaaf2b853dcf/ghc >--------------------------------------------------------------- commit 4eccca7e298c08a35f099bd146aedaaf2b853dcf Author: klebinger.andreas at gmx.at Date: Mon Jan 15 13:52:15 2018 -0500 Remove executable filename check on windows On Windows GHC enforces currently that the real executable is named ghc.exe/ghc-stage[123].exe. I don't see a good reason why this is neccessary. This patch removes this restriction and fixes #14652 Test Plan: ci Reviewers: bgamari, Phyx Reviewed By: Phyx Subscribers: Phyx, rwbarton, thomie, carter GHC Trac Issues: #14652 Differential Revision: https://phabricator.haskell.org/D4296 (cherry picked from commit 1bf70b2041dc2b7c89565fcb46cad8f151f96790) >--------------------------------------------------------------- 4eccca7e298c08a35f099bd146aedaaf2b853dcf compiler/main/SysTools/BaseDir.hs | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index 343be82..2c264b8 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -34,7 +34,6 @@ import qualified System.Win32.Types as Win32 #else import qualified System.Win32.Info as Win32 #endif -import Data.Char import Exception import Foreign import Foreign.C.String @@ -111,7 +110,7 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. _ | ret < size -> do path <- peekCWString buf real <- getFinalPath path -- try to resolve symlinks paths - let libdir = (rootDir . sanitize . maybe path id) real + let libdir = (buildLibDir . sanitize . maybe path id) real exists <- doesDirectoryExist libdir if exists then return $ Just libdir @@ -126,19 +125,11 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. then drop 4 s else s - rootDir s = case splitFileName $ normalise s of - (d, ghc_exe) - | lower ghc_exe `elem` ["ghc.exe", - "ghc-stage1.exe", - "ghc-stage2.exe", - "ghc-stage3.exe"] -> - case splitFileName $ takeDirectory d of - -- ghc is in $topdir/bin/ghc.exe - (d', _) -> takeDirectory d' "lib" - _ -> fail s + buildLibDir :: FilePath -> FilePath + buildLibDir s = + (takeDirectory . takeDirectory . normalise $ s) "lib" fail s = panic ("can't decompose ghc.exe path: " ++ show s) - lower = map toLower foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 From git at git.haskell.org Thu Jan 18 19:20:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Jan 2018 19:20:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14681 and #14682 with precision-aimed parentheses (33e3b3e) Message-ID: <20180118192057.BED613A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/33e3b3eb55cb6cfa4abc7f57581066779a046626/ghc >--------------------------------------------------------------- commit 33e3b3eb55cb6cfa4abc7f57581066779a046626 Author: Ryan Scott Date: Thu Jan 18 11:06:42 2018 -0500 Fix #14681 and #14682 with precision-aimed parentheses It turns out that `Convert` was recklessly leaving off parentheses in two places: * Negative numeric literals * Patterns in lambda position This patch fixes it by adding three new functions, `isCompoundHsLit`, `isCompoundHsOverLit`, and `isCompoundPat`, and using them in the right places in `Convert`. While I was in town, I also sprinkled `isCompoundPat` among some `Pat`-constructing functions in `HsUtils` to help avoid the likelihood of this problem happening in other places. One of these places is in `TcGenDeriv`, and sprinkling `isCompountPat` there fixes #14682 Test Plan: make test TEST="T14681 T14682" Reviewers: alanz, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14681, #14682 Differential Revision: https://phabricator.haskell.org/D4323 (cherry picked from commit 575c009d9e4b25384ef984c09b2c54f909693e93) >--------------------------------------------------------------- 33e3b3eb55cb6cfa4abc7f57581066779a046626 compiler/hsSyn/Convert.hs | 17 +- compiler/hsSyn/HsLit.hs | 26 +++ compiler/hsSyn/HsPat.hs | 55 ++++++ compiler/hsSyn/HsTypes.hs | 5 +- compiler/hsSyn/HsUtils.hs | 9 +- compiler/typecheck/TcGenDeriv.hs | 6 +- testsuite/tests/deriving/should_compile/T14682.hs | 10 ++ .../tests/deriving/should_compile/T14682.stderr | 194 +++++++++++++++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + testsuite/tests/th/T14681.hs | 9 + testsuite/tests/th/T14681.stderr | 11 ++ testsuite/tests/th/all.T | 1 + 12 files changed, 334 insertions(+), 10 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 33e3b3eb55cb6cfa4abc7f57581066779a046626 From git at git.haskell.org Fri Jan 19 23:46:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Jan 2018 23:46:45 +0000 (UTC) Subject: [commit: ghc] branch 'wip/14691' created Message-ID: <20180119234645.C275B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/14691 Referencing: dacc95cc6647644f6a6c67f7cae39059e80c05ed From git at git.haskell.org Fri Jan 19 23:46:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Jan 2018 23:46:48 +0000 (UTC) Subject: [commit: ghc] wip/14691: wip: type EvTerm = CoreExpr (#14691) (dacc95c) Message-ID: <20180119234648.9ED0C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/dacc95cc6647644f6a6c67f7cae39059e80c05ed/ghc >--------------------------------------------------------------- commit dacc95cc6647644f6a6c67f7cae39059e80c05ed Author: Joachim Breitner Date: Fri Jan 19 18:44:54 2018 -0500 wip: type EvTerm = CoreExpr (#14691) This replaces the constructors with smart constructors. Next steps * copy the actual implementation from DsBinds to TcEvidence (or better, into a separate module EvTerm). * implement zoking for core expressions >--------------------------------------------------------------- dacc95cc6647644f6a6c67f7cae39059e80c05ed compiler/deSugar/Desugar.hs | 2 +- compiler/deSugar/DsBinds.hs | 32 ++++------ compiler/deSugar/DsExpr.hs | 4 +- compiler/deSugar/Match.hs | 4 +- compiler/deSugar/MatchCon.hs | 2 +- compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcCanonical.hs | 22 +++---- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcEvidence.hs | 130 ++++++++++++++++++++------------------ compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 7 +- compiler/typecheck/TcInteract.hs | 36 +++++------ compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 4 +- compiler/typecheck/TcSMonad.hs | 2 +- 15 files changed, 132 insertions(+), 123 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dacc95cc6647644f6a6c67f7cae39059e80c05ed From git at git.haskell.org Sat Jan 20 14:31:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Jan 2018 14:31:31 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: triggering CI for Simon's patch (6546344) Message-ID: <20180120143131.A16853A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/6546344f0952e9c82e92cc2b6b51fa7951c3c6c0/ghc >--------------------------------------------------------------- commit 6546344f0952e9c82e92cc2b6b51fa7951c3c6c0 Author: Gabor Greif Date: Wed Jan 17 14:47:00 2018 +0100 WIP: triggering CI for Simon's patch >--------------------------------------------------------------- 6546344f0952e9c82e92cc2b6b51fa7951c3c6c0 compiler/codeGen/StgCmmClosure.hs | 8 ++++++++ compiler/coreSyn/CoreOpt.hs | 20 +++++++++++++++++++- compiler/prelude/PrelRules.hs | 9 ++------- 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1da1f70..1736bba 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,6 +68,8 @@ module StgCmmClosure ( import GhcPrelude +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import SMRep import Cmm @@ -326,6 +328,11 @@ mkLFImported id -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor + | isValueUnfolding unf + , Just expr <- maybeUnfoldingTemplate unf + , Just con <- exprIsSatConApp_maybe expr + = LFCon con + | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") @@ -333,6 +340,7 @@ mkLFImported id = mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id + unf = realIdUnfolding id ------------- mkLFStringLit :: LambdaFormInfo diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 0f35e8f..f144e06 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -12,7 +12,8 @@ module CoreOpt ( joinPointBinding_maybe, joinPointBindings_maybe, -- ** Predicates on expressions - exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, + exprIsConApp_maybe, exprIsLiteral_maybe, + exprIsLambda_maybe, exprIsSatConApp_maybe, -- ** Coercions and casts pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo @@ -791,6 +792,23 @@ exprIsConApp_maybe (in_scope, id_unf) expr extend (Right s) v e = Right (extendSubst s v e) +exprIsSatConApp_maybe :: CoreExpr -> Maybe DataCon +-- Returns (Just dc) for a saturated application of dc +-- Simpler than exprIsConApp_maybe +exprIsSatConApp_maybe e = go 0 e + where + go :: Arity -> CoreExpr -> Maybe DataCon + go n_val_args (Var v) + | Just dc <- isDataConWorkId_maybe v + , dataConRepArity dc == n_val_args + = Just dc + go n_val_args (App f a) + | isTypeArg a = go n_val_args f + | otherwise = go (n_val_args + 1) f + go n_val_args (Cast e _) = go n_val_args e + go n_val_args (Tick _ e) = go n_val_args e + go _ _ = Nothing + -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion -> Maybe (DataCon, [Type], [CoreExpr]) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index db79589..3e9899f 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -33,7 +33,7 @@ import CoreSyn import MkCore import Id import Literal -import CoreOpt ( exprIsLiteral_maybe ) +import CoreOpt ( exprIsLiteral_maybe, exprIsSatConApp_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim @@ -41,7 +41,6 @@ import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon , unwrapNewTyCon_maybe, tyConDataCons ) import DataCon ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId ) import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) -import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) import PrelNames @@ -695,9 +694,6 @@ removeOp32 = do getArgs :: RuleM [CoreExpr] getArgs = RuleM $ \_ _ args -> Just args -getInScopeEnv :: RuleM InScopeEnv -getInScopeEnv = RuleM $ \_ iu _ -> Just iu - -- return the n-th argument of this rule, if it is a literal -- argument indices start from 0 getLiteral :: Int -> RuleM Literal @@ -916,8 +912,7 @@ dataToTagRule = a `mplus` b b = do dflags <- getDynFlags [_, val_arg] <- getArgs - in_scope <- getInScopeEnv - (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg + dc <- liftMaybe $ exprIsSatConApp_maybe val_arg ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return () return $ mkIntVal dflags (toInteger (dataConTagZ dc)) From git at git.haskell.org Sat Jan 20 14:31:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Jan 2018 14:31:34 +0000 (UTC) Subject: [commit: ghc] wip/T14677's head updated: WIP: triggering CI for Simon's patch (6546344) Message-ID: <20180120143134.111F03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14677' now includes: 6b1ff00 Fix references to cminusminus.org 1e14fd3 Inform hole substitutions of typeclass constraints (fixes #14273). 8bb150d Revert "Fix regression on i386 due to get/setAllocationCounter change" e1d4140 Revert "Improve accuracy of get/setAllocationCounter" 3335811 cmm: Include braces on default branch as required by the parser 2a78cf7 Remove unused extern cost centre collection 575c009 Fix #14681 and #14682 with precision-aimed parentheses 6546344 WIP: triggering CI for Simon's patch From git at git.haskell.org Sat Jan 20 15:17:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Jan 2018 15:17:57 +0000 (UTC) Subject: [commit: ghc] wip/14691: Implement the pure evTerm smart constructors (9bc184a) Message-ID: <20180120151757.DB2203A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/9bc184af3a8b9e31591cde36d6cf64dac7710174/ghc >--------------------------------------------------------------- commit 9bc184af3a8b9e31591cde36d6cf64dac7710174 Author: Joachim Breitner Date: Sat Jan 20 10:15:42 2018 -0500 Implement the pure evTerm smart constructors and move some of them with heavier dependencies to TcEvTerm (otherwise we’d get module import cycles). >--------------------------------------------------------------- 9bc184af3a8b9e31591cde36d6cf64dac7710174 compiler/ghc.cabal.in | 1 + compiler/typecheck/TcCanonical.hs | 1 + compiler/typecheck/TcErrors.hs | 1 + compiler/typecheck/TcEvTerm.hs | 43 ++++++++++++++++++++++++++ compiler/typecheck/TcEvidence.hs | 65 +++++++++++---------------------------- compiler/typecheck/TcInteract.hs | 1 + 6 files changed, 65 insertions(+), 47 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 1e3447b..d4387cb 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -471,6 +471,7 @@ Library TcTypeable TcType TcEvidence + TcEvTerm TcUnify TcInteract TcCanonical diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 87d45f2..1a5a4fd 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -19,6 +19,7 @@ import Type import TcFlatten import TcSMonad import TcEvidence +import TcEvTerm import Class import TyCon import TyCoRep -- cleverly decomposes types, good for completeness checking diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 37db63f..2f8f4cf 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -31,6 +31,7 @@ import TyCon import Class import DataCon import TcEvidence +import TcEvTerm import HsExpr ( UnboundVar(..) ) import HsBinds ( PatSynBind(..) ) import Name diff --git a/compiler/typecheck/TcEvTerm.hs b/compiler/typecheck/TcEvTerm.hs new file mode 100644 index 0000000..c1eb117 --- /dev/null +++ b/compiler/typecheck/TcEvTerm.hs @@ -0,0 +1,43 @@ +-- | Smart constructors for EvTerm +-- (those who have too heavy dependencies for TcEvidence) +module TcEvTerm + ( evDelayedError, evLit, evCallStack, evTypeable) + +where + +import GhcPrelude + +import FastString +import Var +import Type +import CoreSyn +import CoreUtils +import Class ( classSCSelId ) +import Id ( isEvVar ) +import CoreFVs ( exprSomeFreeVars ) +import MkCore ( tYPE_ERROR_ID ) +import Literal ( Literal(..) ) +import TcEvidence + +-- Used with Opt_DeferTypeErrors +-- See Note [Deferring coercion errors to runtime] +-- in TcSimplify +evDelayedError :: Type -> FastString -> EvTerm +evDelayedError ty msg + = Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg] + where + errorId = tYPE_ERROR_ID + litMsg = Lit (MachStr (fastStringToByteString msg)) + +-- Dictionary for KnownNat and KnownSymbol classes. +-- Note [KnownNat & KnownSymbol and EvLit] +evLit :: EvLit -> EvTerm +evLit = undefined + +-- Dictionary for CallStack implicit parameters +evCallStack :: EvCallStack -> EvTerm +evCallStack = undefined + +-- Dictionary for (Typeable ty) +evTypeable :: Type -> EvTypeable -> EvTerm +evTypeable = undefined diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index faf8650..02e1699 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -20,8 +20,7 @@ module TcEvidence ( -- EvTerm (already a CoreExpr) EvTerm, - evId, evCoercion, evCast, evDFunApp, evDelayedError, evSuperClass, - evLit, evCallStack, evTypeable, evSelector, + evId, evCoercion, evCast, evDFunApp, evSuperClass, evSelector, mkEvCast, evVarsOfTerm, mkEvScSelectors, EvLit(..), evTermCoercion, @@ -64,8 +63,10 @@ import Name import Pair import CoreSyn -import Id (isEvVar) -import CoreFVs (exprSomeFreeVars) +import CoreUtils +import Class ( classSCSelId ) +import Id ( isEvVar ) +import CoreFVs ( exprSomeFreeVars ) import Util import Bag @@ -482,57 +483,43 @@ mkGivenEvBind ev tm = EvBind { eb_is_given = True, eb_lhs = ev, eb_rhs = tm } type EvTerm = CoreExpr --- An EvTerm is (usually) constructed by any of these smart constructors: +-- An EvTerm is (usually) constructed by any of the constructors here +-- and those more complicates ones who were moved to module TcEvTerm -- | Any sort of evidence Id, including coercions evId :: EvId -> EvTerm -evId eid = undefined +evId = Var -- coercion bindings -- See Note [Coercion evidence terms] evCoercion :: TcCoercion -> EvTerm -evCoercion tc = undefined - +evCoercion = Coercion -- | d |> co evCast :: EvTerm -> TcCoercion -> EvTerm -evCast et tc = undefined +evCast et tc | isReflCo tc = et + | otherwise = Cast et tc -- Dictionary instance application evDFunApp :: DFunId -> [Type] -> [EvTerm] -> EvTerm -evDFunApp dfunid tys ets = undefined - --- Used with Opt_DeferTypeErrors --- See Note [Deferring coercion errors to runtime] --- in TcSimplify -evDelayedError :: Type -> FastString -> EvTerm -evDelayedError = undefined +evDFunApp df tys ets = Var df `mkTyApps` tys `mkApps` ets -- n'th superclass. Used for both equalities and -- dictionaries, even though the former have no -- selector Id. We count up from _0_ evSuperClass :: EvTerm -> Int -> EvTerm -evSuperClass = undefined - --- Dictionary for KnownNat and KnownSymbol classes. --- Note [KnownNat & KnownSymbol and EvLit] -evLit :: EvLit -> EvTerm -evLit = undefined - --- Dictionary for CallStack implicit parameters -evCallStack :: EvCallStack -> EvTerm -evCallStack = undefined - --- Dictionary for (Typeable ty) -evTypeable :: Type -> EvTypeable -> EvTerm -evTypeable = undefined +evSuperClass d n = Var sc_sel_id `mkTyApps` tys `App` d + where + (cls, tys) = getClassPredTys (exprType d) + sc_sel_id = classSCSelId cls n -- Zero-indexed -- Selector id plus the types at which it -- should be instantiated, used for HasField -- dictionaries; see Note [HasField instances] -- in TcInterface evSelector :: Id -> [Type] -> [EvTerm] -> EvTerm -evSelector = undefined +evSelector sel_id tys tms = Var sel_id `mkTyApps` tys `mkApps` tms + -- | Instructions on how to make a 'Typeable' dictionary. -- See Note [Typeable evidence terms] @@ -830,9 +817,6 @@ evTermCoercion tm = pprPanic "evTermCoercion" (ppr tm) evVarsOfTerm :: EvTerm -> VarSet evVarsOfTerm = exprSomeFreeVars isEvVar -evVarsOfTerms :: [EvTerm] -> VarSet -evVarsOfTerms = mapUnionVarSet evVarsOfTerm - -- | Do SCC analysis on a bag of 'EvBind's. sccEvBinds :: Bag EvBind -> [SCC EvBind] sccEvBinds bs = stronglyConnCompFromEdgedVerticesUniq edges @@ -848,19 +832,6 @@ sccEvBinds bs = stronglyConnCompFromEdgedVerticesUniq edges -- is still deterministic even if the edges are in nondeterministic order -- as explained in Note [Deterministic SCC] in Digraph. -evVarsOfCallStack :: EvCallStack -> VarSet -evVarsOfCallStack cs = case cs of - EvCsEmpty -> emptyVarSet - EvCsPushCall _ _ tm -> evVarsOfTerm tm - -evVarsOfTypeable :: EvTypeable -> VarSet -evVarsOfTypeable ev = - case ev of - EvTypeableTyCon _ e -> mapUnionVarSet evVarsOfTerm e - EvTypeableTyApp e1 e2 -> evVarsOfTerms [e1,e2] - EvTypeableTrFun e1 e2 -> evVarsOfTerms [e1,e2] - EvTypeableTyLit e -> evVarsOfTerm e - {- ************************************************************************ * * diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 9dc2fff..7af3d04 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -47,6 +47,7 @@ import FamInstEnv import Unify ( tcUnifyTyWithTFs ) import TcEvidence +import TcEvTerm import Outputable import TcRnTypes From git at git.haskell.org Sat Jan 20 15:42:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Jan 2018 15:42:18 +0000 (UTC) Subject: [commit: ghc] wip/14691: Implement evLit (70cbf28) Message-ID: <20180120154218.83FCD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/70cbf288e46f3b1a49257c1e48af2f24a5512b15/ghc >--------------------------------------------------------------- commit 70cbf288e46f3b1a49257c1e48af2f24a5512b15 Author: Joachim Breitner Date: Sat Jan 20 10:32:38 2018 -0500 Implement evLit but really, the whole EvLit data type is now obsolete, as it just defers the construction of Core from matchKnownSymbol to makeLitDict. >--------------------------------------------------------------- 70cbf288e46f3b1a49257c1e48af2f24a5512b15 compiler/typecheck/TcEvTerm.hs | 13 +++++-------- compiler/typecheck/TcInteract.hs | 6 ++++-- compiler/typecheck/TcSMonad.hs | 3 +++ 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcEvTerm.hs b/compiler/typecheck/TcEvTerm.hs index c1eb117..ea1cab7 100644 --- a/compiler/typecheck/TcEvTerm.hs +++ b/compiler/typecheck/TcEvTerm.hs @@ -8,16 +8,12 @@ where import GhcPrelude import FastString -import Var import Type import CoreSyn -import CoreUtils -import Class ( classSCSelId ) -import Id ( isEvVar ) -import CoreFVs ( exprSomeFreeVars ) -import MkCore ( tYPE_ERROR_ID ) +import MkCore ( tYPE_ERROR_ID, mkStringExprFS, mkNaturalExpr ) import Literal ( Literal(..) ) import TcEvidence +import HscTypes -- Used with Opt_DeferTypeErrors -- See Note [Deferring coercion errors to runtime] @@ -31,8 +27,9 @@ evDelayedError ty msg -- Dictionary for KnownNat and KnownSymbol classes. -- Note [KnownNat & KnownSymbol and EvLit] -evLit :: EvLit -> EvTerm -evLit = undefined +evLit :: MonadThings m => EvLit -> m EvTerm +evLit (EvNum n) = mkNaturalExpr n +evLit (EvStr n) = mkStringExprFS n -- Dictionary for CallStack implicit parameters evCallStack :: EvCallStack -> EvTerm diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 7af3d04..353851d 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2588,8 +2588,10 @@ makeLitDict clas ty el $ idType meth -- forall n. KnownNat n => SNat n , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty] -- SNat n ~ Integer - , let ev_tm = mkEvCast (evLit el) (mkTcSymCo (mkTcTransCo co_dict co_rep)) - = return $ GenInst { lir_new_theta = [] + = do + litExpr <- evLit el + let ev_tm = mkEvCast (litExpr :: EvTerm) (mkTcSymCo (mkTcTransCo co_dict co_rep)) + return $ GenInst { lir_new_theta = [] , lir_mk_ev = \_ -> ev_tm , lir_safe_over = True } diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index f7a2561..196ee27 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -2385,6 +2385,9 @@ instance MonadFail.MonadFail TcS where instance MonadUnique TcS where getUniqueSupplyM = wrapTcS getUniqueSupplyM +instance MonadThings TcS where + lookupThing n = wrapTcS (lookupThing n) + -- Basic functionality -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ wrapTcS :: TcM a -> TcS a From git at git.haskell.org Sat Jan 20 15:42:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Jan 2018 15:42:21 +0000 (UTC) Subject: [commit: ghc] wip/14691: With EvTerm = CoreExpr, there is no need for a EvLit data type (0dfb778) Message-ID: <20180120154221.4F66C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/0dfb7787e14f1f6879fd31762bc31c05097ad47a/ghc >--------------------------------------------------------------- commit 0dfb7787e14f1f6879fd31762bc31c05097ad47a Author: Joachim Breitner Date: Sat Jan 20 10:38:26 2018 -0500 With EvTerm = CoreExpr, there is no need for a EvLit data type >--------------------------------------------------------------- 0dfb7787e14f1f6879fd31762bc31c05097ad47a compiler/typecheck/TcEvTerm.hs | 11 ++----- compiler/typecheck/TcEvidence.hs | 60 +---------------------------------- compiler/typecheck/TcInteract.hs | 68 +++++++++++++++++++++++++++++++++++----- 3 files changed, 63 insertions(+), 76 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0dfb7787e14f1f6879fd31762bc31c05097ad47a From git at git.haskell.org Sat Jan 20 19:03:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Jan 2018 19:03:51 +0000 (UTC) Subject: [commit: ghc] wip/14691: Checkpoint zonkCoreExpr (0b20598) Message-ID: <20180120190351.EB46D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/0b2059823daf33bd656c3e0618daef260ecbedea/ghc >--------------------------------------------------------------- commit 0b2059823daf33bd656c3e0618daef260ecbedea Author: Joachim Breitner Date: Sat Jan 20 14:03:22 2018 -0500 Checkpoint zonkCoreExpr >--------------------------------------------------------------- 0b2059823daf33bd656c3e0618daef260ecbedea compiler/typecheck/TcHsSyn.hs | 57 ++++++++++++++++++++++++++++++++++++------- 1 file changed, 48 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index d56416c..e0d4bc0 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -71,6 +71,7 @@ import Bag import Outputable import Util import UniqFM +import CoreSyn import Control.Monad import Data.List ( partition ) @@ -952,7 +953,7 @@ zonkCoFn env (WpCast co) = do { co' <- zonkCoToCo env co ; return (env, WpCast co') } zonkCoFn env (WpEvLam ev) = do { (env', ev') <- zonkEvBndrX env ev ; return (env', WpEvLam ev') } -zonkCoFn env (WpEvApp arg) = do { arg' <- zonkEvTerm env arg +zonkCoFn env (WpEvApp arg) = do { arg' <- zonkCoreExpr env arg ; return (env, WpEvApp arg') } zonkCoFn env (WpTyLam tv) = ASSERT( isImmutableTyVar tv ) do { (env', tv') <- zonkTyBndrX env tv @@ -1419,7 +1420,45 @@ zonkVect _ (HsVectInstIn _) = panic "TcHsSyn.zonkVect: HsVectInstIn" ************************************************************************ -} -zonkEvTerm env et = error "zonkEvTerm" +zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr +zonkCoreExpr env (Var v) + | isCoVar v + = Coercion <$> zonkCoVarOcc env v + | otherwise + = return (Var $ zonkIdOcc env v) +zonkCoreExpr _ (Lit l) + = return $ Lit l +zonkCoreExpr env (Coercion co) + = Coercion <$> zonkCoToCo env co +zonkCoreExpr env (App e1 e2) + = App <$> zonkCoreExpr env e1 <*> zonkCoreExpr env e2 +zonkCoreExpr env (Lam v e) + = do v' <- zonkIdBndr env v + let env1 = extendIdZonkEnv1 env v' + Lam v' <$> zonkCoreExpr env1 e +zonkCoreExpr env (Let bind e) + = do (env1, bind') <- zonkCoreBind env bind + Let bind'<$> zonkCoreExpr env1 e + +zonkCoreBind :: ZonkEnv -> CoreBind -> TcM (ZonkEnv, CoreBind) +zonkCoreBind env (NonRec v e) + = do v' <- zonkIdBndr env v + e' <- zonkCoreExpr env e + let env1 = extendIdZonkEnv1 env v' + return (env1, NonRec v' e') +zonkCoreBind env (Rec pairs) + = do (env1, pairs') <- fixM go + return (env1, Rec pairs') + where + go ~(_, new_pairs) = do + let env1 = extendIdZonkEnvRec env (map fst new_pairs) + pairs' <- mapM (zonkCorePair env1) pairs + return (env1, pairs') + +zonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr) +zonkCorePair env (v,e) = (,) <$> zonkIdBndr env v <*> zonkCoreExpr env e + + {- zonkEvTerm :: ZonkEnv -> EvTerm -> TcM EvTerm zonkEvTerm env (EvId v) = ASSERT2( isId v, ppr v ) @@ -1459,18 +1498,18 @@ zonkEvTerm env (EvSelector sel_id tys tms) zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable zonkEvTypeable env (EvTypeableTyCon tycon e) - = do { e' <- mapM (zonkEvTerm env) e + = do { e' <- mapM (zonkCoreExpr env) e ; return $ EvTypeableTyCon tycon e' } zonkEvTypeable env (EvTypeableTyApp t1 t2) - = do { t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 + = do { t1' <- zonkCoreExpr env t1 + ; t2' <- zonkCoreExpr env t2 ; return (EvTypeableTyApp t1' t2') } zonkEvTypeable env (EvTypeableTrFun t1 t2) - = do { t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 + = do { t1' <- zonkCoreExpr env t1 + ; t2' <- zonkCoreExpr env t2 ; return (EvTypeableTrFun t1' t2') } zonkEvTypeable env (EvTypeableTyLit t1) - = do { t1' <- zonkEvTerm env t1 + = do { t1' <- zonkCoreExpr env t1 ; return (EvTypeableTyLit t1') } zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds]) @@ -1513,7 +1552,7 @@ zonkEvBind env bind@(EvBind { eb_lhs = var, eb_rhs = term }) ; term' <- case getEqPredTys_maybe (idType var') of Just (r, ty1, ty2) | ty1 `eqType` ty2 -> return (evCoercion (mkTcReflCo r ty1)) - _other -> zonkEvTerm env term + _other -> zonkCoreExpr env term ; return (bind { eb_lhs = var', eb_rhs = term' }) } From git at git.haskell.org Sun Jan 21 13:39:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 13:39:18 +0000 (UTC) Subject: [commit: ghc] wip/14691: Implement zonkCoreExpr (2a4c06b) Message-ID: <20180121133918.CF0FE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/2a4c06be668091182f36377f076a48925a6f2cb5/ghc >--------------------------------------------------------------- commit 2a4c06be668091182f36377f076a48925a6f2cb5 Author: Joachim Breitner Date: Sat Jan 20 14:03:22 2018 -0500 Implement zonkCoreExpr >--------------------------------------------------------------- 2a4c06be668091182f36377f076a48925a6f2cb5 compiler/typecheck/TcHsSyn.hs | 117 +++++++++++++++++++++++------------------- 1 file changed, 63 insertions(+), 54 deletions(-) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index d56416c..d1d58aa 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -71,6 +71,7 @@ import Bag import Outputable import Util import UniqFM +import CoreSyn import Control.Monad import Data.List ( partition ) @@ -952,7 +953,7 @@ zonkCoFn env (WpCast co) = do { co' <- zonkCoToCo env co ; return (env, WpCast co') } zonkCoFn env (WpEvLam ev) = do { (env', ev') <- zonkEvBndrX env ev ; return (env', WpEvLam ev') } -zonkCoFn env (WpEvApp arg) = do { arg' <- zonkEvTerm env arg +zonkCoFn env (WpEvApp arg) = do { arg' <- zonkCoreExpr env arg ; return (env, WpEvApp arg') } zonkCoFn env (WpTyLam tv) = ASSERT( isImmutableTyVar tv ) do { (env', tv') <- zonkTyBndrX env tv @@ -1419,59 +1420,67 @@ zonkVect _ (HsVectInstIn _) = panic "TcHsSyn.zonkVect: HsVectInstIn" ************************************************************************ -} -zonkEvTerm env et = error "zonkEvTerm" -{- -zonkEvTerm :: ZonkEnv -> EvTerm -> TcM EvTerm -zonkEvTerm env (EvId v) = ASSERT2( isId v, ppr v ) - zonkEvVarOcc env v -zonkEvTerm env (EvCoercion co) = do { co' <- zonkCoToCo env co - ; return (EvCoercion co') } -zonkEvTerm env (EvCast tm co) = do { tm' <- zonkEvTerm env tm - ; co' <- zonkCoToCo env co - ; return (mkEvCast tm' co') } -zonkEvTerm _ (EvLit l) = return (EvLit l) - -zonkEvTerm env (EvTypeable ty ev) = - do { ev' <- zonkEvTypeable env ev - ; ty' <- zonkTcTypeToType env ty - ; return (EvTypeable ty' ev') } -zonkEvTerm env (EvCallStack cs) - = case cs of - EvCsEmpty -> return (EvCallStack cs) - EvCsPushCall n l tm -> do { tm' <- zonkEvTerm env tm - ; return (EvCallStack (EvCsPushCall n l tm')) } - -zonkEvTerm env (EvSuperClass d n) = do { d' <- zonkEvTerm env d - ; return (EvSuperClass d' n) } -zonkEvTerm env (EvDFunApp df tys tms) - = do { tys' <- zonkTcTypeToTypes env tys - ; tms' <- mapM (zonkEvTerm env) tms - ; return (EvDFunApp (zonkIdOcc env df) tys' tms') } -zonkEvTerm env (EvDelayedError ty msg) - = do { ty' <- zonkTcTypeToType env ty - ; return (EvDelayedError ty' msg) } -zonkEvTerm env (EvSelector sel_id tys tms) - = do { sel_id' <- zonkIdBndr env sel_id - ; tys' <- zonkTcTypeToTypes env tys - ; tms' <- mapM (zonkEvTerm env) tms - ; return (EvSelector sel_id' tys' tms') } --} +zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr +zonkCoreExpr env (Var v) + | isCoVar v + = Coercion <$> zonkCoVarOcc env v + | otherwise + = return (Var $ zonkIdOcc env v) +zonkCoreExpr _ (Lit l) + = return $ Lit l +zonkCoreExpr env (Coercion co) + = Coercion <$> zonkCoToCo env co +zonkCoreExpr env (Type ty) + = Type <$> zonkTcTypeToType env ty + +zonkCoreExpr env (Cast e co) + = Cast <$> zonkCoreExpr env e <*> zonkCoToCo env co +zonkCoreExpr env (Tick t e) + = Tick t <$> zonkCoreExpr env e -- Do we need to zonk in ticks? + +zonkCoreExpr env (App e1 e2) + = App <$> zonkCoreExpr env e1 <*> zonkCoreExpr env e2 +zonkCoreExpr env (Lam v e) + = do v' <- zonkIdBndr env v + let env1 = extendIdZonkEnv1 env v' + Lam v' <$> zonkCoreExpr env1 e +zonkCoreExpr env (Let bind e) + = do (env1, bind') <- zonkCoreBind env bind + Let bind'<$> zonkCoreExpr env1 e +zonkCoreExpr env (Case scrut b ty alts) + = do scrut' <- zonkCoreExpr env scrut + ty' <- zonkTcTypeToType env ty + b' <- zonkIdBndr env b + let env1 = extendIdZonkEnv1 env b' + alts' <- mapM (zonkCoreAlt env1) alts + return $ Case scrut' b' ty' alts' + +zonkCoreAlt :: ZonkEnv -> CoreAlt -> TcM CoreAlt +zonkCoreAlt env (dc, pats, rhs) + = do pats' <- mapM (zonkIdBndr env) pats + let env1 = extendZonkEnv env pats' + rhs' <- zonkCoreExpr env1 rhs + return $ (dc, pats', rhs') + +zonkCoreBind :: ZonkEnv -> CoreBind -> TcM (ZonkEnv, CoreBind) +zonkCoreBind env (NonRec v e) + = do v' <- zonkIdBndr env v + e' <- zonkCoreExpr env e + let env1 = extendIdZonkEnv1 env v' + return (env1, NonRec v' e') +zonkCoreBind env (Rec pairs) + = do (env1, pairs') <- fixM go + return (env1, Rec pairs') + where + go ~(_, new_pairs) = do + let env1 = extendIdZonkEnvRec env (map fst new_pairs) + pairs' <- mapM (zonkCorePair env1) pairs + return (env1, pairs') + +zonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr) +zonkCorePair env (v,e) = (,) <$> zonkIdBndr env v <*> zonkCoreExpr env e + -zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable -zonkEvTypeable env (EvTypeableTyCon tycon e) - = do { e' <- mapM (zonkEvTerm env) e - ; return $ EvTypeableTyCon tycon e' } -zonkEvTypeable env (EvTypeableTyApp t1 t2) - = do { t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTyApp t1' t2') } -zonkEvTypeable env (EvTypeableTrFun t1 t2) - = do { t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTrFun t1' t2') } -zonkEvTypeable env (EvTypeableTyLit t1) - = do { t1' <- zonkEvTerm env t1 - ; return (EvTypeableTyLit t1') } zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds]) zonkTcEvBinds_s env bs = do { (env, bs') <- mapAccumLM zonk_tc_ev_binds env bs @@ -1513,7 +1522,7 @@ zonkEvBind env bind@(EvBind { eb_lhs = var, eb_rhs = term }) ; term' <- case getEqPredTys_maybe (idType var') of Just (r, ty1, ty2) | ty1 `eqType` ty2 -> return (evCoercion (mkTcReflCo r ty1)) - _other -> zonkEvTerm env term + _other -> zonkCoreExpr env term ; return (bind { eb_lhs = var', eb_rhs = term' }) } From git at git.haskell.org Sun Jan 21 14:03:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 14:03:37 +0000 (UTC) Subject: [commit: ghc] wip/14691: Implement evCallStack (e99186f) Message-ID: <20180121140337.9E83D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/e99186f4d0043254db457a50853acfac824dc11b/ghc >--------------------------------------------------------------- commit e99186f4d0043254db457a50853acfac824dc11b Author: Joachim Breitner Date: Sun Jan 21 09:03:00 2018 -0500 Implement evCallStack >--------------------------------------------------------------- e99186f4d0043254db457a50853acfac824dc11b compiler/deSugar/DsBinds.hs | 47 +------------------------------------ compiler/typecheck/TcCanonical.hs | 3 ++- compiler/typecheck/TcEvTerm.hs | 49 +++++++++++++++++++++++++++++++++++---- compiler/typecheck/TcSMonad.hs | 4 ++++ 4 files changed, 52 insertions(+), 51 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 55765f3..b87d5ad 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1307,6 +1307,7 @@ tyConRep tc ; return (Var tc_rep_id) } | otherwise = pprPanic "tyConRep" (ppr tc) +-} {- Note [Memoising typeOf] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1317,49 +1318,3 @@ the proxy argument. This is what went wrong in #3245 and #9203. So we help GHC by manually keeping the 'rep' *outside* the lambda. -} - -{-********************************************************************** -* * - Desugaring EvCallStack evidence -* * -**********************************************************************-} - -dsEvCallStack :: EvCallStack -> DsM CoreExpr --- See Note [Overview of implicit CallStacks] in TcEvidence.hs -dsEvCallStack cs = do - df <- getDynFlags - m <- getModule - srcLocDataCon <- dsLookupDataCon srcLocDataConName - let mkSrcLoc l = - liftM (mkCoreConApps srcLocDataCon) - (sequence [ mkStringExprFS (unitIdFS $ moduleUnitId m) - , mkStringExprFS (moduleNameFS $ moduleName m) - , mkStringExprFS (srcSpanFile l) - , return $ mkIntExprInt df (srcSpanStartLine l) - , return $ mkIntExprInt df (srcSpanStartCol l) - , return $ mkIntExprInt df (srcSpanEndLine l) - , return $ mkIntExprInt df (srcSpanEndCol l) - ]) - - emptyCS <- Var <$> dsLookupGlobalId emptyCallStackName - - pushCSVar <- dsLookupGlobalId pushCallStackName - let pushCS name loc rest = - mkCoreApps (Var pushCSVar) [mkCoreTup [name, loc], rest] - - let mkPush name loc tm = do - nameExpr <- mkStringExprFS name - locExpr <- mkSrcLoc loc - case tm of - EvCallStack EvCsEmpty -> return (pushCS nameExpr locExpr emptyCS) - _ -> do tmExpr <- dsEvTerm tm - -- at this point tmExpr :: IP sym CallStack - -- but we need the actual CallStack to pass to pushCS, - -- so we use unwrapIP to strip the dictionary wrapper - -- See Note [Overview of implicit CallStacks] - let ip_co = unwrapIP (exprType tmExpr) - return (pushCS nameExpr locExpr (mkCastDs tmExpr ip_co)) - case cs of - EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm - EvCsEmpty -> return emptyCS --} diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 1a5a4fd..0b85567 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -172,7 +172,8 @@ solveCallStack ev ev_cs = do -- We're given ev_cs :: CallStack, but the evidence term should be a -- dictionary, so we have to coerce ev_cs to a dictionary for -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] - let ev_tm = mkEvCast (evCallStack ev_cs) (wrapIP (ctEvPred ev)) + cs_tm <- evCallStack ev_cs + let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) setWantedEvBind (ctEvEvId ev) ev_tm canClass :: CtEvidence diff --git a/compiler/typecheck/TcEvTerm.hs b/compiler/typecheck/TcEvTerm.hs index f79b742..7e148f6 100644 --- a/compiler/typecheck/TcEvTerm.hs +++ b/compiler/typecheck/TcEvTerm.hs @@ -1,4 +1,4 @@ --- | Smart constructors for EvTerm + -- (those who have too heavy dependencies for TcEvidence) module TcEvTerm ( evDelayedError, evCallStack, evTypeable) @@ -10,9 +10,16 @@ import GhcPrelude import FastString import Type import CoreSyn -import MkCore ( tYPE_ERROR_ID ) +import MkCore import Literal ( Literal(..) ) import TcEvidence +import HscTypes +import DynFlags +import Name +import Module +import CoreUtils +import PrelNames +import SrcLoc -- Used with Opt_DeferTypeErrors -- See Note [Deferring coercion errors to runtime] @@ -25,8 +32,42 @@ evDelayedError ty msg litMsg = Lit (MachStr (fastStringToByteString msg)) -- Dictionary for CallStack implicit parameters -evCallStack :: EvCallStack -> EvTerm -evCallStack = undefined +evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) => + EvCallStack -> m CoreExpr +-- See Note [Overview of implicit CallStacks] in TcEvidence.hs +evCallStack cs = do + df <- getDynFlags + m <- getModule + srcLocDataCon <- lookupDataCon srcLocDataConName + let mkSrcLoc l = mkCoreConApps srcLocDataCon <$> + sequence [ mkStringExprFS (unitIdFS $ moduleUnitId m) + , mkStringExprFS (moduleNameFS $ moduleName m) + , mkStringExprFS (srcSpanFile l) + , return $ mkIntExprInt df (srcSpanStartLine l) + , return $ mkIntExprInt df (srcSpanStartCol l) + , return $ mkIntExprInt df (srcSpanEndLine l) + , return $ mkIntExprInt df (srcSpanEndCol l) + ] + + emptyCS <- Var <$> lookupId emptyCallStackName + + pushCSVar <- lookupId pushCallStackName + let pushCS name loc rest = + mkCoreApps (Var pushCSVar) [mkCoreTup [name, loc], rest] + + let mkPush name loc tm = do + nameExpr <- mkStringExprFS name + locExpr <- mkSrcLoc loc + -- at this point tm :: IP sym CallStack + -- but we need the actual CallStack to pass to pushCS, + -- so we use unwrapIP to strip the dictionary wrapper + -- See Note [Overview of implicit CallStacks] + let ip_co = unwrapIP (exprType tm) + return (pushCS nameExpr locExpr (Cast tm ip_co)) + + case cs of + EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm + EvCsEmpty -> return emptyCS -- Dictionary for (Typeable ty) evTypeable :: Type -> EvTypeable -> EvTerm diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 196ee27..14e010d 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -143,6 +143,7 @@ import TyCon import TcErrors ( solverDepthErrorTcS ) import Name +import Module ( HasModule, getModule ) import RdrName ( GlobalRdrEnv, GlobalRdrElt ) import qualified RnEnv as TcM import Var @@ -2385,6 +2386,9 @@ instance MonadFail.MonadFail TcS where instance MonadUnique TcS where getUniqueSupplyM = wrapTcS getUniqueSupplyM +instance HasModule TcS where + getModule = wrapTcS getModule + instance MonadThings TcS where lookupThing n = wrapTcS (lookupThing n) From git at git.haskell.org Sun Jan 21 14:14:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 14:14:41 +0000 (UTC) Subject: [commit: ghc] wip/14691: Remove Note [Memoising typeOf] (9531e14) Message-ID: <20180121141441.A46153A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/9531e1479d21017ccb6d3437fb325e934c968d3f/ghc >--------------------------------------------------------------- commit 9531e1479d21017ccb6d3437fb325e934c968d3f Author: Joachim Breitner Date: Sun Jan 21 09:04:13 2018 -0500 Remove Note [Memoising typeOf] its reference (and presumably relevance) was removed in 8fa4bf9. >--------------------------------------------------------------- 9531e1479d21017ccb6d3437fb325e934c968d3f compiler/deSugar/DsBinds.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index b87d5ad..5974a60 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1309,12 +1309,3 @@ tyConRep tc = pprPanic "tyConRep" (ppr tc) -} -{- Note [Memoising typeOf] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -See #3245, #9203 - -IMPORTANT: we don't want to recalculate the TypeRep once per call with -the proxy argument. This is what went wrong in #3245 and #9203. So we -help GHC by manually keeping the 'rep' *outside* the lambda. --} - From git at git.haskell.org Sun Jan 21 14:14:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 14:14:44 +0000 (UTC) Subject: [commit: ghc] wip/14691: Implement evTypeable (34d283c) Message-ID: <20180121141444.75D3B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/34d283c76da071268b8f23a644f3d765cc9ec5bc/ghc >--------------------------------------------------------------- commit 34d283c76da071268b8f23a644f3d765cc9ec5bc Author: Joachim Breitner Date: Sun Jan 21 09:14:04 2018 -0500 Implement evTypeable which requires mild refactoring in TcInteract, as lir_mk_ev is now monadic >--------------------------------------------------------------- 34d283c76da071268b8f23a644f3d765cc9ec5bc compiler/deSugar/DsBinds.hs | 122 --------------------------------------- compiler/typecheck/TcEvTerm.hs | 121 +++++++++++++++++++++++++++++++++++++- compiler/typecheck/TcInteract.hs | 25 ++++---- 3 files changed, 131 insertions(+), 137 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 34d283c76da071268b8f23a644f3d765cc9ec5bc From git at git.haskell.org Sun Jan 21 15:02:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 15:02:13 +0000 (UTC) Subject: [commit: ghc] wip/14691: use tcLookupGlobal in TcS’s MonadThings instance (428f4f2) Message-ID: <20180121150213.14F883A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/428f4f2f2563908b531374aed7016a222ad04a7f/ghc >--------------------------------------------------------------- commit 428f4f2f2563908b531374aed7016a222ad04a7f Author: Joachim Breitner Date: Sun Jan 21 10:01:50 2018 -0500 use tcLookupGlobal in TcS’s MonadThings instance >--------------------------------------------------------------- 428f4f2f2563908b531374aed7016a222ad04a7f compiler/typecheck/TcSMonad.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 14e010d..b1c55f2 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -128,7 +128,8 @@ import FamInstEnv import qualified TcRnMonad as TcM import qualified TcMType as TcM import qualified TcEnv as TcM - ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass, tcLookupId ) + ( checkWellStaged, topIdLvl, tcGetDefaultTys + , tcLookupClass, tcLookupId, tcLookupGlobal ) import PrelNames( heqTyConKey, eqTyConKey ) import Kind import TcType @@ -2390,7 +2391,7 @@ instance HasModule TcS where getModule = wrapTcS getModule instance MonadThings TcS where - lookupThing n = wrapTcS (lookupThing n) + lookupThing n = wrapTcS (TcM.tcLookupGlobal n) -- Basic functionality -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Sun Jan 21 15:58:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 15:58:40 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #14335 (5e8ea6a) Message-ID: <20180121155840.BE96D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e8ea6a62e948bcc0da1279f06844fd1d8e979bd/ghc >--------------------------------------------------------------- commit 5e8ea6a62e948bcc0da1279f06844fd1d8e979bd Author: Ben Gamari Date: Thu Jan 18 18:23:06 2018 -0500 testsuite: Add test for #14335 Subscribers: rwbarton, thomie GHC Trac Issues: #14335 Differential Revision: https://phabricator.haskell.org/D4202 >--------------------------------------------------------------- 5e8ea6a62e948bcc0da1279f06844fd1d8e979bd testsuite/tests/plugins/Makefile | 5 +++++ testsuite/tests/plugins/all.T | 6 ++++++ 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index 1ff8d40..96443c9 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -52,3 +52,8 @@ T12567a: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2 "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 2>&1 | grep "T12567a.hs, T12567a.o" 1>&2 "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567b.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2 + +.PHONY: T14335 +T14335: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -fexternal-interpreter --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -hide-all-plugin-packages -plugin-package simple-plugin + ./plugins01 diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 5f53531..0e523f0 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -67,3 +67,9 @@ test('T12567a', [extra_files(['T12567b.hs', 'simple-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T12567a TOP={top}')], run_command, ['$MAKE -s --no-print-directory T12567a']) + +test('T14335', + [extra_files(['simple-plugin/', 'plugins01.hs']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins01 TOP={top}'), + expect_broken(14335)], + run_command, ['$MAKE -s --no-print-directory T14335']) From git at git.haskell.org Sun Jan 21 16:38:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 16:38:25 +0000 (UTC) Subject: [commit: ghc] wip/14691: Revert "use tcLookupGlobal in TcS’s MonadThings instance" (f1636a3) Message-ID: <20180121163825.7C5FE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/f1636a370a41fda5b53c56a23adbd9842778edeb/ghc >--------------------------------------------------------------- commit f1636a370a41fda5b53c56a23adbd9842778edeb Author: Joachim Breitner Date: Sun Jan 21 11:38:02 2018 -0500 Revert "use tcLookupGlobal in TcS’s MonadThings instance" This reverts commit 428f4f2f2563908b531374aed7016a222ad04a7f, which was pretty pointless, and did not help. >--------------------------------------------------------------- f1636a370a41fda5b53c56a23adbd9842778edeb compiler/typecheck/TcSMonad.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index b1c55f2..14e010d 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -128,8 +128,7 @@ import FamInstEnv import qualified TcRnMonad as TcM import qualified TcMType as TcM import qualified TcEnv as TcM - ( checkWellStaged, topIdLvl, tcGetDefaultTys - , tcLookupClass, tcLookupId, tcLookupGlobal ) + ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass, tcLookupId ) import PrelNames( heqTyConKey, eqTyConKey ) import Kind import TcType @@ -2391,7 +2390,7 @@ instance HasModule TcS where getModule = wrapTcS getModule instance MonadThings TcS where - lookupThing n = wrapTcS (TcM.tcLookupGlobal n) + lookupThing n = wrapTcS (lookupThing n) -- Basic functionality -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Sun Jan 21 23:33:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 23:33:30 +0000 (UTC) Subject: [commit: ghc] wip/14691: Try using tcLookup instead of tcLookupGlobal (cb7deb6) Message-ID: <20180121233330.4E8433A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/cb7deb6d0f36132594ccad3c86bddc7d7cdbb0dd/ghc >--------------------------------------------------------------- commit cb7deb6d0f36132594ccad3c86bddc7d7cdbb0dd Author: Joachim Breitner Date: Sun Jan 21 18:32:32 2018 -0500 Try using tcLookup instead of tcLookupGlobal >--------------------------------------------------------------- cb7deb6d0f36132594ccad3c86bddc7d7cdbb0dd compiler/typecheck/TcEnv.hs | 11 ++++++++++- compiler/typecheck/TcErrors.hs | 16 +++++++++++++++- compiler/typecheck/TcEvTerm.hs | 28 +++++++--------------------- compiler/typecheck/TcSMonad.hs | 7 +++++-- 4 files changed, 37 insertions(+), 25 deletions(-) diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 28130b7..0520296 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -34,7 +34,7 @@ module TcEnv( isTypeClosedLetBndr, tcLookup, tcLookupLocated, tcLookupLocalIds, - tcLookupId, tcLookupIdMaybe, tcLookupTyVar, + tcLookupId, tcLookupIdMaybe, tcLookupTyVar, tcLookupTyConLocal, tcLookupLcl_maybe, getInLocalScope, wrongThingErr, pprBinders, @@ -365,6 +365,15 @@ tcLookupIdMaybe name AGlobal (AnId id) -> return $ Just id _ -> return Nothing } +tcLookupTyConLocal :: Name -> TcM TyCon +tcLookupTyConLocal name + = do { thing <- tcLookup name + ; case thing of + ATcTyCon tycon -> return tycon + AGlobal (ATyCon tycon) -> return tycon + _ -> pprPanic "tcLookupTyCon" (ppr thing) } + + tcLookupLocalIds :: [Name] -> TcM [TcId] -- We expect the variables to all be bound, and all at -- the same level as the lookup. Only used in one place... diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 2f8f4cf..70f8b20 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -31,7 +31,6 @@ import TyCon import Class import DataCon import TcEvidence -import TcEvTerm import HsExpr ( UnboundVar(..) ) import HsBinds ( PatSynBind(..) ) import Name @@ -61,6 +60,10 @@ import Pair import qualified GHC.LanguageExtensions as LangExt import FV ( fvVarList, fvVarSet, unionFV ) +import CoreSyn +import MkCore +import Literal + import Control.Monad ( when ) import Data.Foldable ( toList ) import Data.List ( partition, mapAccumL, nub, sortBy, unfoldr, foldl') @@ -3151,3 +3154,14 @@ solverDepthErrorTcS loc ty , text "(any upper bound you could choose might fail unpredictably with" , text " minor updates to GHC, so disabling the check is recommended if" , text " you're sure that type checking should terminate)" ] + + +-- Used with Opt_DeferTypeErrors +-- See Note [Deferring coercion errors to runtime] +-- in TcSimplify +evDelayedError :: Type -> FastString -> EvTerm +evDelayedError ty msg + = Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg] + where + errorId = tYPE_ERROR_ID + litMsg = Lit (MachStr (fastStringToByteString msg)) diff --git a/compiler/typecheck/TcEvTerm.hs b/compiler/typecheck/TcEvTerm.hs index 21cce3b..e9d3db3 100644 --- a/compiler/typecheck/TcEvTerm.hs +++ b/compiler/typecheck/TcEvTerm.hs @@ -1,20 +1,17 @@ -- (those who have too heavy dependencies for TcEvidence) module TcEvTerm - ( evDelayedError, evCallStack, evTypeable) - + ( evCallStack, evTypeable) where import GhcPrelude -import FastString +import TcSMonad import Type import CoreSyn import MkCore -import Literal ( Literal(..) ) import TcEvidence import HscTypes -import DynFlags import Name import Module import CoreUtils @@ -26,19 +23,8 @@ import MkId import TysWiredIn import Control.Monad (zipWithM) --- Used with Opt_DeferTypeErrors --- See Note [Deferring coercion errors to runtime] --- in TcSimplify -evDelayedError :: Type -> FastString -> EvTerm -evDelayedError ty msg - = Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg] - where - errorId = tYPE_ERROR_ID - litMsg = Lit (MachStr (fastStringToByteString msg)) - -- Dictionary for CallStack implicit parameters -evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) => - EvCallStack -> m CoreExpr +evCallStack :: EvCallStack -> TcS CoreExpr -- See Note [Overview of implicit CallStacks] in TcEvidence.hs evCallStack cs = do df <- getDynFlags @@ -74,12 +60,12 @@ evCallStack cs = do EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm EvCsEmpty -> return emptyCS -evTypeable :: MonadThings m => Type -> EvTypeable -> m CoreExpr +evTypeable :: Type -> EvTypeable -> TcS CoreExpr -- Return a CoreExpr :: Typeable ty -- This code is tightly coupled to the representation -- of TypeRep, in base library Data.Typeable.Internals evTypeable ty ev - = do { tyCl <- lookupTyCon typeableClassName -- Typeable + = do { tyCl <- tcLookupTyCon typeableClassName -- Typeable ; let kind = typeKind ty Just typeable_data_con = tyConSingleDataCon_maybe tyCl -- "Data constructor" @@ -93,11 +79,11 @@ evTypeable ty ev type TypeRepExpr = CoreExpr -- | Returns a @CoreExpr :: TypeRep ty@ -ds_ev_typeable :: MonadThings m => Type -> EvTypeable -> m CoreExpr +ds_ev_typeable :: Type -> EvTypeable -> TcS CoreExpr ds_ev_typeable ty (EvTypeableTyCon tc kind_ev) = do { mkTrCon <- lookupId mkTrConName -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a - ; someTypeRepTyCon <- lookupTyCon someTypeRepTyConName + ; someTypeRepTyCon <- tcLookupTyCon someTypeRepTyConName ; someTypeRepDataCon <- lookupDataCon someTypeRepDataConName -- SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 14e010d..70640c4 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -43,7 +43,7 @@ module TcSMonad ( getTopEnv, getGblEnv, getLclEnv, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, - tcLookupClass, tcLookupId, + tcLookupClass, tcLookupId, tcLookupTyCon, -- Inerts InertSet(..), InertCans(..), @@ -128,7 +128,7 @@ import FamInstEnv import qualified TcRnMonad as TcM import qualified TcMType as TcM import qualified TcEnv as TcM - ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass, tcLookupId ) + ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass, tcLookupId, tcLookupTyConLocal ) import PrelNames( heqTyConKey, eqTyConKey ) import Kind import TcType @@ -2781,6 +2781,9 @@ tcLookupClass c = wrapTcS $ TcM.tcLookupClass c tcLookupId :: Name -> TcS Id tcLookupId n = wrapTcS $ TcM.tcLookupId n +tcLookupTyCon :: Name -> TcS TyCon +tcLookupTyCon n = wrapTcS $ TcM.tcLookupTyConLocal n + -- Setting names as used (used in the deriving of Coercible evidence) -- Too hackish to expose it to TcS? In that case somehow extract the used -- constructors from the result of solveInteract From git at git.haskell.org Sun Jan 21 23:41:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Jan 2018 23:41:52 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Update Cabal submodule (61db0b8) Message-ID: <20180121234152.E2EBA3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/61db0b8941cfb7ed8941ed29bdb04bd8ef3b71a5/ghc >--------------------------------------------------------------- commit 61db0b8941cfb7ed8941ed29bdb04bd8ef3b71a5 Author: Oleg Grenrus Date: Sun Jan 21 20:37:17 2018 +0200 Update Cabal submodule - Cabal-2.2 uses SPDX license identifiers, so I had to update `cabal-version: 2.1` packages `license: BSD3` to `license: BSD-3-Clause` - `ghc-cabal` used old ReadP parsec, now it uses `parsec` too - InstalledPackageInfo pretty-printing have changed a little, fields with default values aren't printed. This can be changed in `Cabal` still, but I haven't found problems with omitting them. Note: `BSD-3-Clause` is parsed as "name = BSD, version = 3" by old parser (because 3-Clause looks like version 3 with tag Clause). If you see *"BSD-3" is not a valid license*, then something is using old parser still. Fixes #9885. (cherry picked from commit 5d6e0806c690ac1958e4cbf609bc6b18048fb761) >--------------------------------------------------------------- 61db0b8941cfb7ed8941ed29bdb04bd8ef3b71a5 libraries/Cabal | 2 +- libraries/base/base.cabal | 2 +- libraries/ghc-prim/ghc-prim.cabal | 2 +- .../backpack/cabal/bkpcabal06/bkpcabal06.cabal | 2 +- testsuite/tests/cabal/ghcpkg01.stdout | 39 ++++------------------ utils/ghc-cabal/Main.hs | 6 ++-- 6 files changed, 13 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 61db0b8941cfb7ed8941ed29bdb04bd8ef3b71a5 From git at git.haskell.org Mon Jan 22 01:39:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:38 +0000 (UTC) Subject: [commit: ghc] master: Add new mbmi and mbmi2 compiler flags (f855769) Message-ID: <20180122013938.6EF493A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f855769690eb998ea25818ee794714957852af48/ghc >--------------------------------------------------------------- commit f855769690eb998ea25818ee794714957852af48 Author: John Ky Date: Sun Jan 21 11:55:45 2018 -0500 Add new mbmi and mbmi2 compiler flags This adds support for the bit deposit and extraction operations provided by the BMI and BMI2 instruction set extensions on modern amd64 machines. Implement x86 code generator for pdep and pext. Properly initialise bmiVersion field. pdep and pext test cases Fix pattern match for pdep and pext instructions Fix build of pdep and pext code for 32-bit architectures Test Plan: Validate Reviewers: austin, simonmar, bgamari, angerman Reviewed By: bgamari Subscribers: trommler, carter, angerman, thomie, rwbarton, newhoggy GHC Trac Issues: #14206 Differential Revision: https://phabricator.haskell.org/D4236 >--------------------------------------------------------------- f855769690eb998ea25818ee794714957852af48 compiler/cmm/CmmMachOp.hs | 2 + compiler/cmm/CmmParse.y | 10 ++ compiler/cmm/PprC.hs | 2 + compiler/codeGen/StgCmmPrim.hs | 28 +++++ compiler/coreSyn/MkCore.hs | 1 - compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 97 +++++++++++++---- compiler/main/DriverPipeline.hs | 2 + compiler/main/DynFlags.hs | 27 +++++ compiler/nativeGen/CPrim.hs | 20 ++++ compiler/nativeGen/PPC/CodeGen.hs | 2 + compiler/nativeGen/SPARC/CodeGen.hs | 2 + compiler/nativeGen/X86/CodeGen.hs | 69 +++++++++++++ compiler/nativeGen/X86/Instr.hs | 9 ++ compiler/nativeGen/X86/Ppr.hs | 13 +++ compiler/prelude/primops.txt.pp | 22 ++++ libraries/ghc-prim/cbits/pdep.c | 48 +++++++++ libraries/ghc-prim/cbits/pext.c | 44 ++++++++ libraries/ghc-prim/ghc-prim.cabal | 2 + testsuite/tests/codeGen/should_run/all.T | 2 + testsuite/tests/codeGen/should_run/cgrun075.hs | 115 +++++++++++++++++++++ .../{cgrun071.stdout => cgrun075.stdout} | 0 testsuite/tests/codeGen/should_run/cgrun076.hs | 115 +++++++++++++++++++++ .../{cgrun071.stdout => cgrun076.stdout} | 0 23 files changed, 611 insertions(+), 21 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f855769690eb998ea25818ee794714957852af48 From git at git.haskell.org Mon Jan 22 01:39:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:41 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add testcase for #14670 (765ba65) Message-ID: <20180122013941.A4A1D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/765ba657c08453615521f5cb0b2418512e606743/ghc >--------------------------------------------------------------- commit 765ba657c08453615521f5cb0b2418512e606743 Author: Ben Gamari Date: Sun Jan 21 11:57:34 2018 -0500 testsuite: Add testcase for #14670 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14670 Differential Revision: https://phabricator.haskell.org/D4314 >--------------------------------------------------------------- 765ba657c08453615521f5cb0b2418512e606743 testsuite/tests/rebindable/T14670.hs | 11 +++++++++++ testsuite/tests/rebindable/all.T | 1 + 2 files changed, 12 insertions(+) diff --git a/testsuite/tests/rebindable/T14670.hs b/testsuite/tests/rebindable/T14670.hs new file mode 100644 index 0000000..8a99c57 --- /dev/null +++ b/testsuite/tests/rebindable/T14670.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RebindableSyntax #-} + +module Lib where + +import Prelude (IO) + +pure = undefined + +foo :: IO () +foo = do + pure () diff --git a/testsuite/tests/rebindable/all.T b/testsuite/tests/rebindable/all.T index 83bfa2f..f796a38 100644 --- a/testsuite/tests/rebindable/all.T +++ b/testsuite/tests/rebindable/all.T @@ -34,3 +34,4 @@ test('T10112', normal, compile, ['']) test('T11216', normal, compile, ['']) test('T11216A', normal, compile, ['']) test('T12080', normal, compile, ['']) +test('T14670', expect_broken(14670), compile, ['']) From git at git.haskell.org Mon Jan 22 01:39:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:44 +0000 (UTC) Subject: [commit: ghc] master: Fix #14692 by correcting an off-by-one error in TcGenDeriv (0074a08) Message-ID: <20180122013944.6A5B73A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0074a08ea9dfd1416aa57a9504be73dcdf7a1e2b/ghc >--------------------------------------------------------------- commit 0074a08ea9dfd1416aa57a9504be73dcdf7a1e2b Author: Ryan Scott Date: Sun Jan 21 12:06:06 2018 -0500 Fix #14692 by correcting an off-by-one error in TcGenDeriv A silly mistake in `gen_Show_binds` was causing derived `Show` instances for empty data types to case on the precedence argument instead of the actual value being showed. Test Plan: make test TEST=drv-empty-data Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14692 Differential Revision: https://phabricator.haskell.org/D4328 >--------------------------------------------------------------- 0074a08ea9dfd1416aa57a9504be73dcdf7a1e2b compiler/typecheck/TcGenDeriv.hs | 2 +- testsuite/tests/deriving/should_compile/drv-empty-data.stderr | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index b2d45fd..1ac3505 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1132,7 +1132,7 @@ gen_Show_binds get_fixity loc tycon = (unitBag shows_prec, emptyBag) where data_cons = tyConDataCons tycon - shows_prec = mkFunBindEC 1 loc showsPrec_RDR id (map pats_etc data_cons) + shows_prec = mkFunBindEC 2 loc showsPrec_RDR id (map pats_etc data_cons) comma_space = nlHsVar showCommaSpace_RDR pats_etc data_con diff --git a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr index e131c1c..5baf6a6 100644 --- a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr +++ b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr @@ -7,7 +7,7 @@ Derived class instances: GHC.Read.readListPrec = GHC.Read.readListPrecDefault instance GHC.Show.Show (DrvEmptyData.Void a) where - GHC.Show.showsPrec z = case z of + GHC.Show.showsPrec _ z = case z of instance GHC.Classes.Ord (DrvEmptyData.Void a) where GHC.Classes.compare _ z = GHC.Types.EQ From git at git.haskell.org Mon Jan 22 01:39:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:47 +0000 (UTC) Subject: [commit: ghc] master: tentative improvement to callstack docs (5edb18a) Message-ID: <20180122013947.4BAE13A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5edb18a962cbfee0ff869b1a77ebf2cd79dd8ef5/ghc >--------------------------------------------------------------- commit 5edb18a962cbfee0ff869b1a77ebf2cd79dd8ef5 Author: Alp Mestanogullari Date: Sun Jan 21 12:07:58 2018 -0500 tentative improvement to callstack docs This is an attempt at clarifying the docs for HasCallStack in both the user guide and libraries/base/GHC/Stack/Types.hs. The example used right now is built around an hypothetical 'error' function that doesn't itself print call stacks, and the fact that this doesn't hold makes it all confusing, see #14635. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14635 Differential Revision: https://phabricator.haskell.org/D4317 >--------------------------------------------------------------- 5edb18a962cbfee0ff869b1a77ebf2cd79dd8ef5 docs/users_guide/glasgow_exts.rst | 67 +++++++++++++++++++++++++++++++-------- libraries/base/GHC/Stack/Types.hs | 23 ++++++++------ 2 files changed, 66 insertions(+), 24 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 34efbfd..4125c33 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -14958,28 +14958,67 @@ HasCallStack ``GHC.Stack.HasCallStack`` is a lightweight method of obtaining a partial call-stack at any point in the program. -A function can request its call-site with the ``HasCallStack`` constraint. -For example, we can define :: +A function can request its call-site with the ``HasCallStack`` constraint +and access it as a Haskell value by using ``callStack``. - errorWithCallStack :: HasCallStack => String -> a +One can then use functions from ``GHC.Stack`` to inspect or pretty +print (as is done in ``f`` below) the call stack. -as a variant of ``error`` that will get its call-site (as of GHC 8.0, -``error`` already gets its call-site, but let's assume for the sake of -demonstration that it does not). We can access the call-stack inside -``errorWithCallStack`` with ``GHC.Stack.callStack``. :: + f :: HasCallStack => IO () + f = putStrLn (prettyCallStack callStack) - errorWithCallStack :: HasCallStack => String -> a - errorWithCallStack msg = error (msg ++ "\n" ++ prettyCallStack callStack) + g :: HasCallStack => IO () + g = f -Thus, if we call ``errorWithCallStack`` we will get a formatted call-stack -alongside our error message. +Evaluating ``f`` directly shows a call stack with a single entry, +while evaluating ``g``, which also requests its call-site, shows +two entries, one for each computation "annotated" with +``HasCallStack``. .. code-block:: none - ghci> errorWithCallStack "die" - *** Exception: die + ghci> f CallStack (from HasCallStack): - errorWithCallStack, called at :2:1 in interactive:Ghci1 + f, called at :19:1 in interactive:Ghci1 + ghci> g + CallStack (from HasCallStack): + f, called at :17:5 in main:Main + g, called at :20:1 in interactive:Ghci2 + +The ``error`` function from the Prelude supports printing the call stack that +led to the error in addition to the usual error message: + +.. code-block:: none + + ghci> error "bad" + *** Exception: bad + CallStack (from HasCallStack): + error, called at :25:1 in interactive:Ghci5 + +The call stack here consists of a single entry, pinpointing the source +of the call to ``error``. However, by annotating several computations +with ``HasCallStack``, figuring out the exact circumstances and sequences +of calls that lead to a call to ``error`` becomes a lot easier, as demonstrated +with the simple example below. :: + + f :: HasCallStack => IO () + f = error "bad bad bad" + + g :: HasCallStack => IO () + g = f + + h :: HasCallStack => IO () + h = g + +.. code-block:: none + + ghci> h + *** Exception: bad bad bad + CallStack (from HasCallStack): + error, called at call-stack.hs:4:5 in main:Main + f, called at call-stack.hs:7:5 in main:Main + g, called at call-stack.hs:10:5 in main:Main + h, called at :28:1 in interactive:Ghci1 The ``CallStack`` will only extend as far as the types allow it, for example :: diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index d9e7552..b5858f2 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -75,25 +75,28 @@ type HasCallStack = (?callStack :: CallStack) -- For example, we can define -- -- @ --- errorWithCallStack :: HasCallStack => String -> a +-- putStrLnWithCallStack :: HasCallStack => String -> IO () -- @ -- --- as a variant of @error@ that will get its call-site. We can access the --- call-stack inside @errorWithCallStack@ with 'GHC.Stack.callStack'. +-- as a variant of @putStrLn@ that will get its call-site and print it, +-- along with the string given as argument. We can access the +-- call-stack inside @putStrLnWithCallStack@ with 'GHC.Stack.callStack'. -- -- @ --- errorWithCallStack :: HasCallStack => String -> a --- errorWithCallStack msg = error (msg ++ "\\n" ++ prettyCallStack callStack) +-- putStrLnWithCallStack :: HasCallStack => String -> IO () +-- putStrLnWithCallStack msg = do +-- putStrLn msg +-- putStrLn (prettyCallStack callStack) -- @ -- --- Thus, if we call @errorWithCallStack@ we will get a formatted call-stack --- alongside our error message. +-- Thus, if we call @putStrLnWithCallStack@ we will get a formatted call-stack +-- alongside our string. -- -- --- >>> errorWithCallStack "die" --- *** Exception: die +-- >>> putStrLnWithCallStack "hello" +-- hello -- CallStack (from HasCallStack): --- errorWithCallStack, called at :2:1 in interactive:Ghci1 +-- putStrLnWithCallStack, called at :2:1 in interactive:Ghci1 -- -- -- GHC solves 'HasCallStack' constraints in three steps: From git at git.haskell.org Mon Jan 22 01:39:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:50 +0000 (UTC) Subject: [commit: ghc] master: [rts] Adjust whitehole_spin (180ca65) Message-ID: <20180122013950.0F9103A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/180ca65ff6d1b4f3f4cdadc569fd4de107be14db/ghc >--------------------------------------------------------------- commit 180ca65ff6d1b4f3f4cdadc569fd4de107be14db Author: Douglas Wilson Date: Sun Jan 21 12:08:19 2018 -0500 [rts] Adjust whitehole_spin Rename to whitehole_gc_spin, in preparation for adding stats for the whitehole busy-loop in SMPClosureOps. Make whitehole_gc_spin volatile, and move it to be defined and statically initialised in GC.c. This saves some #ifs, and I'm pretty sure it should be volatile. Test Plan: ./validate Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4300 >--------------------------------------------------------------- 180ca65ff6d1b4f3f4cdadc569fd4de107be14db rts/Stats.c | 5 +++-- rts/sm/Evac.c | 7 ++----- rts/sm/GC.c | 4 ++++ rts/sm/GC.h | 2 +- rts/sm/Storage.c | 4 ---- 5 files changed, 10 insertions(+), 12 deletions(-) diff --git a/rts/Stats.c b/rts/Stats.c index fa85878..26bdac0 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -16,7 +16,7 @@ #include "Profiling.h" #include "GetTime.h" #include "sm/Storage.h" -#include "sm/GC.h" // gc_alloc_block_sync, whitehole_spin +#include "sm/GC.h" // gc_alloc_block_sync, whitehole_gc_spin #include "sm/GCThread.h" #include "sm/BlockAlloc.h" @@ -769,7 +769,8 @@ stat_exit (void) uint32_t g; statsPrintf("gc_alloc_block_sync: %"FMT_Word64"\n", gc_alloc_block_sync.spin); - statsPrintf("whitehole_spin: %"FMT_Word64"\n", whitehole_spin); + statsPrintf("whitehole_gc_spin: %"FMT_Word64"\n" + , whitehole_gc_spin); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { statsPrintf("gen[%d].sync: %"FMT_Word64"\n", g, generations[g].sync.spin); } diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index 526f063..738e3e4 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -28,10 +28,6 @@ #include "CNF.h" #include "Scav.h" -#if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC) -StgWord64 whitehole_spin = 0; -#endif - #if defined(THREADED_RTS) && !defined(PARALLEL_GC) #define evacuate(p) evacuate1(p) #define evacuate_BLACKHOLE(p) evacuate_BLACKHOLE1(p) @@ -197,8 +193,9 @@ spin: info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info); if (info == (W_)&stg_WHITEHOLE_info) { #if defined(PROF_SPIN) - whitehole_spin++; + whitehole_gc_spin++; #endif + busy_wait_nop(); goto spin; } if (IS_FORWARDING_PTR(info)) { diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 4dbc5e0..c5ab7a8 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -133,6 +133,10 @@ uint32_t n_gc_threads; // For stats: static long copied; // *words* copied & scavenged during this GC +#if defined(PROF_SPIN) && defined(THREADED_RTS) +volatile StgWord64 whitehole_gc_spin = 0; +#endif + bool work_stealing; uint32_t static_flag = STATIC_FLAG_B; diff --git a/rts/sm/GC.h b/rts/sm/GC.h index c6b0c13..78f0549 100644 --- a/rts/sm/GC.h +++ b/rts/sm/GC.h @@ -46,7 +46,7 @@ extern uint32_t mutlist_MUTVARS, mutlist_MUTARRS, mutlist_MVARS, mutlist_OTHERS, #endif #if defined(PROF_SPIN) && defined(THREADED_RTS) -extern StgWord64 whitehole_spin; +extern volatile StgWord64 whitehole_gc_spin; #endif void gcWorkerThread (Capability *cap); diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index e801c34..c4dbdc2 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -197,11 +197,7 @@ initStorage (void) #if defined(THREADED_RTS) initSpinLock(&gc_alloc_block_sync); -#if defined(PROF_SPIN) - whitehole_spin = 0; #endif -#endif - N = 0; for (n = 0; n < n_numa_nodes; n++) { From git at git.haskell.org Mon Jan 22 01:39:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:52 +0000 (UTC) Subject: [commit: ghc] master: Implement underscores in numeric literals (NumericUnderscores extension) (4a13c5b) Message-ID: <20180122013952.EE0BC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a13c5b1f4beb53cbf1f3529acdf3ba37528e694/ghc >--------------------------------------------------------------- commit 4a13c5b1f4beb53cbf1f3529acdf3ba37528e694 Author: Takenobu Tani Date: Sun Jan 21 12:08:59 2018 -0500 Implement underscores in numeric literals (NumericUnderscores extension) Implement the proposal of underscores in numeric literals. Underscores in numeric literals are simply ignored. The specification of the feature is available here: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/000 9-numeric-underscores.rst For a discussion of the various choices: https://github.com/ghc-proposals/ghc-proposals/pull/76 Implementation detail: * Added dynamic flag * `NumericUnderscores` extension flag is added for this feature. * Alex "Regular expression macros" in Lexer.x * Add `@numspc` (numeric spacer) macro to represent multiple underscores. * Modify `@decimal`, `@decimal`, `@binary`, `@octal`, `@hexadecimal`, `@exponent`, and `@bin_exponent` macros to include `@numspc`. * Alex "Rules" in Lexer.x * To be simpler, we have only the definitions with underscores. And then we have a separate function (`tok_integral` and `tok_frac`) that validates the literals. * Validation functions in Lexer.x * `tok_integral` and `tok_frac` functions validate whether contain underscores or not. If `NumericUnderscores` extensions are not enabled, check that there are no underscores. * `tok_frac` function is created by merging `strtoken` and `init_strtoken`. * `init_strtoken` is deleted. Because it is no longer used. * Remove underscores from target literal string * `parseUnsignedInteger`, `readRational__`, and `readHexRational} use the customized `span'` function to remove underscores. * Added Testcase * testcase for NumericUnderscores enabled. NumericUnderscores0.hs and NumericUnderscores1.hs * testcase for NumericUnderscores disabled. NoNumericUnderscores0.hs and NoNumericUnderscores1.hs * testcase to invalid pattern for NumericUnderscores enabled. NumericUnderscoresFail0.hs and NumericUnderscoresFail1.hs Test Plan: `validate` including the above testcase Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: carter, rwbarton, thomie GHC Trac Issues: #14473 Differential Revision: https://phabricator.haskell.org/D4235 >--------------------------------------------------------------- 4a13c5b1f4beb53cbf1f3529acdf3ba37528e694 compiler/main/DynFlags.hs | 1 + compiler/parser/Lexer.x | 101 +++++++++++++-------- compiler/utils/StringBuffer.hs | 1 + compiler/utils/Util.hs | 21 ++++- docs/users_guide/glasgow_exts.rst | 87 ++++++++++++++++++ .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + testsuite/tests/driver/T4437.hs | 3 +- .../parser/should_fail/NoNumericUnderscores0.hs | 12 +++ .../should_fail/NoNumericUnderscores0.stderr | 3 + .../parser/should_fail/NoNumericUnderscores1.hs | 12 +++ .../should_fail/NoNumericUnderscores1.stderr | 3 + .../parser/should_fail/NumericUnderscoresFail0.hs | 13 +++ .../should_fail/NumericUnderscoresFail0.stderr | 4 + .../parser/should_fail/NumericUnderscoresFail1.hs | 20 ++++ .../should_fail/NumericUnderscoresFail1.stderr | 7 ++ testsuite/tests/parser/should_fail/all.T | 7 ++ .../tests/parser/should_run/NumericUnderscores0.hs | 101 +++++++++++++++++++++ .../parser/should_run/NumericUnderscores0.stdout | 13 +++ .../tests/parser/should_run/NumericUnderscores1.hs | 88 ++++++++++++++++++ .../parser/should_run/NumericUnderscores1.stdout | 14 +++ testsuite/tests/parser/should_run/all.T | 2 + 21 files changed, 469 insertions(+), 45 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4a13c5b1f4beb53cbf1f3529acdf3ba37528e694 From git at git.haskell.org Mon Jan 22 01:39:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:56 +0000 (UTC) Subject: [commit: ghc] master: Use IntSet in Dataflow (8829743) Message-ID: <20180122013956.29F053A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/88297438d550a93f72261447a215b6a58b4fae55/ghc >--------------------------------------------------------------- commit 88297438d550a93f72261447a215b6a58b4fae55 Author: Bartosz Nitka Date: Sun Jan 21 12:11:28 2018 -0500 Use IntSet in Dataflow Before this change, a list was used as a substitute for a heap. This led to quadratic behavior on a simple program (see new test case). This change replaces it with IntSet in effect reverting 5a1a2633553. @simonmar said it's fine to revert as long as nofib results are good. Test Plan: new test case: 20% improvement 3x improvement when N=10000 nofib: I run it twice for before and after because the compile time results are noisy. - Compile Allocations: ``` before before re-run after after re-run -1 s.d. ----- -0.0% -0.1% -0.1% +1 s.d. ----- +0.0% +0.1% +0.1% Average ----- +0.0% -0.0% -0.0% ``` - Compile Time: ``` before before re-run after after re-run -1 s.d. ----- -0.1% -2.3% -2.6% +1 s.d. ----- +5.2% +3.7% +4.4% Average ----- +2.5% +0.7% +0.8% ``` I checked each case and couldn't find consistent slow-down/speed-up on compile time. Full results here: P173 Reviewers: simonpj, simonmar, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter, simonmar GHC Trac Issues: #14667 Differential Revision: https://phabricator.haskell.org/D4329 >--------------------------------------------------------------- 88297438d550a93f72261447a215b6a58b4fae55 compiler/cmm/Hoopl/Dataflow.hs | 34 ++++++++--------------- testsuite/tests/perf/compiler/all.T | 12 ++++++++ testsuite/tests/perf/compiler/genManyAlternatives | 34 +++++++++++++++++++++++ 3 files changed, 57 insertions(+), 23 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index b2a7716..2310db2 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -132,7 +132,8 @@ fixpointAnalysis direction lattice do_block entries blockmap = loop start blocks = sortBlocks direction entries blockmap num_blocks = length blocks block_arr = {-# SCC "block_arr" #-} listArray (0, num_blocks - 1) blocks - start = {-# SCC "start" #-} [0 .. num_blocks - 1] + start = {-# SCC "start" #-} IntSet.fromDistinctAscList + [0 .. num_blocks - 1] dep_blocks = {-# SCC "dep_blocks" #-} mkDepBlocks direction blocks join = fact_join lattice @@ -140,8 +141,7 @@ fixpointAnalysis direction lattice do_block entries blockmap = loop start :: IntHeap -- ^ Worklist, i.e., blocks to process -> FactBase f -- ^ Current result (increases monotonically) -> FactBase f - loop [] !fbase1 = fbase1 - loop (index : todo1) !fbase1 = + loop todo !fbase1 | Just (index, todo1) <- IntSet.minView todo = let block = block_arr ! index out_facts = {-# SCC "do_block" #-} do_block block fbase1 -- For each of the outgoing edges, we join it with the current @@ -151,6 +151,7 @@ fixpointAnalysis direction lattice do_block entries blockmap = loop start mapFoldWithKey (updateFact join dep_blocks) (todo1, fbase1) out_facts in loop todo2 fbase2 + loop _ !fbase1 = fbase1 rewriteCmmBwd :: DataflowLattice f @@ -196,7 +197,8 @@ fixpointRewrite dir lattice do_block entries blockmap = loop start blockmap num_blocks = length blocks block_arr = {-# SCC "block_arr_rewrite" #-} listArray (0, num_blocks - 1) blocks - start = {-# SCC "start_rewrite" #-} [0 .. num_blocks - 1] + start = {-# SCC "start_rewrite" #-} + IntSet.fromDistinctAscList [0 .. num_blocks - 1] dep_blocks = {-# SCC "dep_blocks_rewrite" #-} mkDepBlocks dir blocks join = fact_join lattice @@ -205,8 +207,8 @@ fixpointRewrite dir lattice do_block entries blockmap = loop start blockmap -> LabelMap CmmBlock -- ^ Rewritten blocks. -> FactBase f -- ^ Current facts. -> UniqSM (LabelMap CmmBlock, FactBase f) - loop [] !blocks1 !fbase1 = return (blocks1, fbase1) - loop (index : todo1) !blocks1 !fbase1 = do + loop todo !blocks1 !fbase1 + | Just (index, todo1) <- IntSet.minView todo = do -- Note that we use the *original* block here. This is important. -- We're optimistically rewriting blocks even before reaching the fixed -- point, which means that the rewrite might be incorrect. So if the @@ -220,6 +222,7 @@ fixpointRewrite dir lattice do_block entries blockmap = loop start blockmap mapFoldWithKey (updateFact join dep_blocks) (todo1, fbase1) out_facts loop todo2 blocks2 fbase2 + loop _ !blocks1 !fbase1 = return (blocks1, fbase1) {- @@ -344,7 +347,7 @@ updateFact fact_join dep_blocks lbl new_fact (todo, fbase) (NotChanged _) -> (todo, fbase) (Changed f) -> let !z = mapInsert lbl f fbase in (changed, z) where - changed = IntSet.foldr insertIntHeap todo $ + changed = todo `IntSet.union` mapFindWithDefault IntSet.empty lbl dep_blocks {- @@ -436,19 +439,4 @@ joinBlocksOO (BMiddle n) b = blockCons n b joinBlocksOO b (BMiddle n) = blockSnoc b n joinBlocksOO b1 b2 = BCat b1 b2 --- ----------------------------------------------------------------------------- --- a Heap of Int - --- We should really use a proper Heap here, but my attempts to make --- one have not succeeded in beating the simple ordered list. Another --- alternative is IntSet (using deleteFindMin), but that was also --- slower than the ordered list in my experiments --SDM 25/1/2012 - -type IntHeap = [Int] -- ordered - -insertIntHeap :: Int -> [Int] -> [Int] -insertIntHeap x [] = [x] -insertIntHeap x (y:ys) - | x < y = x : y : ys - | x == y = x : ys - | otherwise = y : insertIntHeap x ys +type IntHeap = IntSet diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index bd038a2..51dc6e8 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -1166,6 +1166,18 @@ test('ManyConstructors', multimod_compile, ['ManyConstructors', '-v0']) +test('ManyAlternatives', + [ compiler_stats_num_field('bytes allocated', + [(wordsize(64), 1398898072, 10), + # initial: 1756999240 + # 2018-01-20: 1398898072 Use IntSet in Dataflow + ]), + pre_cmd('./genManyAlternatives'), + extra_files(['genManyAlternatives']), + ], + multimod_compile, + ['ManyAlternatives', '-v0']) + test('T13701', [ compiler_stats_num_field('bytes allocated', [(platform('x86_64-apple-darwin'), 2217187888, 10), diff --git a/testsuite/tests/perf/compiler/genManyAlternatives b/testsuite/tests/perf/compiler/genManyAlternatives new file mode 100755 index 0000000..1035425 --- /dev/null +++ b/testsuite/tests/perf/compiler/genManyAlternatives @@ -0,0 +1,34 @@ +SIZE=1000 +MODULE=ManyAlternatives + +# Generates a module with a large number of alternatives that looks +# like this: +# +# module ManyAlternatives where +# +# data A1000 = A0 +# | A0001 +# | A0002 +# ... +# | A1000 +# +# f :: A -> Int +# f A0001 = 1990001 +# f A0002 = 1990002 +# ... +# f A1000 = 1991000 +# +# The point of this test is to check if we don't regress on #14667 reintroducing +# some code that's quadratic in the number of alternatives. + +echo "module $MODULE where" > $MODULE.hs +echo >> $MODULE.hs +echo "data A$SIZE = A0" >> $MODULE.hs +for i in $(seq -w 1 $SIZE); do + echo " | A$i" >> $MODULE.hs +done +echo >> $MODULE.hs +echo "f :: A$SIZE -> Int" >> $MODULE.hs +for i in $(seq -w 1 $SIZE); do + echo "f A$i = 199$i" >> $MODULE.hs +done From git at git.haskell.org Mon Jan 22 01:39:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:39:58 +0000 (UTC) Subject: [commit: ghc] master: SysTools: Add detection support for LLD linker (6c0db98) Message-ID: <20180122013958.E5C783A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c0db98bc5d1dceb8fa48544532f85d386900e4a/ghc >--------------------------------------------------------------- commit 6c0db98bc5d1dceb8fa48544532f85d386900e4a Author: Ben Gamari Date: Sun Jan 21 13:31:29 2018 -0500 SysTools: Add detection support for LLD linker I noticed while trying to test against LLVM 5.0 that GHC would throw "Couldn't figure out linker information" warnings due to LLD being chosen by configure. Adding detection support to silence these is simple enough, let's just do it. >--------------------------------------------------------------- 6c0db98bc5d1dceb8fa48544532f85d386900e4a compiler/main/DynFlags.hs | 1 + compiler/main/SysTools/Info.hs | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 77837e6..05d1ec1 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -5481,6 +5481,7 @@ isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of data LinkerInfo = GnuLD [Option] | GnuGold [Option] + | LlvmLLD [Option] | DarwinLD [Option] | SolarisLD [Option] | AixLD [Option] diff --git a/compiler/main/SysTools/Info.hs b/compiler/main/SysTools/Info.hs index e9dc685..6b31057 100644 --- a/compiler/main/SysTools/Info.hs +++ b/compiler/main/SysTools/Info.hs @@ -96,6 +96,7 @@ https://gcc.gnu.org/onlinedocs/gcc-5.2.0/gcc.pdf : neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o neededLinkArgs (GnuGold o) = o +neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o neededLinkArgs (SolarisLD o) = o neededLinkArgs (AixLD o) = o @@ -140,6 +141,9 @@ getLinkerInfo' dflags = do -- ELF specific flag, see Note [ELF needed shared libs] return (GnuGold [Option "-Wl,--no-as-needed"]) + | any ("LLD" `isPrefixOf`) stdo = + return (LlvmLLD []) + -- Unknown linker. | otherwise = fail "invalid --version output, or linker is unsupported" From git at git.haskell.org Mon Jan 22 01:40:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:40:01 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal submodule (2671ccc) Message-ID: <20180122014001.BC2603A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2671cccde749ed64129097358f81bff43480cdb9/ghc >--------------------------------------------------------------- commit 2671cccde749ed64129097358f81bff43480cdb9 Author: Oleg Grenrus Date: Sun Jan 21 20:37:17 2018 +0200 Update Cabal submodule - Cabal-2.2 uses SPDX license identifiers, so I had to update `cabal-version: 2.1` packages `license: BSD3` to `license: BSD-3-Clause` - `ghc-cabal` used old ReadP parsec, now it uses `parsec` too - InstalledPackageInfo pretty-printing have changed a little, fields with default values aren't printed. This can be changed in `Cabal` still, but I haven't found problems with omitting them. Note: `BSD-3-Clause` is parsed as "name = BSD, version = 3" by old parser (because 3-Clause looks like version 3 with tag Clause). If you see *"BSD-3" is not a valid license*, then something is using old parser still. Fixes #9885. >--------------------------------------------------------------- 2671cccde749ed64129097358f81bff43480cdb9 libraries/Cabal | 2 +- libraries/base/base.cabal | 2 +- libraries/ghc-prim/ghc-prim.cabal | 2 +- .../backpack/cabal/bkpcabal06/bkpcabal06.cabal | 2 +- testsuite/tests/cabal/ghcpkg01.stdout | 39 ++++------------------ utils/ghc-cabal/Main.hs | 6 ++-- 6 files changed, 13 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2671cccde749ed64129097358f81bff43480cdb9 From git at git.haskell.org Mon Jan 22 01:40:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 01:40:04 +0000 (UTC) Subject: [commit: ghc] master: Bump transformers submodule to 0.5.5.0 (24e56eb) Message-ID: <20180122014004.852453A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/24e56ebd010846683b236b6ef3678c2217640120/ghc >--------------------------------------------------------------- commit 24e56ebd010846683b236b6ef3678c2217640120 Author: Ben Gamari Date: Sun Jan 21 20:09:20 2018 -0500 Bump transformers submodule to 0.5.5.0 >--------------------------------------------------------------- 24e56ebd010846683b236b6ef3678c2217640120 libraries/transformers | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/transformers b/libraries/transformers index 36311d3..33b3c8a 160000 --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit 36311d39bc545261dab85d4a27af562db1868ed6 +Subproject commit 33b3c8a71778ae37040088dfe022c648373777a8 From git at git.haskell.org Mon Jan 22 12:01:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 12:01:00 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: triggering CI for Simon's patch (2b6281d) Message-ID: <20180122120100.BC96B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/2b6281d711e1a17c701d1eac3fb7bace68830534/ghc >--------------------------------------------------------------- commit 2b6281d711e1a17c701d1eac3fb7bace68830534 Author: Gabor Greif Date: Wed Jan 17 14:47:00 2018 +0100 WIP: triggering CI for Simon's patch >--------------------------------------------------------------- 2b6281d711e1a17c701d1eac3fb7bace68830534 compiler/codeGen/StgCmmClosure.hs | 8 ++++++++ compiler/coreSyn/CoreOpt.hs | 20 +++++++++++++++++++- compiler/prelude/PrelRules.hs | 9 ++------- 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1da1f70..1736bba 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,6 +68,8 @@ module StgCmmClosure ( import GhcPrelude +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import SMRep import Cmm @@ -326,6 +328,11 @@ mkLFImported id -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor + | isValueUnfolding unf + , Just expr <- maybeUnfoldingTemplate unf + , Just con <- exprIsSatConApp_maybe expr + = LFCon con + | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") @@ -333,6 +340,7 @@ mkLFImported id = mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id + unf = realIdUnfolding id ------------- mkLFStringLit :: LambdaFormInfo diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 0f35e8f..f144e06 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -12,7 +12,8 @@ module CoreOpt ( joinPointBinding_maybe, joinPointBindings_maybe, -- ** Predicates on expressions - exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, + exprIsConApp_maybe, exprIsLiteral_maybe, + exprIsLambda_maybe, exprIsSatConApp_maybe, -- ** Coercions and casts pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo @@ -791,6 +792,23 @@ exprIsConApp_maybe (in_scope, id_unf) expr extend (Right s) v e = Right (extendSubst s v e) +exprIsSatConApp_maybe :: CoreExpr -> Maybe DataCon +-- Returns (Just dc) for a saturated application of dc +-- Simpler than exprIsConApp_maybe +exprIsSatConApp_maybe e = go 0 e + where + go :: Arity -> CoreExpr -> Maybe DataCon + go n_val_args (Var v) + | Just dc <- isDataConWorkId_maybe v + , dataConRepArity dc == n_val_args + = Just dc + go n_val_args (App f a) + | isTypeArg a = go n_val_args f + | otherwise = go (n_val_args + 1) f + go n_val_args (Cast e _) = go n_val_args e + go n_val_args (Tick _ e) = go n_val_args e + go _ _ = Nothing + -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion -> Maybe (DataCon, [Type], [CoreExpr]) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index db79589..3e9899f 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -33,7 +33,7 @@ import CoreSyn import MkCore import Id import Literal -import CoreOpt ( exprIsLiteral_maybe ) +import CoreOpt ( exprIsLiteral_maybe, exprIsSatConApp_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim @@ -41,7 +41,6 @@ import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon , unwrapNewTyCon_maybe, tyConDataCons ) import DataCon ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId ) import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) -import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) import PrelNames @@ -695,9 +694,6 @@ removeOp32 = do getArgs :: RuleM [CoreExpr] getArgs = RuleM $ \_ _ args -> Just args -getInScopeEnv :: RuleM InScopeEnv -getInScopeEnv = RuleM $ \_ iu _ -> Just iu - -- return the n-th argument of this rule, if it is a literal -- argument indices start from 0 getLiteral :: Int -> RuleM Literal @@ -916,8 +912,7 @@ dataToTagRule = a `mplus` b b = do dflags <- getDynFlags [_, val_arg] <- getArgs - in_scope <- getInScopeEnv - (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg + dc <- liftMaybe $ exprIsSatConApp_maybe val_arg ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return () return $ mkIntVal dflags (toInteger (dataConTagZ dc)) From git at git.haskell.org Mon Jan 22 12:01:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 12:01:03 +0000 (UTC) Subject: [commit: ghc] wip/T14677's head updated: WIP: triggering CI for Simon's patch (2b6281d) Message-ID: <20180122120103.38C253A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14677' now includes: 5e8ea6a testsuite: Add test for #14335 f855769 Add new mbmi and mbmi2 compiler flags 765ba65 testsuite: Add testcase for #14670 0074a08 Fix #14692 by correcting an off-by-one error in TcGenDeriv 5edb18a tentative improvement to callstack docs 180ca65 [rts] Adjust whitehole_spin 4a13c5b Implement underscores in numeric literals (NumericUnderscores extension) 8829743 Use IntSet in Dataflow 6c0db98 SysTools: Add detection support for LLD linker 2671ccc Update Cabal submodule 24e56eb Bump transformers submodule to 0.5.5.0 2b6281d WIP: triggering CI for Simon's patch From git at git.haskell.org Mon Jan 22 15:06:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 15:06:46 +0000 (UTC) Subject: [commit: ghc] wip/float-join-points: Fix a bug in (f592436) Message-ID: <20180122150646.53D953A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/float-join-points Link : http://ghc.haskell.org/trac/ghc/changeset/f592436eaba59b5c7383e070b331491a27483b42/ghc >--------------------------------------------------------------- commit f592436eaba59b5c7383e070b331491a27483b42 Author: Simon Peyton Jones Date: Mon Jan 22 14:58:51 2018 +0000 Fix a bug in commit 68ccfbd60c7bca7a3fc2b1918b5e78b1c85e6014 Author: Simon Peyton Jones Date: Fri Oct 27 16:20:24 2017 +0100 Wip on floating join points in add_one in 'abstract' in 'SimplUtils.abstractFloat' >--------------------------------------------------------------- f592436eaba59b5c7383e070b331491a27483b42 compiler/simplCore/SimplUtils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 34d29e5..dd172a9 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1735,7 +1735,7 @@ abstractFloats dflags top_lvl main_vs float_binds in_scope body vs_here_set = mkDVarSet vs_here fv_subst' = foldl add_one fv_subst bndrs fvs_one (bndr, rhs) = exprFVs rhs `unionFV` varTypeTyCoFVs bndr - add_one subst bndr = extendVarEnv fv_subst bndr vs_here_set + add_one subst bndr = extendVarEnv subst bndr vs_here_set -- For a recursive group, it's a bit of a pain to work out the minimal -- set of tyvars over which to abstract: From git at git.haskell.org Mon Jan 22 15:06:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 15:06:49 +0000 (UTC) Subject: [commit: ghc] wip/float-join-points: Tiny refactor (swap order of args to (&&)) (730f382) Message-ID: <20180122150649.1DBA53A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/float-join-points Link : http://ghc.haskell.org/trac/ghc/changeset/730f382795217ff5dadb985b6a7e778d59bc6199/ghc >--------------------------------------------------------------- commit 730f382795217ff5dadb985b6a7e778d59bc6199 Author: Simon Peyton Jones Date: Mon Jan 22 15:03:02 2018 +0000 Tiny refactor (swap order of args to (&&)) >--------------------------------------------------------------- 730f382795217ff5dadb985b6a7e778d59bc6199 compiler/simplCore/SetLevels.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index f0c9063..946a41a 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -1166,8 +1166,8 @@ profitableFloat env dest_lvl (bndr:_) = True | otherwise - = not (isJoinId bndr) - && not (floatTopLvlOnly env) + = not (floatTopLvlOnly env) + && not (isJoinId bndr) && (dest_lvl `ltMajLvl` le_ctxt_lvl env) profitableFloat _ _ [] = panic "profitableFloat" From git at git.haskell.org Mon Jan 22 15:54:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 15:54:58 +0000 (UTC) Subject: [commit: ghc] wip/14691: Try using tcLookupId instead of lookupId (f00a371) Message-ID: <20180122155458.A4C8C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/f00a37149ce9f018008bf52da2d7df09f6055d78/ghc >--------------------------------------------------------------- commit f00a37149ce9f018008bf52da2d7df09f6055d78 Author: Joachim Breitner Date: Mon Jan 22 10:54:17 2018 -0500 Try using tcLookupId instead of lookupId (the latter goes through tcLookupGlobal) >--------------------------------------------------------------- f00a37149ce9f018008bf52da2d7df09f6055d78 compiler/typecheck/TcEvTerm.hs | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcEvTerm.hs b/compiler/typecheck/TcEvTerm.hs index e9d3db3..114d4e4 100644 --- a/compiler/typecheck/TcEvTerm.hs +++ b/compiler/typecheck/TcEvTerm.hs @@ -81,7 +81,7 @@ type TypeRepExpr = CoreExpr -- | Returns a @CoreExpr :: TypeRep ty@ ds_ev_typeable :: Type -> EvTypeable -> TcS CoreExpr ds_ev_typeable ty (EvTypeableTyCon tc kind_ev) - = do { mkTrCon <- lookupId mkTrConName + = do { mkTrCon <- tcLookupId mkTrConName -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a ; someTypeRepTyCon <- tcLookupTyCon someTypeRepTyConName ; someTypeRepDataCon <- lookupDataCon someTypeRepDataConName @@ -90,7 +90,7 @@ ds_ev_typeable ty (EvTypeableTyCon tc kind_ev) ; tc_rep <- tyConRep tc -- :: TyCon ; let ks = tyConAppArgs ty -- Construct a SomeTypeRep - toSomeTypeRep :: MonadThings m => Type -> EvTerm -> m CoreExpr + toSomeTypeRep :: Type -> EvTerm -> TcS CoreExpr toSomeTypeRep t ev = do rep <- getRep ev t return $ mkCoreConApps someTypeRepDataCon [Type (typeKind t), Type t, rep] @@ -113,7 +113,7 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2) | Just (t1,t2) <- splitAppTy_maybe ty = do { e1 <- getRep ev1 t1 ; e2 <- getRep ev2 t2 - ; mkTrApp <- lookupId mkTrAppName + ; mkTrApp <- tcLookupId mkTrAppName -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). -- TypeRep a -> TypeRep b -> TypeRep (a b) ; let (k1, k2) = splitFunTy (typeKind t1) @@ -127,7 +127,7 @@ ds_ev_typeable ty (EvTypeableTrFun ev1 ev2) | Just (t1,t2) <- splitFunTy_maybe ty = do { e1 <- getRep ev1 t1 ; e2 <- getRep ev2 t2 - ; mkTrFun <- lookupId mkTrFunName + ; mkTrFun <- tcLookupId mkTrFunName -- mkTrFun :: forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). -- TypeRep a -> TypeRep b -> TypeRep (a -> b) ; let r1 = getRuntimeRep t1 @@ -137,7 +137,7 @@ ds_ev_typeable ty (EvTypeableTrFun ev1 ev2) } ds_ev_typeable ty (EvTypeableTyLit dict) - = do { fun <- lookupId tr_fun + = do { fun <- tcLookupId tr_fun ; let proxy = mkTyApps (Var proxyHashId) [ty_kind, ty] ; return (mkApps (mkTyApps (Var fun) [ty]) [ dict, proxy ]) } where @@ -153,23 +153,22 @@ ds_ev_typeable ty (EvTypeableTyLit dict) ds_ev_typeable ty ev = pprPanic "dsEvTypeable" (ppr ty $$ ppr ev) -getRep :: MonadThings m - => EvTerm -- ^ EvTerm for @Typeable ty@ +getRep :: EvTerm -- ^ EvTerm for @Typeable ty@ -> Type -- ^ The type @ty@ - -> m TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@ + -> TcS TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@ -- namely @typeRep# dict@ -- Remember that -- typeRep# :: forall k (a::k). Typeable k a -> TypeRep a getRep ev ty - = do { typeRepId <- lookupId typeRepIdName + = do { typeRepId <- tcLookupId typeRepIdName ; let ty_args = [typeKind ty, ty] ; return (mkApps (mkTyApps (Var typeRepId) ty_args) [ ev ]) } -tyConRep :: MonadThings m => TyCon -> m CoreExpr +tyConRep :: TyCon -> TcS CoreExpr -- Returns CoreExpr :: TyCon tyConRep tc | Just tc_rep_nm <- tyConRepName_maybe tc - = do { tc_rep_id <- lookupId tc_rep_nm + = do { tc_rep_id <- tcLookupId tc_rep_nm ; return (Var tc_rep_id) } | otherwise = pprPanic "tyConRep" (ppr tc) From git at git.haskell.org Mon Jan 22 17:02:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 17:02:47 +0000 (UTC) Subject: [commit: packages/terminfo] master: Bump to 0.4.1.1 (1e9460c) Message-ID: <20180122170247.AD9493A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo On branch : master Link : http://git.haskell.org/packages/terminfo.git/commitdiff/1e9460ca4f651099c6a0ad26eb1197297d5e8089 >--------------------------------------------------------------- commit 1e9460ca4f651099c6a0ad26eb1197297d5e8089 Author: Judah Jacobson Date: Sun Jan 21 16:04:56 2018 -0800 Bump to 0.4.1.1 >--------------------------------------------------------------- 1e9460ca4f651099c6a0ad26eb1197297d5e8089 terminfo.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/terminfo.cabal b/terminfo.cabal index d8f2179..3284525 100644 --- a/terminfo.cabal +++ b/terminfo.cabal @@ -1,6 +1,6 @@ Name: terminfo Cabal-Version: >=1.10 -Version: 0.4.1.0 +Version: 0.4.1.1 Category: User Interfaces License: BSD3 License-File: LICENSE From git at git.haskell.org Mon Jan 22 17:37:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 17:37:34 +0000 (UTC) Subject: [commit: ghc] master: Improve comments about TcLevel invariants (a3cde5f) Message-ID: <20180122173734.81D7F3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a3cde5fd76b0e519f27267079e4ea89516ffdc04/ghc >--------------------------------------------------------------- commit a3cde5fd76b0e519f27267079e4ea89516ffdc04 Author: Simon Peyton Jones Date: Mon Jan 22 14:49:46 2018 +0000 Improve comments about TcLevel invariants >--------------------------------------------------------------- a3cde5fd76b0e519f27267079e4ea89516ffdc04 compiler/typecheck/TcRnTypes.hs | 7 +++++-- compiler/typecheck/TcSimplify.hs | 10 +++++----- compiler/typecheck/TcType.hs | 31 +++++++++++++++++++++---------- 3 files changed, 31 insertions(+), 17 deletions(-) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 5e97935..00927d7 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -2391,7 +2391,9 @@ Yuk! -} data Implication - = Implic { + = Implic { -- Invariants for a tree of implications: + -- see TcType Note [TcLevel and untouchable type variables] + ic_tclvl :: TcLevel, -- TcLevel of unification variables -- allocated /inside/ this implication @@ -2410,7 +2412,8 @@ data Implication -- for the implication, and hence for all the -- given evidence variables - ic_wanted :: WantedConstraints, -- The wanted + ic_wanted :: WantedConstraints, -- The wanteds + -- See Invariang (WantedInf) in TcType ic_binds :: EvBindsVar, -- Points to the place to fill in the -- abstraction and bindings. diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 70c8f96..62a4800 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1910,7 +1910,7 @@ allow the implication to make progress. promoteTyVar :: TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore --- invariant (MetaTvInv) in Note [TcLevel and untouchable type variables] in TcType +-- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in TcType -- Return True <=> we did some promotion -- See Note [Promoting unification variables] promoteTyVar tclvl tv @@ -1924,7 +1924,7 @@ promoteTyVar tclvl tv promoteTyVarTcS :: TcLevel -> TcTyVar -> TcS () -- When we float a constraint out of an implication we must restore --- invariant (MetaTvInv) in Note [TcLevel and untouchable type variables] in TcType +-- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in TcType -- See Note [Promoting unification variables] -- We don't just call promoteTyVar because we want to use unifyTyVar, -- not writeMetaTyVar @@ -2067,7 +2067,7 @@ When we are inferring a type, we simplify the constraint, and then use approximateWC to produce a list of candidate constraints. Then we MUST a) Promote any meta-tyvars that have been floated out by - approximateWC, to restore invariant (MetaTvInv) described in + approximateWC, to restore invariant (WantedInv) described in Note [TcLevel and untouchable type variables] in TcType. b) Default the kind of any meta-tyvars that are not mentioned in @@ -2084,8 +2084,8 @@ Note [Promoting unification variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we float an equality out of an implication we must "promote" free unification variables of the equality, in order to maintain Invariant -(MetaTvInv) from Note [TcLevel and untouchable type variables] in TcType. for the -leftover implication. +(WantedInv) from Note [TcLevel and untouchable type variables] in +TcType. for the leftover implication. This is absolutely necessary. Consider the following example. We start with two implications and a class with a functional dependency. diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 441545c..de37aa8 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -680,25 +680,36 @@ Note [TcLevel and untouchable type variables] * INVARIANTS. In a tree of Implications, - (ImplicInv) The level number of an Implication is + (ImplicInv) The level number (ic_tclvl) of an Implication is STRICTLY GREATER THAN that of its parent - (MetaTvInv) The level number of a unification variable is - LESS THAN OR EQUAL TO that of its parent - implication + (GivenInv) The level number of a unification variable appearing + in the 'ic_given' of an implication I should be + STRICTLY LESS THAN the ic_tclvl of I + + (WantedInv) The level number of a unification variable appearing + in the 'ic_wanted' of an implication I should be + LESS THAN OR EQUAL TO the ic_tclvl of I + See Note [WantedInv] * A unification variable is *touchable* if its level number is EQUAL TO that of its immediate parent implication. -* INVARIANT - (GivenInv) The free variables of the ic_given of an - implication are all untouchable; ie their level - numbers are LESS THAN the ic_tclvl of the implication +Note [WantedInv] +~~~~~~~~~~~~~~~~ +Why is WantedInv important? Consider this implication, where +the constraint (C alpha[3]) disobeys WantedInv: + + forall[2] a. blah => (C alpha[3]) + (forall[3] b. alpha[3] ~ b) + +We can unify alpha:=b in the inner implication, because 'alpha' is +touchable; but then 'b' has excaped its scope into the outer implication. Note [Skolem escape prevention] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We only unify touchable unification variables. Because of -(MetaTvInv), there can be no occurrences of the variable further out, +(WantedInv), there can be no occurrences of the variable further out, so the unification can't cause the skolems to escape. Example: data T = forall a. MkT a (a->Int) f x (MkT v f) = length [v,x] @@ -770,7 +781,7 @@ sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) -- So <= would be equivalent checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool --- Checks (MetaTvInv) from Note [TcLevel and untouchable type variables] +-- Checks (WantedInv) from Note [TcLevel and untouchable type variables] checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl From git at git.haskell.org Mon Jan 22 17:38:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 17:38:45 +0000 (UTC) Subject: [commit: ghc] wip/14691: Revert "Implement evTypeable" (4b3057d) Message-ID: <20180122173845.67B573A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/4b3057df6f52e93a90f5c3d3f39290f21c6b49ed/ghc >--------------------------------------------------------------- commit 4b3057df6f52e93a90f5c3d3f39290f21c6b49ed Author: Joachim Breitner Date: Mon Jan 22 12:34:45 2018 -0500 Revert "Implement evTypeable" This reverts commit 34d283c76da071268b8f23a644f3d765cc9ec5bc. Lets somehow keep this in the desugarer. >--------------------------------------------------------------- 4b3057df6f52e93a90f5c3d3f39290f21c6b49ed compiler/deSugar/DsBinds.hs | 122 ++++++++++++++++++++++++++++++++++ compiler/typecheck/TcEnv.hs | 11 +-- compiler/typecheck/TcErrors.hs | 16 +---- compiler/typecheck/TcEvTerm.hs | 140 ++++++--------------------------------- compiler/typecheck/TcInteract.hs | 25 ++++--- compiler/typecheck/TcSMonad.hs | 7 +- 6 files changed, 158 insertions(+), 163 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4b3057df6f52e93a90f5c3d3f39290f21c6b49ed From git at git.haskell.org Mon Jan 22 19:20:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 19:20:24 +0000 (UTC) Subject: [commit: ghc] master: Pass -dsuppress-uniques when running T14507 (452dee3) Message-ID: <20180122192024.E373F3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/452dee3ff4f385977e56ac0fbb5adf0a90acbcac/ghc >--------------------------------------------------------------- commit 452dee3ff4f385977e56ac0fbb5adf0a90acbcac Author: Ryan Scott Date: Mon Jan 22 14:16:12 2018 -0500 Pass -dsuppress-uniques when running T14507 Not doing so resulted in different uniques being printed on different environments, as shown in #14703. >--------------------------------------------------------------- 452dee3ff4f385977e56ac0fbb5adf0a90acbcac testsuite/tests/patsyn/should_fail/T14507.stderr | 2 +- testsuite/tests/patsyn/should_fail/all.T | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/patsyn/should_fail/T14507.stderr b/testsuite/tests/patsyn/should_fail/T14507.stderr index 2ed89cb..cec70df 100644 --- a/testsuite/tests/patsyn/should_fail/T14507.stderr +++ b/testsuite/tests/patsyn/should_fail/T14507.stderr @@ -2,7 +2,7 @@ T14507.hs:18:9: error: • Iceland Jack! Iceland Jack! Stop torturing me! Pattern-bound variable x :: TypeRep a - has a type that mentions pattern-bound coercion: co_a2CF + has a type that mentions pattern-bound coercion: co Hint: use -fprint-explicit-coercions to see the coercions Probable fix: add a pattern signature • In the declaration for pattern synonym ‘SO’ diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 2b3b85b..0f4c608 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -41,4 +41,4 @@ test('T14114', normal, compile_fail, ['']) test('T14380', normal, compile_fail, ['']) test('T14498', normal, compile_fail, ['']) test('T14552', normal, compile_fail, ['']) -test('T14507', normal, compile_fail, ['']) +test('T14507', normal, compile_fail, ['-dsuppress-uniques']) From git at git.haskell.org Mon Jan 22 20:38:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 20:38:25 +0000 (UTC) Subject: [commit: ghc] wip/14691: Trying to add EvTypeableTyLit back to to EvTerm (broken checkpoint) (bba40d1) Message-ID: <20180122203825.63FFE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/bba40d1a28aa4d559af43c2ff0538f18e55cb720/ghc >--------------------------------------------------------------- commit bba40d1a28aa4d559af43c2ff0538f18e55cb720 Author: Joachim Breitner Date: Mon Jan 22 15:12:16 2018 -0500 Trying to add EvTypeableTyLit back to to EvTerm (broken checkpoint) but this means that an EvTerm can no longer occur nested in an CoreExpr representing an EvTerm, so this approach is kinda doomed. >--------------------------------------------------------------- bba40d1a28aa4d559af43c2ff0538f18e55cb720 compiler/deSugar/DsBinds.hs | 108 +++++++++++++++++++++----------------- compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcEvTerm.hs | 47 +---------------- compiler/typecheck/TcEvidence.hs | 74 ++++++++++++++++++++------ compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 28 ++++++++-- compiler/typecheck/TcRnTypes.hs | 4 +- compiler/typecheck/TcSMonad.hs | 2 +- 9 files changed, 152 insertions(+), 121 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bba40d1a28aa4d559af43c2ff0538f18e55cb720 From git at git.haskell.org Mon Jan 22 20:38:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 20:38:28 +0000 (UTC) Subject: [commit: ghc] wip/14691: Start over with #14691 and only add EvExpr to EvTerm (9ea4186) Message-ID: <20180122203828.441BC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/9ea4186fa8f90212884eba50888d58fa80e49e13/ghc >--------------------------------------------------------------- commit 9ea4186fa8f90212884eba50888d58fa80e49e13 Author: Joachim Breitner Date: Mon Jan 22 15:35:24 2018 -0500 Start over with #14691 and only add EvExpr to EvTerm this can be useful for typechecker plugins, without disrupting the architecture of where Typeable evidence is created in the desgurar, not the typechecker. Some of the non-recursive constructors, such as `EvDelayedError` or `EvLit`, could possibly be dropped in favor of storing the `CoreExpr` directory. But there is not much to be gained from that. >--------------------------------------------------------------- 9ea4186fa8f90212884eba50888d58fa80e49e13 compiler/deSugar/Desugar.hs | 2 +- compiler/deSugar/DsBinds.hs | 37 ++++++- compiler/deSugar/DsExpr.hs | 4 +- compiler/deSugar/Match.hs | 4 +- compiler/deSugar/MatchCon.hs | 2 +- compiler/ghc.cabal.in | 1 - compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcCanonical.hs | 26 +++-- compiler/typecheck/TcErrors.hs | 3 +- compiler/typecheck/TcEvTerm.hs | 31 ------ compiler/typecheck/TcEvidence.hs | 217 +++++++++++++++++++++++--------------- compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 32 +++++- compiler/typecheck/TcInteract.hs | 97 ++++------------- compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 4 +- compiler/typecheck/TcSMonad.hs | 9 +- 17 files changed, 243 insertions(+), 234 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9ea4186fa8f90212884eba50888d58fa80e49e13 From git at git.haskell.org Mon Jan 22 22:59:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 22:59:32 +0000 (UTC) Subject: [commit: ghc] wip/14691: Trying to add EvTypeable back to to EvTerm (checkpoint) (1dd450d) Message-ID: <20180122225932.531D53A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/1dd450d62bd1dafa3f0bb9de7cc840c4810457a2/ghc >--------------------------------------------------------------- commit 1dd450d62bd1dafa3f0bb9de7cc840c4810457a2 Author: Joachim Breitner Date: Mon Jan 22 17:06:19 2018 -0500 Trying to add EvTypeable back to to EvTerm (checkpoint) but without the other constructors. This is trying to include an EvCallStack constructor, but it turns out that `solveCallStack` in `TcCanonical` tries to wrap that in an `mkEvCast`. So lets defer this casting until the desugarer runs. >--------------------------------------------------------------- 1dd450d62bd1dafa3f0bb9de7cc840c4810457a2 compiler/deSugar/DsBinds.hs | 50 ++------- compiler/deSugar/Match.hs | 4 +- compiler/ghc.cabal.in | 1 + compiler/typecheck/Inst.hs | 6 +- compiler/typecheck/TcCanonical.hs | 34 +++--- compiler/typecheck/TcErrors.hs | 3 +- compiler/typecheck/TcEvTerm.hs | 31 ++++++ compiler/typecheck/TcEvidence.hs | 218 +++++++++++++++----------------------- compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 32 +----- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcInteract.hs | 118 +++++++++++++++------ compiler/typecheck/TcMType.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 8 +- compiler/typecheck/TcRnTypes.hs | 6 +- compiler/typecheck/TcSMonad.hs | 19 ++-- 16 files changed, 262 insertions(+), 274 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1dd450d62bd1dafa3f0bb9de7cc840c4810457a2 From git at git.haskell.org Mon Jan 22 23:24:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Jan 2018 23:24:02 +0000 (UTC) Subject: [commit: ghc] wip/14691: Forgot zonkEvTerm env (EvCallStack ty cs) (2e5bc02) Message-ID: <20180122232402.0623D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/2e5bc02c38c05f7d12d046f1934eac20910c93ca/ghc >--------------------------------------------------------------- commit 2e5bc02c38c05f7d12d046f1934eac20910c93ca Author: Joachim Breitner Date: Mon Jan 22 18:23:45 2018 -0500 Forgot zonkEvTerm env (EvCallStack ty cs) >--------------------------------------------------------------- 2e5bc02c38c05f7d12d046f1934eac20910c93ca compiler/typecheck/TcHsSyn.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 43ff221..fc448ff 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -1425,6 +1425,13 @@ zonkEvTerm env (EvExpr e) = EvExpr <$> zonkCoreExpr env e zonkEvTerm env (EvTypeable ty ev) = EvTypeable <$> zonkTcTypeToType env ty <*> zonkEvTypeable env ev +zonkEvTerm env (EvCallStack ty cs) + = do ty' <- zonkTcTypeToType env ty + case cs of + EvCsEmpty -> return (EvCallStack ty' cs) + EvCsPushCall n l tm -> do { tm' <- zonkEvTerm env tm + ; return (EvCallStack ty' (EvCsPushCall n l tm')) } + zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr zonkCoreExpr env (Var v) From git at git.haskell.org Tue Jan 23 00:38:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Jan 2018 00:38:11 +0000 (UTC) Subject: [commit: ghc] wip/14691: Use EvExpr instead of EvTerm where possible (071962d) Message-ID: <20180123003811.049313A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/071962d30c9ac5d9ee0dedc5df0d6ce3d2e1bc0a/ghc >--------------------------------------------------------------- commit 071962d30c9ac5d9ee0dedc5df0d6ce3d2e1bc0a Author: Joachim Breitner Date: Mon Jan 22 19:02:30 2018 -0500 Use EvExpr instead of EvTerm where possible to clutter the code less with calls to the EvExpr constructors. >--------------------------------------------------------------- 071962d30c9ac5d9ee0dedc5df0d6ce3d2e1bc0a compiler/typecheck/Inst.hs | 2 +- compiler/typecheck/TcCanonical.hs | 17 ++++++++--------- compiler/typecheck/TcEvidence.hs | 8 ++++---- compiler/typecheck/TcInteract.hs | 6 +++--- compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcSMonad.hs | 10 +++++----- 6 files changed, 22 insertions(+), 23 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 071962d30c9ac5d9ee0dedc5df0d6ce3d2e1bc0a From git at git.haskell.org Tue Jan 23 00:38:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Jan 2018 00:38:13 +0000 (UTC) Subject: [commit: ghc] wip/14691: Remove EvCallStack (51d5533) Message-ID: <20180123003813.DA5DC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/51d5533979e7a189c21da544996c207a31da047e/ghc >--------------------------------------------------------------- commit 51d5533979e7a189c21da544996c207a31da047e Author: Joachim Breitner Date: Sun Jan 21 09:03:00 2018 -0500 Remove EvCallStack and move code from the desugarer into the type checker. Also, use EvExpr instead of EvTerm where possible (i.e. where no EvTypeable has to reach). >--------------------------------------------------------------- 51d5533979e7a189c21da544996c207a31da047e compiler/deSugar/DsBinds.hs | 47 --------------------------------------- compiler/typecheck/TcCanonical.hs | 13 ++++++----- compiler/typecheck/TcErrors.hs | 4 ++-- compiler/typecheck/TcEvTerm.hs | 44 +++++++++++++++++++++++++++++++++--- compiler/typecheck/TcEvidence.hs | 18 ++++----------- compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 7 ------ compiler/typecheck/TcInteract.hs | 14 ++++++------ compiler/typecheck/TcSMonad.hs | 6 ++--- 9 files changed, 66 insertions(+), 89 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 51d5533979e7a189c21da544996c207a31da047e From git at git.haskell.org Tue Jan 23 01:43:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Jan 2018 01:43:23 +0000 (UTC) Subject: [commit: ghc] wip/14691: Fix TcPluginM (5c71968) Message-ID: <20180123014323.3B8303A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/5c7196845ac9ccc85fe1b3f0349b844783f7449a/ghc >--------------------------------------------------------------- commit 5c7196845ac9ccc85fe1b3f0349b844783f7449a Author: Joachim Breitner Date: Mon Jan 22 20:38:40 2018 -0500 Fix TcPluginM >--------------------------------------------------------------- 5c7196845ac9ccc85fe1b3f0349b844783f7449a compiler/typecheck/TcPluginM.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcPluginM.hs b/compiler/typecheck/TcPluginM.hs index 807989e..b84e5ad 100644 --- a/compiler/typecheck/TcPluginM.hs +++ b/compiler/typecheck/TcPluginM.hs @@ -70,7 +70,7 @@ import TcRnMonad ( TcGblEnv, TcLclEnv, Ct, CtLoc, TcPluginM import TcMType ( TcTyVar, TcType ) import TcEnv ( TcTyThing ) import TcEvidence ( TcCoercion, CoercionHole - , EvTerm, EvBind, mkGivenEvBind ) + , EvExpr, EvBind, mkGivenEvBind ) import TcRnTypes ( CtEvidence(..) ) import Var ( EvVar ) @@ -170,7 +170,7 @@ newDerived loc pty = return CtDerived { ctev_pred = pty, ctev_loc = loc } -- | Create a new given constraint, with the supplied evidence. This -- must not be invoked from 'tcPluginInit' or 'tcPluginStop', or it -- will panic. -newGiven :: CtLoc -> PredType -> EvTerm -> TcPluginM CtEvidence +newGiven :: CtLoc -> PredType -> EvExpr -> TcPluginM CtEvidence newGiven loc pty evtm = do new_ev <- newEvVar pty setEvBind $ mkGivenEvBind new_ev evtm From git at git.haskell.org Tue Jan 23 12:16:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Jan 2018 12:16:30 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14688' created Message-ID: <20180123121630.9FC1D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14688 Referencing: 30f275c3679d3f01d26c5d469931a0fb0b0c8541 From git at git.haskell.org Tue Jan 23 12:16:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Jan 2018 12:16:33 +0000 (UTC) Subject: [commit: ghc] wip/T14688: patch (30f275c) Message-ID: <20180123121633.8A2A73A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14688 Link : http://ghc.haskell.org/trac/ghc/changeset/30f275c3679d3f01d26c5d469931a0fb0b0c8541/ghc >--------------------------------------------------------------- commit 30f275c3679d3f01d26c5d469931a0fb0b0c8541 Author: Matthew Pickering Date: Tue Jan 23 10:37:37 2018 +0000 patch >--------------------------------------------------------------- 30f275c3679d3f01d26c5d469931a0fb0b0c8541 compiler/coreSyn/CoreArity.hs | 4 ++-- compiler/coreSyn/CoreUnfold.hs | 4 ++-- compiler/coreSyn/CoreUtils.hs | 17 +++++++++-------- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index 945cad6..538648d 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -514,9 +514,9 @@ getBotArity _ = Nothing mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun mk_cheap_fn dflags cheap_app | not (gopt Opt_DictsCheap dflags) - = \e _ -> exprIsCheapX cheap_app e + = \e _ -> exprIsCheapX True cheap_app e | otherwise - = \e mb_ty -> exprIsCheapX cheap_app e + = \e mb_ty -> exprIsCheapX True cheap_app e || case mb_ty of Nothing -> False Just ty -> isDictLikeTy ty diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index c459fd2..f30aca6 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -1241,8 +1241,8 @@ tryUnfolding dflags id lone_variable = True | otherwise = case cont_info of - CaseCtxt -> not (lone_variable && is_wf) -- Note [Lone variables] - ValAppCtxt -> True -- Note [Cast then apply] + CaseCtxt -> not (lone_variable && is_exp) -- Note [Lone variables] + ValAppCtxt -> True -- Note [Cast then apply] RuleArgCtxt -> uf_arity > 0 -- See Note [Unfold info lazy contexts] DiscArgCtxt -> uf_arity > 0 -- RhsCtxt -> uf_arity > 0 -- diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 5e32dc6..c99e05f 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -1131,18 +1131,18 @@ in this (which it previously was): -} -------------------- +exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] +exprIsWorkFree = exprIsCheapX True isWorkFreeApp + exprIsCheap :: CoreExpr -> Bool -exprIsCheap = exprIsCheapX isCheapApp +exprIsCheap = exprIsCheapX True isCheapApp exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable = exprIsCheapX isExpandableApp - -exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] -exprIsWorkFree = exprIsCheapX isWorkFreeApp +exprIsExpandable = exprIsCheapX False isExpandableApp -------------------- -exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool -exprIsCheapX ok_app e +exprIsCheapX :: Bool -> CheapAppFun -> CoreExpr -> Bool +exprIsCheapX ok_case ok_app e = ok e where ok e = go 0 e @@ -1153,7 +1153,8 @@ exprIsCheapX ok_app e go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && + go n (Case scrut _ _ alts) = ok_case && + ok scrut && and [ go n rhs | (_,_,rhs) <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e From git at git.haskell.org Tue Jan 23 14:43:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Jan 2018 14:43:31 +0000 (UTC) Subject: [commit: ghc] wip/14691: Avoid exprType in evSuperClass, it does not work pre-zonking (3318a0d) Message-ID: <20180123144331.B6CB13A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/3318a0d2e8305f15c8d2ccf42237d0b7f893d07c/ghc >--------------------------------------------------------------- commit 3318a0d2e8305f15c8d2ccf42237d0b7f893d07c Author: Joachim Breitner Date: Tue Jan 23 09:42:51 2018 -0500 Avoid exprType in evSuperClass, it does not work pre-zonking but luckily mkEvScSelectors, the only caller of evSuperClass, knows the Class and the arguments. >--------------------------------------------------------------- 3318a0d2e8305f15c8d2ccf42237d0b7f893d07c compiler/typecheck/TcEvidence.hs | 16 ++++------------ compiler/types/Type.hs | 2 +- 2 files changed, 5 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 7bf01fd..bee7045 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -20,7 +20,7 @@ module TcEvidence ( -- EvTerm (already a CoreExpr) EvTerm(..), EvExpr, - evId, evCoercion, evCast, evDFunApp, evSuperClass, evSelector, + evId, evCoercion, evCast, evDFunApp, evSelector, mkEvCast, evVarsOfTerm, mkEvScSelectors, evTypeable, evTermCoercion, @@ -63,7 +63,6 @@ import Name import Pair import CoreSyn -import CoreUtils import Class ( classSCSelId ) import Id ( isEvVar ) import CoreFVs ( exprSomeFreeVars ) @@ -512,15 +511,6 @@ evCast et tc | isReflCo tc = et evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvExpr evDFunApp df tys ets = Var df `mkTyApps` tys `mkApps` ets --- n'th superclass. Used for both equalities and --- dictionaries, even though the former have no --- selector Id. We count up from _0_ -evSuperClass :: EvExpr -> Int -> EvExpr -evSuperClass d n = Var sc_sel_id `mkTyApps` tys `App` d - where - (cls, tys) = getClassPredTys (exprType d) - sc_sel_id = classSCSelId cls n -- Zero-indexed - -- Selector id plus the types at which it -- should be instantiated, used for HasField -- dictionaries; see Note [HasField instances] @@ -756,7 +746,9 @@ mkEvScSelectors :: EvExpr -> Class -> [TcType] -> [(TcPredType, EvExpr)] mkEvScSelectors ev cls tys = zipWith mk_pr (immSuperClasses cls tys) [0..] where - mk_pr pred i = (pred, evSuperClass ev i) + mk_pr pred i = (pred, Var sc_sel_id `mkTyApps` tys `App` ev) + where + sc_sel_id = classSCSelId cls i -- Zero-indexed emptyTcEvBinds :: TcEvBinds emptyTcEvBinds = EvBinds emptyBag diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index acc7a63..3f893db 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1760,7 +1760,7 @@ classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of | Just clas <- tyConClass_maybe tc -> ClassPred clas tys _ -> IrredPred ev_ty -getClassPredTys :: PredType -> (Class, [Type]) +getClassPredTys :: HasDebugCallStack => PredType -> (Class, [Type]) getClassPredTys ty = case getClassPredTys_maybe ty of Just (clas, tys) -> (clas, tys) Nothing -> pprPanic "getClassPredTys" (ppr ty) From git at git.haskell.org Tue Jan 23 22:57:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Jan 2018 22:57:15 +0000 (UTC) Subject: [commit: ghc] master: Allocate less in plus_mod_dep (f00ddea) Message-ID: <20180123225715.12EDE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f00ddea96cc856654ac90fcf7d29556a758d6648/ghc >--------------------------------------------------------------- commit f00ddea96cc856654ac90fcf7d29556a758d6648 Author: Bartosz Nitka Date: Sun Jan 21 17:16:33 2018 +0000 Allocate less in plus_mod_dep This gives a 10% allocation improvement on MultiLayerModules. The idea is to reuse existing tuples, instead of constantly constructing new ones. Test Plan: ./validate Reviewers: simonpj, bgamari Reviewed By: simonpj, bgamari Subscribers: rwbarton, thomie, simonmar, carter Differential Revision: https://phabricator.haskell.org/D4332 >--------------------------------------------------------------- f00ddea96cc856654ac90fcf7d29556a758d6648 compiler/typecheck/TcRnTypes.hs | 11 +++++++---- testsuite/tests/perf/compiler/all.T | 3 ++- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 00927d7..aa14b3b 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1397,10 +1397,13 @@ plusImportAvails imp_orphs = orphs1 `unionLists` orphs2, imp_finsts = finsts1 `unionLists` finsts2 } where - plus_mod_dep (m1, boot1) (m2, boot2) - = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) ) - -- Check mod-names match - (m1, boot1 && boot2) -- If either side can "see" a non-hi-boot interface, use that + plus_mod_dep r1@(m1, boot1) r2@(m2, boot2) + | ASSERT2( m1 == m2, (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) ) + boot1 = r2 + | otherwise = r1 + -- If either side can "see" a non-hi-boot interface, use that + -- Reusing existing tuples saves 10% of allocations on test + -- perf/compiler/MultiLayerModules {- ************************************************************************ diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 51dc6e8..431b288 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -1143,10 +1143,11 @@ test('T13379', test('MultiLayerModules', [ compiler_stats_num_field('bytes allocated', - [(wordsize(64), 6294813000, 10), + [(wordsize(64), 5619893176, 10), # initial: 12139116496 # 2017-05-12: 6956533312 Revert "Use a deterministic map for imp_dep_mods" # 2017-05-31: 6294813000 Faster checkFamInstConsistency + # 2018-01-21: 5619893176 Allocate less in plus_mod_dep ]), pre_cmd('./genMultiLayerModules'), extra_files(['genMultiLayerModules']), From git at git.haskell.org Thu Jan 25 12:21:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 12:21:46 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: triggering CI for Simon's patch (311939b) Message-ID: <20180125122146.4F99F3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/311939b51363d2e1076812ea44617b09c092319e/ghc >--------------------------------------------------------------- commit 311939b51363d2e1076812ea44617b09c092319e Author: Gabor Greif Date: Wed Jan 17 14:47:00 2018 +0100 WIP: triggering CI for Simon's patch >--------------------------------------------------------------- 311939b51363d2e1076812ea44617b09c092319e compiler/codeGen/StgCmmClosure.hs | 8 ++++++++ compiler/coreSyn/CoreOpt.hs | 20 +++++++++++++++++++- compiler/prelude/PrelRules.hs | 9 ++------- 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1da1f70..1736bba 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,6 +68,8 @@ module StgCmmClosure ( import GhcPrelude +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import SMRep import Cmm @@ -326,6 +328,11 @@ mkLFImported id -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor + | isValueUnfolding unf + , Just expr <- maybeUnfoldingTemplate unf + , Just con <- exprIsSatConApp_maybe expr + = LFCon con + | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") @@ -333,6 +340,7 @@ mkLFImported id = mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id + unf = realIdUnfolding id ------------- mkLFStringLit :: LambdaFormInfo diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 0f35e8f..f144e06 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -12,7 +12,8 @@ module CoreOpt ( joinPointBinding_maybe, joinPointBindings_maybe, -- ** Predicates on expressions - exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, + exprIsConApp_maybe, exprIsLiteral_maybe, + exprIsLambda_maybe, exprIsSatConApp_maybe, -- ** Coercions and casts pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo @@ -791,6 +792,23 @@ exprIsConApp_maybe (in_scope, id_unf) expr extend (Right s) v e = Right (extendSubst s v e) +exprIsSatConApp_maybe :: CoreExpr -> Maybe DataCon +-- Returns (Just dc) for a saturated application of dc +-- Simpler than exprIsConApp_maybe +exprIsSatConApp_maybe e = go 0 e + where + go :: Arity -> CoreExpr -> Maybe DataCon + go n_val_args (Var v) + | Just dc <- isDataConWorkId_maybe v + , dataConRepArity dc == n_val_args + = Just dc + go n_val_args (App f a) + | isTypeArg a = go n_val_args f + | otherwise = go (n_val_args + 1) f + go n_val_args (Cast e _) = go n_val_args e + go n_val_args (Tick _ e) = go n_val_args e + go _ _ = Nothing + -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion -> Maybe (DataCon, [Type], [CoreExpr]) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index db79589..3e9899f 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -33,7 +33,7 @@ import CoreSyn import MkCore import Id import Literal -import CoreOpt ( exprIsLiteral_maybe ) +import CoreOpt ( exprIsLiteral_maybe, exprIsSatConApp_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim @@ -41,7 +41,6 @@ import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon , unwrapNewTyCon_maybe, tyConDataCons ) import DataCon ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId ) import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) -import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) import PrelNames @@ -695,9 +694,6 @@ removeOp32 = do getArgs :: RuleM [CoreExpr] getArgs = RuleM $ \_ _ args -> Just args -getInScopeEnv :: RuleM InScopeEnv -getInScopeEnv = RuleM $ \_ iu _ -> Just iu - -- return the n-th argument of this rule, if it is a literal -- argument indices start from 0 getLiteral :: Int -> RuleM Literal @@ -916,8 +912,7 @@ dataToTagRule = a `mplus` b b = do dflags <- getDynFlags [_, val_arg] <- getArgs - in_scope <- getInScopeEnv - (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg + dc <- liftMaybe $ exprIsSatConApp_maybe val_arg ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return () return $ mkIntVal dflags (toInteger (dataConTagZ dc)) From git at git.haskell.org Thu Jan 25 12:21:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 12:21:52 +0000 (UTC) Subject: [commit: ghc] wip/T14677's head updated: WIP: reproduction of bug with slow/wrapper closure (36f1621) Message-ID: <20180125122152.4C0093A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14677' now includes: a3cde5f Improve comments about TcLevel invariants 452dee3 Pass -dsuppress-uniques when running T14507 f00ddea Allocate less in plus_mod_dep 311939b WIP: triggering CI for Simon's patch 36f1621 WIP: reproduction of bug with slow/wrapper closure From git at git.haskell.org Thu Jan 25 12:21:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 12:21:49 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: reproduction of bug with slow/wrapper closure (36f1621) Message-ID: <20180125122149.ACFDE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/36f1621014a86ed1d591802020d9b68499b9783e/ghc >--------------------------------------------------------------- commit 36f1621014a86ed1d591802020d9b68499b9783e Author: Gabor Greif Date: Thu Jan 25 12:20:30 2018 +0100 WIP: reproduction of bug with slow/wrapper closure >--------------------------------------------------------------- 36f1621014a86ed1d591802020d9b68499b9783e T14677.hs | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/T14677.hs b/T14677.hs new file mode 100644 index 0000000..3c6dd87 --- /dev/null +++ b/T14677.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Main where + +import GHC.Event + +-- frobbed from GHC.Event.Internal +data Backend = forall a. Backend { + beState :: !a + + , beModifyFd :: a + -> Event -- old events to watch for ('mempty' for new) + -> Event -- new events to watch for ('mempty' to delete) + -> IO Bool + } + +backend :: (a -> Event -> Event -> IO Bool) -> a -> Backend +backend = flip Backend + +{-# NOINLINE be #-} +be = backend mod ev + where mod e0 e1 e2 = do putStrLn "Should be:" + putStrLn "([evtRead],[],[evtWrite])" + putStrLn "Is:" + print (e0, e1, e2) + "([evtRead],[],[evtWrite])" <- pure $ show (e0, e1, e2) + pure $ e0 == evtRead + ev = evtRead + +main = case be of + Backend { beModifyFd = mod, beState = sta } -> mod sta mempty evtWrite >>= print From git at git.haskell.org Thu Jan 25 17:20:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 17:20:39 +0000 (UTC) Subject: [commit: ghc] master: Remove dead code: mkNthCoRole (076bdb3) Message-ID: <20180125172039.44B803A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/076bdb36cf93b453ed08a36224e7d67b15be7162/ghc >--------------------------------------------------------------- commit 076bdb36cf93b453ed08a36224e7d67b15be7162 Author: Simon Peyton Jones Date: Thu Jan 25 09:58:17 2018 +0000 Remove dead code: mkNthCoRole >--------------------------------------------------------------- 076bdb36cf93b453ed08a36224e7d67b15be7162 compiler/types/Coercion.hs | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 3f83b09..cec56b1 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -29,7 +29,7 @@ module Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, mkTransAppCo, - mkNthCo, mkNthCoRole, mkLRCo, + mkNthCo, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCos, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkHomoForAllCos_NoRefl, mkPhantomCo, @@ -804,15 +804,6 @@ mkTransCo co1 (Refl {}) = co1 mkTransCo (Refl {}) co2 = co2 mkTransCo co1 co2 = TransCo co1 co2 --- the Role is the desired one. It is the caller's responsibility to make --- sure this request is reasonable -mkNthCoRole :: Role -> Int -> Coercion -> Coercion -mkNthCoRole role n co - = downgradeRole role nth_role $ nth_co - where - nth_co = mkNthCo n co - nth_role = coercionRole nth_co - mkNthCo :: Int -> Coercion -> Coercion mkNthCo 0 (Refl _ ty) | Just (tv, _) <- splitForAllTy_maybe ty From git at git.haskell.org Thu Jan 25 17:20:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 17:20:42 +0000 (UTC) Subject: [commit: ghc] master: Comments about CoercionHoles (d36ae5d) Message-ID: <20180125172042.655353A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d36ae5d6a448178e3db4736f6a4364e48ac7041b/ghc >--------------------------------------------------------------- commit d36ae5d6a448178e3db4736f6a4364e48ac7041b Author: Simon Peyton Jones Date: Thu Jan 25 09:57:01 2018 +0000 Comments about CoercionHoles Richard was confused; I hope these comments help. >--------------------------------------------------------------- d36ae5d6a448178e3db4736f6a4364e48ac7041b compiler/typecheck/TcSimplify.hs | 11 +++++---- compiler/types/TyCoRep.hs | 51 ++++++++++++++++++++++++++++++---------- 2 files changed, 44 insertions(+), 18 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 62a4800..e0588ea 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -2346,13 +2346,14 @@ The "bound variables of the implication" are 3. The binders of all evidence bindings in `ic_binds`. Example forall a. (d :: t1 ~ t2) EvBinds { (co :: t1 ~# t2) = superclass-sel d } - => [W] co : (a ~# b |> co) - Here `co` is gotten by superclass selection from `d`. + => [W] co2 : (a ~# b |> co) + Here `co` is gotten by superclass selection from `d`, and the + wanted constraint co2 must not float. - 4. And the evidence variable of any equality constraint whose type - mentions a bound variable. Example: + 4. And the evidence variable of any equality constraint (incl + Wanted ones) whose type mentions a bound variable. Example: forall k. [W] co1 :: t1 ~# t2 |> co2 - [W] co2 :: k ~# * + [W] co2 :: k ~# * Here, since `k` is bound, so is `co2` and hence so is `co1`. Here (1,2,3) are handled by the "seed_skols" calculation, and diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index d9cc42b..588963d 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1214,6 +1214,8 @@ instance Outputable UnivCoProvenance where -- | A coercion to be filled in by the type-checker. See Note [Coercion holes] data CoercionHole = CoercionHole { ch_co_var :: CoVar + -- See Note [CoercionHoles and coercion free variables] + , ch_ref :: IORef (Maybe Coercion) } @@ -1254,7 +1256,7 @@ During typechecking, constraint solving for type classes works by For equality constraints we use a different strategy. See Note [The equality types story] in TysPrim for background on equality constraints. - - For boxed equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just + - For /boxed/ equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just like type classes above. (Indeed, boxed equality constraints *are* classes.) - But for /unboxed/ equality constraints (t1 ~R# t2) and (t1 ~N# t2) we use a different plan @@ -1270,15 +1272,24 @@ For unboxed equalities: The main reason for all this is that there may be no good place to let-bind the evidence for unboxed equalities: - - We emit constraints for kind coercions, to be used - to cast a type's kind. These coercions then must be used in types. Because - they might appear in a top-level type, there is no place to bind these - (unlifted) coercions in the usual way. + + - We emit constraints for kind coercions, to be used to cast a + type's kind. These coercions then must be used in types. Because + they might appear in a top-level type, there is no place to bind + these (unlifted) coercions in the usual way. - A coercion for (forall a. t1) ~ (forall a. t2) will look like forall a. (coercion for t1~t2) - But the coercion for (t1~t2) may mention 'a', and we don't have let-bindings - within coercions. We could add them, but coercion holes are easier. + But the coercion for (t1~t2) may mention 'a', and we don't have + let-bindings within coercions. We could add them, but coercion + holes are easier. + + - Moreover, nothing is lost from the lack of let-bindings. For + dicionaries want to achieve sharing to avoid recomoputing the + dictionary. But coercions are entirely erased, so there's little + benefit to sharing. Indeed, even if we had a let-binding, we + always inline types and coercions at every use site and drop the + binding. Other notes about HoleCo: @@ -1289,14 +1300,26 @@ Other notes about HoleCo: type-checking vs forms that can appear in core proper, holes in Core will be ruled out. - * The Unique carried with a coercion hole is used solely for debugging. + * See Note [CoercionHoles and coercion free variables] + + * Coercion holes can be compared for equality like other coercions: + by looking at the types coerced. + + +Note [CoercionHoles and coercion free variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Why does a CoercionHole contain a CoVar, as well as reference to +fill in? Because we want to treat that CoVar as a free variable of +the coercion. See Trac #14584, and Note [What prevents a +constraint from floating] in TcSimplify, item (4): + + forall k. [W] co1 :: t1 ~# t2 |> co2 + [W] co2 :: k ~# * - * Coercion holes can be compared for equality only like other coercions: - only by looking at the types coerced. +Here co2 is a CoercionHole. But we /must/ know that it is free in +co1, because that's all that stops it floating outside the +implication. - * We don't use holes for other evidence because other evidence wants to - be /shared/. But coercions are entirely erased, so there's little - benefit to sharing. Note [ProofIrrelProv] ~~~~~~~~~~~~~~~~~~~~~ @@ -1461,6 +1484,7 @@ tyCoFVsOfCo (CoVarCo v) fv_cand in_scope acc = tyCoFVsOfCoVar v fv_cand in_scope acc tyCoFVsOfCo (HoleCo h) fv_cand in_scope acc = tyCoFVsOfCoVar (coHoleCoVar h) fv_cand in_scope acc + -- See Note [CoercionHoles and coercion free variables] tyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1 @@ -1525,6 +1549,7 @@ coVarsOfCo (ForAllCo tv kind_co co) coVarsOfCo (FunCo _ co1 co2) = coVarsOfCo co1 `unionVarSet` coVarsOfCo co2 coVarsOfCo (CoVarCo v) = coVarsOfCoVar v coVarsOfCo (HoleCo h) = coVarsOfCoVar (coHoleCoVar h) + -- See Note [CoercionHoles and coercion free variables] coVarsOfCo (AxiomInstCo _ _ as) = coVarsOfCos as coVarsOfCo (UnivCo p _ t1 t2) = coVarsOfProv p `unionVarSet` coVarsOfTypes [t1, t2] coVarsOfCo (SymCo co) = coVarsOfCo co From git at git.haskell.org Thu Jan 25 17:20:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 17:20:45 +0000 (UTC) Subject: [commit: ghc] master: Comments only (2a2e6a8) Message-ID: <20180125172045.8111A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2a2e6a8f703ef2a38cc85bd57ce9e29d2c9f2913/ghc >--------------------------------------------------------------- commit 2a2e6a8f703ef2a38cc85bd57ce9e29d2c9f2913 Author: Simon Peyton Jones Date: Thu Jan 25 09:58:53 2018 +0000 Comments only >--------------------------------------------------------------- 2a2e6a8f703ef2a38cc85bd57ce9e29d2c9f2913 compiler/coreSyn/CoreOpt.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 0f35e8f..04e604e 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -968,9 +968,9 @@ pushCoTyArg co ty -- tyR = forall (a2 :: k2). ty2 co1 = mkNthCo 0 co - -- co1 :: k1 ~ k2 - -- Note that NthCo can extract an equality between the kinds - -- of the types related by a coercion between forall-types. + -- co1 :: k1 ~N k2 + -- Note that NthCo can extract a Nominal equality between the + -- kinds of the types related by a coercion between forall-types. -- See the NthCo case in CoreLint. co2 = mkInstCo co (mkCoherenceLeftCo (mkNomReflCo ty) co1) From git at git.haskell.org Thu Jan 25 17:20:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 17:20:48 +0000 (UTC) Subject: [commit: ghc] master: Fix the lone-variable case in callSiteInline (0636689) Message-ID: <20180125172048.7500B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/06366890ba77c20198d7fccc870083b0bbfb1b11/ghc >--------------------------------------------------------------- commit 06366890ba77c20198d7fccc870083b0bbfb1b11 Author: Simon Peyton Jones Date: Thu Jan 25 10:32:46 2018 +0000 Fix the lone-variable case in callSiteInline See Note [Lone variables] in CoreUnfold and Note [exprIsExpandable] in CoreUtils. Helpfully pointed out by Matthew Pickering in Trac #14688 Nofib results are good: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna +0.1% +0.3% 0.151 0.151 0.0% awards +0.0% -0.2% 0.001 0.001 0.0% compress2 +0.6% -0.7% -4.8% -5.0% -4.0% eliza +0.0% -2.4% 0.001 0.001 0.0% fulsom +0.4% -13.3% -7.6% -7.6% +190.0% gamteb +0.0% -0.6% 0.062 0.062 0.0% gg +0.1% -0.4% 0.016 0.016 0.0% ida +0.1% +0.3% 0.110 0.110 0.0% kahan +0.0% -0.7% -0.9% -0.9% 0.0% mate +0.1% -5.2% -4.9% -4.9% 0.0% n-body +0.0% -0.2% -0.3% -3.0% 0.0% pretty +0.0% -2.8% 0.000 0.000 0.0% scs +0.0% -0.2% +1.6% +2.4% 0.0% simple +0.4% -0.2% -2.3% -2.3% -3.4% veritas +0.4% -1.0% 0.003 0.003 0.0% wang +0.0% -1.6% 0.165 0.165 0.0% -------------------------------------------------------------------------------- Min -0.0% -13.3% -16.2% -18.8% -4.0% Max +0.6% +0.3% +4.9% +4.9% +190.0% Geometric Mean +0.1% -0.3% -1.7% -2.4% +0.9% >--------------------------------------------------------------- 06366890ba77c20198d7fccc870083b0bbfb1b11 compiler/coreSyn/CoreUnfold.hs | 9 ++-- compiler/coreSyn/CoreUtils.hs | 102 +++++++++++++++++++++++++++++------------ 2 files changed, 77 insertions(+), 34 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index c459fd2..2e2b7a3 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -1241,8 +1241,8 @@ tryUnfolding dflags id lone_variable = True | otherwise = case cont_info of - CaseCtxt -> not (lone_variable && is_wf) -- Note [Lone variables] - ValAppCtxt -> True -- Note [Cast then apply] + CaseCtxt -> not (lone_variable && is_exp) -- Note [Lone variables] + ValAppCtxt -> True -- Note [Cast then apply] RuleArgCtxt -> uf_arity > 0 -- See Note [Unfold info lazy contexts] DiscArgCtxt -> uf_arity > 0 -- RhsCtxt -> uf_arity > 0 -- @@ -1388,9 +1388,10 @@ because the latter is strict. s = "foo" f = \x -> ...(error s)... -Fundamentally such contexts should not encourage inlining because the +Fundamentally such contexts should not encourage inlining because, provided +the RHS is "expandable" (see Note [exprIsExpandable] in CoreUtils) the context can ``see'' the unfolding of the variable (e.g. case or a -RULE) so there's no gain. If the thing is bound to a value. +RULE) so there's no gain. However, watch out: diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 5e32dc6..3d5f4bc 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -1083,29 +1083,6 @@ Note that exprIsHNF does not imply exprIsCheap. Eg This responds True to exprIsHNF (you can discard a seq), but False to exprIsCheap. -Note [exprIsExpandable] -~~~~~~~~~~~~~~~~~~~~~~~ -An expression is "expandable" if we are willing to dupicate it, if doing -so might make a RULE or case-of-constructor fire. Mainly this means -data-constructor applications, but it's a bit more generous than exprIsCheap -because it is true of "CONLIKE" Ids: see Note [CONLIKE pragma] in BasicTypes. - -It is used to set the uf_expandable field of an Unfolding, and that -in turn is used - * In RULE matching - * In exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe - -But take care: exprIsExpandable should /not/ be true of primops. I -found this in test T5623a: - let q = /\a. Ptr a (a +# b) - in case q @ Float of Ptr v -> ...q... - -q's inlining should not be expandable, else exprIsConApp_maybe will -say that (q @ Float) expands to (Ptr a (a +# b)), and that will -duplicate the (a +# b) primop, which we should not do lightly. -(It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) - - Note [Arguments and let-bindings exprIsCheapX] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ What predicate should we apply to the argument of an application, or the @@ -1131,16 +1108,12 @@ in this (which it previously was): -} -------------------- -exprIsCheap :: CoreExpr -> Bool -exprIsCheap = exprIsCheapX isCheapApp - -exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable = exprIsCheapX isExpandableApp - exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] exprIsWorkFree = exprIsCheapX isWorkFreeApp --------------------- +exprIsCheap :: CoreExpr -> Bool +exprIsCheap = exprIsCheapX isCheapApp + exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool exprIsCheapX ok_app e = ok e @@ -1168,6 +1141,75 @@ exprIsCheapX ok_app e -- App, Let: see Note [Arguments and let-bindings exprIsCheapX] +{- Note [exprIsExpandable] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +An expression is "expandable" if we are willing to duplicate it, if doing +so might make a RULE or case-of-constructor fire. Consider + let x = (a,b) + y = build g + in ....(case x of (p,q) -> rhs)....(foldr k z y).... + +We don't inline 'x' or 'y' (see Note [Lone variables] in CoreUnfold), +but we do want + + * the case-expression to simplify + (via exprIsConApp_maybe, exprIsLiteral_maybe) + + * the foldr/build RULE to fire + (by expanding the unfolding during rule matching) + +So we classify the unfolding of a let-binding as "expandable" (via the +uf_expandable field) if we want to do this kind of on-the-fly +expansion. Specifically: + +* True of constructor applications (K a b) + +* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in BasicTypes. + (NB: exprIsCheap might not be true of this) + +* False of case-expressions. If we have + let x = case ... in ...(case x of ...)... + we won't simplify. We have to inline x. See Trac #14688. + +* False of let-expressions (same reason); and in any case we + float lets out of an RHS if doing so will reveal an expandable + application (see SimplEnv.doFloatFromRhs). + +* Take care: exprIsExpandable should /not/ be true of primops. I + found this in test T5623a: + let q = /\a. Ptr a (a +# b) + in case q @ Float of Ptr v -> ...q... + + q's inlining should not be expandable, else exprIsConApp_maybe will + say that (q @ Float) expands to (Ptr a (a +# b)), and that will + duplicate the (a +# b) primop, which we should not do lightly. + (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) +-} + +------------------------------------- +exprIsExpandable :: CoreExpr -> Bool +-- See Note [exprIsExpandable] +exprIsExpandable e + = ok e + where + ok e = go 0 e + + -- n is the number of value arguments + go n (Var v) = isExpandableApp v n + go _ (Lit {}) = True + go _ (Type {}) = True + go _ (Coercion {}) = True + go n (Cast e _) = go n e + go n (Tick t e) | tickishCounts t = False + | otherwise = go n e + go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e + | otherwise = go n e + go n (App f e) | isRuntimeArg e = go (n+1) f && ok e + | otherwise = go n f + go _ (Case {}) = False + go _ (Let {}) = False + + ------------------------------------- type CheapAppFun = Id -> Arity -> Bool -- Is an application of this function to n *value* args From git at git.haskell.org Thu Jan 25 20:15:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 20:15:54 +0000 (UTC) Subject: [commit: ghc] branch 'wip/tdammers/T11735' created Message-ID: <20180125201554.57B7B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/tdammers/T11735 Referencing: 8ac966971ec6c30cc3681a913fb9fb1c2342f6cc From git at git.haskell.org Thu Jan 25 20:15:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 20:15:57 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Applying patch suggested in #11735 to improve coercionKind perf (4572849) Message-ID: <20180125201557.34B6B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/45728499292108c8f180cb3ce106228163dc8812/ghc >--------------------------------------------------------------- commit 45728499292108c8f180cb3ce106228163dc8812 Author: Tobias Dammers Date: Wed Jan 24 16:05:55 2018 +0100 Applying patch suggested in #11735 to improve coercionKind perf >--------------------------------------------------------------- 45728499292108c8f180cb3ce106228163dc8812 compiler/types/Coercion.hs | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 3f83b09..e1a5b7c 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1702,22 +1702,18 @@ coercionType co = case coercionKindRole co of -- i.e. the kind of @c@ relates @t1@ and @t2@, then @coercionKind c = Pair t1 t2 at . coercionKind :: Coercion -> Pair Type -coercionKind co = go co +coercionKind co = + {-# SCC "coercionKind" #-} + go co where go (Refl _ ty) = Pair ty ty go (TyConAppCo _ tc cos)= mkTyConApp tc <$> (sequenceA $ map go cos) go (AppCo co1 co2) = mkAppTy <$> go co1 <*> go co2 - go (ForAllCo tv1 k_co co) - = let Pair _ k2 = go k_co - tv2 = setTyVarKind tv1 k2 - Pair ty1 ty2 = go co - subst = zipTvSubst [tv1] [TyVarTy tv2 `mk_cast_ty` mkSymCo k_co] - ty2' = substTyAddInScope subst ty2 in - -- We need free vars of ty2 in scope to satisfy the invariant - -- from Note [The substitution invariant] - -- This is doing repeated substitutions and probably doesn't - -- need to, see #11735 - mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2' + go co@(ForAllCo tv1 k_co co1) + | isReflCo k_co = mkInvForAllTy tv1 <$> go co1 + | otherwise = go_forall empty_subst co + where + empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfCo co) go (FunCo _ co1 co2) = mkFunTy <$> go co1 <*> go co2 go (CoVarCo cv) = coVarTypes cv go (HoleCo h) = coVarTypes (coHoleCoVar h) @@ -1769,10 +1765,16 @@ coercionKind co = go co go_app (InstCo co arg) args = go_app co (arg:args) go_app co args = piResultTys <$> go co <*> (sequenceA $ map go args) - -- The real mkCastTy is too slow, and we can easily have nested ForAllCos. - mk_cast_ty :: Type -> Coercion -> Type - mk_cast_ty ty (Refl {}) = ty - mk_cast_ty ty co = CastTy ty co + go_forall subst (ForAllCo tv1 k_co co) + = mkInvForAllTy <$> Pair tv1 tv2 <*> go_forall subst' co + where + Pair _ k2 = go k_co + tv2 = setTyVarKind tv1 (substTy subst k2) + subst' | isReflCo k_co = extendTCvInScope subst tv1 + | otherwise = extendTvSubst (extendTCvInScope subst tv2) tv1 $ + TyVarTy tv2 `mkCastTy` mkSymCo k_co + go_forall subst other_co + = substTy subst `pLiftSnd` go other_co -- | Apply 'coercionKind' to multiple 'Coercion's coercionKinds :: [Coercion] -> Pair [Type] From git at git.haskell.org Thu Jan 25 20:16:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 20:16:00 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Added SCCs to hunt down #14683 (73a9975) Message-ID: <20180125201600.2096D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/73a99750e131d30dd6e638823ba32927aa8e84ca/ghc >--------------------------------------------------------------- commit 73a99750e131d30dd6e638823ba32927aa8e84ca Author: Tobias Dammers Date: Wed Jan 24 16:07:00 2018 +0100 Added SCCs to hunt down #14683 >--------------------------------------------------------------- 73a99750e131d30dd6e638823ba32927aa8e84ca compiler/simplCore/Simplify.hs | 79 +++++++++++++++++++++++++----------------- compiler/types/TyCoRep.hs | 9 ++--- 2 files changed, 53 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 73a99750e131d30dd6e638823ba32927aa8e84ca From git at git.haskell.org Thu Jan 25 20:16:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 20:16:03 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Refactored coercionKindsRole (as per #11735) (d0ef693) Message-ID: <20180125201603.135153A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/d0ef6939b9330c3dcf6a4dddd1b1d1bad7c1ad08/ghc >--------------------------------------------------------------- commit d0ef6939b9330c3dcf6a4dddd1b1d1bad7c1ad08 Author: Tobias Dammers Date: Wed Jan 24 17:20:20 2018 +0100 Refactored coercionKindsRole (as per #11735) >--------------------------------------------------------------- d0ef6939b9330c3dcf6a4dddd1b1d1bad7c1ad08 compiler/types/Coercion.hs | 74 ++++++++++++++++------------------------------ 1 file changed, 25 insertions(+), 49 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index e1a5b7c..36874a4 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1783,77 +1783,53 @@ coercionKinds tys = sequenceA $ map coercionKind tys -- | Get a coercion's kind and role. -- Why both at once? See Note [Computing a coercion kind and role] coercionKindRole :: Coercion -> (Pair Type, Role) -coercionKindRole = go +coercionKindRole co = (coercionKind co, coercionRole co) + +-- | Retrieve the role from a coercion. +coercionRole :: Coercion -> Role +coercionRole = go where - go (Refl r ty) = (Pair ty ty, r) - go (TyConAppCo r tc cos) - = (mkTyConApp tc <$> (sequenceA $ map coercionKind cos), r) - go (AppCo co1 co2) - = let (tys1, r1) = go co1 in - (mkAppTy <$> tys1 <*> coercionKind co2, r1) - go (ForAllCo tv1 k_co co) - = let Pair _ k2 = coercionKind k_co - tv2 = setTyVarKind tv1 k2 - (Pair ty1 ty2, r) = go co - subst = zipTvSubst [tv1] [TyVarTy tv2 `mkCastTy` mkSymCo k_co] - ty2' = substTyAddInScope subst ty2 in - -- We need free vars of ty2 in scope to satisfy the invariant - -- from Note [The substitution invariant] - -- This is doing repeated substitutions and probably doesn't - -- need to, see #11735 - (mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2', r) - go (FunCo r co1 co2) - = (mkFunTy <$> coercionKind co1 <*> coercionKind co2, r) + go (Refl r _) = r + go (TyConAppCo r _ _) = r + go (AppCo co1 _) = go co1 + go (ForAllCo _ _ co) = go co + go (FunCo r _ _) = r go (CoVarCo cv) = go_var cv go (HoleCo h) = go_var (coHoleCoVar h) - go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax) - go (UnivCo _ r ty1 ty2) = (Pair ty1 ty2, r) - go (SymCo co) = first swap $ go co - go (TransCo co1 co2) - = let (tys1, r) = go co1 in - (Pair (pFst tys1) (pSnd $ coercionKind co2), r) + go (AxiomInstCo ax _ _) = coAxiomRole ax + go (UnivCo _ r _ _) = r + go (SymCo co) = go co + go (TransCo co1 co2) = go co1 go (NthCo d co) | Just (tv1, _) <- splitForAllTy_maybe ty1 = ASSERT( d == 0 ) - let (tv2, _) = splitForAllTy ty2 in - (tyVarKind <$> Pair tv1 tv2, Nominal) + Nominal | otherwise = let (tc1, args1) = splitTyConApp ty1 (_tc2, args2) = splitTyConApp ty2 in ASSERT2( tc1 == _tc2, ppr d $$ ppr tc1 $$ ppr _tc2 ) - ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d) + (nthRole r tc1 d) where - (Pair ty1 ty2, r) = go co - go co@(LRCo {}) = (coercionKind co, Nominal) + (Pair ty1 ty2, r) = coercionKindRole co + go (LRCo {}) = Nominal go (InstCo co arg) = go_app co [arg] - go (CoherenceCo co1 co2) - = let (Pair t1 t2, r) = go co1 in - (Pair (t1 `mkCastTy` co2) t2, r) - go co@(KindCo {}) = (coercionKind co, Nominal) - go (SubCo co) = (coercionKind co, Representational) - go co@(AxiomRuleCo ax _) = (coercionKind co, coaxrRole ax) + go (CoherenceCo co1 _) = go co1 + go (KindCo {}) = Nominal + go (SubCo _) = Representational + go (AxiomRuleCo ax _) = coaxrRole ax ------------- - go_var cv = (coVarTypes cv, coVarRole cv) + go_var = coVarRole ------------- - go_app :: Coercion -> [Coercion] -> (Pair Type, Role) + go_app :: Coercion -> [Coercion] -> Role -- Collect up all the arguments and apply all at once -- See Note [Nested InstCos] go_app (InstCo co arg) args = go_app co (arg:args) - go_app co args - = let (pair, r) = go co in - (piResultTys <$> pair <*> (sequenceA $ map coercionKind args), r) - --- | Retrieve the role from a coercion. -coercionRole :: Coercion -> Role -coercionRole = snd . coercionKindRole - -- There's not a better way to do this, because NthCo needs the *kind* - -- and role of its argument. Luckily, laziness should generally avoid - -- the need for computing kinds in other cases. + go_app co args = go co {- Note [Nested InstCos] From git at git.haskell.org Thu Jan 25 20:16:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 20:16:06 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Simplification as per #11735 (4eb140f) Message-ID: <20180125201606.0AE4A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/4eb140f564189270b12c992911aec6974f940cc3/ghc >--------------------------------------------------------------- commit 4eb140f564189270b12c992911aec6974f940cc3 Author: Tobias Dammers Date: Thu Jan 25 11:16:30 2018 +0100 Simplification as per #11735 (https://ghc.haskell.org/trac/ghc/ticket/11735#comment:19) >--------------------------------------------------------------- 4eb140f564189270b12c992911aec6974f940cc3 compiler/types/Coercion.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 36874a4..08d9f5b 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1815,7 +1815,7 @@ coercionRole = go where (Pair ty1 ty2, r) = coercionKindRole co go (LRCo {}) = Nominal - go (InstCo co arg) = go_app co [arg] + go (InstCo co arg) = go_app co go (CoherenceCo co1 _) = go co1 go (KindCo {}) = Nominal go (SubCo _) = Representational @@ -1825,11 +1825,9 @@ coercionRole = go go_var = coVarRole ------------- - go_app :: Coercion -> [Coercion] -> Role - -- Collect up all the arguments and apply all at once - -- See Note [Nested InstCos] - go_app (InstCo co arg) args = go_app co (arg:args) - go_app co args = go co + go_app :: Coercion -> Role + go_app (InstCo co arg) = go_app co + go_app co = go co {- Note [Nested InstCos] From git at git.haskell.org Thu Jan 25 20:16:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Jan 2018 20:16:09 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Caching coercion roles in NthCo (#11735) (8ac9669) Message-ID: <20180125201609.00CEB3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/8ac966971ec6c30cc3681a913fb9fb1c2342f6cc/ghc >--------------------------------------------------------------- commit 8ac966971ec6c30cc3681a913fb9fb1c2342f6cc Author: Tobias Dammers Date: Thu Jan 25 20:33:58 2018 +0100 Caching coercion roles in NthCo (#11735) >--------------------------------------------------------------- 8ac966971ec6c30cc3681a913fb9fb1c2342f6cc compiler/coreSyn/CoreFVs.hs | 2 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/iface/ToIface.hs | 2 +- compiler/typecheck/TcTyDecls.hs | 2 +- compiler/typecheck/TcType.hs | 2 +- compiler/typecheck/TcUnify.hs | 2 +- compiler/typecheck/TcValidity.hs | 2 +- compiler/types/Coercion.hs | 45 ++++++++++++++++++++++------------------ compiler/types/FamInstEnv.hs | 2 +- compiler/types/OptCoercion.hs | 4 ++-- compiler/types/TyCoRep.hs | 32 +++++++++++++++++++++------- compiler/types/Type.hs | 8 +++---- 13 files changed, 64 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8ac966971ec6c30cc3681a913fb9fb1c2342f6cc From git at git.haskell.org Fri Jan 26 02:42:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 02:42:08 +0000 (UTC) Subject: [commit: ghc] wip/14691: s,ctEvTerm,ctEvExpr,g (dc6de0a) Message-ID: <20180126024208.BEA2B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/dc6de0a3d6c7acc1b4147a66de8fd6d8b9c60e54/ghc >--------------------------------------------------------------- commit dc6de0a3d6c7acc1b4147a66de8fd6d8b9c60e54 Author: Joachim Breitner Date: Thu Jan 25 21:37:40 2018 -0500 s,ctEvTerm,ctEvExpr,g >--------------------------------------------------------------- dc6de0a3d6c7acc1b4147a66de8fd6d8b9c60e54 compiler/typecheck/TcCanonical.hs | 4 ++-- compiler/typecheck/TcInteract.hs | 12 ++++++------ compiler/typecheck/TcMType.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 8 ++++---- compiler/typecheck/TcSMonad.hs | 4 ++-- 5 files changed, 15 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index e159c3a..60f4497 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -153,7 +153,7 @@ canClassNC ev cls tys -- Then we solve the wanted by pushing the call-site -- onto the newly emitted CallStack - ; let ev_cs = EvCsPushCall func (ctLocSpan loc) (ctEvTerm new_ev) + ; let ev_cs = EvCsPushCall func (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs ; canClass new_ev cls tys False } @@ -1845,7 +1845,7 @@ rewriteEvidence old_ev@(CtDerived {}) new_pred _co -- rewriteEvidence to put the isTcReflCo test first! -- Why? Because for *Derived* constraints, c, the coercion, which -- was produced by flattening, may contain suspended calls to - -- (ctEvTerm c), which fails for Derived constraints. + -- (ctEvExpr c), which fails for Derived constraints. -- (Getting this wrong caused Trac #7384.) continueWith (old_ev { ctev_pred = new_pred }) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 11d9252..39424de 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -694,8 +694,8 @@ interactIrred inerts workItem@(CIrredCan { cc_ev = ev_w, cc_insol = insoluble }) swap_me :: SwapFlag -> CtEvidence -> EvExpr swap_me swap ev = case swap of - NotSwapped -> ctEvTerm ev - IsSwapped -> evCoercion (mkTcSymCo (evTermCoercion (EvExpr (ctEvTerm ev)))) + NotSwapped -> ctEvExpr ev + IsSwapped -> evCoercion (mkTcSymCo (evTermCoercion (EvExpr (ctEvExpr ev)))) interactIrred _ wi = pprPanic "interactIrred" (ppr wi) @@ -1001,9 +1001,9 @@ interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs { what_next <- solveOneFromTheOther ev_i ev_w ; traceTcS "lookupInertDict" (ppr what_next) ; case what_next of - KeepInert -> do { setEvBindIfWanted ev_w (ctEvTerm ev_i) + KeepInert -> do { setEvBindIfWanted ev_w (ctEvExpr ev_i) ; return $ Stop ev_w (text "Dict equal" <+> parens (ppr what_next)) } - KeepWork -> do { setEvBindIfWanted ev_i (ctEvTerm ev_w) + KeepWork -> do { setEvBindIfWanted ev_i (ctEvExpr ev_w) ; updInertDicts $ \ ds -> delDict ds cls tys ; continueWith workItem } } } @@ -1057,7 +1057,7 @@ shortCutSolver dflags ev_w ev_i new_wanted_cached cache pty | ClassPred cls tys <- classifyPredType pty = lift $ case findDict cache loc_w cls tys of - Just ctev -> return $ Cached (ctEvTerm ctev) + Just ctev -> return $ Cached (ctEvExpr ctev) Nothing -> Fresh <$> newWantedNC loc_w pty | otherwise = mzero @@ -2202,7 +2202,7 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = fl, cc_class = cls ; continueWith work_item } | Just ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached - = do { setEvBindIfWanted fl (ctEvTerm ev) + = do { setEvBindIfWanted fl (ctEvExpr ev) ; stopWith fl "Dict/Top (cached)" } | otherwise -- Wanted or Derived, but not cached diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 2881491..4de99b5 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -207,7 +207,7 @@ emitWanted :: CtOrigin -> TcPredType -> TcM EvExpr emitWanted origin pty = do { ev <- newWanted origin Nothing pty ; emitSimple $ mkNonCanonical ev - ; return $ ctEvTerm ev } + ; return $ ctEvExpr ev } -- | Emits a new equality constraint emitWantedEq :: CtOrigin -> TypeOrKind -> Role -> TcType -> TcType -> TcM Coercion diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 2718d6b..364fd95 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -78,7 +78,7 @@ module TcRnTypes( mkNonCanonical, mkNonCanonicalCt, mkGivens, mkIrredCt, mkInsolubleCt, ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel, - ctEvTerm, ctEvCoercion, ctEvEvId, + ctEvExpr, ctEvCoercion, ctEvEvId, tyCoVarsOfCt, tyCoVarsOfCts, tyCoVarsOfCtList, tyCoVarsOfCtsList, @@ -2674,9 +2674,9 @@ ctEvEqRel = predTypeEqRel . ctEvPred ctEvRole :: CtEvidence -> Role ctEvRole = eqRelRole . ctEvEqRel -ctEvTerm :: CtEvidence -> EvExpr -ctEvTerm ev@(CtWanted { ctev_dest = HoleDest _ }) = evCoercion $ ctEvCoercion ev -ctEvTerm ev = evId (ctEvEvId ev) +ctEvExpr :: CtEvidence -> EvExpr +ctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ }) = evCoercion $ ctEvCoercion ev +ctEvExpr ev = evId (ctEvEvId ev) -- Always returns a coercion whose type is precisely ctev_pred of the CtEvidence. -- See also Note [Given in ctEvCoercion] diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index cd8eea1..af77a2c 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -2998,7 +2998,7 @@ freshGoals :: [MaybeNew] -> [CtEvidence] freshGoals mns = [ ctev | Fresh ctev <- mns ] getEvExpr :: MaybeNew -> EvExpr -getEvExpr (Fresh ctev) = ctEvTerm ctev +getEvExpr (Fresh ctev) = ctEvExpr ctev getEvExpr (Cached evt) = evt setEvBind :: EvBind -> TcS () @@ -3111,7 +3111,7 @@ newWantedEvVar loc pty Just ctev | not (isDerived ctev) -> do { traceTcS "newWantedEvVar/cache hit" $ ppr ctev - ; return $ Cached (ctEvTerm ctev) } + ; return $ Cached (ctEvExpr ctev) } _ -> do { ctev <- newWantedEvVarNC loc pty ; return (Fresh ctev) } } From git at git.haskell.org Fri Jan 26 02:42:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 02:42:17 +0000 (UTC) Subject: [commit: ghc] wip/14691's head updated: Update test suite output due to #14691 (c022a9f) Message-ID: <20180126024217.C42913A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/14691' now includes: 5e8ea6a testsuite: Add test for #14335 f855769 Add new mbmi and mbmi2 compiler flags 765ba65 testsuite: Add testcase for #14670 0074a08 Fix #14692 by correcting an off-by-one error in TcGenDeriv 5edb18a tentative improvement to callstack docs 180ca65 [rts] Adjust whitehole_spin 4a13c5b Implement underscores in numeric literals (NumericUnderscores extension) 8829743 Use IntSet in Dataflow 6c0db98 SysTools: Add detection support for LLD linker 2671ccc Update Cabal submodule 24e56eb Bump transformers submodule to 0.5.5.0 a3cde5f Improve comments about TcLevel invariants 452dee3 Pass -dsuppress-uniques when running T14507 f00ddea Allocate less in plus_mod_dep d36ae5d Comments about CoercionHoles 076bdb3 Remove dead code: mkNthCoRole 2a2e6a8 Comments only 0636689 Fix the lone-variable case in callSiteInline dc6de0a s,ctEvTerm,ctEvExpr,g 73ed13e Merge remote-tracking branch 'origin/master' into wip/14691 c022a9f Update test suite output due to #14691 From git at git.haskell.org Fri Jan 26 02:42:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 02:42:12 +0000 (UTC) Subject: [commit: ghc] wip/14691: Merge remote-tracking branch 'origin/master' into wip/14691 (73ed13e) Message-ID: <20180126024212.1A8703A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/73ed13ed36e5a8e3fe29b9c349dfc292bed66a98/ghc >--------------------------------------------------------------- commit 73ed13ed36e5a8e3fe29b9c349dfc292bed66a98 Merge: dc6de0a 0636689 Author: Joachim Breitner Date: Thu Jan 25 21:38:59 2018 -0500 Merge remote-tracking branch 'origin/master' into wip/14691 >--------------------------------------------------------------- 73ed13ed36e5a8e3fe29b9c349dfc292bed66a98 compiler/cmm/CmmMachOp.hs | 2 + compiler/cmm/CmmParse.y | 10 ++ compiler/cmm/Hoopl/Dataflow.hs | 34 ++--- compiler/cmm/PprC.hs | 2 + compiler/codeGen/StgCmmPrim.hs | 28 ++++ compiler/coreSyn/CoreOpt.hs | 6 +- compiler/coreSyn/CoreUnfold.hs | 9 +- compiler/coreSyn/CoreUtils.hs | 102 ++++++++++---- compiler/coreSyn/MkCore.hs | 1 - compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 97 ++++++++++--- compiler/main/DriverPipeline.hs | 2 + compiler/main/DynFlags.hs | 29 ++++ compiler/main/SysTools/Info.hs | 4 + compiler/nativeGen/CPrim.hs | 20 +++ compiler/nativeGen/PPC/CodeGen.hs | 2 + compiler/nativeGen/SPARC/CodeGen.hs | 2 + compiler/nativeGen/X86/CodeGen.hs | 69 +++++++++ compiler/nativeGen/X86/Instr.hs | 9 ++ compiler/nativeGen/X86/Ppr.hs | 13 ++ compiler/parser/Lexer.x | 101 ++++++++------ compiler/prelude/primops.txt.pp | 22 +++ compiler/typecheck/TcGenDeriv.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 18 ++- compiler/typecheck/TcSimplify.hs | 21 +-- compiler/typecheck/TcType.hs | 31 +++-- compiler/types/Coercion.hs | 11 +- compiler/types/TyCoRep.hs | 51 +++++-- compiler/utils/StringBuffer.hs | 1 + compiler/utils/Util.hs | 21 ++- docs/users_guide/glasgow_exts.rst | 154 +++++++++++++++++++-- libraries/Cabal | 2 +- libraries/base/GHC/Stack/Types.hs | 23 +-- libraries/base/base.cabal | 2 +- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + libraries/ghc-prim/cbits/pdep.c | 48 +++++++ libraries/ghc-prim/cbits/pext.c | 44 ++++++ libraries/ghc-prim/ghc-prim.cabal | 4 +- libraries/transformers | 2 +- rts/Stats.c | 5 +- rts/sm/Evac.c | 7 +- rts/sm/GC.c | 4 + rts/sm/GC.h | 2 +- rts/sm/Storage.c | 4 - .../backpack/cabal/bkpcabal06/bkpcabal06.cabal | 2 +- testsuite/tests/cabal/ghcpkg01.stdout | 39 +----- testsuite/tests/codeGen/should_run/all.T | 2 + testsuite/tests/codeGen/should_run/cgrun075.hs | 115 +++++++++++++++ .../{cgrun071.stdout => cgrun075.stdout} | 0 testsuite/tests/codeGen/should_run/cgrun076.hs | 115 +++++++++++++++ .../{cgrun071.stdout => cgrun076.stdout} | 0 .../deriving/should_compile/drv-empty-data.stderr | 2 +- testsuite/tests/driver/T4437.hs | 3 +- .../parser/should_fail/NoNumericUnderscores0.hs | 12 ++ .../should_fail/NoNumericUnderscores0.stderr | 3 + .../parser/should_fail/NoNumericUnderscores1.hs | 12 ++ .../should_fail/NoNumericUnderscores1.stderr | 3 + .../parser/should_fail/NumericUnderscoresFail0.hs | 13 ++ .../should_fail/NumericUnderscoresFail0.stderr | 4 + .../parser/should_fail/NumericUnderscoresFail1.hs | 20 +++ .../should_fail/NumericUnderscoresFail1.stderr | 7 + testsuite/tests/parser/should_fail/all.T | 7 + .../tests/parser/should_run/NumericUnderscores0.hs | 101 ++++++++++++++ .../parser/should_run/NumericUnderscores0.stdout | 13 ++ .../tests/parser/should_run/NumericUnderscores1.hs | 88 ++++++++++++ .../parser/should_run/NumericUnderscores1.stdout | 14 ++ testsuite/tests/parser/should_run/all.T | 2 + testsuite/tests/patsyn/should_fail/T14507.stderr | 2 +- testsuite/tests/patsyn/should_fail/all.T | 2 +- testsuite/tests/perf/compiler/all.T | 15 +- testsuite/tests/perf/compiler/genManyAlternatives | 34 +++++ testsuite/tests/plugins/Makefile | 5 + testsuite/tests/plugins/all.T | 6 + testsuite/tests/rebindable/T14670.hs | 11 ++ testsuite/tests/rebindable/all.T | 1 + utils/ghc-cabal/Main.hs | 6 +- 75 files changed, 1424 insertions(+), 257 deletions(-) From git at git.haskell.org Fri Jan 26 02:42:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 02:42:14 +0000 (UTC) Subject: [commit: ghc] wip/14691: Update test suite output due to #14691 (c022a9f) Message-ID: <20180126024214.E54B03A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/c022a9f0562ff4b69b6db288d31a2df3bdaad7a6/ghc >--------------------------------------------------------------- commit c022a9f0562ff4b69b6db288d31a2df3bdaad7a6 Author: Joachim Breitner Date: Thu Jan 25 21:41:43 2018 -0500 Update test suite output due to #14691 >--------------------------------------------------------------- c022a9f0562ff4b69b6db288d31a2df3bdaad7a6 testsuite/tests/indexed-types/should_fail/T8129.stdout | 2 +- testsuite/tests/perf/compiler/all.T | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/indexed-types/should_fail/T8129.stdout b/testsuite/tests/indexed-types/should_fail/T8129.stdout index f2bab63..8a0fb29 100644 --- a/testsuite/tests/indexed-types/should_fail/T8129.stdout +++ b/testsuite/tests/indexed-types/should_fail/T8129.stdout @@ -1,3 +1,3 @@ • Could not deduce (C x0 (F x0)) • Could not deduce (C x0 (F x0)) - • Could not deduce (C x0 (F x0)) + \ \\226\\128\\162 Could not deduce (C x0 (F x0))\n\ diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 431b288..257d9b0 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -39,7 +39,7 @@ test('T1969', # 2013-11-13 17 (x86/Windows, 64bit machine) # 2015-07-11 21 (x86/Linux, 64bit machine) use +RTS -G1 # 2016-04-06 30 (x86/Linux, 64bit machine) - (wordsize(64), 61, 20)]), + (wordsize(64), 78, 20)]), # 28 (amd64/Linux) # 34 (amd64/Linux) # 2012-09-20 23 (amd64/Linux) @@ -55,6 +55,7 @@ test('T1969', # See the comment 16 on #8472. # 2017-02-17 83 (amd64/Linux) Type-indexed Typeable # 2017-03-31 61 (amd64/Linux) Fix memory leak in simplifier + # 2018-01-25 78 (amd64/Linux) Use CoreExpr for EvTerm compiler_stats_num_field('max_bytes_used', [(platform('i386-unknown-mingw32'), 5719436, 20), # 2010-05-17 5717704 (x86/Windows) @@ -1213,7 +1214,8 @@ test('Naperian', compiler_stats_num_field('bytes allocated', [(platform('x86_64-unknown-mingw32'), 54116696, 10), # 2017-12-24 54116696 (x64/Windows) - Unknown - (wordsize(64), 2381935784, 10)]) + (wordsize(64), 53576760, 10)]) + # 2018-01-25 53576760 (x64/Linux) - The previous value looked very wrong ], compile, ['']) From git at git.haskell.org Fri Jan 26 16:20:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 16:20:07 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump haddock.Cabal allocations due to submodule bump (40c753f) Message-ID: <20180126162007.5AA3C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/40c753f14b314e74723465e6f79316657307f373/ghc >--------------------------------------------------------------- commit 40c753f14b314e74723465e6f79316657307f373 Author: Ben Gamari Date: Mon Jan 22 11:50:47 2018 -0500 testsuite: Bump haddock.Cabal allocations due to submodule bump >--------------------------------------------------------------- 40c753f14b314e74723465e6f79316657307f373 testsuite/tests/perf/haddock/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 4ecd52e..db378fe 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -70,7 +70,7 @@ test('haddock.Cabal', [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 20104611952, 5) + [(wordsize(64), 25261834904, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -122,6 +122,7 @@ test('haddock.Cabal', # 2017-11-02: 17133915848 (amd64/Linux) - Phabricator D4144 # 2017-11-06: 18936339648 (amd64/Linux) - Unknown # 2017-11-09: 20104611952 (amd64/Linux) - Bump Cabal + # 2018-01-22: 25261834904 (amd64/Linux) - Bump Cabal ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) From git at git.haskell.org Fri Jan 26 16:20:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 16:20:10 +0000 (UTC) Subject: [commit: ghc] master: Bump terminfo submodule (d6e0338) Message-ID: <20180126162010.425113A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d6e0338b6bdb0c340e09474423c81d90dfc65745/ghc >--------------------------------------------------------------- commit d6e0338b6bdb0c340e09474423c81d90dfc65745 Author: Ben Gamari Date: Sun Jan 21 22:18:24 2018 -0500 Bump terminfo submodule >--------------------------------------------------------------- d6e0338b6bdb0c340e09474423c81d90dfc65745 libraries/terminfo | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/terminfo b/libraries/terminfo index 17a0852..1e9460c 160000 --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 17a0852ba15b32f5fa9c56daefc075b6826edc7b +Subproject commit 1e9460ca4f651099c6a0ad26eb1197297d5e8089 From git at git.haskell.org Fri Jan 26 16:50:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 16:50:30 +0000 (UTC) Subject: [commit: ghc] wip/14691: Merge remote-tracking branch 'origin/master' into wip/14691 (73f91e6) Message-ID: <20180126165030.D646C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/14691 Link : http://ghc.haskell.org/trac/ghc/changeset/73f91e6f3871af9e6a57f9f294f1e8c0a0aecfde/ghc >--------------------------------------------------------------- commit 73f91e6f3871af9e6a57f9f294f1e8c0a0aecfde Merge: c022a9f 40c753f Author: Joachim Breitner Date: Fri Jan 26 11:50:14 2018 -0500 Merge remote-tracking branch 'origin/master' into wip/14691 >--------------------------------------------------------------- 73f91e6f3871af9e6a57f9f294f1e8c0a0aecfde libraries/terminfo | 2 +- testsuite/tests/perf/haddock/all.T | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) From git at git.haskell.org Fri Jan 26 16:50:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 16:50:33 +0000 (UTC) Subject: [commit: ghc] wip/14691's head updated: Merge remote-tracking branch 'origin/master' into wip/14691 (73f91e6) Message-ID: <20180126165033.DD8B23A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/14691' now includes: d6e0338 Bump terminfo submodule 40c753f testsuite: Bump haddock.Cabal allocations due to submodule bump 73f91e6 Merge remote-tracking branch 'origin/master' into wip/14691 From git at git.haskell.org Fri Jan 26 16:52:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 16:52:33 +0000 (UTC) Subject: [commit: ghc] master: Turn EvTerm (almost) into CoreExpr (#14691) (0e022e5) Message-ID: <20180126165233.111263A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e022e56b130ab9d277965b794e70d8d3fb29533/ghc >--------------------------------------------------------------- commit 0e022e56b130ab9d277965b794e70d8d3fb29533 Author: Joachim Breitner Date: Fri Jan 26 11:50:48 2018 -0500 Turn EvTerm (almost) into CoreExpr (#14691) Ideally, I'd like to do type EvTerm = CoreExpr and the type checker builds the evidence terms as it goes. This failed, becuase the evidence for `Typeable` refers to local identifiers that are added *after* the typechecker solves constraints. Therefore, `EvTerm` stays a data type with two constructors: `EvExpr` for `CoreExpr` evidence, and `EvTypeable` for the others. Delted `Note [Memoising typeOf]`, its reference (and presumably relevance) was removed in 8fa4bf9. Differential Revision: https://phabricator.haskell.org/D4341 >--------------------------------------------------------------- 0e022e56b130ab9d277965b794e70d8d3fb29533 compiler/deSugar/DsBinds.hs | 94 +--------- compiler/deSugar/Match.hs | 4 +- compiler/ghc.cabal.in | 1 + compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcCanonical.hs | 34 ++-- compiler/typecheck/TcErrors.hs | 7 +- compiler/typecheck/TcEvTerm.hs | 69 +++++++ compiler/typecheck/TcEvidence.hs | 206 ++++++++------------- compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 100 ++++++---- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcInteract.hs | 118 ++++++++---- compiler/typecheck/TcMType.hs | 4 +- compiler/typecheck/TcPatSyn.hs | 6 +- compiler/typecheck/TcPluginM.hs | 4 +- compiler/typecheck/TcRnTypes.hs | 8 +- compiler/typecheck/TcSMonad.hs | 31 ++-- compiler/types/Type.hs | 2 +- .../tests/indexed-types/should_fail/T8129.stdout | 2 +- testsuite/tests/perf/compiler/all.T | 6 +- 20 files changed, 363 insertions(+), 341 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0e022e56b130ab9d277965b794e70d8d3fb29533 From git at git.haskell.org Fri Jan 26 16:53:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 16:53:10 +0000 (UTC) Subject: [commit: ghc] branch 'wip/14691' deleted Message-ID: <20180126165310.1F9193A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/14691 From git at git.haskell.org Fri Jan 26 19:40:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:40:56 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add testcase for #12158 (983e491) Message-ID: <20180126194056.DC18A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/983e491927a461457cc587197ce1644746db894b/ghc >--------------------------------------------------------------- commit 983e491927a461457cc587197ce1644746db894b Author: Ben Gamari Date: Fri Jan 26 12:55:25 2018 -0500 testsuite: Add testcase for #12158 Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4334 >--------------------------------------------------------------- 983e491927a461457cc587197ce1644746db894b testsuite/tests/ghci/scripts/T12158.script | 2 ++ testsuite/tests/ghci/scripts/all.T | 1 + 2 files changed, 3 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T12158.script b/testsuite/tests/ghci/scripts/T12158.script new file mode 100644 index 0000000..d18f360 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12158.script @@ -0,0 +1,2 @@ +data Stock = Stock {name :: String, ric :: String, price :: Float} deriving (Show) +price Stock{name=name,ric=ric,price=price} = price diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index e453591..ced4841 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -245,6 +245,7 @@ test('T12091', [extra_run_opts('-fobject-code')], ghci_script, ['T12091.script']) test('T12523', normal, ghci_script, ['T12523.script']) test('T12024', normal, ghci_script, ['T12024.script']) +test('T12158', expect_broken(12158), ghci_script, ['T12158.script']) test('T12447', expect_broken(12447), ghci_script, ['T12447.script']) test('T10249', normal, ghci_script, ['T10249.script']) test('T12550', normal, ghci_script, ['T12550.script']) From git at git.haskell.org Fri Jan 26 19:40:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:40:59 +0000 (UTC) Subject: [commit: ghc] master: Haddock needs to pass visible modules for instance filtering (66961dc) Message-ID: <20180126194059.C72603A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/66961dc85e39bbc43a1c065ee00c381a7ee579e1/ghc >--------------------------------------------------------------- commit 66961dc85e39bbc43a1c065ee00c381a7ee579e1 Author: Alec Theriault Date: Fri Jan 26 13:05:31 2018 -0500 Haddock needs to pass visible modules for instance filtering The GHC-side `getNameToInstancesIndex` filters out incorrectly some instances because it is not aware of what modules are visible. Using `runTcInteractive` means that `ie_visible` gets initialized to a one module set containing some dummy GHCi module. This is clearly not the module set we want to check against to see if a given orphan instance is visible or not. In fact, GHC has no way of knowing what we want that module set to be since it doesn't know ahead of time which modules Haddock is making its docs for. The fix is just to pass that set in as an argument. Bumps haddock submodule. Reviewers: bgamari Reviewed By: bgamari Subscribers: duog, alexbiehl, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4290 >--------------------------------------------------------------- 66961dc85e39bbc43a1c065ee00c381a7ee579e1 compiler/main/GHC.hs | 11 +++++++---- utils/haddock | 2 +- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 343ef37..1e54f0e 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -1244,12 +1244,15 @@ getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env) -- by 'Name'. Each name's lists will contain every instance in which that name -- is mentioned in the instance head. getNameToInstancesIndex :: GhcMonad m - => m (Messages, Maybe (NameEnv ([ClsInst], [FamInst]))) -getNameToInstancesIndex = do + => [Module] -- ^ visible modules. An orphan instance will be returned if and + -- only it is visible from at least one module in the list. + -> m (Messages, Maybe (NameEnv ([ClsInst], [FamInst]))) +getNameToInstancesIndex visible_mods = do hsc_env <- getSession liftIO $ runTcInteractive hsc_env $ do { loadUnqualIfaces hsc_env (hsc_IC hsc_env) - ; InstEnvs {ie_global, ie_local, ie_visible} <- tcGetInstEnvs + ; InstEnvs {ie_global, ie_local} <- tcGetInstEnvs + ; let visible_mods' = mkModuleSet visible_mods ; (pkg_fie, home_fie) <- tcGetFamInstEnvs -- We use Data.Sequence.Seq because we are creating left associated -- mappends. @@ -1257,7 +1260,7 @@ getNameToInstancesIndex = do ; let cls_index = Map.fromListWith mappend [ (n, Seq.singleton ispec) | ispec <- instEnvElts ie_local ++ instEnvElts ie_global - , instIsVisible ie_visible ispec + , instIsVisible visible_mods' ispec , n <- nameSetElemsStable $ orphNamesOfClsInst ispec ] ; let fam_index = Map.fromListWith mappend diff --git a/utils/haddock b/utils/haddock index 2484138..dd80ae1 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 24841386cff6fdccc11accf9daa815c2c7444d65 +Subproject commit dd80ae1773ea6aae48c3c5a899d510699783d6ee From git at git.haskell.org Fri Jan 26 19:41:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:02 +0000 (UTC) Subject: [commit: ghc] master: Option for LINE pragmas to get lexed into tokens (9a57cfe) Message-ID: <20180126194102.AFFBE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a57cfebd2e65109884712a27a0f29d1a71f57b7/ghc >--------------------------------------------------------------- commit 9a57cfebd2e65109884712a27a0f29d1a71f57b7 Author: Alec Theriault Date: Fri Jan 26 13:09:58 2018 -0500 Option for LINE pragmas to get lexed into tokens This adds a parser-level switch to have 'LINE' and 'COLUMN' pragmas lexed into actual tokens (as opposed to updating the position information in the parser). 'lexTokenStream' is the only place where this option is enabled. Reviewers: bgamari, alexbiehl, mpickering Reviewed By: mpickering Subscribers: alanz, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4336 >--------------------------------------------------------------- 9a57cfebd2e65109884712a27a0f29d1a71f57b7 compiler/parser/Lexer.x | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index d8a670e..2f5eccd 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -652,7 +652,8 @@ data Token | ITrules_prag SourceText | ITwarning_prag SourceText | ITdeprecated_prag SourceText - | ITline_prag + | ITline_prag SourceText -- not usually produced, see 'use_pos_prags' + | ITcolumn_prag SourceText -- not usually produced, see 'use_pos_prags' | ITscc_prag SourceText | ITgenerated_prag SourceText | ITcore_prag SourceText -- hdaume: core annotations @@ -1147,6 +1148,27 @@ rulePrag span buf len = do let !src = lexemeToString buf len return (L span (ITrules_prag (SourceText src))) +-- When 'use_pos_prags' is not set, it is expected that we emit a token instead +-- of updating the position in 'PState' +linePrag :: Action +linePrag span buf len = do + ps <- getPState + if use_pos_prags ps + then begin line_prag2 span buf len + else let !src = lexemeToString buf len + in return (L span (ITline_prag (SourceText src))) + +-- When 'use_pos_prags' is not set, it is expected that we emit a token instead +-- of updating the position in 'PState' +columnPrag :: Action +columnPrag span buf len = do + ps <- getPState + let !src = lexemeToString buf len + if use_pos_prags ps + then begin column_prag span buf len + else let !src = lexemeToString buf len + in return (L span (ITcolumn_prag (SourceText src))) + endPrag :: Action endPrag span _buf _len = do setExts (.&. complement (xbit InRulePragBit)) @@ -1892,6 +1914,10 @@ data PState = PState { -- token doesn't need to close anything: alr_justClosedExplicitLetBlock :: Bool, + -- If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}' + -- update the 'loc' field. Otherwise, those pragmas are lexed as tokens. + use_pos_prags :: Bool, + -- The next three are used to implement Annotations giving the -- locations of 'noise' tokens in the source, so that users of -- the GHC API can do source to source conversions. @@ -2398,6 +2424,7 @@ mkPStatePure options buf loc = alr_context = [], alr_expecting_ocurly = Nothing, alr_justClosedExplicitLetBlock = False, + use_pos_prags = True, annotations = [], comment_q = [], annotations_comments = [] @@ -2809,14 +2836,14 @@ reportLexError loc1 loc2 buf str lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token] lexTokenStream buf loc dflags = unP go initState where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream - initState = mkPState dflags' buf loc + initState = (mkPState dflags' buf loc) { use_pos_prags = False } go = do ltok <- lexer False return case ltok of L _ ITeof -> return [] _ -> liftM (ltok:) go -linePrags = Map.singleton "line" (begin line_prag2) +linePrags = Map.singleton "line" linePrag fileHeaderPrags = Map.fromList([("options", lex_string_prag IToptions_prag), ("options_ghc", lex_string_prag IToptions_prag), @@ -2861,7 +2888,7 @@ oneWordPrags = Map.fromList [ ("incoherent", strtoken (\s -> ITincoherent_prag (SourceText s))), ("ctype", strtoken (\s -> ITctype (SourceText s))), ("complete", strtoken (\s -> ITcomplete_prag (SourceText s))), - ("column", begin column_prag) + ("column", columnPrag) ] twoWordPrags = Map.fromList([ From git at git.haskell.org Fri Jan 26 19:41:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:05 +0000 (UTC) Subject: [commit: ghc] master: Add ptr-eq short-cut to `compareByteArrays#` primitive (31c260f) Message-ID: <20180126194105.83DF93A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31c260f3967d2c06063c962a98475058daa45c6d/ghc >--------------------------------------------------------------- commit 31c260f3967d2c06063c962a98475058daa45c6d Author: Herbert Valerio Riedel Date: Fri Jan 26 13:07:17 2018 -0500 Add ptr-eq short-cut to `compareByteArrays#` primitive This is an obvious optimisation whose overhead is neglectable but which significantly simplifies the common uses of `compareByteArrays#` which would otherwise require to make *careful* use of `reallyUnsafePtrEquality#` or (equally fragile) `byteArrayContents#` which can result in less optimal assembler code being generated. Test Plan: carefully examined generated cmm/asm code; validate via phab Reviewers: alexbiehl, bgamari, simonmar Reviewed By: bgamari, simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4319 >--------------------------------------------------------------- 31c260f3967d2c06063c962a98475058daa45c6d compiler/codeGen/StgCmmPrim.hs | 43 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 948af2a..8ec132b 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -1746,8 +1746,51 @@ doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n = do dflags <- getDynFlags ba1_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba1 (arrWordsHdrSize dflags)) ba1_off ba2_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba2 (arrWordsHdrSize dflags)) ba2_off + + -- short-cut in case of equal pointers avoiding a costly + -- subroutine call to the memcmp(3) routine; the Cmm logic below + -- results in assembly code being generated for + -- + -- cmpPrefix10 :: ByteArray# -> ByteArray# -> Int# + -- cmpPrefix10 ba1 ba2 = compareByteArrays# ba1 0# ba2 0# 10# + -- + -- that looks like + -- + -- leaq 16(%r14),%rax + -- leaq 16(%rsi),%rbx + -- xorl %ecx,%ecx + -- cmpq %rbx,%rax + -- je l_ptr_eq + -- + -- ; NB: the common case (unequal pointers) falls-through + -- ; the conditional jump, and therefore matches the + -- ; usual static branch prediction convention of modern cpus + -- + -- subq $8,%rsp + -- movq %rbx,%rsi + -- movq %rax,%rdi + -- movl $10,%edx + -- xorl %eax,%eax + -- call memcmp + -- addq $8,%rsp + -- movslq %eax,%rax + -- movq %rax,%rcx + -- l_ptr_eq: + -- movq %rcx,%rbx + -- jmp *(%rbp) + + l_ptr_eq <- newBlockId + l_ptr_ne <- newBlockId + + emit (mkAssign (CmmLocal res) (zeroExpr dflags)) + emit (mkCbranch (cmmEqWord dflags ba1_p ba2_p) + l_ptr_eq l_ptr_ne (Just False)) + + emitLabel l_ptr_ne emitMemcmpCall res ba1_p ba2_p n 1 + emitLabel l_ptr_eq + -- ---------------------------------------------------------------------------- -- Copying byte arrays From git at git.haskell.org Fri Jan 26 19:41:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:08 +0000 (UTC) Subject: [commit: ghc] master: Handle the likely:True case in CmmContFlowOpt (52dfb25) Message-ID: <20180126194108.79B113A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/52dfb25c400bf1225132fdb8d7c25fa385c8ae3f/ghc >--------------------------------------------------------------- commit 52dfb25c400bf1225132fdb8d7c25fa385c8ae3f Author: klebinger.andreas at gmx.at Date: Fri Jan 26 13:06:50 2018 -0500 Handle the likely:True case in CmmContFlowOpt It's better to fall through to the likely case than to jump to it. We optimize for this in CmmContFlowOpt when likely:False. This commit extends the logic there to handle cases with likely:True as well. Test Plan: ci Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: simonmar, alexbiehl, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4306 >--------------------------------------------------------------- 52dfb25c400bf1225132fdb8d7c25fa385c8ae3f compiler/cmm/CmmContFlowOpt.hs | 45 ++++++++++++++++++++++++++++----------- compiler/nativeGen/X86/CodeGen.hs | 3 +++ 2 files changed, 35 insertions(+), 13 deletions(-) diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index 5f34a91..1efc3e6 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -283,34 +283,53 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id } Just b | Just dest <- canShortcut b -> dest _otherwise -> l - -- For a conditional, we invert the conditional if that would make it - -- more likely that the branch-not-taken case becomes a fallthrough. - -- This helps the native codegen a little bit, and probably has no - -- effect on LLVM. It's convenient to do it here, where we have the - -- information about predecessors. + -- See Note [Invert Cmm conditionals] swapcond_last | CmmCondBranch cond t f l <- shortcut_last - , likelyFalse l - , numPreds f > 1 - , hasOnePredecessor t + , hasOnePredecessor t -- inverting will make t a fallthrough + , likelyTrue l || (numPreds f > 1) , Just cond' <- maybeInvertCmmExpr cond = CmmCondBranch cond' f t (invertLikeliness l) | otherwise = shortcut_last - likelyFalse (Just False) = True - likelyFalse Nothing = True - likelyFalse _ = False + likelyTrue (Just True) = True + likelyTrue _ = False - invertLikeliness (Just b) = Just (not b) - invertLikeliness Nothing = Nothing + invertLikeliness :: Maybe Bool -> Maybe Bool + invertLikeliness = fmap not -- Number of predecessors for a block numPreds bid = mapLookup bid backEdges `orElse` 0 hasOnePredecessor b = numPreds b == 1 +{- + Note [Invert Cmm conditionals] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The native code generator always produces jumps to the true branch. + Falling through to the false branch is however faster. So we try to + arrange for that to happen. + This means we invert the condition if: + * The likely path will become a fallthrough. + * We can't guarantee a fallthrough for the false branch but for the + true branch. + + In some cases it's faster to avoid inverting when the false branch is likely. + However determining when that is the case is neither easy nor cheap so for + now we always invert as this produces smaller binaries and code that is + equally fast on average. (On an i7-6700K) + + TODO: + There is also the edge case when both branches have multiple predecessors. + In this case we could assume that we will end up with a jump for BOTH + branches. In this case it might be best to put the likely path in the true + branch especially if there are large numbers of predecessors as this saves + us the jump thats not taken. However I haven't tested this and as of early + 2018 we almost never generate cmm where this would apply. +-} + -- Functions for incrementing and decrementing number of predecessors. If -- decrementing would set the predecessor count to 0, we remove entry from the -- map. diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index eb6af1f..09757e7 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -210,6 +210,9 @@ stmtToInstrs stmt = do -> genCCall dflags is32Bit target result_regs args CmmBranch id -> genBranch id + + --We try to arrange blocks such that the likely branch is the fallthrough + --in CmmContFlowOpt. So we can assume the condition is likely false here. CmmCondBranch arg true false _ -> do b1 <- genCondJump true arg b2 <- genBranch false From git at git.haskell.org Fri Jan 26 19:41:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:11 +0000 (UTC) Subject: [commit: ghc] master: Remove Hoopl.Unique (bd58e29) Message-ID: <20180126194111.68C603A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd58e290a4dc3beed2e63fbe549aadbdf17ae437/ghc >--------------------------------------------------------------- commit bd58e290a4dc3beed2e63fbe549aadbdf17ae437 Author: Michal Terepeta Date: Fri Jan 26 13:09:29 2018 -0500 Remove Hoopl.Unique Reasons to remove: - It's confusing - we already have a widely used `Unique` module in `basicTypes/` that defines a newtype called `Unique` - `Hoopl.Unique` is not actually used much I've also moved the `Unique{Map,Set}` from `Hoopl.Unique` to `Hoopl.Collections` to keep things together. But that module is also a bit funny - it defines two type-classes that have only one instance each. So we should probably either remove them or use them more widely... In any case, that will be a separate change. Signed-off-by: Michal Terepeta Test Plan: ./validate Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: kavon, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4331 >--------------------------------------------------------------- bd58e290a4dc3beed2e63fbe549aadbdf17ae437 compiler/cmm/BlockId.hs | 5 +-- compiler/cmm/Hoopl/Collections.hs | 71 ++++++++++++++++++++++++++++++ compiler/cmm/Hoopl/Label.hs | 25 +++++------ compiler/cmm/Hoopl/Unique.hs | 93 --------------------------------------- compiler/ghc.cabal.in | 1 - 5 files changed, 85 insertions(+), 110 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bd58e290a4dc3beed2e63fbe549aadbdf17ae437 From git at git.haskell.org Fri Jan 26 19:41:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:14 +0000 (UTC) Subject: [commit: ghc] master: Add ability to parse likely flags for ifs in Cmm. (e7dcc70) Message-ID: <20180126194114.56EDE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7dcc7085315ea8ebc2d6808fde2d9c37fd10c67/ghc >--------------------------------------------------------------- commit e7dcc7085315ea8ebc2d6808fde2d9c37fd10c67 Author: klebinger.andreas at gmx.at Date: Fri Jan 26 13:07:05 2018 -0500 Add ability to parse likely flags for ifs in Cmm. Adding the ability to parse likely flags in Cmm allows better codegen for cmm files. Test Plan: ci Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14672 Differential Revision: https://phabricator.haskell.org/D4316 >--------------------------------------------------------------- e7dcc7085315ea8ebc2d6808fde2d9c37fd10c67 compiler/cmm/CmmLex.x | 12 +++++++++++- compiler/cmm/CmmParse.y | 50 +++++++++++++++++++++++++++++-------------------- 2 files changed, 41 insertions(+), 21 deletions(-) diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x index a68f155..691ca5e 100644 --- a/compiler/cmm/CmmLex.x +++ b/compiler/cmm/CmmLex.x @@ -99,6 +99,10 @@ $white_no_nl+ ; "&&" { kw CmmT_BoolAnd } "||" { kw CmmT_BoolOr } + "True" { kw CmmT_True } + "False" { kw CmmT_False } + "likely" { kw CmmT_likely} + P at decimal { global_regN (\n -> VanillaReg n VGcPtr) } R at decimal { global_regN (\n -> VanillaReg n VNonGcPtr) } F at decimal { global_regN FloatReg } @@ -180,6 +184,9 @@ data CmmToken | CmmT_Int Integer | CmmT_Float Rational | CmmT_EOF + | CmmT_False + | CmmT_True + | CmmT_likely deriving (Show) -- ----------------------------------------------------------------------------- @@ -266,7 +273,10 @@ reservedWordsFM = listToUFM $ ( "b512", CmmT_bits512 ), ( "f32", CmmT_float32 ), ( "f64", CmmT_float64 ), - ( "gcptr", CmmT_gcptr ) + ( "gcptr", CmmT_gcptr ), + ( "likely", CmmT_likely), + ( "True", CmmT_True ), + ( "False", CmmT_False ) ] tok_decimal span buf len diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 8afbd2f..cf660d2 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -299,6 +299,10 @@ import qualified Data.Map as M '&&' { L _ (CmmT_BoolAnd) } '||' { L _ (CmmT_BoolOr) } + 'True' { L _ (CmmT_True ) } + 'False' { L _ (CmmT_False) } + 'likely'{ L _ (CmmT_likely)} + 'CLOSURE' { L _ (CmmT_CLOSURE) } 'INFO_TABLE' { L _ (CmmT_INFO_TABLE) } 'INFO_TABLE_RET'{ L _ (CmmT_INFO_TABLE_RET) } @@ -629,10 +633,10 @@ stmt :: { CmmParse () } { doCall $2 [] $4 } | '(' formals ')' '=' 'call' expr '(' exprs0 ')' ';' { doCall $6 $2 $8 } - | 'if' bool_expr 'goto' NAME - { do l <- lookupLabel $4; cmmRawIf $2 l } - | 'if' bool_expr '{' body '}' else - { cmmIfThenElse $2 (withSourceNote $3 $5 $4) $6 } + | 'if' bool_expr cond_likely 'goto' NAME + { do l <- lookupLabel $5; cmmRawIf $2 l $3 } + | 'if' bool_expr cond_likely '{' body '}' else + { cmmIfThenElse $2 (withSourceNote $4 $6 $5) $7 $3 } | 'push' '(' exprs0 ')' maybe_body { pushStackFrame $3 $5 } | 'reserve' expr '=' lreg maybe_body @@ -721,6 +725,12 @@ else :: { CmmParse () } : {- empty -} { return () } | 'else' '{' body '}' { withSourceNote $2 $4 $3 } +cond_likely :: { Maybe Bool } + : '(' 'likely' ':' 'True' ')' { Just True } + | '(' 'likely' ':' 'False' ')' { Just False } + | {- empty -} { Nothing } + + -- we have to write this out longhand so that Happy's precedence rules -- can kick in. expr :: { CmmParse CmmExpr } @@ -1289,11 +1299,11 @@ data BoolExpr -- ToDo: smart constructors which simplify the boolean expression. -cmmIfThenElse cond then_part else_part = do +cmmIfThenElse cond then_part else_part likely = do then_id <- newBlockId join_id <- newBlockId c <- cond - emitCond c then_id + emitCond c then_id likely else_part emit (mkBranch join_id) emitLabel then_id @@ -1301,38 +1311,38 @@ cmmIfThenElse cond then_part else_part = do -- fall through to join emitLabel join_id -cmmRawIf cond then_id = do +cmmRawIf cond then_id likely = do c <- cond - emitCond c then_id + emitCond c then_id likely -- 'emitCond cond true_id' emits code to test whether the cond is true, -- branching to true_id if so, and falling through otherwise. -emitCond (BoolTest e) then_id = do +emitCond (BoolTest e) then_id likely = do else_id <- newBlockId - emit (mkCbranch e then_id else_id Nothing) + emit (mkCbranch e then_id else_id likely) emitLabel else_id -emitCond (BoolNot (BoolTest (CmmMachOp op args))) then_id +emitCond (BoolNot (BoolTest (CmmMachOp op args))) then_id likely | Just op' <- maybeInvertComparison op - = emitCond (BoolTest (CmmMachOp op' args)) then_id -emitCond (BoolNot e) then_id = do + = emitCond (BoolTest (CmmMachOp op' args)) then_id (not <$> likely) +emitCond (BoolNot e) then_id likely = do else_id <- newBlockId - emitCond e else_id + emitCond e else_id likely emit (mkBranch then_id) emitLabel else_id -emitCond (e1 `BoolOr` e2) then_id = do - emitCond e1 then_id - emitCond e2 then_id -emitCond (e1 `BoolAnd` e2) then_id = do +emitCond (e1 `BoolOr` e2) then_id likely = do + emitCond e1 then_id likely + emitCond e2 then_id likely +emitCond (e1 `BoolAnd` e2) then_id likely = do -- we'd like to invert one of the conditionals here to avoid an -- extra branch instruction, but we can't use maybeInvertComparison -- here because we can't look too closely at the expression since -- we're in a loop. and_id <- newBlockId else_id <- newBlockId - emitCond e1 and_id + emitCond e1 and_id likely emit (mkBranch else_id) emitLabel and_id - emitCond e2 then_id + emitCond e2 then_id likely emitLabel else_id -- ----------------------------------------------------------------------------- From git at git.haskell.org Fri Jan 26 19:41:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:17 +0000 (UTC) Subject: [commit: ghc] master: base: Refactor Show ErrorCall instance into proper ShowS style (302aee5) Message-ID: <20180126194117.64A883A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/302aee52b61b754267c48465e94683f4aeda3fe8/ghc >--------------------------------------------------------------- commit 302aee52b61b754267c48465e94683f4aeda3fe8 Author: Ben Gamari Date: Fri Jan 26 13:06:34 2018 -0500 base: Refactor Show ErrorCall instance into proper ShowS style Test Plan: Validate Reviewers: hvr, dfeuer Reviewed By: dfeuer Subscribers: dfeuer, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4304 >--------------------------------------------------------------- 302aee52b61b754267c48465e94683f4aeda3fe8 libraries/base/GHC/Exception.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index d3a6745..37f47a6 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -184,7 +184,8 @@ instance Exception ErrorCall -- | @since 4.0.0.0 instance Show ErrorCall where showsPrec _ (ErrorCallWithLocation err "") = showString err - showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc) + showsPrec _ (ErrorCallWithLocation err loc) = + showString err . showChar '\n' . showString loc errorCallException :: String -> SomeException errorCallException s = toException (ErrorCall s) From git at git.haskell.org Fri Jan 26 19:41:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:20 +0000 (UTC) Subject: [commit: ghc] master: Sort valid substitutions for typed holes by "relevance" (cbdea95) Message-ID: <20180126194120.797DA3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cbdea95938bf09e8e3e7be31918549224d171873/ghc >--------------------------------------------------------------- commit cbdea95938bf09e8e3e7be31918549224d171873 Author: Matthías Páll Gissurarson Date: Fri Jan 26 13:07:36 2018 -0500 Sort valid substitutions for typed holes by "relevance" This is an initial attempt at tackling the issue of how to order the suggestions provided by the valid substitutions checker, by sorting them by creating a graph of how they subsume each other. We'd like to order them in such a manner that the most "relevant" suggestions are displayed first, so that the suggestion that the user might be looking for is displayed before more far-fetched suggestions (and thus also displayed when they'd otherwise be cut-off by the `-fmax-valid-substitutions` limit). The previous ordering was based on the order in which the elements appear in the list of imports, which I believe is less correlated with relevance than this ordering. A drawback of this approach is that, since we now want to sort the elements, we can no longer "bail out early" when we've hit the `-fmax-valid-substitutions` limit. Reviewers: bgamari, dfeuer Reviewed By: dfeuer Subscribers: dfeuer, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4326 >--------------------------------------------------------------- cbdea95938bf09e8e3e7be31918549224d171873 compiler/main/DynFlags.hs | 8 +- compiler/typecheck/TcErrors.hs | 166 +++++-- compiler/typecheck/TcSimplify.hs | 7 +- compiler/typecheck/TcSimplify.hs-boot | 4 +- docs/users_guide/glasgow_exts.rst | 299 +++++++++++-- docs/users_guide/using-optimisation.rst | 16 +- testsuite/tests/ghci/scripts/T10249.stderr | 3 +- testsuite/tests/ghci/scripts/T8353.stderr | 60 +-- testsuite/tests/th/T10267.stderr | 8 +- .../tests/typecheck/should_compile/T13050.stderr | 174 ++++---- .../tests/typecheck/should_compile/T14273.stderr | 18 +- .../tests/typecheck/should_compile/T14590.stderr | 232 +++++----- .../tests/typecheck/should_compile/T9497a.stderr | 6 +- .../should_compile/hole_constraints.stderr | 4 +- .../tests/typecheck/should_compile/holes.stderr | 496 ++++++++++----------- .../tests/typecheck/should_compile/holes2.stderr | 18 +- .../tests/typecheck/should_compile/holes3.stderr | 496 ++++++++++----------- .../should_compile/valid_substitutions.stderr | 82 ++-- .../valid_substitutions_interactions.stderr | 4 +- .../tests/typecheck/should_fail/T9497d.stderr | 6 +- .../tests/typecheck/should_run/T9497a-run.stderr | 6 +- .../tests/typecheck/should_run/T9497b-run.stderr | 6 +- .../tests/typecheck/should_run/T9497c-run.stderr | 6 +- 23 files changed, 1200 insertions(+), 925 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cbdea95938bf09e8e3e7be31918549224d171873 From git at git.haskell.org Fri Jan 26 19:41:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:23 +0000 (UTC) Subject: [commit: ghc] master: Linker: ignore empty paths in addEnvPaths (cacba07) Message-ID: <20180126194123.A707C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cacba075d72473511f6924c6505952ff12a20316/ghc >--------------------------------------------------------------- commit cacba075d72473511f6924c6505952ff12a20316 Author: Ömer Sinan Ağacan Date: Fri Jan 26 13:09:17 2018 -0500 Linker: ignore empty paths in addEnvPaths Previously `splitEnv` worked like this: > splitEnv "foo:::bar::baz:" ["foo","","","bar","","baz",""] with this patch: > splitEnv working_dir "foo:::bar:baz:" ["foo",working_dir,working_dir"bar","baz",working_dir] This fixes #14695, where having a trailing `:` in the env variable caused ghci to pass empty `-B` parameter to `gcc`, which in turned caused the next parameter (`--print-file-name`) to be considered as the argument to `-B`. As a result ghci did not work. The `working_dir` argument is to have a similar behavior with POSIX: according to chapter 8.3 zero-length prefix means current working directory. Reviewers: hvr, bgamari, AndreasK, simonmar Reviewed By: bgamari, AndreasK, simonmar Subscribers: AndreasK, rwbarton, thomie, carter GHC Trac Issues: #14695 Differential Revision: https://phabricator.haskell.org/D4330 >--------------------------------------------------------------- cacba075d72473511f6924c6505952ff12a20316 compiler/ghci/Linker.hs | 19 +++++++++++++------ testsuite/tests/rts/Makefile | 4 ++++ testsuite/tests/rts/all.T | 1 + 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 3481379..a91df32 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -1547,15 +1547,22 @@ getSystemDirectories = return [] -- given. If the variable does not exist then just return the identity. addEnvPaths :: String -> [String] -> IO [String] addEnvPaths name list - = do values <- lookupEnv name + = do -- According to POSIX (chapter 8.3) a zero-length prefix means current + -- working directory. Replace empty strings in the env variable with + -- `working_dir` (see also #14695). + working_dir <- getCurrentDirectory + values <- lookupEnv name case values of Nothing -> return list - Just arr -> return $ list ++ splitEnv arr + Just arr -> return $ list ++ splitEnv working_dir arr where - splitEnv :: String -> [String] - splitEnv value = case break (== envListSep) value of - (x, [] ) -> [x] - (x, (_:xs)) -> x : splitEnv xs + splitEnv :: FilePath -> String -> [String] + splitEnv working_dir value = + case break (== envListSep) value of + (x, [] ) -> + [if null x then working_dir else x] + (x, (_:xs)) -> + (if null x then working_dir else x) : splitEnv working_dir xs #if defined(mingw32_HOST_OS) envListSep = ';' #else diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile index a6d2482..ded3be1 100644 --- a/testsuite/tests/rts/Makefile +++ b/testsuite/tests/rts/Makefile @@ -174,3 +174,7 @@ T11788: .PHONY: T12497 T12497: echo main | "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) T12497.hs + +.PHONY: T14695 +T14695: + echo ":quit" | LD_LIBRARY_PATH="foo:" "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 6377bde..fe86dd1 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -382,3 +382,4 @@ test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13894', normal, compile_and_run, ['']) test('T14497', normal, compile_and_run, ['-O']) +test('T14695', normal, run_command, ['$MAKE -s --no-print-directory T14695']) From git at git.haskell.org Fri Jan 26 19:41:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:27 +0000 (UTC) Subject: [commit: ghc] master: Fix #14719 by using the setting the right SrcSpan (59fa7b3) Message-ID: <20180126194127.635DA3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59fa7b32b018a91f81773ca676251a0b2761ef56/ghc >--------------------------------------------------------------- commit 59fa7b32b018a91f81773ca676251a0b2761ef56 Author: Ryan Scott Date: Fri Jan 26 13:10:26 2018 -0500 Fix #14719 by using the setting the right SrcSpan Currently, error messages that germane to GADT constructors put the source span at only the first character in the constructor, leading to insufficient caret diagnostics. This can be easily fixed by using a source span that spans the entire constructor, instead of just the first character. Test Plan: make test TEST=T14719 Reviewers: alanz, bgamari, simonpj Reviewed By: alanz, simonpj Subscribers: simonpj, goldfire, rwbarton, thomie, carter GHC Trac Issues: #14719 Differential Revision: https://phabricator.haskell.org/D4344 >--------------------------------------------------------------- 59fa7b32b018a91f81773ca676251a0b2761ef56 compiler/typecheck/TcTyClsDecls.hs | 4 ++-- testsuite/tests/gadt/T14719.hs | 8 ++++++++ testsuite/tests/gadt/T14719.stderr | 18 ++++++++++++++++++ testsuite/tests/gadt/all.T | 1 + testsuite/tests/polykinds/T9222.stderr | 4 ++-- 5 files changed, 31 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index cd08570..7436b0d 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2538,8 +2538,8 @@ checkValidTyConTyVars tc ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con - = setSrcSpan (srcLocSpan (getSrcLoc con)) $ - addErrCtxt (dataConCtxt con) $ + = setSrcSpan (getSrcSpan con) $ + addErrCtxt (dataConCtxt con) $ do { -- Check that the return type of the data constructor -- matches the type constructor; eg reject this: -- data T a where { MkT :: Bogus a } diff --git a/testsuite/tests/gadt/T14719.hs b/testsuite/tests/gadt/T14719.hs new file mode 100644 index 0000000..004116d --- /dev/null +++ b/testsuite/tests/gadt/T14719.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} +module T14719 where + +data Foo1 where + MkFoo1 :: Bool + +newtype Foo2 where + MkFoo2 :: Foo2 diff --git a/testsuite/tests/gadt/T14719.stderr b/testsuite/tests/gadt/T14719.stderr new file mode 100644 index 0000000..cfac00c --- /dev/null +++ b/testsuite/tests/gadt/T14719.stderr @@ -0,0 +1,18 @@ + +T14719.hs:5:3: error: + • Data constructor ‘MkFoo1’ returns type ‘Bool’ + instead of an instance of its parent type ‘Foo1’ + • In the definition of data constructor ‘MkFoo1’ + In the data type declaration for ‘Foo1’ + | +5 | MkFoo1 :: Bool + | ^^^^^^^^^^^^^^ + +T14719.hs:8:3: error: + • The constructor of a newtype must have exactly one field + but ‘MkFoo2’ has none + • In the definition of data constructor ‘MkFoo2’ + In the newtype declaration for ‘Foo2’ + | +8 | MkFoo2 :: Foo2 + | ^^^^^^^^^^^^^^ diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index c81ab80..59ec307 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -115,3 +115,4 @@ test('T9380', normal, compile_and_run, ['']) test('T12087', normal, compile_fail, ['']) test('T12468', normal, compile_fail, ['']) test('T14320', normal, compile, ['']) +test('T14719', normal, compile_fail, ['-fdiagnostics-show-caret']) diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr index 6e143e0..604cc1b 100644 --- a/testsuite/tests/polykinds/T9222.stderr +++ b/testsuite/tests/polykinds/T9222.stderr @@ -5,12 +5,12 @@ T9222.hs:13:3: error: inside the constraints: a ~ '(b0, c0) bound by the type of the constructor ‘Want’: (a ~ '(b0, c0)) => Proxy b0 - at T9222.hs:13:3 + at T9222.hs:13:3-43 ‘c’ is a rigid type variable bound by the type of the constructor ‘Want’: forall i1 j1 (a :: (i1, j1)) (b :: i1) (c :: j1). ((a ~ '(b, c)) => Proxy b) -> Want a - at T9222.hs:13:3 + at T9222.hs:13:3-43 • In the ambiguity check for ‘Want’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the definition of data constructor ‘Want’ From git at git.haskell.org Fri Jan 26 19:41:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 19:41:30 +0000 (UTC) Subject: [commit: ghc] master: Fix Windows stack allocations. (a55d581) Message-ID: <20180126194130.4CED43A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a55d581f8f2923560c3444253050b13fdf2dec10/ghc >--------------------------------------------------------------- commit a55d581f8f2923560c3444253050b13fdf2dec10 Author: Tamar Christina Date: Fri Jan 26 13:10:10 2018 -0500 Fix Windows stack allocations. On Windows we use the function `win32AllocStack` to do stack allocations in 4k blocks and insert a stack check afterwards to ensure the allocation returned a valid block. The problem is this function does something that by C semantics is pointless. The stack allocated value can never escape the function, and the stack isn't used so the compiler just optimizes away the entire function body. After considering a bunch of other possibilities I think the simplest fix is to just disable optimizations for the function. Alternatively inline assembly is an option but the stack check function doesn't have a very portable name as it relies on e.g. `libgcc`. Thanks to Sergey Vinokurov for helping diagnose and test. Test Plan: ./validate Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14669 Differential Revision: https://phabricator.haskell.org/D4343 >--------------------------------------------------------------- a55d581f8f2923560c3444253050b13fdf2dec10 includes/Stg.h | 10 ++++++++++ rts/StgCRun.c | 16 +++++++++++----- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/includes/Stg.h b/includes/Stg.h index f377e50..2e02347 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -204,6 +204,16 @@ #define STG_UNUSED GNUC3_ATTRIBUTE(__unused__) +/* Prevent functions from being optimized. + See Note [Windows Stack allocations] */ +#if defined(__clang__) +#define STG_NO_OPTIMIZE __attribute__((optnone)) +#elif defined(__GNUC__) || defined(__GNUG__) +#define STG_NO_OPTIMIZE __attribute__((optimize("O0"))) +#else +#define STG_NO_OPTIMIZE /* nothing */ +#endif + /* ----------------------------------------------------------------------------- Global type definitions -------------------------------------------------------------------------- */ diff --git a/rts/StgCRun.c b/rts/StgCRun.c index 176e64c..5460598 100644 --- a/rts/StgCRun.c +++ b/rts/StgCRun.c @@ -99,11 +99,17 @@ StgFunPtr StgReturn(void) #endif #if defined(mingw32_HOST_OS) -// On windows the stack has to be allocated 4k at a time, otherwise -// we get a segfault. The C compiler knows how to do this (it calls -// _alloca()), so we make sure that we can allocate as much stack as -// we need: -StgWord8 *win32AllocStack(void) +/* + * Note [Windows Stack allocations] + * + * On windows the stack has to be allocated 4k at a time, otherwise + * we get a segfault. The C compiler knows how to do this (it calls + * _alloca()), so we make sure that we can allocate as much stack as + * we need. However since we are doing a local stack allocation and the value + * isn't valid outside the frame, compilers are free to optimize this allocation + * and the corresponding stack check away. So to prevent that we request that + * this function never be optimized (See #14669). */ +STG_NO_OPTIMIZE StgWord8 *win32AllocStack(void) { StgWord8 stack[RESERVED_C_STACK_BYTES + 16 + 12]; return stack; From git at git.haskell.org Fri Jan 26 22:05:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 22:05:45 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: a shot in the dark (d47d32b) Message-ID: <20180126220545.3873D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/d47d32b5211831886910f8abc0431809ccacf0c8/ghc >--------------------------------------------------------------- commit d47d32b5211831886910f8abc0431809ccacf0c8 Author: Gabor Greif Date: Fri Jan 26 23:05:31 2018 +0100 WIP: a shot in the dark >--------------------------------------------------------------- d47d32b5211831886910f8abc0431809ccacf0c8 compiler/codeGen/StgCmmExpr.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935..f90aebc 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -738,7 +738,16 @@ cgIdApp fun_id args = do node_points dflags = nodeMustPointToIt dflags lf_info case getCallMethod dflags fun_name cg_fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of -- A value in WHNF, so we can just return it. + EnterIt | Just con <- maybeIsLFCon lf_info -> pprPanic "maybeIsLFCon EnterIt" (ppr con) + ReturnIt + -- | Just con <- maybeIsLFCon lf_info -> emitReturn [CmmLoad (CmmMachOp (MO_Add $ typeWidth $ gcWord dflags) [fun, CmmLit (CmmInt 7 $ typeWidth $ gcWord dflags)]) $ gcWord dflags] + | Just con <- maybeIsLFCon lf_info + , CmmLit (CmmLabelOff lab _) <- fun -> + let ty = gcWord dflags + width = typeWidth ty + offsLoad = CmmLoad (CmmMachOp (MO_Add width) [cmmUntag dflags fun, CmmLit (CmmInt 8 width)]) $ ty + in emitReturn [pprTrace "offsLoad" (ppr offsLoad) offsLoad] | isVoidTy (idType fun_id) -> emitReturn [] | otherwise -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged? From git at git.haskell.org Fri Jan 26 22:22:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Jan 2018 22:22:53 +0000 (UTC) Subject: [commit: ghc] master: cmm: Use two equality checks for two alt switch with default (7ff6023) Message-ID: <20180126222253.815FC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ff6023537fdef32bbe9b4c357012d705d9b931f/ghc >--------------------------------------------------------------- commit 7ff6023537fdef32bbe9b4c357012d705d9b931f Author: U-Maokai\andi Date: Fri Jan 26 15:43:13 2018 -0500 cmm: Use two equality checks for two alt switch with default For code like: f 1 = e1 f 7 = e2 f _ = e3 We can treat it as a sparse jump table, check if we are outside of the range in one direction first and then start checking the values. GHC currently does this by checking for x>7, then x <= 7 and at last x == 1. This patch changes this such that we only compare for equality against the two values and jump to the default if non are equal. The resulting code is both faster and smaller. wheel-sieve1 improves by 4-8% depending on problem size. This implements the idea from #14644 Reviewers: bgamari, simonmar, simonpj, nomeata Reviewed By: simonpj, nomeata Subscribers: nomeata, simonpj, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4294 >--------------------------------------------------------------- 7ff6023537fdef32bbe9b4c357012d705d9b931f compiler/cmm/CmmSwitch.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/compiler/cmm/CmmSwitch.hs b/compiler/cmm/CmmSwitch.hs index 3edfe5c..ce77946 100644 --- a/compiler/cmm/CmmSwitch.hs +++ b/compiler/cmm/CmmSwitch.hs @@ -251,6 +251,68 @@ data SwitchPlan -- findSingleValues -- 5. The thus collected pieces are assembled to a balanced binary tree. +{- + Note [Two alts + default] + ~~~~~~~~~~~~~~~~~~~~~~~~~ + +Discussion and a bit more info at #14644 + +When dealing with a switch of the form: +switch(e) { + case 1: goto l1; + case 3000: goto l2; + default: goto ldef; +} + +If we treat it as a sparse jump table we would generate: + +if (e > 3000) //Check if value is outside of the jump table. + goto ldef; +else { + if (e < 3000) { //Compare to upper value + if(e != 1) //Compare to remaining value + goto ldef; + else + goto l2; + } + else + goto l1; +} + +Instead we special case this to : + +if (e==1) goto l1; +else if (e==3000) goto l2; +else goto l3; + +This means we have: +* Less comparisons for: 1,<3000 +* Unchanged for 3000 +* One more for >3000 + +This improves code in a few ways: +* One comparison less means smaller code which helps with cache. +* It exchanges a taken jump for two jumps no taken in the >range case. + Jumps not taken are cheaper (See Agner guides) making this about as fast. +* For all other cases the first range check is removed making it faster. + +The end result is that the change is not measurably slower for the case +>3000 and faster for the other cases. + +This makes running this kind of match in an inner loop cheaper by 10-20% +depending on the data. +In nofib this improves wheel-sieve1 by 4-9% depending on problem +size. + +We could also add a second conditional jump after the comparison to +keep the range check like this: + cmp 3000, rArgument + jg + je +While this is fairly cheap it made no big difference for the >3000 case +and slowed down all other cases making it not worthwhile. +-} + -- | Does the target support switch out of the box? Then leave this to the -- target! @@ -272,6 +334,10 @@ createSwitchPlan (SwitchTargets _signed (lo,hi) Nothing m) --Checking If |range| = 2 is enough if we have two unique literals , hi - lo == 1 = IfEqual x1 l1 (Unconditionally l2) +-- See Note [Two alts + default] +createSwitchPlan (SwitchTargets _signed _range (Just defLabel) m) + | [(x1, l1), (x2,l2)] <- M.toAscList m + = IfEqual x1 l1 (IfEqual x2 l2 (Unconditionally defLabel)) createSwitchPlan (SwitchTargets signed range mbdef m) = -- pprTrace "createSwitchPlan" (text (show ids) $$ text (show (range,m)) $$ text (show pieces) $$ text (show flatPlan) $$ text (show plan)) $ plan From git at git.haskell.org Sat Jan 27 03:21:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:21:33 +0000 (UTC) Subject: [commit: hadrian] master: Add a free ACM download link for the paper (d2e83f2) Message-ID: <20180127032133.2ABAE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/d2e83f2a1d07000688e4e7e994a82f49613c9213 >--------------------------------------------------------------- commit d2e83f2a1d07000688e4e7e994a82f49613c9213 Author: Andrey Mokhov Date: Mon Dec 11 19:43:31 2017 +0000 Add a free ACM download link for the paper Fix #488 >--------------------------------------------------------------- d2e83f2a1d07000688e4e7e994a82f49613c9213 README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index d188a4a..0684380 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,8 @@ Hadrian is a new build system for the [Glasgow Haskell Compiler][ghc]. It is bas on [Shake][shake] and we hope that it will soon replace the current [Make-based build system][make]. If you are curious about the rationale behind the project and the architecture of the build system you can find more details in -this [Haskell Symposium 2016 paper][paper] and this [Haskell eXchange 2016 talk][talk]. +this [Haskell Symposium 2016 paper](https://dl.acm.org/authorize?N41275) and this +[Haskell eXchange 2016 talk][talk]. The new build system can work side-by-side with the existing build system. Note, there is some interaction between them: they put (some) build results in the same directories, @@ -179,7 +180,6 @@ enjoy the project. [ghc]: https://en.wikipedia.org/wiki/Glasgow_Haskell_Compiler [shake]: https://github.com/ndmitchell/shake [make]: https://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -[paper]: https://www.staff.ncl.ac.uk/andrey.mokhov/Hadrian.pdf [talk]: https://skillsmatter.com/skillscasts/8722-meet-hadrian-a-new-build-system-for-ghc [issues]: https://github.com/snowleopard/hadrian/issues [ghc-preparation]: https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation From git at git.haskell.org Sat Jan 27 03:21:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:21:37 +0000 (UTC) Subject: [commit: hadrian] master: Drop redundant dependencies on in-tree packages (#491) (7d2368d) Message-ID: <20180127032137.328C43A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/7d2368d714c7ed3fb8c096882564575aacf2b396 >--------------------------------------------------------------- commit 7d2368d714c7ed3fb8c096882564575aacf2b396 Author: Andrey Mokhov Date: Thu Dec 14 02:32:37 2017 +0000 Drop redundant dependencies on in-tree packages (#491) See #481 >--------------------------------------------------------------- 7d2368d714c7ed3fb8c096882564575aacf2b396 cabal.project | 3 --- stack.yaml | 3 --- 2 files changed, 6 deletions(-) diff --git a/cabal.project b/cabal.project index 0d2b509..176d1ee 100644 --- a/cabal.project +++ b/cabal.project @@ -1,5 +1,2 @@ packages: ./ ../libraries/Cabal/Cabal/ - ../libraries/hpc/ - ../libraries/parsec/ - ../libraries/text/ diff --git a/stack.yaml b/stack.yaml index 1d3f6e3..da03763 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,9 +7,6 @@ resolver: lts-9.0 packages: - '.' - '../libraries/Cabal/Cabal' -- '../libraries/hpc' -- '../libraries/parsec' -- '../libraries/text' extra-deps: - shake-0.16 From git at git.haskell.org Sat Jan 27 03:21:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:21:35 +0000 (UTC) Subject: [commit: hadrian] master: Fix CI (#489) (2609bd0) Message-ID: <20180127032135.2E5923A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/2609bd02b6f517777175a8f34e05a9e36570e511 >--------------------------------------------------------------- commit 2609bd02b6f517777175a8f34e05a9e36570e511 Author: Andrey Mokhov Date: Mon Dec 11 21:43:25 2017 +0000 Fix CI (#489) Delete the .git folder explicitly >--------------------------------------------------------------- 2609bd02b6f517777175a8f34e05a9e36570e511 .travis.yml | 2 +- circle.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index b89f42b..63b3e31 100644 --- a/.travis.yml +++ b/.travis.yml @@ -77,7 +77,7 @@ install: - cabal install alex happy # GHC comes with an older version of Hadrian, so we delete it - - rm -r ghc/hadrian/* + - rm -rf ghc/hadrian/.git # Travis has already cloned Hadrian into ./ and we need to move it # to ./ghc/hadrian -- one way to do it is to move the .git directory diff --git a/circle.yml b/circle.yml index e9a4b6a..f04f4c7 100644 --- a/circle.yml +++ b/circle.yml @@ -22,7 +22,7 @@ compile: - git clone --depth 1 --recursive git://github.com/ghc/ghc # GHC comes with an older version of Hadrian, so we delete it - - rm -r ghc/hadrian/* + - rm -rf ghc/hadrian/.git # move hadrian's .git into ./ghc/hadrian and perform a hard reset in order to regenerate Hadrian files - mv .git ghc/hadrian # NOTE: we must write them in the same line because each line From git at git.haskell.org Sat Jan 27 03:21:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:21:39 +0000 (UTC) Subject: [commit: hadrian] master: Fix broken colours with `-j` (#484) (fdc35b1) Message-ID: <20180127032139.39E703A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/fdc35b1859c5b0781f26bb8b1754f4087f2afdbd >--------------------------------------------------------------- commit fdc35b1859c5b0781f26bb8b1754f4087f2afdbd Author: Patrick Dougherty Date: Sat Dec 16 20:25:50 2017 -0600 Fix broken colours with `-j` (#484) * Fix colours * Simplify data types * Fix doc typo >--------------------------------------------------------------- fdc35b1859c5b0781f26bb8b1754f4087f2afdbd README.md | 2 +- circle.yml | 2 +- doc/user-settings.md | 15 +++++++-- hadrian.cabal | 1 - src/Hadrian/Utilities.hs | 87 +++++++++++++++++++++++++++++++++++++----------- src/UserSettings.hs | 5 ++- 6 files changed, 85 insertions(+), 27 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fdc35b1859c5b0781f26bb8b1754f4087f2afdbd From git at git.haskell.org Sat Jan 27 03:21:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:21:41 +0000 (UTC) Subject: [commit: hadrian] master: [WIP] Support run GHC's test from hadrian. (#495) (63a5563) Message-ID: <20180127032141.460A23A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/63a556382f4b3154ed2ce3a6c8a36f79d9b8e3b1 >--------------------------------------------------------------- commit 63a556382f4b3154ed2ce3a6c8a36f79d9b8e3b1 Author: HE, Tao Date: Fri Jan 26 07:10:48 2018 -0600 [WIP] Support run GHC's test from hadrian. (#495) * Support run GHC's test from hadrian. 1. Necessary command line arguments to run test driver. + `--test-only=` + `--test-skip-perf` + `--test-summary=` + `--test-junit=` + `--test-config=` 2. Synchronize configurations from test.mk. 3. Synchronize GHC's compilation flags from test.mk (that's very important). * The `RunTest` builder and `test` rule to run GHC's test. * Timeout rules. * Reduce boilerplate. * Fix warning. * Move getTestArgs into Settings.Builders.RunTest. * Drop `validate` related code to avoid confusion. * Replace explicit `chmod +x` with `makeExecutable`. * Fix executable's extension. >--------------------------------------------------------------- 63a556382f4b3154ed2ce3a6c8a36f79d9b8e3b1 cfg/system.config.in | 4 ++ hadrian.cabal | 1 + src/Builder.hs | 6 ++ src/CommandLine.hs | 59 ++++++++++++++++-- src/Hadrian/Utilities.hs | 22 ++++++- src/Rules/Test.hs | 131 ++++++++++++++++++++++++--------------- src/Settings/Builders/RunTest.hs | 107 ++++++++++++++++++++++++++++++++ src/Settings/Default.hs | 2 + 8 files changed, 276 insertions(+), 56 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 63a556382f4b3154ed2ce3a6c8a36f79d9b8e3b1 From git at git.haskell.org Sat Jan 27 03:21:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:21:59 +0000 (UTC) Subject: [commit: ghc] master: Bump hadrian submodule (1cb12ea) Message-ID: <20180127032159.5177B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1cb12eae648c964c411f4c83730f3db05e409f48/ghc >--------------------------------------------------------------- commit 1cb12eae648c964c411f4c83730f3db05e409f48 Author: Ben Gamari Date: Fri Jan 26 22:20:27 2018 -0500 Bump hadrian submodule >--------------------------------------------------------------- 1cb12eae648c964c411f4c83730f3db05e409f48 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 86216e2..63a5563 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 86216e249f307a778bef3755afb7474910bc60cc +Subproject commit 63a556382f4b3154ed2ce3a6c8a36f79d9b8e3b1 From git at git.haskell.org Sat Jan 27 03:58:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:58:12 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Make mkNthCo take a Role parameter. (8a6aa50) Message-ID: <20180127035812.3A3CE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/8a6aa5030d34592200fbe799bf38abf3701544db/ghc >--------------------------------------------------------------- commit 8a6aa5030d34592200fbe799bf38abf3701544db Author: Richard Eisenberg Date: Fri Jan 26 22:09:33 2018 -0500 Make mkNthCo take a Role parameter. Most callers of mkNthCo know the role of the coercion they are trying to make. So instead of calculating this role, just pass it in. >--------------------------------------------------------------- 8a6aa5030d34592200fbe799bf38abf3701544db compiler/coreSyn/CoreLint.hs | 11 ++- compiler/coreSyn/CoreOpt.hs | 24 +++---- compiler/coreSyn/CoreUtils.hs | 4 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/TcCanonical.hs | 2 +- compiler/typecheck/TcEvidence.hs | 4 +- compiler/typecheck/TcUnify.hs | 4 +- compiler/types/Coercion.hs | 146 +++++++++++++++++++------------------- compiler/types/Coercion.hs-boot | 2 +- compiler/types/OptCoercion.hs | 109 ++++++++++++---------------- compiler/types/TyCoRep.hs | 11 ++- compiler/types/Type.hs | 6 +- compiler/types/Unify.hs | 4 +- 13 files changed, 159 insertions(+), 170 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8a6aa5030d34592200fbe799bf38abf3701544db From git at git.haskell.org Sat Jan 27 03:58:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:58:15 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Update core-spec with new NthCo (f43a853) Message-ID: <20180127035815.2575D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/f43a8531df660aee270791295c34812e169e1e8b/ghc >--------------------------------------------------------------- commit f43a8531df660aee270791295c34812e169e1e8b Author: Richard Eisenberg Date: Fri Jan 26 22:28:42 2018 -0500 Update core-spec with new NthCo >--------------------------------------------------------------- f43a8531df660aee270791295c34812e169e1e8b docs/core-spec/CoreLint.ott | 5 +++-- docs/core-spec/CoreSyn.ott | 6 ++++-- docs/core-spec/core-spec.mng | 2 +- docs/core-spec/core-spec.pdf | Bin 354307 -> 355707 bytes 4 files changed, 8 insertions(+), 5 deletions(-) diff --git a/docs/core-spec/CoreLint.ott b/docs/core-spec/CoreLint.ott index 3a3468d..1fb9e09 100644 --- a/docs/core-spec/CoreLint.ott +++ b/docs/core-spec/CoreLint.ott @@ -299,12 +299,13 @@ G |-ty ti : k2' not (si is_a_coercion) not (ti is_a_coercion) R' = (tyConRolesX R T)[i] +R' <= R0 ---------------------- :: NthCoTyCon -G |-co nth i g : si k2~R' k2' ti +G |-co nth R0 i g : si k2~R0 k2' ti G |-co g : (forall z1_k1.t1) k3~R k4 (forall z2_k2.t2) --------------------------- :: NthCoForAll -G |-co nth 0 g : k1 *~Nom * k2 +G |-co nth R0 0 g : k1 *~R0 * k2 G |-co g : (s1 s2) k~Nom k' (t1 t2) G |-ty s1 : k1 diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott index 78118d5..e12f68b 100644 --- a/docs/core-spec/CoreSyn.ott +++ b/docs/core-spec/CoreSyn.ott @@ -152,8 +152,8 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | g1 ; g2 :: :: TransCo {{ com \ctor{TransCo}: Transitivity }} | mu $ :: :: AxiomRuleCo {{ com \ctor{AxiomRuleCo}: Axiom-rule application (for type-nats) }} - | nth I g :: :: NthCo {{ com \ctor{NthCo}: Projection (0-indexed) }} - {{ tex \textsf{nth}^{[[I]]}\,[[g]] }} + | nth R I g :: :: NthCo {{ com \ctor{NthCo}: Projection (0-indexed) }} + {{ tex \textsf{nth}^{[[I]]}_{[[R]]}\,[[g]] }} | LorR g :: :: LRCo {{ com \ctor{LRCo}: Left/right projection }} | g @ h :: :: InstCo {{ com \ctor{InstCo}: Instantiation }} | g |> h :: :: CoherenceCo {{ com \ctor{CoherenceCo}: Coherence }} @@ -453,6 +453,8 @@ formula :: 'formula_' ::= | role_list1 = role_list2 :: :: eq_role_list | R1 /= R2 :: :: role_neq | R1 = R2 :: :: eq_role + | R1 <= R2 :: :: lte_role + {{ tex [[R1]] \leq [[R2]] }} | = tyConDataCons T :: :: tyConDataCons | O ( n ) = R :: :: role_lookup | R elt role_list :: :: role_elt diff --git a/docs/core-spec/core-spec.mng b/docs/core-spec/core-spec.mng index 5800321..64e90bb 100644 --- a/docs/core-spec/core-spec.mng +++ b/docs/core-spec/core-spec.mng @@ -30,7 +30,7 @@ System FC, as implemented in GHC\footnote{This document was originally prepared by Richard Eisenberg (\texttt{eir at cis.upenn.edu}), but it should be maintained by anyone who edits the functions or data structures mentioned in this file. Please feel free to contact Richard for more information.}\\ -\Large 23 October, 2015 +\Large 26 January, 2018 \end{center} \section{Introduction} diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf index 1e13911..3732818 100644 Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ From git at git.haskell.org Sat Jan 27 03:58:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 03:58:18 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Discard reflexive casts during Simplify (b595f99) Message-ID: <20180127035818.079393A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/b595f99b64c8c505d4b68bd408daf3e6ccf558b6/ghc >--------------------------------------------------------------- commit b595f99b64c8c505d4b68bd408daf3e6ccf558b6 Author: Richard Eisenberg Date: Fri Jan 26 22:42:46 2018 -0500 Discard reflexive casts during Simplify Previously, we went to great lengths to build just the right reflexive casts, only to discard them shortly later. Now, just skip creating reflexive casts altogether. >--------------------------------------------------------------- b595f99b64c8c505d4b68bd408daf3e6ccf558b6 compiler/coreSyn/CoreOpt.hs | 44 +++++++++++++++++++++++++----------------- compiler/simplCore/Simplify.hs | 39 +++++++++++++++++++++++-------------- 2 files changed, 50 insertions(+), 33 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 440d7c5..d4ddd84 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -732,9 +732,11 @@ exprIsConApp_maybe (in_scope, id_unf) expr go subst (Tick t expr) cont | not (tickishIsCode t) = go subst expr cont go subst (Cast expr co1) (CC args co2) - | Just (args', co1') <- pushCoArgs (subst_co subst co1) args + | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args -- See Note [Push coercions in exprIsConApp_maybe] - = go subst expr (CC args' (co1' `mkTransCo` co2)) + = case m_co1' of + Just co1' -> go subst expr (CC args' (co1' `mkTransCo` co2)) + Nothing -> go subst expr (CC args' co2) go subst (App fun arg) (CC args co) = go subst fun (CC (subst_arg subst arg : args) co) go subst (Lam var body) (CC (arg:args) co) @@ -928,36 +930,40 @@ Here we implement the "push rules" from FC papers: by pushing the coercion into the arguments -} -pushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], Coercion) -pushCoArgs co [] = return ([], co) -pushCoArgs co (arg:args) = do { (arg', co1) <- pushCoArg co arg - ; (args', co2) <- pushCoArgs co1 args - ; return (arg':args', co2) } +pushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], Maybe Coercion) +pushCoArgs co [] = return ([], Just co) +pushCoArgs co (arg:args) = do { (arg', m_co1) <- pushCoArg co arg + ; case m_co1 of + Just co1 -> do { (args', m_co2) <- pushCoArgs co1 args + ; return (arg':args', m_co2) } + Nothing -> return (arg':args, Nothing) } -pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, Coercion) +pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, Maybe Coercion) -- We have (fun |> co) arg, and we want to transform it to -- (fun arg) |> co -- This may fail, e.g. if (fun :: N) where N is a newtype -- C.f. simplCast in Simplify.hs -- 'co' is always Representational +-- If the returned coercion is Nothing, then it would have been reflexive +pushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty + ; return (Type ty', m_co') } +pushCoArg co val_arg = do { (arg_co, m_co') <- pushCoValArg co + ; return (val_arg `mkCast` arg_co, m_co') } -pushCoArg co (Type ty) = do { (ty', co') <- pushCoTyArg co ty - ; return (Type ty', co') } -pushCoArg co val_arg = do { (arg_co, co') <- pushCoValArg co - ; return (mkCast val_arg arg_co, co') } - -pushCoTyArg :: Coercion -> Type -> Maybe (Type, Coercion) +pushCoTyArg :: CoercionR -> Type -> Maybe (Type, Maybe CoercionR) -- We have (fun |> co) @ty -- Push the coercion through to return -- (fun @ty') |> co' -- 'co' is always Representational +-- If the returned coercion is Nothing, then it would have been reflexive; +-- it's faster not to compute it, though. pushCoTyArg co ty | tyL `eqType` tyR - = Just (ty, mkRepReflCo (piResultTy tyR ty)) + = Just (ty, Nothing) | isForAllTy tyL = ASSERT2( isForAllTy tyR, ppr co $$ ppr ty ) - Just (ty `mkCastTy` mkSymCo co1, co2) + Just (ty `mkCastTy` mkSymCo co1, Just co2) | otherwise = Nothing @@ -977,14 +983,16 @@ pushCoTyArg co ty -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] -- Arg of mkInstCo is always nominal, hence mkNomReflCo -pushCoValArg :: CoercionR -> Maybe (Coercion, Coercion) +pushCoValArg :: CoercionR -> Maybe (Coercion, Maybe Coercion) -- We have (fun |> co) arg -- Push the coercion through to return -- (fun (arg |> co_arg)) |> co_res -- 'co' is always Representational +-- If the second returned Coercion is actually Nothing, then no cast is necessary; +-- the returned coercion would have been reflexive. pushCoValArg co | tyL `eqType` tyR - = Just (mkRepReflCo arg, mkRepReflCo res) + = Just (mkRepReflCo arg, Nothing) | isFunTy tyL , (co1, co2) <- decomposeFunCo Representational co diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 19cbe2e..3d94dae 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1225,26 +1225,43 @@ simplCast env body co0 cont0 ; cont1 <- {-#SCC "simplCast-addCoerce" #-} addCoerce co1 cont0 ; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 } where + -- If the first parameter is Nothing, then simplifying revealed a + -- reflexive coercion. Omit. + addCoerce0 :: Maybe OutCoercion -> SimplCont -> SimplM SimplCont + addCoerce0 Nothing cont = cont + addCoerce0 (Just co) cont = addCoerce co cont + addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont + addCoerce co cont -- just skip reflexive casts + | isReflexiveCo co = {-#SCC "addCoerce-reflexive" #-} + return cont + -- It's worth checking isReflexiveCo. + -- For example, in the initial form of a worker + -- we may find (coerce T (coerce S (\x.e))) y + -- and we'd like it to simplify to e[y/x] in one round + -- of simplification + addCoerce co1 (CastIt co2 cont) = {-#SCC "addCoerce-simple-recursion" #-} addCoerce (mkTransCo co1 co2) cont addCoerce co cont@(ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) - | Just (arg_ty', co') <- pushCoTyArg co arg_ty + | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty = {-#SCC "addCoerce-pushCoTyArg" #-} - do { tail' <- addCoerce co' tail - ; return (cont { sc_arg_ty = arg_ty', sc_cont = tail' }) } + case m_co' of + Just co' -> do { tail' <- addCoerce co' tail + ; return (cont { sc_arg_ty = arg_ty', sc_cont = tail' }) } + Nothing -> return cont addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup, sc_cont = tail }) - | Just (co1, co2) <- pushCoValArg co + | Just (co1, m_co2) <- pushCoValArg co , Pair _ new_ty <- coercionKind co1 , not (isTypeLevPoly new_ty) -- without this check, we get a lev-poly arg -- See Note [Levity polymorphism invariants] in CoreSyn -- test: typecheck/should_run/EtaExpandLevPoly = {-#SCC "addCoerce-pushCoValArg" #-} - do { tail' <- addCoerce co2 tail + do { tail' <- addCoerce0 m_co2 tail ; if isReflCo co1 then return (cont { sc_cont = tail' }) -- Avoid simplifying if possible; @@ -1261,16 +1278,8 @@ simplCast env body co0 cont0 , sc_dup = dup' , sc_cont = tail' }) } } - addCoerce co cont - | isReflexiveCo co = {-#SCC "addCoerce-reflexive" #-} - return cont - | otherwise = {-#SCC "addCoerce-other" #-} - return (CastIt co cont) - -- It's worth checking isReflexiveCo. - -- For example, in the initial form of a worker - -- we may find (coerce T (coerce S (\x.e))) y - -- and we'd like it to simplify to e[y/x] in one round - -- of simplification + addCoerce co cont = {-#SCC "addCoerce-other" #-} + return (CastIt co cont) simplArg :: SimplEnv -> DupFlag -> StaticEnv -> CoreExpr -> SimplM (DupFlag, StaticEnv, OutExpr) From git at git.haskell.org Sat Jan 27 14:56:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 14:56:02 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: This should really have been in the previous commit. (ee83b71) Message-ID: <20180127145602.8434D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/ee83b713d4b8767594e5c9597e3e6f2bbc1f1525/ghc >--------------------------------------------------------------- commit ee83b713d4b8767594e5c9597e3e6f2bbc1f1525 Author: Richard Eisenberg Date: Sat Jan 27 09:55:21 2018 -0500 This should really have been in the previous commit. >--------------------------------------------------------------- ee83b713d4b8767594e5c9597e3e6f2bbc1f1525 compiler/coreSyn/CoreOpt.hs | 4 ++-- compiler/simplCore/Simplify.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index d4ddd84..6521cc4 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -1000,12 +1000,12 @@ pushCoValArg co -- then co1 :: tyL1 ~ tyR1 -- co2 :: tyL2 ~ tyR2 = ASSERT2( isFunTy tyR, ppr co $$ ppr arg ) - Just (mkSymCo co1, co2) + Just (mkSymCo co1, Just co2) | otherwise = Nothing where - (arg, res) = splitFunTy tyR + (arg, _) = splitFunTy tyR Pair tyL tyR = coercionKind co pushCoercionIntoLambda diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 3d94dae..a0df602 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1228,7 +1228,7 @@ simplCast env body co0 cont0 -- If the first parameter is Nothing, then simplifying revealed a -- reflexive coercion. Omit. addCoerce0 :: Maybe OutCoercion -> SimplCont -> SimplM SimplCont - addCoerce0 Nothing cont = cont + addCoerce0 Nothing cont = return cont addCoerce0 (Just co) cont = addCoerce co cont addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont From git at git.haskell.org Sat Jan 27 19:18:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 19:18:09 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: exclude casts for now (eef0c05) Message-ID: <20180127191809.AF8413A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/eef0c057551ef860c1ace2e1c7509bcdc3c8eb91/ghc >--------------------------------------------------------------- commit eef0c057551ef860c1ace2e1c7509bcdc3c8eb91 Author: Gabor Greif Date: Sat Jan 27 20:16:52 2018 +0100 WIP: exclude casts for now >--------------------------------------------------------------- eef0c057551ef860c1ace2e1c7509bcdc3c8eb91 compiler/codeGen/StgCmmClosure.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1736bba..2c6cf19 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,7 +68,7 @@ module StgCmmClosure ( import GhcPrelude -import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate, Expr(Cast) ) import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import SMRep @@ -331,7 +331,10 @@ mkLFImported id | isValueUnfolding unf , Just expr <- maybeUnfoldingTemplate unf , Just con <- exprIsSatConApp_maybe expr - = LFCon con + , let casted (Cast _ _) = True + casted _ = False + , not $ casted expr + = pprTrace "mkLFImported" (ppr unf <+> ppr expr <+> ppr con) LFCon con | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") From git at git.haskell.org Sat Jan 27 19:18:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 19:18:12 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: trace other way round (39107d2) Message-ID: <20180127191812.98D433A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/39107d280ad3e3a753bfe66182161681a41b1dbc/ghc >--------------------------------------------------------------- commit 39107d280ad3e3a753bfe66182161681a41b1dbc Author: Gabor Greif Date: Sat Jan 27 20:17:49 2018 +0100 WIP: trace other way round >--------------------------------------------------------------- 39107d280ad3e3a753bfe66182161681a41b1dbc compiler/codeGen/StgCmmClosure.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 2c6cf19..f64a311 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -331,10 +331,10 @@ mkLFImported id | isValueUnfolding unf , Just expr <- maybeUnfoldingTemplate unf , Just con <- exprIsSatConApp_maybe expr - , let casted (Cast _ _) = True + , let casted (Cast _ _) = pprTrace "mkLFImported" (ppr unf <+> ppr expr <+> ppr con) True casted _ = False , not $ casted expr - = pprTrace "mkLFImported" (ppr unf <+> ppr expr <+> ppr con) LFCon con + = LFCon con | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") From git at git.haskell.org Sat Jan 27 19:26:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 19:26:27 +0000 (UTC) Subject: [commit: ghc] wip/T14677: Revert "WIP: a shot in the dark" (f3f2851) Message-ID: <20180127192627.BA5FA3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/f3f285122a32ffcebaf5aad1acf4c2bb0c48e450/ghc >--------------------------------------------------------------- commit f3f285122a32ffcebaf5aad1acf4c2bb0c48e450 Author: Gabor Greif Date: Sat Jan 27 20:25:57 2018 +0100 Revert "WIP: a shot in the dark" This reverts commit d47d32b5211831886910f8abc0431809ccacf0c8. >--------------------------------------------------------------- f3f285122a32ffcebaf5aad1acf4c2bb0c48e450 compiler/codeGen/StgCmmExpr.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index f90aebc..3fcc935 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -738,16 +738,7 @@ cgIdApp fun_id args = do node_points dflags = nodeMustPointToIt dflags lf_info case getCallMethod dflags fun_name cg_fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of -- A value in WHNF, so we can just return it. - EnterIt | Just con <- maybeIsLFCon lf_info -> pprPanic "maybeIsLFCon EnterIt" (ppr con) - ReturnIt - -- | Just con <- maybeIsLFCon lf_info -> emitReturn [CmmLoad (CmmMachOp (MO_Add $ typeWidth $ gcWord dflags) [fun, CmmLit (CmmInt 7 $ typeWidth $ gcWord dflags)]) $ gcWord dflags] - | Just con <- maybeIsLFCon lf_info - , CmmLit (CmmLabelOff lab _) <- fun -> - let ty = gcWord dflags - width = typeWidth ty - offsLoad = CmmLoad (CmmMachOp (MO_Add width) [cmmUntag dflags fun, CmmLit (CmmInt 8 width)]) $ ty - in emitReturn [pprTrace "offsLoad" (ppr offsLoad) offsLoad] | isVoidTy (idType fun_id) -> emitReturn [] | otherwise -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged? From git at git.haskell.org Sat Jan 27 21:46:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Jan 2018 21:46:58 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735: Fix testsuite failures (d74b37d) Message-ID: <20180127214658.95AAE3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735 Link : http://ghc.haskell.org/trac/ghc/changeset/d74b37d56538823c425d653e45a92f4fdbec9f28/ghc >--------------------------------------------------------------- commit d74b37d56538823c425d653e45a92f4fdbec9f28 Author: Richard Eisenberg Date: Sat Jan 27 16:46:36 2018 -0500 Fix testsuite failures >--------------------------------------------------------------- d74b37d56538823c425d653e45a92f4fdbec9f28 compiler/backpack/RnModIface.hs | 2 +- compiler/iface/IfaceSyn.hs | 2 +- compiler/iface/IfaceType.hs | 14 +++++++----- compiler/iface/TcIface.hs | 2 +- compiler/iface/ToIface.hs | 2 +- compiler/types/Coercion.hs | 28 ++---------------------- compiler/types/OptCoercion.hs | 9 ++++---- testsuite/tests/pmcheck/should_compile/T11195.hs | 2 +- 8 files changed, 20 insertions(+), 41 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d74b37d56538823c425d653e45a92f4fdbec9f28 From git at git.haskell.org Sun Jan 28 08:22:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 08:22:12 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: triggering CI for Simon's patch (155ba82) Message-ID: <20180128082212.6302B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/155ba82899956e1b9ee21257a115302fcd78b67f/ghc >--------------------------------------------------------------- commit 155ba82899956e1b9ee21257a115302fcd78b67f Author: Gabor Greif Date: Wed Jan 17 14:47:00 2018 +0100 WIP: triggering CI for Simon's patch >--------------------------------------------------------------- 155ba82899956e1b9ee21257a115302fcd78b67f compiler/codeGen/StgCmmClosure.hs | 8 ++++++++ compiler/coreSyn/CoreOpt.hs | 20 +++++++++++++++++++- compiler/prelude/PrelRules.hs | 9 ++------- 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1da1f70..1736bba 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,6 +68,8 @@ module StgCmmClosure ( import GhcPrelude +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import SMRep import Cmm @@ -326,6 +328,11 @@ mkLFImported id -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor + | isValueUnfolding unf + , Just expr <- maybeUnfoldingTemplate unf + , Just con <- exprIsSatConApp_maybe expr + = LFCon con + | arity > 0 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") @@ -333,6 +340,7 @@ mkLFImported id = mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id + unf = realIdUnfolding id ------------- mkLFStringLit :: LambdaFormInfo diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 04e604e..2661483 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -12,7 +12,8 @@ module CoreOpt ( joinPointBinding_maybe, joinPointBindings_maybe, -- ** Predicates on expressions - exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, + exprIsConApp_maybe, exprIsLiteral_maybe, + exprIsLambda_maybe, exprIsSatConApp_maybe, -- ** Coercions and casts pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo @@ -791,6 +792,23 @@ exprIsConApp_maybe (in_scope, id_unf) expr extend (Right s) v e = Right (extendSubst s v e) +exprIsSatConApp_maybe :: CoreExpr -> Maybe DataCon +-- Returns (Just dc) for a saturated application of dc +-- Simpler than exprIsConApp_maybe +exprIsSatConApp_maybe e = go 0 e + where + go :: Arity -> CoreExpr -> Maybe DataCon + go n_val_args (Var v) + | Just dc <- isDataConWorkId_maybe v + , dataConRepArity dc == n_val_args + = Just dc + go n_val_args (App f a) + | isTypeArg a = go n_val_args f + | otherwise = go (n_val_args + 1) f + go n_val_args (Cast e _) = go n_val_args e + go n_val_args (Tick _ e) = go n_val_args e + go _ _ = Nothing + -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion -> Maybe (DataCon, [Type], [CoreExpr]) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index db79589..3e9899f 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -33,7 +33,7 @@ import CoreSyn import MkCore import Id import Literal -import CoreOpt ( exprIsLiteral_maybe ) +import CoreOpt ( exprIsLiteral_maybe, exprIsSatConApp_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim @@ -41,7 +41,6 @@ import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon , unwrapNewTyCon_maybe, tyConDataCons ) import DataCon ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId ) import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) -import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) import PrelNames @@ -695,9 +694,6 @@ removeOp32 = do getArgs :: RuleM [CoreExpr] getArgs = RuleM $ \_ _ args -> Just args -getInScopeEnv :: RuleM InScopeEnv -getInScopeEnv = RuleM $ \_ iu _ -> Just iu - -- return the n-th argument of this rule, if it is a literal -- argument indices start from 0 getLiteral :: Int -> RuleM Literal @@ -916,8 +912,7 @@ dataToTagRule = a `mplus` b b = do dflags <- getDynFlags [_, val_arg] <- getArgs - in_scope <- getInScopeEnv - (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg + dc <- liftMaybe $ exprIsSatConApp_maybe val_arg ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return () return $ mkIntVal dflags (toInteger (dataConTagZ dc)) From git at git.haskell.org Sun Jan 28 08:22:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 08:22:15 +0000 (UTC) Subject: [commit: ghc] wip/T14677: WIP: exclude casts for now (7d47c16) Message-ID: <20180128082215.8BC273A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14677 Link : http://ghc.haskell.org/trac/ghc/changeset/7d47c16262c8d324aef4f66cc3406f3975d7f6e0/ghc >--------------------------------------------------------------- commit 7d47c16262c8d324aef4f66cc3406f3975d7f6e0 Author: Gabor Greif Date: Sat Jan 27 20:16:52 2018 +0100 WIP: exclude casts for now >--------------------------------------------------------------- 7d47c16262c8d324aef4f66cc3406f3975d7f6e0 compiler/codeGen/StgCmmClosure.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1736bba..f64a311 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -68,7 +68,7 @@ module StgCmmClosure ( import GhcPrelude -import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate ) +import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate, Expr(Cast) ) import CoreOpt( exprIsSatConApp_maybe ) import StgSyn import SMRep @@ -331,6 +331,9 @@ mkLFImported id | isValueUnfolding unf , Just expr <- maybeUnfoldingTemplate unf , Just con <- exprIsSatConApp_maybe expr + , let casted (Cast _ _) = pprTrace "mkLFImported" (ppr unf <+> ppr expr <+> ppr con) True + casted _ = False + , not $ casted expr = LFCon con | arity > 0 From git at git.haskell.org Sun Jan 28 08:22:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 08:22:18 +0000 (UTC) Subject: [commit: ghc] wip/T14677's head updated: WIP: exclude casts for now (7d47c16) Message-ID: <20180128082218.6B0923A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14677' now includes: d36ae5d Comments about CoercionHoles 076bdb3 Remove dead code: mkNthCoRole 2a2e6a8 Comments only 0636689 Fix the lone-variable case in callSiteInline d6e0338 Bump terminfo submodule 40c753f testsuite: Bump haddock.Cabal allocations due to submodule bump 0e022e5 Turn EvTerm (almost) into CoreExpr (#14691) 983e491 testsuite: Add testcase for #12158 66961dc Haddock needs to pass visible modules for instance filtering 302aee5 base: Refactor Show ErrorCall instance into proper ShowS style 52dfb25 Handle the likely:True case in CmmContFlowOpt e7dcc70 Add ability to parse likely flags for ifs in Cmm. 31c260f Add ptr-eq short-cut to `compareByteArrays#` primitive cbdea95 Sort valid substitutions for typed holes by "relevance" cacba07 Linker: ignore empty paths in addEnvPaths bd58e29 Remove Hoopl.Unique 9a57cfe Option for LINE pragmas to get lexed into tokens a55d581 Fix Windows stack allocations. 59fa7b3 Fix #14719 by using the setting the right SrcSpan 7ff6023 cmm: Use two equality checks for two alt switch with default 1cb12ea Bump hadrian submodule 155ba82 WIP: triggering CI for Simon's patch 7d47c16 WIP: exclude casts for now From git at git.haskell.org Sun Jan 28 16:06:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:10 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: don't reenter WHNF thing for re-tagging (eac9f6c) Message-ID: <20180128160610.D8A3B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/eac9f6c8419cc1875c59d87d0f2b13a0dab56ebb/ghc >--------------------------------------------------------------- commit eac9f6c8419cc1875c59d87d0f2b13a0dab56ebb Author: Gabor Greif Date: Wed Dec 27 19:47:50 2017 +0100 WIP: don't reenter WHNF thing for re-tagging this is a very crude test. How to make it more robust? >--------------------------------------------------------------- eac9f6c8419cc1875c59d87d0f2b13a0dab56ebb compiler/codeGen/StgCmmClosure.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index f64a311..15a123e 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards #-} - +{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -225,8 +225,13 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description + deriving Show - +deriving instance Show TopLevelFlag +deriving instance Show OneShotInfo +deriving instance Show ArgDescr +deriving instance Show StandardFormInfo +instance Show DataCon where show _ = "" ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms @@ -587,6 +592,10 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt +getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" + = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt + getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -- n_args=0 because it'd be ill-typed to apply a saturated From git at git.haskell.org Sun Jan 28 16:06:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:13 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: look at evaluated-ness (c6c3939) Message-ID: <20180128160613.C8B743A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/c6c3939426c639a6f370c3cedd8dc49c4a0da293/ghc >--------------------------------------------------------------- commit c6c3939426c639a6f370c3cedd8dc49c4a0da293 Author: Gabor Greif Date: Wed Jan 3 16:55:15 2018 +0100 WIP: look at evaluated-ness >--------------------------------------------------------------- c6c3939426c639a6f370c3cedd8dc49c4a0da293 compiler/codeGen/StgCmmClosure.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 669b1e5..4c7fdd7 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -71,6 +71,7 @@ import GhcPrelude import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate, Expr(Cast) ) import CoreOpt( exprIsSatConApp_maybe ) import StgSyn +import CoreSyn (isEvaldUnfolding) import SMRep import Cmm import PprCmmExpr() @@ -631,6 +632,15 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function +getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info + | isEvaldUnfolding (idUnfolding id) + , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + = pprTrace "getCallMethod" (ppr id) ReturnIt -- seems to come from case, must be (tagged) WHNF already +{- +getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" -- TODO: make this robust + = ReturnIt -- seems to come from case, must be (tagged) WHNF already +-} getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) EnterIt -- Not a function From git at git.haskell.org Sun Jan 28 16:06:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:16 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: cleanups (95212cd) Message-ID: <20180128160616.AF8A03A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/95212cdf6d1742f1bc5bd44ced3d0d51712d985e/ghc >--------------------------------------------------------------- commit 95212cdf6d1742f1bc5bd44ced3d0d51712d985e Author: Gabor Greif Date: Thu Dec 28 10:58:55 2017 +0100 WIP: cleanups and add TODO (also this should be more performant, by consing less) >--------------------------------------------------------------- 95212cdf6d1742f1bc5bd44ced3d0d51712d985e compiler/codeGen/StgCmmClosure.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 15a123e..9ce952e 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE CPP, RecordWildCards #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -225,13 +225,8 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description - deriving Show -deriving instance Show TopLevelFlag -deriving instance Show OneShotInfo -deriving instance Show ArgDescr -deriving instance Show StandardFormInfo -instance Show DataCon where show _ = "" + ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms @@ -592,9 +587,9 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info - | occNameString (nameOccName name) == "wild" - = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt +getCallMethod _ name _ (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" -- TODO: make this robust + = ReturnIt -- seems to come from case, must be (tagged) WHNF already getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt From git at git.haskell.org Sun Jan 28 16:06:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:19 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: ooops (9c25791) Message-ID: <20180128160619.9441D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/9c25791daa622cc946bf2779a3bed5035b67c4de/ghc >--------------------------------------------------------------- commit 9c25791daa622cc946bf2779a3bed5035b67c4de Author: Gabor Greif Date: Thu Dec 28 12:00:23 2017 +0100 WIP: ooops >--------------------------------------------------------------- 9c25791daa622cc946bf2779a3bed5035b67c4de compiler/codeGen/StgCmmClosure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 9ce952e..669b1e5 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -587,7 +587,7 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ name _ (LFUnknown False) 0 _v_args cg_loc _self_loop_info +getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust = ReturnIt -- seems to come from case, must be (tagged) WHNF already From git at git.haskell.org Sun Jan 28 16:06:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:22 +0000 (UTC) Subject: [commit: ghc] wip/T14626: Test the absence of re-tagging (e300b42) Message-ID: <20180128160622.754F13A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/e300b42a12c018fc9b81f04e4d300575148b35c4/ghc >--------------------------------------------------------------- commit e300b42a12c018fc9b81f04e4d300575148b35c4 Author: Gabor Greif Date: Wed Jan 3 18:40:19 2018 +0100 Test the absence of re-tagging >--------------------------------------------------------------- e300b42a12c018fc9b81f04e4d300575148b35c4 testsuite/tests/codeGen/should_compile/Makefile | 4 ++++ testsuite/tests/codeGen/should_compile/T14626.hs | 7 +++++++ testsuite/tests/codeGen/should_compile/T14626.stdout | 3 +++ 3 files changed, 14 insertions(+) diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile index a841438..eaad461 100644 --- a/testsuite/tests/codeGen/should_compile/Makefile +++ b/testsuite/tests/codeGen/should_compile/Makefile @@ -7,6 +7,10 @@ T2578: T14626: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-uniques T14626.hs | grep case + echo == CMM == + # we don't want to see re-tagging, like: R1 = R1 & (-8); + - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm -dsuppress-uniques -fforce-recomp T14626.hs | grep 'R1 = R1 & (-[48])' + echo == /CMM == debug: # Without optimisations, we should get annotations for basically diff --git a/testsuite/tests/codeGen/should_compile/T14626.hs b/testsuite/tests/codeGen/should_compile/T14626.hs index a665694..76c7e2e 100644 --- a/testsuite/tests/codeGen/should_compile/T14626.hs +++ b/testsuite/tests/codeGen/should_compile/T14626.hs @@ -13,3 +13,10 @@ f v = case v of -- f v = case v of -- MkT y -> case y of z -> dataToTag# z -- But it was! See Trac #14626 comment:4 + + +data Letters = A | B | C | D | E | F + +consonant A = B +consonant E = C +consonant other = other diff --git a/testsuite/tests/codeGen/should_compile/T14626.stdout b/testsuite/tests/codeGen/should_compile/T14626.stdout index 31e280e..35803ee 100644 --- a/testsuite/tests/codeGen/should_compile/T14626.stdout +++ b/testsuite/tests/codeGen/should_compile/T14626.stdout @@ -1,2 +1,5 @@ case dt of dt { __DEFAULT -> T14626.MkT dt } case v of { T14626.MkT y [Occ=Once] -> + case ds of wild { +== CMM == +== /CMM == From git at git.haskell.org Sun Jan 28 16:06:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:25 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: yes, this crashes (81d8366) Message-ID: <20180128160625.67D053A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/81d8366fceaa2eb89afa92f72303c1f997aae516/ghc >--------------------------------------------------------------- commit 81d8366fceaa2eb89afa92f72303c1f997aae516 Author: Gabor Greif Date: Wed Jan 3 22:53:06 2018 +0100 WIP: yes, this crashes trying allowing only OtherCon next >--------------------------------------------------------------- 81d8366fceaa2eb89afa92f72303c1f997aae516 compiler/codeGen/StgCmmClosure.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 662dd1a..1d6c654 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -634,7 +634,8 @@ getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) - , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info From git at git.haskell.org Sun Jan 28 16:06:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:28 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: exclude top-level values for now (b1f1c92) Message-ID: <20180128160628.52B333A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/b1f1c920474de31e7d94496d600a3f4694f969bd/ghc >--------------------------------------------------------------- commit b1f1c920474de31e7d94496d600a3f4694f969bd Author: Gabor Greif Date: Thu Jan 4 00:56:00 2018 +0100 WIP: exclude top-level values for now as they probably won't get tagged correctly this way >--------------------------------------------------------------- b1f1c920474de31e7d94496d600a3f4694f969bd compiler/codeGen/StgCmmClosure.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1d6c654..f655afd 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, RecordWildCards #-} +{-# LANGUAGE CPP, RecordWildCards, LambdaCase #-} ----------------------------------------------------------------------------- -- @@ -71,7 +71,7 @@ import GhcPrelude import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate, Expr(Cast) ) import CoreOpt( exprIsSatConApp_maybe ) import StgSyn -import CoreSyn (isEvaldUnfolding) +import CoreSyn (isEvaldUnfolding, Unfolding(..)) import SMRep import Cmm import PprCmmExpr() @@ -632,10 +632,12 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function -getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info +getCallMethod _ _name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id + , OtherCon _ <- idUnfolding id + -- , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info From git at git.haskell.org Sun Jan 28 16:06:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:31 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: silence for benchmarks (58afdb0) Message-ID: <20180128160631.55CEC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/58afdb0ee1faa9273fe24384ab66dd198db0d098/ghc >--------------------------------------------------------------- commit 58afdb0ee1faa9273fe24384ab66dd198db0d098 Author: Gabor Greif Date: Wed Jan 3 17:15:12 2018 +0100 WIP: silence for benchmarks >--------------------------------------------------------------- 58afdb0ee1faa9273fe24384ab66dd198db0d098 compiler/codeGen/StgCmmClosure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 4c7fdd7..662dd1a 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -635,7 +635,7 @@ getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - = pprTrace "getCallMethod" (ppr id) ReturnIt -- seems to come from case, must be (tagged) WHNF already + = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust From git at git.haskell.org Sun Jan 28 16:06:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:37 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: some more de-strictifying (bdfa919) Message-ID: <20180128160637.208DF3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/bdfa91956326db08c525c90bc908941ed2636f14/ghc >--------------------------------------------------------------- commit bdfa91956326db08c525c90bc908941ed2636f14 Author: Gabor Greif Date: Fri Jan 12 15:41:40 2018 +0100 WIP: some more de-strictifying >--------------------------------------------------------------- bdfa91956326db08c525c90bc908941ed2636f14 compiler/codeGen/StgCmmClosure.hs | 2 +- compiler/utils/Outputable.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 24f21f0..d5caff8 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -768,7 +768,7 @@ data ClosureInfo -- code for ticky and profiling, and we could pass the information -- around separately, but it doesn't do much harm to keep it here. - closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon + closureLFInfo :: LambdaFormInfo, -- NOTE: not an LFCon -- this tells us about what the closure contains: it's right-hand-side. -- the rest is just an unpacked CmmInfoTable. diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 793b8fb..fd0de1e 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -321,7 +321,7 @@ code (either C or assembly), or generating interface files. newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc } data SDocContext = SDC - { sdocStyle :: !PprStyle + { sdocStyle :: PprStyle , sdocLastColour :: !Col.PprColour -- ^ The most recently used colour. This allows nesting colours. , sdocDynFlags :: !DynFlags From git at git.haskell.org Sun Jan 28 16:06:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:34 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: an attempt to add assert code (failed, for now) (13c3a0a) Message-ID: <20180128160634.3A5163A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/13c3a0ad1582c8787bbaa9b979b245c03bc00545/ghc >--------------------------------------------------------------- commit 13c3a0ad1582c8787bbaa9b979b245c03bc00545 Author: Gabor Greif Date: Wed Jan 10 22:41:24 2018 +0100 WIP: an attempt to add assert code (failed, for now) >--------------------------------------------------------------- 13c3a0ad1582c8787bbaa9b979b245c03bc00545 compiler/codeGen/StgCmmClosure.hs | 20 ++++++++++++++------ compiler/codeGen/StgCmmExpr.hs | 7 +++++++ rts/Apply.cmm | 9 +++++++++ 3 files changed, 30 insertions(+), 6 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index dfa98ca..1b4e0be 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, RecordWildCards, LambdaCase #-} +{-# LANGUAGE CPP, RecordWildCards, LambdaCase, PatternSynonyms #-} ----------------------------------------------------------------------------- -- @@ -30,7 +30,7 @@ module StgCmmClosure ( maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable, -- * Used by other modules - CgLoc(..), SelfLoopInfo, CallMethod(..), + CgLoc(..), SelfLoopInfo, CallMethod(.., ReturnIt), nodeMustPointToIt, isKnownFun, funTag, tagForArity, getCallMethod, -- * ClosureInfo @@ -532,12 +532,15 @@ Known fun (>1 arg), fvs & yes & yes & registers & node When black-holing, single-entry closures could also be entered via node (rather than directly) to catch double-entry. -} +pattern ReturnIt :: CallMethod +pattern ReturnIt = ReturnIt' False + data CallMethod = EnterIt -- No args, not a function | JumpToIt BlockId [LocalReg] -- A join point or a header of a local loop - | ReturnIt -- It's a value (function, unboxed value, + | ReturnIt' Bool -- It's a value (function, unboxed value, -- or constructor), so just return it. | SlowCall -- Unknown fun, or known fun with @@ -632,15 +635,20 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function + getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id , OtherCon _ <- idUnfolding id , let str = occNameString (nameOccName name) - , take 4 str == "wild" || take 2 str == "ds" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True - , take 4 str == "wild" || take 2 str == "ds" - = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already + , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + -- , take 4 str == "wild" || (take 2 str == "ds" && str /= "ds1" && str /= "ds2") + -- , take 4 str == "wild" || (str == "ds" || str == "ds1" || str == "ds2" || str == "ds3") -- CRASH + -- , take 4 str == "wild" || (str == "ds2" || str == "ds3") -- CRASH + -- , take 4 str == "wild" || (str == "ds3") -- CRASH: FastString + , take 4 str == "wild" || (str == "ds2") + = pprTrace "####getCallMethod" (ppr id) ReturnIt' True -- seems to come from case, must be (tagged) WHNF already diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935..32b9ccf 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -31,6 +31,7 @@ import StgCmmClosure import StgSyn +import Module (rtsUnitId) import MkGraph import BlockId import Cmm @@ -743,6 +744,12 @@ cgIdApp fun_id args = do | otherwise -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged? + ReturnIt' True -- TODO: add assertion + -> ASSERT( null args ) ASSERT( not (isVoidTy (idType fun_id)) ) + do emitRtsCall rtsUnitId + (fsLit "checkTagged") [(fun, AddrHint)] False + emitReturn [fun] + EnterIt -> ASSERT( null args ) -- Discarding arguments emitEnter fun diff --git a/rts/Apply.cmm b/rts/Apply.cmm index 15d8250..dde6f41 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -12,6 +12,15 @@ #include "Cmm.h" +checkTagged ( P_ obj ) +{ + if (GETTAG(obj)==0) { + ccall debugBelch("NOT TAGGED! "); + } + return(); +} + + /* ---------------------------------------------------------------------------- * Evaluate a closure and return it. * From git at git.haskell.org Sun Jan 28 16:06:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:40 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: "ds" is the suspect (151a0d7) Message-ID: <20180128160640.136463A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/151a0d739ae03987234d11a474a756094785e8e6/ghc >--------------------------------------------------------------- commit 151a0d739ae03987234d11a474a756094785e8e6 Author: Gabor Greif Date: Thu Jan 4 14:17:02 2018 +0100 WIP: "ds" is the suspect let's see what happens for /= "ds"... >--------------------------------------------------------------- 151a0d739ae03987234d11a474a756094785e8e6 compiler/codeGen/StgCmmClosure.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index f655afd..dfa98ca 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -632,13 +632,24 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function -getCallMethod _ _name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info +getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id , OtherCon _ <- idUnfolding id - -- , take 4 (occNameString (nameOccName name)) == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + , let str = occNameString (nameOccName name) + , take 4 str == "wild" || take 2 str == "ds" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True + , take 4 str == "wild" || take 2 str == "ds" = {-pprTrace "getCallMethod" (ppr id)-} ReturnIt -- seems to come from case, must be (tagged) WHNF already + + + + +{- + , head str /= '$' + -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later + , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ text str $$ ppr (idUnfolding id)) True +-} {- getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust From git at git.haskell.org Sun Jan 28 16:06:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:42 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: barf, don't just belch (bd2a1dd) Message-ID: <20180128160642.E2E493A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/bd2a1dd1abad6a5e5bb06cba402f05f93faf24d0/ghc >--------------------------------------------------------------- commit bd2a1dd1abad6a5e5bb06cba402f05f93faf24d0 Author: Gabor Greif Date: Thu Jan 11 12:11:52 2018 +0100 WIP: barf, don't just belch >--------------------------------------------------------------- bd2a1dd1abad6a5e5bb06cba402f05f93faf24d0 rts/Apply.cmm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Apply.cmm b/rts/Apply.cmm index dde6f41..7bbf610 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -15,7 +15,7 @@ checkTagged ( P_ obj ) { if (GETTAG(obj)==0) { - ccall debugBelch("NOT TAGGED! "); + ccall barf("NOT TAGGED! ") never returns; } return(); } From git at git.haskell.org Sun Jan 28 16:06:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:48 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: to confirm my suspicion, remove the bangs (a4471ab) Message-ID: <20180128160648.A21263A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/a4471abf0209237e5d99b34575d47c3bccc6b604/ghc >--------------------------------------------------------------- commit a4471abf0209237e5d99b34575d47c3bccc6b604 Author: Gabor Greif Date: Thu Jan 11 23:18:24 2018 +0100 WIP: to confirm my suspicion, remove the bangs I'll back this out later >--------------------------------------------------------------- a4471abf0209237e5d99b34575d47c3bccc6b604 compiler/basicTypes/Name.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 637fc69..75f835b 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -108,9 +108,9 @@ import Data.Data -- that thing originated. data Name = Name { n_sort :: NameSort, -- What sort of name it is - n_occ :: !OccName, -- Its occurrence name + n_occ :: OccName, -- Its occurrence name n_uniq :: {-# UNPACK #-} !Unique, - n_loc :: !SrcSpan -- Definition site + n_loc :: SrcSpan -- Definition site } -- NOTE: we make the n_loc field strict to eliminate some potential From git at git.haskell.org Sun Jan 28 16:06:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:45 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: add taggedness assert when optimizing (cd13133) Message-ID: <20180128160645.D30743A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/cd13133b0a9e440123c5216021e0b1b5a33cab5f/ghc >--------------------------------------------------------------- commit cd13133b0a9e440123c5216021e0b1b5a33cab5f Author: Gabor Greif Date: Thu Jan 11 07:27:14 2018 +0100 WIP: add taggedness assert when optimizing >--------------------------------------------------------------- cd13133b0a9e440123c5216021e0b1b5a33cab5f compiler/codeGen/StgCmmClosure.hs | 23 ++--------------------- compiler/codeGen/StgCmmExpr.hs | 8 +++++++- 2 files changed, 9 insertions(+), 22 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1b4e0be..24f21f0 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -638,31 +638,12 @@ getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | isEvaldUnfolding (idUnfolding id) - -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - -- , (\case OtherCon _ -> False; _ -> True) $ idUnfolding id , OtherCon _ <- idUnfolding id , let str = occNameString (nameOccName name) - , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True - -- , take 4 str == "wild" || (take 2 str == "ds" && str /= "ds1" && str /= "ds2") - -- , take 4 str == "wild" || (str == "ds" || str == "ds1" || str == "ds2" || str == "ds3") -- CRASH - -- , take 4 str == "wild" || (str == "ds2" || str == "ds3") -- CRASH - -- , take 4 str == "wild" || (str == "ds3") -- CRASH: FastString + -- , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True , take 4 str == "wild" || (str == "ds2") - = pprTrace "####getCallMethod" (ppr id) ReturnIt' True -- seems to come from case, must be (tagged) WHNF already + = pprTrace "####getCallMethod" (ppr id) ReturnIt' (str == "ds2") -- seems to come from case, must be (tagged) WHNF already - - - -{- - , head str /= '$' - -- , ('w':'i':'l':'d':_) <- occNameString (nameOccName name) -- FIXME: remove later - , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ text str $$ ppr (idUnfolding id)) True --} -{- -getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info - | occNameString (nameOccName name) == "wild" -- TODO: make this robust - = ReturnIt -- seems to come from case, must be (tagged) WHNF already --} getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) EnterIt -- Not a function diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 32b9ccf..2a63f96 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -746,8 +746,14 @@ cgIdApp fun_id args = do ReturnIt' True -- TODO: add assertion -> ASSERT( null args ) ASSERT( not (isVoidTy (idType fun_id)) ) - do emitRtsCall rtsUnitId + do lgood <- newBlockId + lcall <- newBlockId + emit $ mkCbranch (cmmIsTagged dflags fun) + lgood lcall Nothing + emitLabel lcall + emitRtsCall rtsUnitId (fsLit "checkTagged") [(fun, AddrHint)] False + emitLabel lgood emitReturn [fun] EnterIt -> ASSERT( null args ) -- Discarding arguments From git at git.haskell.org Sun Jan 28 16:06:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:54 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: focus on SDC for now (8a555d0) Message-ID: <20180128160654.88C293A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/8a555d0d1de2fb27d4dbd290cbba1c9ef70d9db5/ghc >--------------------------------------------------------------- commit 8a555d0d1de2fb27d4dbd290cbba1c9ef70d9db5 Author: Gabor Greif Date: Mon Jan 15 18:12:12 2018 +0100 WIP: focus on SDC for now >--------------------------------------------------------------- 8a555d0d1de2fb27d4dbd290cbba1c9ef70d9db5 compiler/codeGen/StgCmmCon.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index bc3d69c..6415370 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -32,6 +32,8 @@ import StgCmmProf ( curCCS ) import TyCon -- NOT NEEDED import Type (isAlgType) +import Name (getName, nameOccName) +import OccName (occNameString) import CmmExpr import CLabel import MkGraph @@ -246,7 +248,8 @@ buildDynCon' dflags _ binder actually_bound ccs con args ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info use_cc blame_cc args_w_offsets - ; when (isDataTyCon $ dataConTyCon con) + ; let conname = occNameString $ nameOccName $ getName $ con -- occNameFS $ getOccName $ getName $ con + ; when (conname == "SDC" && (isDataTyCon $ dataConTyCon con)) $ mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) ; return (mkRhsInit dflags reg lf_info hp_plus_n) } where From git at git.haskell.org Sun Jan 28 16:06:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:51 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: require tagged only when algebraic (485082c) Message-ID: <20180128160651.8337A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/485082cd256e6124d1fb269992ae674bf54a6142/ghc >--------------------------------------------------------------- commit 485082cd256e6124d1fb269992ae674bf54a6142 Author: Gabor Greif Date: Sat Jan 13 14:10:24 2018 +0100 WIP: require tagged only when algebraic >--------------------------------------------------------------- 485082cd256e6124d1fb269992ae674bf54a6142 compiler/codeGen/StgCmmCon.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index d9832c7..fe85f05 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -30,6 +30,7 @@ import StgCmmUtils import StgCmmClosure import StgCmmProf ( curCCS ) +import TyCon import CmmExpr import CLabel import MkGraph @@ -244,7 +245,8 @@ buildDynCon' dflags _ binder actually_bound ccs con args ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info use_cc blame_cc args_w_offsets - ; mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) + ; when (isDataTyCon $ dataConTyCon con) + $ mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) ; return (mkRhsInit dflags reg lf_info hp_plus_n) } where use_cc -- cost-centre to stick in the object From git at git.haskell.org Sun Jan 28 16:06:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:06:57 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: checkpoint (edf094d) Message-ID: <20180128160657.746343A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/edf094d641821adb56c0bcd27b7d91d2a21bfced/ghc >--------------------------------------------------------------- commit edf094d641821adb56c0bcd27b7d91d2a21bfced Author: Gabor Greif Date: Mon Jan 15 07:55:52 2018 +0100 WIP: checkpoint >--------------------------------------------------------------- edf094d641821adb56c0bcd27b7d91d2a21bfced compiler/codeGen/StgCmmCon.hs | 5 +++-- compiler/utils/Outputable.hs | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index a00081c..bc3d69c 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -258,8 +258,9 @@ buildDynCon' dflags _ binder actually_bound ccs con args checkTagOnPtr base (((NonVoid (StgVarArg var)),offset), bang) | isBanged bang - , isAlgType (let ty = idType var in pprTrace "checkTagOnPtrTy" (ppr ty) ty) - = do lgood <- newBlockId + , let ty = idType var + , isAlgType ty + = do lgood <- pprTrace "checkTagOnPtr#Ty" (ppr ty) newBlockId lcall <- newBlockId let p = CmmLoad (cmmOffsetB dflags base offset) (bWord dflags) emit $ mkCbranch (cmmIsTagged dflags p) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index fd0de1e..793b8fb 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -321,7 +321,7 @@ code (either C or assembly), or generating interface files. newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc } data SDocContext = SDC - { sdocStyle :: PprStyle + { sdocStyle :: !PprStyle , sdocLastColour :: !Col.PprColour -- ^ The most recently used colour. This allows nesting colours. , sdocDynFlags :: !DynFlags From git at git.haskell.org Sun Jan 28 16:07:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:07:06 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: be less chatty (c3dd9a1) Message-ID: <20180128160706.2F6673A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/c3dd9a15b60db136a50e40466e304ccf396cbb55/ghc >--------------------------------------------------------------- commit c3dd9a15b60db136a50e40466e304ccf396cbb55 Author: Gabor Greif Date: Wed Jan 17 13:50:59 2018 +0100 WIP: be less chatty >--------------------------------------------------------------- c3dd9a15b60db136a50e40466e304ccf396cbb55 compiler/codeGen/StgCmmClosure.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index d5caff8..0eeb1db 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -641,8 +641,9 @@ getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info , OtherCon _ <- idUnfolding id , let str = occNameString (nameOccName name) -- , take 4 str == "wild" || pprTrace "getCallMethod#####" (ppr id $$ ppr (idUnfolding id)) True - , take 4 str == "wild" || (str == "ds2") - = pprTrace "####getCallMethod" (ppr id) ReturnIt' (str == "ds2") -- seems to come from case, must be (tagged) WHNF already + , let interesting = str == "ds2" + , take 4 str == "wild" || interesting + = (if interesting then pprTrace "####getCallMethod" (ppr id) else GhcPrelude.id) ReturnIt' (str == "ds2") -- seems to come from case, must be (tagged) WHNF already getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) From git at git.haskell.org Sun Jan 28 16:07:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:07:03 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: actuall look at the type of the constr field (1a0fc52) Message-ID: <20180128160703.4DB223A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/1a0fc52ac39c677a34ae6c2f34aecdf0ab784d39/ghc >--------------------------------------------------------------- commit 1a0fc52ac39c677a34ae6c2f34aecdf0ab784d39 Author: Gabor Greif Date: Sat Jan 13 23:47:37 2018 +0100 WIP: actuall look at the type of the constr field >--------------------------------------------------------------- 1a0fc52ac39c677a34ae6c2f34aecdf0ab784d39 compiler/codeGen/StgCmmCon.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index fe85f05..a00081c 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -30,7 +30,8 @@ import StgCmmUtils import StgCmmClosure import StgCmmProf ( curCCS ) -import TyCon +import TyCon -- NOT NEEDED +import Type (isAlgType) import CmmExpr import CLabel import MkGraph @@ -255,13 +256,15 @@ buildDynCon' dflags _ binder actually_bound ccs con args blame_cc = use_cc -- cost-centre on which to blame the alloc (same) - checkTagOnPtr base ((_,offset), bang) | isBanged bang = do - lgood <- newBlockId + checkTagOnPtr base (((NonVoid (StgVarArg var)),offset), bang) + | isBanged bang + , isAlgType (let ty = idType var in pprTrace "checkTagOnPtrTy" (ppr ty) ty) + = do lgood <- newBlockId lcall <- newBlockId let p = CmmLoad (cmmOffsetB dflags base offset) (bWord dflags) emit $ mkCbranch (cmmIsTagged dflags p) lgood lcall Nothing - emitLabel lcall + pprTrace "checkTagOnPtr" (ppr con $$ ppr (dataConRepType con)) emitLabel lcall emitRtsCall rtsUnitId (fsLit "checkTagged") [(p, AddrHint)] False emitLabel lgood From git at git.haskell.org Sun Jan 28 16:07:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:07:09 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: makefile foolings (99c525b) Message-ID: <20180128160709.070133A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/99c525ba8945b2b21c4b004816f450b66f6ae84f/ghc >--------------------------------------------------------------- commit 99c525ba8945b2b21c4b004816f450b66f6ae84f Author: Gabor Greif Date: Wed Jan 17 14:45:15 2018 +0100 WIP: makefile foolings >--------------------------------------------------------------- 99c525ba8945b2b21c4b004816f450b66f6ae84f testsuite/tests/codeGen/should_compile/Makefile | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile index eaad461..50d3f0e 100644 --- a/testsuite/tests/codeGen/should_compile/Makefile +++ b/testsuite/tests/codeGen/should_compile/Makefile @@ -6,14 +6,19 @@ T2578: '$(TEST_HC)' $(TEST_HC_OPTS) --make T2578 -fforce-recomp -v0 T14626: + echo == PREP == '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-uniques T14626.hs | grep case + echo == /PREP == + echo echo == CMM == - # we don't want to see re-tagging, like: R1 = R1 & (-8); + # we don't want to see re-tagging, like: R1 = R1 & (-8); - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm -dsuppress-uniques -fforce-recomp T14626.hs | grep 'R1 = R1 & (-[48])' echo == /CMM == + printf "hey\nkdfsf\nzzz\nzzz\nzzz\nusduzsd\n" | sed -e '/kdf/,/uzs/!d' + - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm -dsuppress-uniques -fforce-recomp T13861a.hs # | sed -e '/T14626.consonant_entry/, debug: - # Without optimisations, we should get annotations for basically + # Without optimisations, we should get annotations for basically # all expressions in the example program. echo == Dbg == '$(TEST_HC)' $(TEST_HC_OPTS) debug -fforce-recomp -g -ddump-cmm-verbose \ From git at git.haskell.org Sun Jan 28 16:07:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:07:00 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: implement the runtime assert (e4a92dd) Message-ID: <20180128160700.41E763A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/e4a92dd57e99910f0c2a4a6d886d53ba3b0cace2/ghc >--------------------------------------------------------------- commit e4a92dd57e99910f0c2a4a6d886d53ba3b0cace2 Author: Gabor Greif Date: Sat Jan 13 05:29:24 2018 +0100 WIP: implement the runtime assert >--------------------------------------------------------------- e4a92dd57e99910f0c2a4a6d886d53ba3b0cace2 compiler/codeGen/StgCmmCon.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index a38f7bc..d9832c7 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -33,6 +33,7 @@ import StgCmmProf ( curCCS ) import CmmExpr import CLabel import MkGraph +import BlockId import SMRep import CostCentre import Module @@ -243,6 +244,7 @@ buildDynCon' dflags _ binder actually_bound ccs con args ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info use_cc blame_cc args_w_offsets + ; mapM_ (checkTagOnPtr hp_plus_n) (take ptr_wds $ zip args_w_offsets $ dataConImplBangs con) ; return (mkRhsInit dflags reg lf_info hp_plus_n) } where use_cc -- cost-centre to stick in the object @@ -251,6 +253,18 @@ buildDynCon' dflags _ binder actually_bound ccs con args blame_cc = use_cc -- cost-centre on which to blame the alloc (same) + checkTagOnPtr base ((_,offset), bang) | isBanged bang = do + lgood <- newBlockId + lcall <- newBlockId + let p = CmmLoad (cmmOffsetB dflags base offset) (bWord dflags) + emit $ mkCbranch (cmmIsTagged dflags p) + lgood lcall Nothing + emitLabel lcall + emitRtsCall rtsUnitId + (fsLit "checkTagged") [(p, AddrHint)] False + emitLabel lgood + checkTagOnPtr _ _ = pure () + --------------------------------------------------------------- -- Binding constructor arguments From git at git.haskell.org Sun Jan 28 16:07:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 16:07:12 +0000 (UTC) Subject: [commit: ghc] wip/T14626's head updated: WIP: makefile foolings (99c525b) Message-ID: <20180128160712.527C73A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14626' now includes: 649e777 Make typeToLHsType produce kind signatures for tycon applications 6c34824 Cache the number of data cons in DataTyCon and SumTyCon 954cbc7 Drop dead Given bindings in setImplicationStatus e2998d7 Stop double-stacktrace in ASSERT failures 86ea3b1 comments only 307d1df Fix deep, dark corner of pattern synonyms c732711 Improve pretty-printing for pattern synonyms 40cbab9 Fix another obscure pattern-synonym crash 303106d Make the Div and Mod type families `infixl 7` a1a689d Improve accuracy of get/setAllocationCounter fb78b0d Export typeNat{Div;Mod;Log}TyCon from TcTypeNats 30b1fe2 Remove a bogus warning 66ff794 Fix join-point decision 1c1e46c preInlineUnconditionally is ok for INLINEABLE 448685c Small local refactoring 1577908 Fix two more bugs in partial signatures dbdf77d Lift constructor tag allocation out of a loop f3f90a0 Fix previous patch 6c3eafb KQueue: Fix write notification requests being ignored... b2f10d8 Fix mistaken merge e20046a Support constructor Haddocks in more places a770226 Fix regression on i386 due to get/setAllocationCounter change d1ac1c3 Rename -frule-check to -drule-check and document 492e604 Kill off irrefutable pattern errors 3d17f1f Tweak link order slightly to prefer user shared libs before system ones. 87917a5 Support LIBRARY_PATH and LD_LIBRARY_PATH in rts 9f7edb9 Fix hashbang of gen-data-layout 78306b5 CoreLint: typo in a comment 2feed11 Fix hash in haddock of ghc-prim. 41afbb3 Add flag -fno-it f380115 Parenthesize forall-type args in cvtTypeKind 1bf70b2 Remove executable filename check on windows bc383f2 Simplify guard in createSwitchPlan. 8de8930 configure: Various cleanups cf2c029 Fix quadratic behavior of prepareAlts c65104e Typos in comments 6b1ff00 Fix references to cminusminus.org 1e14fd3 Inform hole substitutions of typeclass constraints (fixes #14273). 8bb150d Revert "Fix regression on i386 due to get/setAllocationCounter change" e1d4140 Revert "Improve accuracy of get/setAllocationCounter" 3335811 cmm: Include braces on default branch as required by the parser 2a78cf7 Remove unused extern cost centre collection 575c009 Fix #14681 and #14682 with precision-aimed parentheses 5e8ea6a testsuite: Add test for #14335 f855769 Add new mbmi and mbmi2 compiler flags 765ba65 testsuite: Add testcase for #14670 0074a08 Fix #14692 by correcting an off-by-one error in TcGenDeriv 5edb18a tentative improvement to callstack docs 180ca65 [rts] Adjust whitehole_spin 4a13c5b Implement underscores in numeric literals (NumericUnderscores extension) 8829743 Use IntSet in Dataflow 6c0db98 SysTools: Add detection support for LLD linker 2671ccc Update Cabal submodule 24e56eb Bump transformers submodule to 0.5.5.0 a3cde5f Improve comments about TcLevel invariants 452dee3 Pass -dsuppress-uniques when running T14507 f00ddea Allocate less in plus_mod_dep d36ae5d Comments about CoercionHoles 076bdb3 Remove dead code: mkNthCoRole 2a2e6a8 Comments only 0636689 Fix the lone-variable case in callSiteInline d6e0338 Bump terminfo submodule 40c753f testsuite: Bump haddock.Cabal allocations due to submodule bump 0e022e5 Turn EvTerm (almost) into CoreExpr (#14691) 983e491 testsuite: Add testcase for #12158 66961dc Haddock needs to pass visible modules for instance filtering 302aee5 base: Refactor Show ErrorCall instance into proper ShowS style 52dfb25 Handle the likely:True case in CmmContFlowOpt e7dcc70 Add ability to parse likely flags for ifs in Cmm. 31c260f Add ptr-eq short-cut to `compareByteArrays#` primitive cbdea95 Sort valid substitutions for typed holes by "relevance" cacba07 Linker: ignore empty paths in addEnvPaths bd58e29 Remove Hoopl.Unique 9a57cfe Option for LINE pragmas to get lexed into tokens a55d581 Fix Windows stack allocations. 59fa7b3 Fix #14719 by using the setting the right SrcSpan 7ff6023 cmm: Use two equality checks for two alt switch with default 1cb12ea Bump hadrian submodule 155ba82 WIP: triggering CI for Simon's patch 7d47c16 WIP: exclude casts for now eac9f6c WIP: don't reenter WHNF thing for re-tagging 95212cd WIP: cleanups 9c25791 WIP: ooops c6c3939 WIP: look at evaluated-ness 58afdb0 WIP: silence for benchmarks e300b42 Test the absence of re-tagging 81d8366 WIP: yes, this crashes b1f1c92 WIP: exclude top-level values for now 151a0d7 WIP: "ds" is the suspect 13c3a0a WIP: an attempt to add assert code (failed, for now) cd13133 WIP: add taggedness assert when optimizing bd2a1dd WIP: barf, don't just belch a4471ab WIP: to confirm my suspicion, remove the bangs bdfa919 WIP: some more de-strictifying e4a92dd WIP: implement the runtime assert 485082c WIP: require tagged only when algebraic 1a0fc52 WIP: actuall look at the type of the constr field edf094d WIP: checkpoint 8a555d0 WIP: focus on SDC for now c3dd9a1 WIP: be less chatty 99c525b WIP: makefile foolings From git at git.haskell.org Sun Jan 28 22:32:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 22:32:29 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T2893' created Message-ID: <20180128223229.46BD63A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T2893 Referencing: a2699289a15f18100b0f51b2b84d6089a8d11827 From git at git.haskell.org Sun Jan 28 22:32:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 22:32:32 +0000 (UTC) Subject: [commit: ghc] wip/T2893: Add HasDebugCallStack to nameModule (3311896) Message-ID: <20180128223232.4ED843A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T2893 Link : http://ghc.haskell.org/trac/ghc/changeset/3311896d34943e27fc9ca8251de011f2cea41c9e/ghc >--------------------------------------------------------------- commit 3311896d34943e27fc9ca8251de011f2cea41c9e Author: Simon Peyton Jones Date: Fri Jan 26 09:03:12 2018 +0000 Add HasDebugCallStack to nameModule This function is called in lots of places, so if it every fails it's good to know from where it was called. >--------------------------------------------------------------- 3311896d34943e27fc9ca8251de011f2cea41c9e compiler/basicTypes/Name.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 637fc69..02eb067 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -194,7 +194,7 @@ instance HasOccName Name where nameUnique :: Name -> Unique nameOccName :: Name -> OccName -nameModule :: Name -> Module +nameModule :: HasDebugCallStack => Name -> Module nameSrcLoc :: Name -> SrcLoc nameSrcSpan :: Name -> SrcSpan From git at git.haskell.org Sun Jan 28 22:32:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 22:32:39 +0000 (UTC) Subject: [commit: ghc] wip/T2893: A tiny bit more tc-tracing (a propos Trac #14723 (a269928) Message-ID: <20180128223239.25BBF3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T2893 Link : http://ghc.haskell.org/trac/ghc/changeset/a2699289a15f18100b0f51b2b84d6089a8d11827/ghc >--------------------------------------------------------------- commit a2699289a15f18100b0f51b2b84d6089a8d11827 Author: Simon Peyton Jones Date: Sat Jan 27 16:56:45 2018 +0000 A tiny bit more tc-tracing (a propos Trac #14723 >--------------------------------------------------------------- a2699289a15f18100b0f51b2b84d6089a8d11827 compiler/typecheck/TcInteract.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 968c553..5a5cb7e 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1742,7 +1742,7 @@ emitFunDepDeriveds fd_eqns = do { traceTcS "emitFunDepDeriveds 1" (ppr (ctl_depth loc) $$ ppr eqs) ; mapM_ (unifyDerived loc Nominal) eqs } | otherwise - = do { traceTcS "emitFunDepDeriveds 2" (ppr (ctl_depth loc) $$ ppr eqs) + = do { traceTcS "emitFunDepDeriveds 2" (ppr (ctl_depth loc) $$ ppr tvs $$ ppr eqs) ; subst <- instFlexi tvs -- Takes account of kind substitution ; mapM_ (do_one_eq loc subst) eqs } @@ -2491,7 +2491,7 @@ matchInstEnv dflags short_cut_solver clas tys loc ; traceTcS "matchInstEnv" $ vcat [ text "goal:" <+> ppr clas <+> ppr tys , text "matches:" <+> ppr matches - , text "unify:" <+> ppr unify + , text "unify:" <+> ppr unify ] ; case (matches, unify, safeHaskFail) of -- Nothing matches From git at git.haskell.org Sun Jan 28 22:32:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Jan 2018 22:32:36 +0000 (UTC) Subject: [commit: ghc] wip/T2893: Implement QuantifiedConstraints (dbcf8d0) Message-ID: <20180128223236.2FAD53A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T2893 Link : http://ghc.haskell.org/trac/ghc/changeset/dbcf8d0b9076ae32b9138623eb84f67c18ed3dab/ghc >--------------------------------------------------------------- commit dbcf8d0b9076ae32b9138623eb84f67c18ed3dab Author: Simon Peyton Jones Date: Sat Jan 27 14:32:34 2018 +0000 Implement QuantifiedConstraints We have wanted quantified constraints for ages and, as I hoped, they proved remarkably simple to implement. All the machinery was already in place. The main ticket is Trac #2893, but also relevant are #5927 #8516 #9123 (especially! higher kinded roles) #14070 #14317 The wiki page is https://ghc.haskell.org/trac/ghc/wiki/QuantifiedContexts Here is the relevant Note: Note [Quantified constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The -XQuantifiedConstraints extension allows type-class contexts like this: data Rose f x = Rose x (f (Rose f x)) instance (Eq a, forall b. Eq b => Eq (f b)) => Eq (Rose f a) where (Rose x1 rs1) == (Rose x2 rs2) = x1==x2 && rs1 >= rs2 Note the (forall b. Eq b => Eq (f b)) in the instance contexts. This quantified constraint is needed to solve the [W] (Eq (f (Rose f x))) constraint which arises form the (==) definition. Here are the moving parts * Language extension {-# LANGUAGE QuantifiedConstraints #-} and add it to ghc-boot-th:GHC.LanguageExtensions.Type.Extension * A new form of evidence, EvDFun, that is used to discharge such wanted constraints * checkValidType gets some changes to accept forall-constraints only in the right places. * Type.PredTree gets a new constructor ForAllPred, and and classifyPredType analyses a PredType to decompose the new forall-constraints * TcSMonad.InertCans gets an extra field, inert_insts, which holds all the Given forall-constraints. In effect, such Given constraints are like local instance decls. * When trying to solve a class constraint, via TcInteract.matchInstEnv, use the InstEnv from inert_insts so that we include the local Given forall-constraints in the lookup. (See TcSMonad.getInstEnvs.) * TcCanonical.canForAll deals with solving a forall-constraint. See Note [Solving a Wanted forall-constraint] Note [Solving a Wanted forall-constraint] * We augment the kick-out code to kick out an inert forall constraint if it can be rewritten by a new type equality; see TcSMonad.kick_out_rewritable Still to come - User manual documentation - A GHC Proposal >--------------------------------------------------------------- dbcf8d0b9076ae32b9138623eb84f67c18ed3dab compiler/deSugar/DsBinds.hs | 7 + compiler/main/DynFlags.hs | 2 + compiler/typecheck/TcCanonical.hs | 166 ++++++++++++++++++--- compiler/typecheck/TcEvidence.hs | 27 +++- compiler/typecheck/TcHsSyn.hs | 16 +- compiler/typecheck/TcInteract.hs | 4 + compiler/typecheck/TcMType.hs | 5 +- compiler/typecheck/TcRnTypes.hs | 5 + compiler/typecheck/TcSMonad.hs | 162 ++++++++++++++++---- compiler/typecheck/TcValidity.hs | 23 ++- compiler/types/InstEnv.hs | 75 +++++++--- compiler/types/Type.hs | 27 +++- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + testsuite/tests/typecheck/should_compile/T2893.hs | 18 +++ testsuite/tests/typecheck/should_compile/T2893a.hs | 27 ++++ testsuite/tests/typecheck/should_compile/all.T | 2 + 16 files changed, 470 insertions(+), 97 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dbcf8d0b9076ae32b9138623eb84f67c18ed3dab From git at git.haskell.org Mon Jan 29 13:34:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 13:34:41 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: asm-emit-time IND_STATIC elimination (4a4dc80) Message-ID: <20180129133441.7974E3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/4a4dc80bab9a8a9096b544011d24f3b380eb30e3/ghc >--------------------------------------------------------------- commit 4a4dc80bab9a8a9096b544011d24f3b380eb30e3 Author: Gabor Greif Date: Mon Jan 29 14:34:25 2018 +0100 WIP: asm-emit-time IND_STATIC elimination >--------------------------------------------------------------- 4a4dc80bab9a8a9096b544011d24f3b380eb30e3 compiler/nativeGen/X86/Ppr.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index f5011b2..95c4728 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -144,6 +144,16 @@ pprBasicBlock info_env (BasicBlock blockid instrs) _other -> empty pprDatas :: (Alignment, CmmStatics) -> SDoc + +pprDatas (_, Statics alias [CmmStaticLit lit@(CmmLabel lbl), CmmStaticLit ind, _, _]) + | lbl == mkIndStaticInfoLabel + , let labelInd (CmmLabelOff l _) = Just l + labelInd (CmmLabel l) = Just l + labelInd _ = Nothing + , Just ind' <- labelInd ind + , let equate = pprGloblDecl alias $$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind') + = pprTrace "IndStaticInfo: pprDatas" (ppr alias <+> ppr lit <+> ppr ind') equate + pprDatas (align, (Statics lbl dats)) = vcat (pprAlign align : pprLabel lbl : map pprData dats) From git at git.haskell.org Mon Jan 29 22:33:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:33:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Bump terminfo submodule (906983c) Message-ID: <20180129223350.D7D813A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/906983caebdc83ed1211231cf6035a2bba15e5e9/ghc >--------------------------------------------------------------- commit 906983caebdc83ed1211231cf6035a2bba15e5e9 Author: Ben Gamari Date: Sun Jan 21 22:18:24 2018 -0500 Bump terminfo submodule >--------------------------------------------------------------- 906983caebdc83ed1211231cf6035a2bba15e5e9 libraries/terminfo | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/terminfo b/libraries/terminfo index 17a0852..1e9460c 160000 --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 17a0852ba15b32f5fa9c56daefc075b6826edc7b +Subproject commit 1e9460ca4f651099c6a0ad26eb1197297d5e8089 From git at git.haskell.org Mon Jan 29 22:33:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:33:58 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Add new mbmi and mbmi2 compiler flags (b75f8d2) Message-ID: <20180129223358.5F12F3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/b75f8d2628a6db74254b34b2c9ca7aa22138e715/ghc >--------------------------------------------------------------- commit b75f8d2628a6db74254b34b2c9ca7aa22138e715 Author: John Ky Date: Sun Jan 21 11:55:45 2018 -0500 Add new mbmi and mbmi2 compiler flags This adds support for the bit deposit and extraction operations provided by the BMI and BMI2 instruction set extensions on modern amd64 machines. Implement x86 code generator for pdep and pext. Properly initialise bmiVersion field. pdep and pext test cases Fix pattern match for pdep and pext instructions Fix build of pdep and pext code for 32-bit architectures Test Plan: Validate Reviewers: austin, simonmar, bgamari, angerman Reviewed By: bgamari Subscribers: trommler, carter, angerman, thomie, rwbarton, newhoggy GHC Trac Issues: #14206 Differential Revision: https://phabricator.haskell.org/D4236 (cherry picked from commit f855769690eb998ea25818ee794714957852af48) >--------------------------------------------------------------- b75f8d2628a6db74254b34b2c9ca7aa22138e715 compiler/cmm/CmmMachOp.hs | 2 + compiler/cmm/CmmParse.y | 10 ++ compiler/cmm/PprC.hs | 2 + compiler/codeGen/StgCmmPrim.hs | 28 +++++ compiler/coreSyn/MkCore.hs | 1 - compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 97 +++++++++++++---- compiler/main/DriverPipeline.hs | 2 + compiler/main/DynFlags.hs | 27 +++++ compiler/nativeGen/CPrim.hs | 20 ++++ compiler/nativeGen/PPC/CodeGen.hs | 2 + compiler/nativeGen/SPARC/CodeGen.hs | 2 + compiler/nativeGen/X86/CodeGen.hs | 69 +++++++++++++ compiler/nativeGen/X86/Instr.hs | 9 ++ compiler/nativeGen/X86/Ppr.hs | 13 +++ compiler/prelude/primops.txt.pp | 22 ++++ libraries/ghc-prim/cbits/pdep.c | 48 +++++++++ libraries/ghc-prim/cbits/pext.c | 44 ++++++++ libraries/ghc-prim/ghc-prim.cabal | 2 + testsuite/tests/codeGen/should_run/all.T | 2 + testsuite/tests/codeGen/should_run/cgrun075.hs | 115 +++++++++++++++++++++ .../{cgrun071.stdout => cgrun075.stdout} | 0 testsuite/tests/codeGen/should_run/cgrun076.hs | 115 +++++++++++++++++++++ .../{cgrun071.stdout => cgrun076.stdout} | 0 23 files changed, 611 insertions(+), 21 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b75f8d2628a6db74254b34b2c9ca7aa22138e715 From git at git.haskell.org Mon Jan 29 22:33:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:33:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: tentative improvement to callstack docs (c105095) Message-ID: <20180129223354.243203A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/c1050953b28b0e6ff6a749cea6935cc153b62960/ghc >--------------------------------------------------------------- commit c1050953b28b0e6ff6a749cea6935cc153b62960 Author: Alp Mestanogullari Date: Sun Jan 21 12:07:58 2018 -0500 tentative improvement to callstack docs This is an attempt at clarifying the docs for HasCallStack in both the user guide and libraries/base/GHC/Stack/Types.hs. The example used right now is built around an hypothetical 'error' function that doesn't itself print call stacks, and the fact that this doesn't hold makes it all confusing, see #14635. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14635 Differential Revision: https://phabricator.haskell.org/D4317 >--------------------------------------------------------------- c1050953b28b0e6ff6a749cea6935cc153b62960 docs/users_guide/glasgow_exts.rst | 67 +++++++++++++++++++++++++++++++-------- libraries/base/GHC/Stack/Types.hs | 23 ++++++++------ 2 files changed, 66 insertions(+), 24 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 3edb8d6..6bca784 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -14895,28 +14895,67 @@ HasCallStack ``GHC.Stack.HasCallStack`` is a lightweight method of obtaining a partial call-stack at any point in the program. -A function can request its call-site with the ``HasCallStack`` constraint. -For example, we can define :: +A function can request its call-site with the ``HasCallStack`` constraint +and access it as a Haskell value by using ``callStack``. - errorWithCallStack :: HasCallStack => String -> a +One can then use functions from ``GHC.Stack`` to inspect or pretty +print (as is done in ``f`` below) the call stack. -as a variant of ``error`` that will get its call-site (as of GHC 8.0, -``error`` already gets its call-site, but let's assume for the sake of -demonstration that it does not). We can access the call-stack inside -``errorWithCallStack`` with ``GHC.Stack.callStack``. :: + f :: HasCallStack => IO () + f = putStrLn (prettyCallStack callStack) - errorWithCallStack :: HasCallStack => String -> a - errorWithCallStack msg = error (msg ++ "\n" ++ prettyCallStack callStack) + g :: HasCallStack => IO () + g = f -Thus, if we call ``errorWithCallStack`` we will get a formatted call-stack -alongside our error message. +Evaluating ``f`` directly shows a call stack with a single entry, +while evaluating ``g``, which also requests its call-site, shows +two entries, one for each computation "annotated" with +``HasCallStack``. .. code-block:: none - ghci> errorWithCallStack "die" - *** Exception: die + ghci> f CallStack (from HasCallStack): - errorWithCallStack, called at :2:1 in interactive:Ghci1 + f, called at :19:1 in interactive:Ghci1 + ghci> g + CallStack (from HasCallStack): + f, called at :17:5 in main:Main + g, called at :20:1 in interactive:Ghci2 + +The ``error`` function from the Prelude supports printing the call stack that +led to the error in addition to the usual error message: + +.. code-block:: none + + ghci> error "bad" + *** Exception: bad + CallStack (from HasCallStack): + error, called at :25:1 in interactive:Ghci5 + +The call stack here consists of a single entry, pinpointing the source +of the call to ``error``. However, by annotating several computations +with ``HasCallStack``, figuring out the exact circumstances and sequences +of calls that lead to a call to ``error`` becomes a lot easier, as demonstrated +with the simple example below. :: + + f :: HasCallStack => IO () + f = error "bad bad bad" + + g :: HasCallStack => IO () + g = f + + h :: HasCallStack => IO () + h = g + +.. code-block:: none + + ghci> h + *** Exception: bad bad bad + CallStack (from HasCallStack): + error, called at call-stack.hs:4:5 in main:Main + f, called at call-stack.hs:7:5 in main:Main + g, called at call-stack.hs:10:5 in main:Main + h, called at :28:1 in interactive:Ghci1 The ``CallStack`` will only extend as far as the types allow it, for example :: diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index d9e7552..b5858f2 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -75,25 +75,28 @@ type HasCallStack = (?callStack :: CallStack) -- For example, we can define -- -- @ --- errorWithCallStack :: HasCallStack => String -> a +-- putStrLnWithCallStack :: HasCallStack => String -> IO () -- @ -- --- as a variant of @error@ that will get its call-site. We can access the --- call-stack inside @errorWithCallStack@ with 'GHC.Stack.callStack'. +-- as a variant of @putStrLn@ that will get its call-site and print it, +-- along with the string given as argument. We can access the +-- call-stack inside @putStrLnWithCallStack@ with 'GHC.Stack.callStack'. -- -- @ --- errorWithCallStack :: HasCallStack => String -> a --- errorWithCallStack msg = error (msg ++ "\\n" ++ prettyCallStack callStack) +-- putStrLnWithCallStack :: HasCallStack => String -> IO () +-- putStrLnWithCallStack msg = do +-- putStrLn msg +-- putStrLn (prettyCallStack callStack) -- @ -- --- Thus, if we call @errorWithCallStack@ we will get a formatted call-stack --- alongside our error message. +-- Thus, if we call @putStrLnWithCallStack@ we will get a formatted call-stack +-- alongside our string. -- -- --- >>> errorWithCallStack "die" --- *** Exception: die +-- >>> putStrLnWithCallStack "hello" +-- hello -- CallStack (from HasCallStack): --- errorWithCallStack, called at :2:1 in interactive:Ghci1 +-- putStrLnWithCallStack, called at :2:1 in interactive:Ghci1 -- -- -- GHC solves 'HasCallStack' constraints in three steps: From git at git.haskell.org Mon Jan 29 22:34:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:34:01 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14692 by correcting an off-by-one error in TcGenDeriv (1d05e0c) Message-ID: <20180129223401.7EF513A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/1d05e0c74ad861946e4deb4f27a77b181cab3089/ghc >--------------------------------------------------------------- commit 1d05e0c74ad861946e4deb4f27a77b181cab3089 Author: Ryan Scott Date: Sun Jan 21 12:06:06 2018 -0500 Fix #14692 by correcting an off-by-one error in TcGenDeriv A silly mistake in `gen_Show_binds` was causing derived `Show` instances for empty data types to case on the precedence argument instead of the actual value being showed. Test Plan: make test TEST=drv-empty-data Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14692 Differential Revision: https://phabricator.haskell.org/D4328 (cherry picked from commit 0074a08ea9dfd1416aa57a9504be73dcdf7a1e2b) >--------------------------------------------------------------- 1d05e0c74ad861946e4deb4f27a77b181cab3089 compiler/typecheck/TcGenDeriv.hs | 2 +- testsuite/tests/deriving/should_compile/drv-empty-data.stderr | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index b2d45fd..1ac3505 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1132,7 +1132,7 @@ gen_Show_binds get_fixity loc tycon = (unitBag shows_prec, emptyBag) where data_cons = tyConDataCons tycon - shows_prec = mkFunBindEC 1 loc showsPrec_RDR id (map pats_etc data_cons) + shows_prec = mkFunBindEC 2 loc showsPrec_RDR id (map pats_etc data_cons) comma_space = nlHsVar showCommaSpace_RDR pats_etc data_con diff --git a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr index e131c1c..5baf6a6 100644 --- a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr +++ b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr @@ -7,7 +7,7 @@ Derived class instances: GHC.Read.readListPrec = GHC.Read.readListPrecDefault instance GHC.Show.Show (DrvEmptyData.Void a) where - GHC.Show.showsPrec z = case z of + GHC.Show.showsPrec _ z = case z of instance GHC.Classes.Ord (DrvEmptyData.Void a) where GHC.Classes.compare _ z = GHC.Types.EQ From git at git.haskell.org Mon Jan 29 22:34:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:34:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Bump process submodule (b779e1a) Message-ID: <20180129223404.BB3E13A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/b779e1add60b31dee84daae65a48fc2ad81ea30a/ghc >--------------------------------------------------------------- commit b779e1add60b31dee84daae65a48fc2ad81ea30a Author: Ben Gamari Date: Tue Jan 23 01:09:34 2018 -0500 Bump process submodule >--------------------------------------------------------------- b779e1add60b31dee84daae65a48fc2ad81ea30a libraries/process | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/process b/libraries/process index 2fb7e73..7c0b581 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 2fb7e739771f4a899a12b45f8b392e4874616b89 +Subproject commit 7c0b58141290b50a338bf391adc0a8c43513165b From git at git.haskell.org Mon Jan 29 22:34:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:34:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Bump filepath submodule (f60ae5a) Message-ID: <20180129223407.EFE3C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/f60ae5acf908cd1da73ec3b505377ba6801bf6ec/ghc >--------------------------------------------------------------- commit f60ae5acf908cd1da73ec3b505377ba6801bf6ec Author: Ben Gamari Date: Tue Jan 23 01:09:52 2018 -0500 Bump filepath submodule >--------------------------------------------------------------- f60ae5acf908cd1da73ec3b505377ba6801bf6ec libraries/filepath | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/filepath b/libraries/filepath index 9c64a63..0991bf3 160000 --- a/libraries/filepath +++ b/libraries/filepath @@ -1 +1 @@ -Subproject commit 9c64a634c144392f36cdad5c8c067824093a64d6 +Subproject commit 0991bf392dbd56b5db9f155ee64fb122ca55017c From git at git.haskell.org Mon Jan 29 22:34:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:34:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix Windows stack allocations. (d4d6e44) Message-ID: <20180129223411.195033A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/d4d6e448d1700dbc074058540724fab54e5f0f33/ghc >--------------------------------------------------------------- commit d4d6e448d1700dbc074058540724fab54e5f0f33 Author: Tamar Christina Date: Fri Jan 26 13:10:10 2018 -0500 Fix Windows stack allocations. On Windows we use the function `win32AllocStack` to do stack allocations in 4k blocks and insert a stack check afterwards to ensure the allocation returned a valid block. The problem is this function does something that by C semantics is pointless. The stack allocated value can never escape the function, and the stack isn't used so the compiler just optimizes away the entire function body. After considering a bunch of other possibilities I think the simplest fix is to just disable optimizations for the function. Alternatively inline assembly is an option but the stack check function doesn't have a very portable name as it relies on e.g. `libgcc`. Thanks to Sergey Vinokurov for helping diagnose and test. Test Plan: ./validate Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14669 Differential Revision: https://phabricator.haskell.org/D4343 (cherry picked from commit a55d581f8f2923560c3444253050b13fdf2dec10) >--------------------------------------------------------------- d4d6e448d1700dbc074058540724fab54e5f0f33 includes/Stg.h | 10 ++++++++++ rts/StgCRun.c | 16 +++++++++++----- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/includes/Stg.h b/includes/Stg.h index f377e50..2e02347 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -204,6 +204,16 @@ #define STG_UNUSED GNUC3_ATTRIBUTE(__unused__) +/* Prevent functions from being optimized. + See Note [Windows Stack allocations] */ +#if defined(__clang__) +#define STG_NO_OPTIMIZE __attribute__((optnone)) +#elif defined(__GNUC__) || defined(__GNUG__) +#define STG_NO_OPTIMIZE __attribute__((optimize("O0"))) +#else +#define STG_NO_OPTIMIZE /* nothing */ +#endif + /* ----------------------------------------------------------------------------- Global type definitions -------------------------------------------------------------------------- */ diff --git a/rts/StgCRun.c b/rts/StgCRun.c index 2166249..4ce0c44 100644 --- a/rts/StgCRun.c +++ b/rts/StgCRun.c @@ -99,11 +99,17 @@ StgFunPtr StgReturn(void) #endif #if defined(mingw32_HOST_OS) -// On windows the stack has to be allocated 4k at a time, otherwise -// we get a segfault. The C compiler knows how to do this (it calls -// _alloca()), so we make sure that we can allocate as much stack as -// we need: -StgWord8 *win32AllocStack(void) +/* + * Note [Windows Stack allocations] + * + * On windows the stack has to be allocated 4k at a time, otherwise + * we get a segfault. The C compiler knows how to do this (it calls + * _alloca()), so we make sure that we can allocate as much stack as + * we need. However since we are doing a local stack allocation and the value + * isn't valid outside the frame, compilers are free to optimize this allocation + * and the corresponding stack check away. So to prevent that we request that + * this function never be optimized (See #14669). */ +STG_NO_OPTIMIZE StgWord8 *win32AllocStack(void) { StgWord8 stack[RESERVED_C_STACK_BYTES + 16 + 12]; return stack; From git at git.haskell.org Mon Jan 29 22:34:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:34:14 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Bump pretty submodule (0c4d9e9) Message-ID: <20180129223414.2EA483A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/0c4d9e98158d5ec4f9d9af3af02b1e3ba3ce63f1/ghc >--------------------------------------------------------------- commit 0c4d9e98158d5ec4f9d9af3af02b1e3ba3ce63f1 Author: Ben Gamari Date: Mon Jan 29 01:28:13 2018 -0500 Bump pretty submodule >--------------------------------------------------------------- 0c4d9e98158d5ec4f9d9af3af02b1e3ba3ce63f1 libraries/pretty | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/pretty b/libraries/pretty index 445e92d..c3a1469 160000 --- a/libraries/pretty +++ b/libraries/pretty @@ -1 +1 @@ -Subproject commit 445e92dd7508978caba5563c1e79b2758dff4767 +Subproject commit c3a1469306b35fa5d023dc570554f97f1a90435d From git at git.haskell.org Mon Jan 29 22:34:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:34:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14719 by using the setting the right SrcSpan (c60c659) Message-ID: <20180129223418.5E24B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/c60c6590fed1a708619db02e5f572f72a26a65ad/ghc >--------------------------------------------------------------- commit c60c6590fed1a708619db02e5f572f72a26a65ad Author: Ryan Scott Date: Fri Jan 26 13:10:26 2018 -0500 Fix #14719 by using the setting the right SrcSpan Currently, error messages that germane to GADT constructors put the source span at only the first character in the constructor, leading to insufficient caret diagnostics. This can be easily fixed by using a source span that spans the entire constructor, instead of just the first character. Test Plan: make test TEST=T14719 Reviewers: alanz, bgamari, simonpj Reviewed By: alanz, simonpj Subscribers: simonpj, goldfire, rwbarton, thomie, carter GHC Trac Issues: #14719 Differential Revision: https://phabricator.haskell.org/D4344 (cherry picked from commit 59fa7b32b018a91f81773ca676251a0b2761ef56) >--------------------------------------------------------------- c60c6590fed1a708619db02e5f572f72a26a65ad compiler/typecheck/TcTyClsDecls.hs | 4 ++-- testsuite/tests/gadt/T14719.hs | 8 ++++++++ testsuite/tests/gadt/T14719.stderr | 18 ++++++++++++++++++ testsuite/tests/gadt/all.T | 1 + testsuite/tests/polykinds/T9222.stderr | 4 ++-- 5 files changed, 31 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index b3051d5..d9180ad 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2533,8 +2533,8 @@ checkValidTyConTyVars tc ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con - = setSrcSpan (srcLocSpan (getSrcLoc con)) $ - addErrCtxt (dataConCtxt con) $ + = setSrcSpan (getSrcSpan con) $ + addErrCtxt (dataConCtxt con) $ do { -- Check that the return type of the data constructor -- matches the type constructor; eg reject this: -- data T a where { MkT :: Bogus a } diff --git a/testsuite/tests/gadt/T14719.hs b/testsuite/tests/gadt/T14719.hs new file mode 100644 index 0000000..004116d --- /dev/null +++ b/testsuite/tests/gadt/T14719.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} +module T14719 where + +data Foo1 where + MkFoo1 :: Bool + +newtype Foo2 where + MkFoo2 :: Foo2 diff --git a/testsuite/tests/gadt/T14719.stderr b/testsuite/tests/gadt/T14719.stderr new file mode 100644 index 0000000..cfac00c --- /dev/null +++ b/testsuite/tests/gadt/T14719.stderr @@ -0,0 +1,18 @@ + +T14719.hs:5:3: error: + • Data constructor ‘MkFoo1’ returns type ‘Bool’ + instead of an instance of its parent type ‘Foo1’ + • In the definition of data constructor ‘MkFoo1’ + In the data type declaration for ‘Foo1’ + | +5 | MkFoo1 :: Bool + | ^^^^^^^^^^^^^^ + +T14719.hs:8:3: error: + • The constructor of a newtype must have exactly one field + but ‘MkFoo2’ has none + • In the definition of data constructor ‘MkFoo2’ + In the newtype declaration for ‘Foo2’ + | +8 | MkFoo2 :: Foo2 + | ^^^^^^^^^^^^^^ diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index c81ab80..59ec307 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -115,3 +115,4 @@ test('T9380', normal, compile_and_run, ['']) test('T12087', normal, compile_fail, ['']) test('T12468', normal, compile_fail, ['']) test('T14320', normal, compile, ['']) +test('T14719', normal, compile_fail, ['-fdiagnostics-show-caret']) diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr index 6e143e0..604cc1b 100644 --- a/testsuite/tests/polykinds/T9222.stderr +++ b/testsuite/tests/polykinds/T9222.stderr @@ -5,12 +5,12 @@ T9222.hs:13:3: error: inside the constraints: a ~ '(b0, c0) bound by the type of the constructor ‘Want’: (a ~ '(b0, c0)) => Proxy b0 - at T9222.hs:13:3 + at T9222.hs:13:3-43 ‘c’ is a rigid type variable bound by the type of the constructor ‘Want’: forall i1 j1 (a :: (i1, j1)) (b :: i1) (c :: j1). ((a ~ '(b, c)) => Proxy b) -> Want a - at T9222.hs:13:3 + at T9222.hs:13:3-43 • In the ambiguity check for ‘Want’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the definition of data constructor ‘Want’ From git at git.haskell.org Mon Jan 29 22:34:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 22:34:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Add ptr-eq short-cut to `compareByteArrays#` primitive (309d632) Message-ID: <20180129223421.96F253A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/309d632c7147b65b9ae017f08d65295e8b1fdbcb/ghc >--------------------------------------------------------------- commit 309d632c7147b65b9ae017f08d65295e8b1fdbcb Author: Herbert Valerio Riedel Date: Fri Jan 26 13:07:17 2018 -0500 Add ptr-eq short-cut to `compareByteArrays#` primitive This is an obvious optimisation whose overhead is neglectable but which significantly simplifies the common uses of `compareByteArrays#` which would otherwise require to make *careful* use of `reallyUnsafePtrEquality#` or (equally fragile) `byteArrayContents#` which can result in less optimal assembler code being generated. Test Plan: carefully examined generated cmm/asm code; validate via phab Reviewers: alexbiehl, bgamari, simonmar Reviewed By: bgamari, simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4319 (cherry picked from commit 31c260f3967d2c06063c962a98475058daa45c6d) >--------------------------------------------------------------- 309d632c7147b65b9ae017f08d65295e8b1fdbcb compiler/codeGen/StgCmmPrim.hs | 43 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index cd61e36..ff0eebd 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -1746,8 +1746,51 @@ doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n = do dflags <- getDynFlags ba1_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba1 (arrWordsHdrSize dflags)) ba1_off ba2_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba2 (arrWordsHdrSize dflags)) ba2_off + + -- short-cut in case of equal pointers avoiding a costly + -- subroutine call to the memcmp(3) routine; the Cmm logic below + -- results in assembly code being generated for + -- + -- cmpPrefix10 :: ByteArray# -> ByteArray# -> Int# + -- cmpPrefix10 ba1 ba2 = compareByteArrays# ba1 0# ba2 0# 10# + -- + -- that looks like + -- + -- leaq 16(%r14),%rax + -- leaq 16(%rsi),%rbx + -- xorl %ecx,%ecx + -- cmpq %rbx,%rax + -- je l_ptr_eq + -- + -- ; NB: the common case (unequal pointers) falls-through + -- ; the conditional jump, and therefore matches the + -- ; usual static branch prediction convention of modern cpus + -- + -- subq $8,%rsp + -- movq %rbx,%rsi + -- movq %rax,%rdi + -- movl $10,%edx + -- xorl %eax,%eax + -- call memcmp + -- addq $8,%rsp + -- movslq %eax,%rax + -- movq %rax,%rcx + -- l_ptr_eq: + -- movq %rcx,%rbx + -- jmp *(%rbp) + + l_ptr_eq <- newBlockId + l_ptr_ne <- newBlockId + + emit (mkAssign (CmmLocal res) (zeroExpr dflags)) + emit (mkCbranch (cmmEqWord dflags ba1_p ba2_p) + l_ptr_eq l_ptr_ne (Just False)) + + emitLabel l_ptr_ne emitMemcmpCall res ba1_p ba2_p n 1 + emitLabel l_ptr_eq + -- ---------------------------------------------------------------------------- -- Copying byte arrays From git at git.haskell.org Mon Jan 29 23:16:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Jan 2018 23:16:36 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: alias only local symbols for now (f85f3c4) Message-ID: <20180129231636.8CE9B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/f85f3c48b31e055887f3a0f8dfaea91f9dcef3db/ghc >--------------------------------------------------------------- commit f85f3c48b31e055887f3a0f8dfaea91f9dcef3db Author: Gabor Greif Date: Mon Jan 29 23:57:45 2018 +0100 WIP: alias only local symbols for now otherwise it seems to trip up darwin ld62 and gnu linkers >--------------------------------------------------------------- f85f3c48b31e055887f3a0f8dfaea91f9dcef3db compiler/nativeGen/X86/Ppr.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 95c4728..f036e40 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -147,6 +147,7 @@ pprDatas :: (Alignment, CmmStatics) -> SDoc pprDatas (_, Statics alias [CmmStaticLit lit@(CmmLabel lbl), CmmStaticLit ind, _, _]) | lbl == mkIndStaticInfoLabel + , not $ externallyVisibleCLabel lbl -- trips ld64 , let labelInd (CmmLabelOff l _) = Just l labelInd (CmmLabel l) = Just l labelInd _ = Nothing From git at git.haskell.org Tue Jan 30 06:07:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 06:07:50 +0000 (UTC) Subject: [commit: ghc] wip/T14626: WIP: alias only local symbols for now (0e7f9e5) Message-ID: <20180130060750.54DBC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14626 Link : http://ghc.haskell.org/trac/ghc/changeset/0e7f9e574889e4e6e42ed44f629794a3f0c679bf/ghc >--------------------------------------------------------------- commit 0e7f9e574889e4e6e42ed44f629794a3f0c679bf Author: Gabor Greif Date: Mon Jan 29 23:57:45 2018 +0100 WIP: alias only local symbols for now otherwise it seems to trip up darwin ld62 and gnu linkers >--------------------------------------------------------------- 0e7f9e574889e4e6e42ed44f629794a3f0c679bf compiler/nativeGen/X86/Ppr.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 95c4728..02e8773 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -151,6 +151,7 @@ pprDatas (_, Statics alias [CmmStaticLit lit@(CmmLabel lbl), CmmStaticLit ind, _ labelInd (CmmLabel l) = Just l labelInd _ = Nothing , Just ind' <- labelInd ind + , not $ externallyVisibleCLabel ind' -- trips ld64 otherwise , let equate = pprGloblDecl alias $$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind') = pprTrace "IndStaticInfo: pprDatas" (ppr alias <+> ppr lit <+> ppr ind') equate From git at git.haskell.org Tue Jan 30 12:23:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:23:43 +0000 (UTC) Subject: [commit: ghc] branch 'wip/tdammers/T11735-2' created Message-ID: <20180130122343.ABB1C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/tdammers/T11735-2 Referencing: 4e0e4712fc5664c9131c8cdd4cceb54369b3c692 From git at git.haskell.org Tue Jan 30 12:23:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:23:45 +0000 (UTC) Subject: [commit: ghc] branch 'wip/tdammers/T11735-1' created Message-ID: <20180130122345.ABE3E3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/tdammers/T11735-1 Referencing: 03d6371a77bbd51e56fa808b4e681bfc806be8f1 From git at git.haskell.org Tue Jan 30 12:23:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:23:49 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-1: Applying patch suggested in #11735 to improve coercionKind perf (03d6371) Message-ID: <20180130122349.01ED33A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-1 Link : http://ghc.haskell.org/trac/ghc/changeset/03d6371a77bbd51e56fa808b4e681bfc806be8f1/ghc >--------------------------------------------------------------- commit 03d6371a77bbd51e56fa808b4e681bfc806be8f1 Author: Tobias Dammers Date: Wed Jan 24 16:05:55 2018 +0100 Applying patch suggested in #11735 to improve coercionKind perf >--------------------------------------------------------------- 03d6371a77bbd51e56fa808b4e681bfc806be8f1 compiler/types/Coercion.hs | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index cec56b1..d92b362 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1693,22 +1693,18 @@ coercionType co = case coercionKindRole co of -- i.e. the kind of @c@ relates @t1@ and @t2@, then @coercionKind c = Pair t1 t2 at . coercionKind :: Coercion -> Pair Type -coercionKind co = go co +coercionKind co = + {-# SCC "coercionKind" #-} + go co where go (Refl _ ty) = Pair ty ty go (TyConAppCo _ tc cos)= mkTyConApp tc <$> (sequenceA $ map go cos) go (AppCo co1 co2) = mkAppTy <$> go co1 <*> go co2 - go (ForAllCo tv1 k_co co) - = let Pair _ k2 = go k_co - tv2 = setTyVarKind tv1 k2 - Pair ty1 ty2 = go co - subst = zipTvSubst [tv1] [TyVarTy tv2 `mk_cast_ty` mkSymCo k_co] - ty2' = substTyAddInScope subst ty2 in - -- We need free vars of ty2 in scope to satisfy the invariant - -- from Note [The substitution invariant] - -- This is doing repeated substitutions and probably doesn't - -- need to, see #11735 - mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2' + go co@(ForAllCo tv1 k_co co1) + | isReflCo k_co = mkInvForAllTy tv1 <$> go co1 + | otherwise = go_forall empty_subst co + where + empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfCo co) go (FunCo _ co1 co2) = mkFunTy <$> go co1 <*> go co2 go (CoVarCo cv) = coVarTypes cv go (HoleCo h) = coVarTypes (coHoleCoVar h) @@ -1760,10 +1756,16 @@ coercionKind co = go co go_app (InstCo co arg) args = go_app co (arg:args) go_app co args = piResultTys <$> go co <*> (sequenceA $ map go args) - -- The real mkCastTy is too slow, and we can easily have nested ForAllCos. - mk_cast_ty :: Type -> Coercion -> Type - mk_cast_ty ty (Refl {}) = ty - mk_cast_ty ty co = CastTy ty co + go_forall subst (ForAllCo tv1 k_co co) + = mkInvForAllTy <$> Pair tv1 tv2 <*> go_forall subst' co + where + Pair _ k2 = go k_co + tv2 = setTyVarKind tv1 (substTy subst k2) + subst' | isReflCo k_co = extendTCvInScope subst tv1 + | otherwise = extendTvSubst (extendTCvInScope subst tv2) tv1 $ + TyVarTy tv2 `mkCastTy` mkSymCo k_co + go_forall subst other_co + = substTy subst `pLiftSnd` go other_co -- | Apply 'coercionKind' to multiple 'Coercion's coercionKinds :: [Coercion] -> Pair [Type] From git at git.haskell.org Tue Jan 30 12:23:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:23:52 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-2: Added SCCs to hunt down #14683 (b2e35b1) Message-ID: <20180130122352.304093A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-2 Link : http://ghc.haskell.org/trac/ghc/changeset/b2e35b1e3bc3d3861966c10fe387de19c54e54a6/ghc >--------------------------------------------------------------- commit b2e35b1e3bc3d3861966c10fe387de19c54e54a6 Author: Tobias Dammers Date: Wed Jan 24 16:07:00 2018 +0100 Added SCCs to hunt down #14683 >--------------------------------------------------------------- b2e35b1e3bc3d3861966c10fe387de19c54e54a6 compiler/simplCore/Simplify.hs | 79 +++++++++++++++++++++++++----------------- compiler/types/TyCoRep.hs | 9 ++--- 2 files changed, 53 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b2e35b1e3bc3d3861966c10fe387de19c54e54a6 From git at git.haskell.org Tue Jan 30 12:23:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:23:58 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-2: Caching coercion roles in NthCo (#11735) (d70106b) Message-ID: <20180130122358.6EF833A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-2 Link : http://ghc.haskell.org/trac/ghc/changeset/d70106b1f6a45f0c82067feb8fe45fa70857f3ed/ghc >--------------------------------------------------------------- commit d70106b1f6a45f0c82067feb8fe45fa70857f3ed Author: Tobias Dammers Date: Thu Jan 25 20:33:58 2018 +0100 Caching coercion roles in NthCo (#11735) >--------------------------------------------------------------- d70106b1f6a45f0c82067feb8fe45fa70857f3ed compiler/coreSyn/CoreFVs.hs | 2 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/iface/ToIface.hs | 2 +- compiler/typecheck/TcTyDecls.hs | 2 +- compiler/typecheck/TcType.hs | 2 +- compiler/typecheck/TcUnify.hs | 2 +- compiler/typecheck/TcValidity.hs | 2 +- compiler/types/Coercion.hs | 45 ++++++++++++++++++++++------------------ compiler/types/FamInstEnv.hs | 2 +- compiler/types/OptCoercion.hs | 4 ++-- compiler/types/TyCoRep.hs | 32 +++++++++++++++++++++------- compiler/types/Type.hs | 8 +++---- 13 files changed, 64 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d70106b1f6a45f0c82067feb8fe45fa70857f3ed From git at git.haskell.org Tue Jan 30 12:23:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:23:55 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-2: Refactored coercionKindsRole (as per #11735) (5a3eb80) Message-ID: <20180130122355.4246E3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-2 Link : http://ghc.haskell.org/trac/ghc/changeset/5a3eb801599e54bc9e537f3b5318fe1f0365fc6f/ghc >--------------------------------------------------------------- commit 5a3eb801599e54bc9e537f3b5318fe1f0365fc6f Author: Tobias Dammers Date: Wed Jan 24 17:20:20 2018 +0100 Refactored coercionKindsRole (as per #11735) >--------------------------------------------------------------- 5a3eb801599e54bc9e537f3b5318fe1f0365fc6f compiler/types/Coercion.hs | 74 ++++++++++++++++------------------------------ 1 file changed, 25 insertions(+), 49 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index cec56b1..9ccbf50 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1772,77 +1772,53 @@ coercionKinds tys = sequenceA $ map coercionKind tys -- | Get a coercion's kind and role. -- Why both at once? See Note [Computing a coercion kind and role] coercionKindRole :: Coercion -> (Pair Type, Role) -coercionKindRole = go +coercionKindRole co = (coercionKind co, coercionRole co) + +-- | Retrieve the role from a coercion. +coercionRole :: Coercion -> Role +coercionRole = go where - go (Refl r ty) = (Pair ty ty, r) - go (TyConAppCo r tc cos) - = (mkTyConApp tc <$> (sequenceA $ map coercionKind cos), r) - go (AppCo co1 co2) - = let (tys1, r1) = go co1 in - (mkAppTy <$> tys1 <*> coercionKind co2, r1) - go (ForAllCo tv1 k_co co) - = let Pair _ k2 = coercionKind k_co - tv2 = setTyVarKind tv1 k2 - (Pair ty1 ty2, r) = go co - subst = zipTvSubst [tv1] [TyVarTy tv2 `mkCastTy` mkSymCo k_co] - ty2' = substTyAddInScope subst ty2 in - -- We need free vars of ty2 in scope to satisfy the invariant - -- from Note [The substitution invariant] - -- This is doing repeated substitutions and probably doesn't - -- need to, see #11735 - (mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2', r) - go (FunCo r co1 co2) - = (mkFunTy <$> coercionKind co1 <*> coercionKind co2, r) + go (Refl r _) = r + go (TyConAppCo r _ _) = r + go (AppCo co1 _) = go co1 + go (ForAllCo _ _ co) = go co + go (FunCo r _ _) = r go (CoVarCo cv) = go_var cv go (HoleCo h) = go_var (coHoleCoVar h) - go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax) - go (UnivCo _ r ty1 ty2) = (Pair ty1 ty2, r) - go (SymCo co) = first swap $ go co - go (TransCo co1 co2) - = let (tys1, r) = go co1 in - (Pair (pFst tys1) (pSnd $ coercionKind co2), r) + go (AxiomInstCo ax _ _) = coAxiomRole ax + go (UnivCo _ r _ _) = r + go (SymCo co) = go co + go (TransCo co1 co2) = go co1 go (NthCo d co) | Just (tv1, _) <- splitForAllTy_maybe ty1 = ASSERT( d == 0 ) - let (tv2, _) = splitForAllTy ty2 in - (tyVarKind <$> Pair tv1 tv2, Nominal) + Nominal | otherwise = let (tc1, args1) = splitTyConApp ty1 (_tc2, args2) = splitTyConApp ty2 in ASSERT2( tc1 == _tc2, ppr d $$ ppr tc1 $$ ppr _tc2 ) - ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d) + (nthRole r tc1 d) where - (Pair ty1 ty2, r) = go co - go co@(LRCo {}) = (coercionKind co, Nominal) + (Pair ty1 ty2, r) = coercionKindRole co + go (LRCo {}) = Nominal go (InstCo co arg) = go_app co [arg] - go (CoherenceCo co1 co2) - = let (Pair t1 t2, r) = go co1 in - (Pair (t1 `mkCastTy` co2) t2, r) - go co@(KindCo {}) = (coercionKind co, Nominal) - go (SubCo co) = (coercionKind co, Representational) - go co@(AxiomRuleCo ax _) = (coercionKind co, coaxrRole ax) + go (CoherenceCo co1 _) = go co1 + go (KindCo {}) = Nominal + go (SubCo _) = Representational + go (AxiomRuleCo ax _) = coaxrRole ax ------------- - go_var cv = (coVarTypes cv, coVarRole cv) + go_var = coVarRole ------------- - go_app :: Coercion -> [Coercion] -> (Pair Type, Role) + go_app :: Coercion -> [Coercion] -> Role -- Collect up all the arguments and apply all at once -- See Note [Nested InstCos] go_app (InstCo co arg) args = go_app co (arg:args) - go_app co args - = let (pair, r) = go co in - (piResultTys <$> pair <*> (sequenceA $ map coercionKind args), r) - --- | Retrieve the role from a coercion. -coercionRole :: Coercion -> Role -coercionRole = snd . coercionKindRole - -- There's not a better way to do this, because NthCo needs the *kind* - -- and role of its argument. Luckily, laziness should generally avoid - -- the need for computing kinds in other cases. + go_app co args = go co {- Note [Nested InstCos] From git at git.haskell.org Tue Jan 30 12:24:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:24:01 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-2: Simplification as per #11735 (6d1c43c) Message-ID: <20180130122401.A294E3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-2 Link : http://ghc.haskell.org/trac/ghc/changeset/6d1c43c6886cb7d283fa1345b55d6d03ecfa5ef9/ghc >--------------------------------------------------------------- commit 6d1c43c6886cb7d283fa1345b55d6d03ecfa5ef9 Author: Tobias Dammers Date: Thu Jan 25 11:16:30 2018 +0100 Simplification as per #11735 (https://ghc.haskell.org/trac/ghc/ticket/11735#comment:19) >--------------------------------------------------------------- 6d1c43c6886cb7d283fa1345b55d6d03ecfa5ef9 compiler/types/Coercion.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 9ccbf50..770c94f 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1804,7 +1804,7 @@ coercionRole = go where (Pair ty1 ty2, r) = coercionKindRole co go (LRCo {}) = Nominal - go (InstCo co arg) = go_app co [arg] + go (InstCo co arg) = go_app co go (CoherenceCo co1 _) = go co1 go (KindCo {}) = Nominal go (SubCo _) = Representational @@ -1814,11 +1814,9 @@ coercionRole = go go_var = coVarRole ------------- - go_app :: Coercion -> [Coercion] -> Role - -- Collect up all the arguments and apply all at once - -- See Note [Nested InstCos] - go_app (InstCo co arg) args = go_app co (arg:args) - go_app co args = go co + go_app :: Coercion -> Role + go_app (InstCo co arg) = go_app co + go_app co = go co {- Note [Nested InstCos] From git at git.haskell.org Tue Jan 30 12:24:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:24:04 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-2: Make mkNthCo take a Role parameter. (705fe73) Message-ID: <20180130122404.E75DF3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-2 Link : http://ghc.haskell.org/trac/ghc/changeset/705fe73023113cb045c9d4ab725b65c0b52bf7fe/ghc >--------------------------------------------------------------- commit 705fe73023113cb045c9d4ab725b65c0b52bf7fe Author: Richard Eisenberg Date: Fri Jan 26 22:09:33 2018 -0500 Make mkNthCo take a Role parameter. Most callers of mkNthCo know the role of the coercion they are trying to make. So instead of calculating this role, just pass it in. >--------------------------------------------------------------- 705fe73023113cb045c9d4ab725b65c0b52bf7fe compiler/coreSyn/CoreLint.hs | 11 +++- compiler/coreSyn/CoreOpt.hs | 30 ++++----- compiler/coreSyn/CoreUtils.hs | 4 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/TcCanonical.hs | 2 +- compiler/typecheck/TcEvidence.hs | 10 +-- compiler/typecheck/TcUnify.hs | 4 +- compiler/types/Coercion.hs | 135 +++++++++++++++++++++----------------- compiler/types/Coercion.hs-boot | 2 +- compiler/types/OptCoercion.hs | 109 +++++++++++++----------------- compiler/types/TyCoRep.hs | 11 ++-- compiler/types/Type.hs | 6 +- compiler/types/Unify.hs | 4 +- 13 files changed, 164 insertions(+), 166 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 705fe73023113cb045c9d4ab725b65c0b52bf7fe From git at git.haskell.org Tue Jan 30 12:24:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 12:24:08 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-2: Update core-spec with new NthCo (4e0e471) Message-ID: <20180130122408.16DF23A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-2 Link : http://ghc.haskell.org/trac/ghc/changeset/4e0e4712fc5664c9131c8cdd4cceb54369b3c692/ghc >--------------------------------------------------------------- commit 4e0e4712fc5664c9131c8cdd4cceb54369b3c692 Author: Richard Eisenberg Date: Fri Jan 26 22:28:42 2018 -0500 Update core-spec with new NthCo >--------------------------------------------------------------- 4e0e4712fc5664c9131c8cdd4cceb54369b3c692 docs/core-spec/CoreLint.ott | 5 +++-- docs/core-spec/CoreSyn.ott | 6 ++++-- docs/core-spec/core-spec.mng | 2 +- docs/core-spec/core-spec.pdf | Bin 354307 -> 355707 bytes 4 files changed, 8 insertions(+), 5 deletions(-) diff --git a/docs/core-spec/CoreLint.ott b/docs/core-spec/CoreLint.ott index 3a3468d..1fb9e09 100644 --- a/docs/core-spec/CoreLint.ott +++ b/docs/core-spec/CoreLint.ott @@ -299,12 +299,13 @@ G |-ty ti : k2' not (si is_a_coercion) not (ti is_a_coercion) R' = (tyConRolesX R T)[i] +R' <= R0 ---------------------- :: NthCoTyCon -G |-co nth i g : si k2~R' k2' ti +G |-co nth R0 i g : si k2~R0 k2' ti G |-co g : (forall z1_k1.t1) k3~R k4 (forall z2_k2.t2) --------------------------- :: NthCoForAll -G |-co nth 0 g : k1 *~Nom * k2 +G |-co nth R0 0 g : k1 *~R0 * k2 G |-co g : (s1 s2) k~Nom k' (t1 t2) G |-ty s1 : k1 diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott index 78118d5..e12f68b 100644 --- a/docs/core-spec/CoreSyn.ott +++ b/docs/core-spec/CoreSyn.ott @@ -152,8 +152,8 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | g1 ; g2 :: :: TransCo {{ com \ctor{TransCo}: Transitivity }} | mu $ :: :: AxiomRuleCo {{ com \ctor{AxiomRuleCo}: Axiom-rule application (for type-nats) }} - | nth I g :: :: NthCo {{ com \ctor{NthCo}: Projection (0-indexed) }} - {{ tex \textsf{nth}^{[[I]]}\,[[g]] }} + | nth R I g :: :: NthCo {{ com \ctor{NthCo}: Projection (0-indexed) }} + {{ tex \textsf{nth}^{[[I]]}_{[[R]]}\,[[g]] }} | LorR g :: :: LRCo {{ com \ctor{LRCo}: Left/right projection }} | g @ h :: :: InstCo {{ com \ctor{InstCo}: Instantiation }} | g |> h :: :: CoherenceCo {{ com \ctor{CoherenceCo}: Coherence }} @@ -453,6 +453,8 @@ formula :: 'formula_' ::= | role_list1 = role_list2 :: :: eq_role_list | R1 /= R2 :: :: role_neq | R1 = R2 :: :: eq_role + | R1 <= R2 :: :: lte_role + {{ tex [[R1]] \leq [[R2]] }} | = tyConDataCons T :: :: tyConDataCons | O ( n ) = R :: :: role_lookup | R elt role_list :: :: role_elt diff --git a/docs/core-spec/core-spec.mng b/docs/core-spec/core-spec.mng index 5800321..64e90bb 100644 --- a/docs/core-spec/core-spec.mng +++ b/docs/core-spec/core-spec.mng @@ -30,7 +30,7 @@ System FC, as implemented in GHC\footnote{This document was originally prepared by Richard Eisenberg (\texttt{eir at cis.upenn.edu}), but it should be maintained by anyone who edits the functions or data structures mentioned in this file. Please feel free to contact Richard for more information.}\\ -\Large 23 October, 2015 +\Large 26 January, 2018 \end{center} \section{Introduction} diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf index 1e13911..3732818 100644 Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ From git at git.haskell.org Tue Jan 30 15:48:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 15:48:36 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-2: Fixed errors introduced by cherry-picking (f3cc973) Message-ID: <20180130154836.628483A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-2 Link : http://ghc.haskell.org/trac/ghc/changeset/f3cc973d39743c1fb80c726688f83184455d9296/ghc >--------------------------------------------------------------- commit f3cc973d39743c1fb80c726688f83184455d9296 Author: Tobias Dammers Date: Tue Jan 30 16:48:00 2018 +0100 Fixed errors introduced by cherry-picking >--------------------------------------------------------------- f3cc973d39743c1fb80c726688f83184455d9296 compiler/typecheck/TcCanonical.hs | 2 +- compiler/typecheck/TcEvidence.hs | 6 +++--- compiler/types/Coercion.hs | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index ac6b6af..7e7154f 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -1266,7 +1266,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 -> do { let ev_co = mkCoVarCo evar ; given_evs <- newGivenEvVars loc $ [ ( mkPrimEqPredRole r ty1 ty2 - , EvCoercion (mkNthCo r i ev_co) ) + , evCoercion (mkNthCo r i ev_co) ) | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..] , r /= Phantom , not (isCoercionTy ty1) && not (isCoercionTy ty2) ] diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index c489d44..d80996e 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -760,9 +760,9 @@ isEmptyTcEvBinds (TcEvBinds {}) = panic "isEmptyTcEvBinds" evTermCoercion :: EvTerm -> TcCoercion -- Applied only to EvTerms of type (s~t) -- See Note [Coercion evidence terms] -evTermCoercion (EvId v) = mkCoVarCo v -evTermCoercion (EvCoercion co) = co -evTermCoercion (EvCast tm co) = mkCoCast Representational (evTermCoercion tm) co +evTermCoercion (EvExpr (Var v)) = mkCoVarCo v +evTermCoercion (EvExpr (Coercion co)) = co +evTermCoercion (EvExpr (Cast tm co)) = mkCoCast Representational (evTermCoercion (EvExpr tm)) co evTermCoercion tm = pprPanic "evTermCoercion" (ppr tm) evVarsOfTerm :: EvTerm -> VarSet diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 7fe7792..a5b476a 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -29,7 +29,7 @@ module Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, mkTransAppCo, - mkNthCo, mkLRCo, + mkNthCo, mkNthCoNoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCos, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkHomoForAllCos_NoRefl, mkPhantomCo, From git at git.haskell.org Tue Jan 30 16:05:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 16:05:35 +0000 (UTC) Subject: [commit: ghc] branch 'wip/tdammers/T14738' created Message-ID: <20180130160535.670603A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/tdammers/T14738 Referencing: 79190eae4ca9446c0a990a7d7c7a66be367456e1 From git at git.haskell.org Tue Jan 30 16:05:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 16:05:38 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T14738: Added some SCCs (79190ea) Message-ID: <20180130160538.78C373A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T14738 Link : http://ghc.haskell.org/trac/ghc/changeset/79190eae4ca9446c0a990a7d7c7a66be367456e1/ghc >--------------------------------------------------------------- commit 79190eae4ca9446c0a990a7d7c7a66be367456e1 Author: Tobias Dammers Date: Tue Jan 30 17:04:47 2018 +0100 Added some SCCs >--------------------------------------------------------------- 79190eae4ca9446c0a990a7d7c7a66be367456e1 compiler/main/TidyPgm.hs | 61 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 42 insertions(+), 19 deletions(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index ce8ac53..c1bc57f 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -337,58 +337,80 @@ tidyProgram hsc_env (ModGuts { mg_module = mod = Err.withTiming (pure dflags) (text "CoreTidy"<+>brackets (ppr mod)) (const ()) $ - do { let { omit_prags = gopt Opt_OmitInterfacePragmas dflags - ; expose_all = gopt Opt_ExposeAllUnfoldings dflags - ; print_unqual = mkPrintUnqualified dflags rdr_env + do { let { omit_prags = + {-#SCC "omit_prags" #-} + gopt Opt_OmitInterfacePragmas dflags + ; expose_all = + {-#SCC "expose_all" #-} + gopt Opt_ExposeAllUnfoldings dflags + ; print_unqual = + {-#SCC "print_unqual" #-} + mkPrintUnqualified dflags rdr_env } - ; let { type_env = typeEnvFromEntities [] tcs fam_insts + ; let { type_env = {-#SCC "type_env" #-} + typeEnvFromEntities [] tcs fam_insts ; implicit_binds - = concatMap getClassImplicitBinds (typeEnvClasses type_env) ++ + = {-#SCC "implicit_binds" #-} + concatMap getClassImplicitBinds (typeEnvClasses type_env) ++ concatMap getTyConImplicitBinds (typeEnvTyCons type_env) } ; (unfold_env, tidy_occ_env) - <- chooseExternalIds hsc_env mod omit_prags expose_all + <- {-# SCC "chooseExternalIds" #-} + chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_rules (vectInfoVar vect_info) ; let { (trimmed_binds, trimmed_rules) - = findExternalRules omit_prags binds imp_rules unfold_env } + = {-#SCC "findExternalRules" #-} + findExternalRules omit_prags binds imp_rules unfold_env } ; (tidy_env, tidy_binds) - <- tidyTopBinds hsc_env mod unfold_env tidy_occ_env trimmed_binds + <- {-#SCC "tidyTopBinds" #-} + tidyTopBinds hsc_env mod unfold_env tidy_occ_env trimmed_binds - ; let { final_ids = [ id | id <- bindersOfBinds tidy_binds, + ; let { final_ids = {-#SCC "final_ids" #-} + [ id | id <- bindersOfBinds tidy_binds, isExternalName (idName id)] - ; type_env1 = extendTypeEnvWithIds type_env final_ids + ; type_env1 = {-#SCC "type_env1" #-} + extendTypeEnvWithIds type_env final_ids - ; tidy_cls_insts = map (tidyClsInstDFun (tidyVarOcc tidy_env)) cls_insts + ; tidy_cls_insts = {-#SCC "tidy_cls_insts" #-} + map (tidyClsInstDFun (tidyVarOcc tidy_env)) cls_insts -- A DFunId will have a binding in tidy_binds, and so will now be in -- tidy_type_env, replete with IdInfo. Its name will be unchanged since -- it was born, but we want Global, IdInfo-rich (or not) DFunId in the -- tidy_cls_insts. Similarly the Ids inside a PatSyn. - ; tidy_rules = tidyRules tidy_env trimmed_rules + ; tidy_rules = {-#SCC "tidy_rules" #-} + tidyRules tidy_env trimmed_rules -- You might worry that the tidy_env contains IdInfo-rich stuff -- and indeed it does, but if omit_prags is on, ext_rules is -- empty - ; tidy_vect_info = tidyVectInfo tidy_env vect_info + ; tidy_vect_info = {-#SCC "tidy_vect_info" #-} + tidyVectInfo tidy_env vect_info -- Tidy the Ids inside each PatSyn, very similarly to DFunIds -- and then override the PatSyns in the type_env with the new tidy ones -- This is really the only reason we keep mg_patsyns at all; otherwise -- they could just stay in type_env - ; tidy_patsyns = map (tidyPatSynIds (tidyVarOcc tidy_env)) patsyns - ; type_env2 = extendTypeEnvWithPatSyns tidy_patsyns type_env1 + ; tidy_patsyns = {-#SCC "tidy_patsyns" #-} + map (tidyPatSynIds (tidyVarOcc tidy_env)) patsyns + ; type_env2 = {-#SCC "type_env2" #-} + extendTypeEnvWithPatSyns tidy_patsyns type_env1 - ; tidy_type_env = tidyTypeEnv omit_prags type_env2 + ; tidy_type_env = {-#SCC "tidy_type_env" #-} + tidyTypeEnv omit_prags type_env2 } -- See Note [Grand plan for static forms] in StaticPtrTable. ; (spt_entries, tidy_binds') <- + {-#SCC "sptCreateStaticBinds" #-} sptCreateStaticBinds hsc_env mod tidy_binds - ; let { spt_init_code = sptModuleInitCode mod spt_entries + ; let { spt_init_code = {-#SCC "spt_init_code" #-} + sptModuleInitCode mod spt_entries ; add_spt_init_code = + {-#SCC "add_spt_init_code" #-} case hscTarget dflags of -- If we are compiling for the interpreter we will insert -- any necessary SPT entries dynamically @@ -411,7 +433,8 @@ tidyProgram hsc_env (ModGuts { mg_module = mod ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env) } - ; endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules + ; {-#SCC "endPassIO" #-} + endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules -- If the endPass didn't print the rules, but ddump-rules is -- on, print now @@ -421,7 +444,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod (pprRulesForUser dflags tidy_rules) -- Print one-line size info - ; let cs = coreBindsStats tidy_binds + ; let cs = {-#SCC "coreBindStats" #-} coreBindsStats tidy_binds ; when (dopt Opt_D_dump_core_stats dflags) (putLogMsg dflags NoReason SevDump noSrcSpan (defaultDumpStyle dflags) From git at git.haskell.org Tue Jan 30 16:26:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 16:26:26 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/T11735-1: Added Note [Nested ForAllCos] according to D4355 (57221a2) Message-ID: <20180130162626.633E33A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/T11735-1 Link : http://ghc.haskell.org/trac/ghc/changeset/57221a25018e4f9560d63a87c5282773ee259d36/ghc >--------------------------------------------------------------- commit 57221a25018e4f9560d63a87c5282773ee259d36 Author: Tobias Dammers Date: Tue Jan 30 17:25:41 2018 +0100 Added Note [Nested ForAllCos] according to D4355 >--------------------------------------------------------------- 57221a25018e4f9560d63a87c5282773ee259d36 compiler/types/Coercion.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index d92b362..7a7918c 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1757,6 +1757,7 @@ coercionKind co = go_app co args = piResultTys <$> go co <*> (sequenceA $ map go args) go_forall subst (ForAllCo tv1 k_co co) + -- See Note [Nested ForAllCos] = mkInvForAllTy <$> Pair tv1 tv2 <*> go_forall subst' co where Pair _ k2 = go k_co @@ -1767,6 +1768,23 @@ coercionKind co = go_forall subst other_co = substTy subst `pLiftSnd` go other_co +{- + +Note [Nested ForAllCos] +~~~~~~~~~~~~~~~~~~~~~~~ + +Suppose we need `coercionKind (ForAllCo a1 (ForAllCo a2 ... (ForAllCo an +co)...) )`. We do not want to perform `n` single-type-variable +substitutions over the kind of `co`; rather we want to do one substitution +which substitutes for all of `a1`, `a2` ... simultaneously. If we do one +at a time we get the performance hole reported in Trac #11735. + +Solution: gather up the type variables for nested `ForAllCos`, and +substitute for them all at once. Remarkably, for Trac #11735 this single +change reduces /total/ compile time by a factor of more than ten. + +-} + -- | Apply 'coercionKind' to multiple 'Coercion's coercionKinds :: [Coercion] -> Pair [Type] coercionKinds tys = sequenceA $ map coercionKind tys From git at git.haskell.org Tue Jan 30 18:48:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 18:48:51 +0000 (UTC) Subject: [commit: ghc] master: Invert likeliness when improving conditionals (96d2eb2) Message-ID: <20180130184851.B6B423A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/96d2eb27eb86540796944253ce47b2bcd6a2df1c/ghc >--------------------------------------------------------------- commit 96d2eb27eb86540796944253ce47b2bcd6a2df1c Author: Alexander Biehl Date: Thu Jan 18 13:21:02 2018 +0100 Invert likeliness when improving conditionals ... in CmmSink >--------------------------------------------------------------- 96d2eb27eb86540796944253ce47b2bcd6a2df1c compiler/cmm/CmmSink.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index 3633ed3..76ce18b 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -462,9 +462,13 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs CmmCondBranch (CmmMachOp (MO_Ne w) args) ti fi l -> CmmCondBranch (cmmMachOpFold dflags (MO_Eq w) args) - fi ti l + fi ti (inv_likeliness l) node' -> node' + inv_likeliness :: Maybe Bool -> Maybe Bool + inv_likeliness Nothing = Nothing + inv_likeliness (Just l) = Just (not l) + inl_exp :: CmmExpr -> CmmExpr -- inl_exp is where the inlining actually takes place! inl_exp (CmmReg (CmmLocal l')) | l == l' = rhs From git at git.haskell.org Tue Jan 30 18:48:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 18:48:54 +0000 (UTC) Subject: [commit: ghc] master: Add likely annotation to cmm files in a few obvious places. (1205629) Message-ID: <20180130184854.DF4583A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1205629228064537545a0be9c2e9a995aa2dcd03/ghc >--------------------------------------------------------------- commit 1205629228064537545a0be9c2e9a995aa2dcd03 Author: klebinger.andreas at gmx.at Date: Mon Jan 29 18:25:00 2018 -0500 Add likely annotation to cmm files in a few obvious places. Provide information about paths more likely to be taken in the cmm files used by the rts. This leads to slightly better assembly being generated. Reviewers: bgamari, erikd, simonmar Subscribers: alexbiehl, rwbarton, thomie, carter GHC Trac Issues: #14672 Differential Revision: https://phabricator.haskell.org/D4324 >--------------------------------------------------------------- 1205629228064537545a0be9c2e9a995aa2dcd03 rts/Compact.cmm | 6 +++--- rts/PrimOps.cmm | 6 +++--- rts/Updates.cmm | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/rts/Compact.cmm b/rts/Compact.cmm index 174444d..719dac8 100644 --- a/rts/Compact.cmm +++ b/rts/Compact.cmm @@ -174,7 +174,7 @@ eval: prim %memcpy(to + cards, p + cards , size - cards, 1); i = 0; loop0: - if (i < ptrs) { + if (i < ptrs) ( likely: True ) { W_ q; q = to + SIZEOF_StgMutArrPtrs + WDS(i); call stg_compactAddWorkerzh( @@ -200,7 +200,7 @@ eval: prim %memcpy(to, p, size, 1); i = 0; loop0: - if (i < ptrs) { + if (i < ptrs) ( likely: True ) { W_ q; q = to + SIZEOF_StgSmallMutArrPtrs + WDS(i); call stg_compactAddWorkerzh( @@ -241,7 +241,7 @@ eval: loop1: StgClosure_payload(to,i) = StgClosure_payload(p,i); i = i + 1; - if (i < ptrs + nptrs) goto loop1; + if (i < ptrs + nptrs) ( likely: True ) goto loop1; } // Next, recursively compact and copy the pointers diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 2b3a304..fb9db0a 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -263,7 +263,7 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) // Initialise all elements of the array with the value in R2 p = arr + SIZEOF_StgMutArrPtrs; for: - if (p < arr + SIZEOF_StgMutArrPtrs + WDS(n)) { + if (p < arr + SIZEOF_StgMutArrPtrs + WDS(n)) (likely: True) { W_[p] = init; p = p + WDS(1); goto for; @@ -392,7 +392,7 @@ stg_newArrayArrayzh ( W_ n /* words */ ) // Initialise all elements of the array with a pointer to the new array p = arr + SIZEOF_StgMutArrPtrs; for: - if (p < arr + SIZEOF_StgMutArrPtrs + WDS(n)) { + if (p < arr + SIZEOF_StgMutArrPtrs + WDS(n)) (likely: True) { W_[p] = arr; p = p + WDS(1); goto for; @@ -426,7 +426,7 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init ) // Initialise all elements of the array with the value in R2 p = arr + SIZEOF_StgSmallMutArrPtrs; for: - if (p < arr + SIZEOF_StgSmallMutArrPtrs + WDS(n)) { + if (p < arr + SIZEOF_StgSmallMutArrPtrs + WDS(n)) (likely: True) { W_[p] = init; p = p + WDS(1); goto for; diff --git a/rts/Updates.cmm b/rts/Updates.cmm index b3b6b20..9d00fb8 100644 --- a/rts/Updates.cmm +++ b/rts/Updates.cmm @@ -54,7 +54,7 @@ INFO_TABLE_RET ( stg_marked_upd_frame, UPDATE_FRAME, // we know the closure is a BLACKHOLE v = StgInd_indirectee(updatee); - if (GETTAG(v) != 0) { + if (GETTAG(v) != 0) (likely: False) { // updated by someone else: discard our value and use the // other one to increase sharing, but check the blocking // queues to see if any threads were waiting on this BLACKHOLE. @@ -63,7 +63,7 @@ INFO_TABLE_RET ( stg_marked_upd_frame, UPDATE_FRAME, } // common case: it is still our BLACKHOLE - if (v == CurrentTSO) { + if (v == CurrentTSO) (likely: True) { updateWithIndirection(updatee, ret, return (ret)); } From git at git.haskell.org Tue Jan 30 19:18:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Jan 2018 19:18:29 +0000 (UTC) Subject: [commit: ghc] master: Update outputs of T12962, scc003 (5e8d314) Message-ID: <20180130191829.7EA373A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e8d314d9ab5a65d329170681db2938cf2d250a3/ghc >--------------------------------------------------------------- commit 5e8d314d9ab5a65d329170681db2938cf2d250a3 Author: Ömer Sinan Ağacan Date: Tue Jan 30 13:49:03 2018 -0500 Update outputs of T12962, scc003 - T12962: just fix function locations - scc003: reorder cost centres, cost centre `f.(...)` renamed to `f.x'` Reviewers: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14704 Differential Revision: https://phabricator.haskell.org/D4351 >--------------------------------------------------------------- 5e8d314d9ab5a65d329170681db2938cf2d250a3 testsuite/tests/profiling/should_run/T12962.prof.sample | 16 ++++++++-------- testsuite/tests/profiling/should_run/scc003.prof.sample | 4 ++-- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/testsuite/tests/profiling/should_run/T12962.prof.sample b/testsuite/tests/profiling/should_run/T12962.prof.sample index 025e9e0..228a92d 100644 --- a/testsuite/tests/profiling/should_run/T12962.prof.sample +++ b/testsuite/tests/profiling/should_run/T12962.prof.sample @@ -11,9 +11,9 @@ MAIN MAIN 0.0 1.2 CAF GHC.IO.Handle.FD 0.0 60.5 CAF GHC.IO.Encoding 0.0 4.8 CAF GHC.Conc.Signal 0.0 1.1 -foo Main T12962.hs:8:1-21 0.0 2.8 -niz3 Main T12962.hs:12:1-27 0.0 20.9 -blah Main T12962.hs:15:1-22 0.0 8.3 +foo Main T12962.hs:12:1-21 0.0 2.8 +niz3 Main T12962.hs:16:1-27 0.0 20.9 +blah Main T12962.hs:19:1-22 0.0 8.3 individual inherited @@ -21,12 +21,12 @@ COST CENTRE MODULE SRC no. entries %time %all MAIN MAIN 110 0 0.0 1.2 0.0 100.0 CAF Main 219 0 0.0 0.0 0.0 32.1 - blah Main T12962.hs:15:1-22 223 1 0.0 8.3 0.0 8.3 - main Main T12962.hs:17:1-47 220 1 0.0 0.0 0.0 23.8 - niz3 Main T12962.hs:12:1-27 222 1 0.0 20.9 0.0 23.7 - foo Main T12962.hs:8:1-21 224 100 0.0 2.8 0.0 2.8 + blah Main T12962.hs:19:1-22 223 1 0.0 8.3 0.0 8.3 + main Main T12962.hs:21:1-47 220 1 0.0 0.0 0.0 23.8 + niz3 Main T12962.hs:16:1-27 222 1 0.0 20.9 0.0 23.7 + foo Main T12962.hs:12:1-21 224 100 0.0 2.8 0.0 2.8 CAF GHC.Conc.Signal 214 0 0.0 1.1 0.0 1.1 CAF GHC.IO.Encoding 204 0 0.0 4.8 0.0 4.8 CAF GHC.IO.Encoding.Iconv 202 0 0.0 0.3 0.0 0.3 CAF GHC.IO.Handle.FD 194 0 0.0 60.5 0.0 60.5 - main Main T12962.hs:17:1-47 221 0 0.0 0.0 0.0 0.0 + main Main T12962.hs:21:1-47 221 0 0.0 0.0 0.0 0.0 diff --git a/testsuite/tests/profiling/should_run/scc003.prof.sample b/testsuite/tests/profiling/should_run/scc003.prof.sample index c809013..d65b875 100644 --- a/testsuite/tests/profiling/should_run/scc003.prof.sample +++ b/testsuite/tests/profiling/should_run/scc003.prof.sample @@ -22,10 +22,10 @@ MAIN MAIN 104 0 0.0 1.9 CAF Main 207 0 0.0 0.0 100.0 0.7 main Main scc003.hs:2:1-22 208 1 0.0 0.6 100.0 0.7 f Main scc003.hs:5:1-41 210 1 0.0 0.0 100.0 0.1 - f.(...) Main scc003.hs:5:11-21 211 1 0.0 0.0 0.0 0.0 - fib Main scc003.hs:8:1-50 212 21891 0.0 0.0 0.0 0.0 f.\ Main scc003.hs:5:32-41 213 1 0.0 0.0 100.0 0.0 fib Main scc003.hs:8:1-50 214 2692537 100.0 0.0 100.0 0.0 + f.x' Main scc003.hs:5:11-21 211 1 0.0 0.0 0.0 0.0 + fib Main scc003.hs:8:1-50 212 21891 0.0 0.0 0.0 0.0 CAF GHC.Conc.Signal 201 0 0.0 1.3 0.0 1.3 CAF GHC.IO.Encoding 191 0 0.0 5.7 0.0 5.7 CAF GHC.IO.Encoding.Iconv 189 0 0.0 0.5 0.0 0.5 From git at git.haskell.org Wed Jan 31 11:36:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 11:36:30 +0000 (UTC) Subject: [commit: ghc] master: A bit more tc-tracing (47031db) Message-ID: <20180131113630.B40393A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47031db4ba0677ede438526770ab23908257fc5c/ghc >--------------------------------------------------------------- commit 47031db4ba0677ede438526770ab23908257fc5c Author: Simon Peyton Jones Date: Wed Jan 31 11:35:20 2018 +0000 A bit more tc-tracing >--------------------------------------------------------------- 47031db4ba0677ede438526770ab23908257fc5c compiler/typecheck/TcSMonad.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index af77a2c..e732fdd 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -421,11 +421,15 @@ data InertSet } instance Outputable InertSet where - ppr is = vcat [ ppr $ inert_cans is - , ppUnless (null dicts) $ - text "Solved dicts" <+> vcat (map ppr dicts) ] + ppr (IS { inert_cans = ics + , inert_fsks = ifsks + , inert_solved_dicts = solved_dicts }) + = vcat [ ppr ics + , text "Inert fsks =" <+> ppr ifsks + , ppUnless (null dicts) $ + text "Solved dicts =" <+> vcat (map ppr dicts) ] where - dicts = bagToList (dictsToBag (inert_solved_dicts is)) + dicts = bagToList (dictsToBag solved_dicts) emptyInert :: InertSet emptyInert @@ -2899,6 +2903,7 @@ unflattenGivens :: IORef InertSet -> TcM () -- is nicely paired with the creation an empty inert_fsks list. unflattenGivens inert_var = do { inerts <- TcM.readTcRef inert_var + ; TcM.traceTc "unflattenGivens" (ppr (inert_fsks inerts)) ; mapM_ flatten_one (inert_fsks inerts) } where flatten_one (fsk, ty) = TcM.writeMetaTyVar fsk ty From git at git.haskell.org Wed Jan 31 11:36:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 11:36:34 +0000 (UTC) Subject: [commit: ghc] master: Move zonkWC to the right place in simplfyInfer (e7c3878) Message-ID: <20180131113634.2693B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7c3878dacbad8120aacbe4423857b5ca9b43eb4/ghc >--------------------------------------------------------------- commit e7c3878dacbad8120aacbe4423857b5ca9b43eb4 Author: Simon Peyton Jones Date: Wed Jan 31 11:35:33 2018 +0000 Move zonkWC to the right place in simplfyInfer runTcSWithEvBinds does some unification, so the zonkWC must be after, not before! Yikes. An outright bug. This fixes Trac #14715. >--------------------------------------------------------------- e7c3878dacbad8120aacbe4423857b5ca9b43eb4 compiler/typecheck/TcSimplify.hs | 5 ++--- testsuite/tests/partial-sigs/should_compile/T14715.hs | 19 +++++++++++++++++++ .../should_compile/T14715.stderr} | 0 testsuite/tests/partial-sigs/should_compile/all.T | 1 + 4 files changed, 22 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 08c781d..b92ebfd 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -649,9 +649,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds psig_givens = mkGivens loc psig_theta_vars ; _ <- solveSimpleGivens psig_givens -- See Note [Add signature contexts as givens] - ; wanteds' <- solveWanteds wanteds - ; TcS.zonkWC wanteds' } - + ; solveWanteds wanteds } -- Find quant_pred_candidates, the predicates that -- we'll consider quantifying over @@ -659,6 +657,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds -- the psig_theta; it's just the extra bit -- NB2: We do not do any defaulting when inferring a type, this can lead -- to less polymorphic types, see Note [Default while Inferring] + ; wanted_transformed_incl_derivs <- TcM.zonkWC wanted_transformed_incl_derivs ; let definite_error = insolubleWC wanted_transformed_incl_derivs -- See Note [Quantification with errors] -- NB: must include derived errors in this test, diff --git a/testsuite/tests/partial-sigs/should_compile/T14715.hs b/testsuite/tests/partial-sigs/should_compile/T14715.hs new file mode 100644 index 0000000..1a902ac --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14715.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T14715 (bench_mulPublic) where + +data Cyc r +data CT zp r'q +class Reduce a b +type family LiftOf b + +bench_mulPublic :: forall z zp zq . (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp,zq) +bench_mulPublic pt sk = do + ct :: CT zp (Cyc zq) <- encrypt sk pt + undefined ct + +encrypt :: forall z zp zq. Reduce z zq => Cyc z -> Cyc zp -> IO (CT zp (Cyc zq)) +encrypt = undefined diff --git a/testsuite/tests/deSugar/should_run/T5472.stdout b/testsuite/tests/partial-sigs/should_compile/T14715.stderr similarity index 100% copy from testsuite/tests/deSugar/should_run/T5472.stdout copy to testsuite/tests/partial-sigs/should_compile/T14715.stderr diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index d13af5c..ebf6338 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -73,4 +73,5 @@ test('T13482', normal, compile, ['']) test('T14217', normal, compile_fail, ['']) test('T14643', normal, compile, ['']) test('T14643a', normal, compile, ['']) +test('T14715', normal, compile, ['']) From git at git.haskell.org Wed Jan 31 12:01:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 12:01:43 +0000 (UTC) Subject: [commit: ghc] wip/T2893: Move SCC on evidence binds to post-desguaring (e0d5286) Message-ID: <20180131120143.ADD7B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T2893 Link : http://ghc.haskell.org/trac/ghc/changeset/e0d5286c8cea23ca27163abe76d63c1f10719fa2/ghc >--------------------------------------------------------------- commit e0d5286c8cea23ca27163abe76d63c1f10719fa2 Author: Simon Peyton Jones Date: Wed Jan 31 11:54:32 2018 +0000 Move SCC on evidence binds to post-desguaring This fixes Trac #14735, and is generally nicer anyway. >--------------------------------------------------------------- e0d5286c8cea23ca27163abe76d63c1f10719fa2 compiler/deSugar/DsBinds.hs | 35 +++++++++++++++++--- compiler/typecheck/TcEvidence.hs | 37 ++++++++++++---------- testsuite/tests/typecheck/should_compile/T14735.hs | 30 ++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 82 insertions(+), 21 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 5af21ae..4246400 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -52,7 +52,7 @@ import Name import VarSet import Rules import VarEnv -import Var( EvVar ) +import Var( EvVar, varType ) import Outputable import Module import SrcLoc @@ -63,6 +63,7 @@ import BasicTypes import DynFlags import FastString import Util +import UniqSet( nonDetEltsUniqSet ) import MonadUtils import qualified GHC.LanguageExtensions as LangExt import Control.Monad @@ -1138,15 +1139,39 @@ dsTcEvBinds (TcEvBinds {}) = panic "dsEvBinds" -- Zonker has got rid of this dsTcEvBinds (EvBinds bs) = dsEvBinds bs dsEvBinds :: Bag EvBind -> DsM [CoreBind] -dsEvBinds bs = mapM ds_scc (sccEvBinds bs) +dsEvBinds bs + = do { ds_bs <- mapBagM dsEvBind bs + ; return (mk_ev_binds ds_bs) } + +mk_ev_binds :: Bag (Id,CoreExpr) -> [CoreBind] +-- We do SCC analysis of the evidence bindings, /after/ desugaring +-- them. This is convenient: it means we can use the CoreSyn +-- free-variable functions rather than having to do accurate free vars +-- for EvTerm. +mk_ev_binds ds_binds + = map ds_scc (stronglyConnCompFromEdgedVerticesUniq edges) where - ds_scc (AcyclicSCC (EvBind { eb_lhs = v, eb_rhs = r})) - = liftM (NonRec v) (dsEvTerm r) - ds_scc (CyclicSCC bs) = liftM Rec (mapM dsEvBind bs) + edges :: [ Node EvVar (EvVar,CoreExpr) ] + edges = foldrBag ((:) . mk_node) [] ds_binds + + mk_node :: (Id, CoreExpr) -> Node EvVar (EvVar,CoreExpr) + mk_node b@(var, rhs) + = DigraphNode { node_payload = b + , node_key = var + , node_dependencies = nonDetEltsUniqSet $ + exprFreeVars rhs `unionVarSet` + coVarsOfType (varType var) } + -- It's OK to use nonDetEltsUniqSet here as stronglyConnCompFromEdgedVertices + -- is still deterministic even if the edges are in nondeterministic order + -- as explained in Note [Deterministic SCC] in Digraph. + + ds_scc (AcyclicSCC (v,r)) = NonRec v r + ds_scc (CyclicSCC prs) = Rec prs dsEvBind :: EvBind -> DsM (Id, CoreExpr) dsEvBind (EvBind { eb_lhs = v, eb_rhs = r}) = liftM ((,) v) (dsEvTerm r) + {-********************************************************************** * * Desugaring EvTerms diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 6d7275b..3b055c7 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -16,7 +16,7 @@ module TcEvidence ( lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap, isEmptyEvBindMap, EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind, - sccEvBinds, evBindVar, + evBindVar, -- EvTerm (already a CoreExpr) EvTerm(..), EvExpr, @@ -773,10 +773,17 @@ evTermCoercion (EvExpr (Coercion co)) = co evTermCoercion (EvExpr (Cast tm co)) = mkCoCast (evTermCoercion (EvExpr tm)) co evTermCoercion tm = pprPanic "evTermCoercion" (ppr tm) + +{- ********************************************************************* +* * + Free variables +* * +********************************************************************* -} + evVarsOfTerm :: EvTerm -> VarSet evVarsOfTerm (EvExpr e) = exprSomeFreeVars isEvVar e evVarsOfTerm (EvTypeable _ ev) = evVarsOfTypeable ev -evVarsOfTerm (EvFun {}) = emptyVarSet +evVarsOfTerm (EvFun {}) = emptyVarSet -- See Note [Free vars of EvFun] evVarsOfTerms :: [EvTerm] -> VarSet evVarsOfTerms = mapUnionVarSet evVarsOfTerm @@ -789,22 +796,20 @@ evVarsOfTypeable ev = EvTypeableTrFun e1 e2 -> evVarsOfTerms [e1,e2] EvTypeableTyLit e -> evVarsOfTerm e --- | Do SCC analysis on a bag of 'EvBind's. -sccEvBinds :: Bag EvBind -> [SCC EvBind] -sccEvBinds bs = stronglyConnCompFromEdgedVerticesUniq edges - where - edges :: [ Node EvVar EvBind ] - edges = foldrBag ((:) . mk_node) [] bs - mk_node :: EvBind -> Node EvVar EvBind - mk_node b@(EvBind { eb_lhs = var, eb_rhs = term }) - = DigraphNode b var (nonDetEltsUniqSet (evVarsOfTerm term `unionVarSet` - coVarsOfType (varType var))) - -- It's OK to use nonDetEltsUniqSet here as stronglyConnCompFromEdgedVertices - -- is still deterministic even if the edges are in nondeterministic order - -- as explained in Note [Deterministic SCC] in Digraph. +{- Note [Free vars of EvFun] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Finding the free vars of an EvFun is made tricky by the fact the +bindings et_binds may be a mutable variable. Fortunately, we +can just squeeze by. Here's how. + +* evVarsOfTerm is used only by TcSimplify.neededEvVars. +* Each EvBindsVar in an et_binds field of an EvFun is /also/ in the + ic_binds field of an Implication +* So we can track usage via the processing for that implication, + (see Note [Tracking redundant constraints] in TcSimplify). + We can ignore usage from the EvFun altogether. -{- ************************************************************************ * * Pretty printing diff --git a/testsuite/tests/typecheck/should_compile/T14735.hs b/testsuite/tests/typecheck/should_compile/T14735.hs new file mode 100644 index 0000000..c48231b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14735.hs @@ -0,0 +1,30 @@ +{-# Language QuantifiedConstraints #-} +{-# Language StandaloneDeriving #-} +{-# Language DataKinds #-} +{-# Language TypeOperators #-} +{-# Language GADTs #-} +{-# Language KindSignatures #-} +{-# Language FlexibleInstances #-} +{-# Language UndecidableInstances #-} +{-# Language MultiParamTypeClasses #-} +{-# Language RankNTypes #-} +{-# Language ConstraintKinds #-} + +module T14735 where + +import Data.Kind + +data D c where + D :: c => D c + +newtype a :- b = S (a => D b) + +class C1 a b +class C2 a b +instance C1 a b => C2 a b + +class (forall xx. f xx) => Limit f +instance (forall xx. f xx) => Limit f + +impl :: Limit (C1 a) :- Limit (C2 a) +impl = S D diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 622ece0..c8000c9 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -592,3 +592,4 @@ test('T13032', normal, compile, ['']) test('T14273', normal, compile, ['-fdefer-type-errors -fno-max-valid-substitutions']) test('T2893', normal, compile, ['']) test('T2893a', normal, compile, ['']) +test('T14735', normal, compile, ['']) From git at git.haskell.org Wed Jan 31 12:01:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 12:01:46 +0000 (UTC) Subject: [commit: ghc] wip/T2893: Add QuantifiedConstraints to ghc-only extensions (ba61a1b) Message-ID: <20180131120146.9D2223A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T2893 Link : http://ghc.haskell.org/trac/ghc/changeset/ba61a1b029624ce9d363d322ff621609e10838b0/ghc >--------------------------------------------------------------- commit ba61a1b029624ce9d363d322ff621609e10838b0 Author: Simon Peyton Jones Date: Wed Jan 31 11:59:51 2018 +0000 Add QuantifiedConstraints to ghc-only extensions ...following workflow in DynFlags Note [Adding a language extension] >--------------------------------------------------------------- ba61a1b029624ce9d363d322ff621609e10838b0 testsuite/tests/driver/T4437.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 6a46e52..807cbff 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -40,7 +40,8 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", "EmptyDataDeriving", - "NumericUnderscores"] + "NumericUnderscores", + "QuantifiedConstraints"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", From git at git.haskell.org Wed Jan 31 12:01:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 12:01:49 +0000 (UTC) Subject: [commit: ghc] wip/T2893: Add missing cases for ForAllPred (8c3a134) Message-ID: <20180131120149.961793A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T2893 Link : http://ghc.haskell.org/trac/ghc/changeset/8c3a134045ad4f25080996917b3fe77cb506b17b/ghc >--------------------------------------------------------------- commit 8c3a134045ad4f25080996917b3fe77cb506b17b Author: Simon Peyton Jones Date: Wed Jan 31 12:00:43 2018 +0000 Add missing cases for ForAllPred Should fix Trac #14744 >--------------------------------------------------------------- 8c3a134045ad4f25080996917b3fe77cb506b17b compiler/specialise/Specialise.hs | 1 + compiler/typecheck/TcCanonical.hs | 0 compiler/typecheck/TcType.hs | 2 ++ 3 files changed, 3 insertions(+) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index c4fe042..bc3e27f 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -2011,6 +2011,7 @@ mkCallUDs' env f args EqPred {} -> True IrredPred {} -> True -- Things like (D []) where D is a -- Constraint-ranged family; Trac #7785 + ForAllPred {} -> True {- Note [Type determines value] diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index de37aa8..ab0519d 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1983,6 +1983,7 @@ pickQuantifiablePreds qtvs theta EqPred NomEq ty1 ty2 -> quant_fun ty1 || quant_fun ty2 IrredPred ty -> tyCoVarsOfType ty `intersectsVarSet` qtvs + ForAllPred {} -> False pick_cls_pred flex_ctxt cls tys = tyCoVarsOfTypes tys `intersectsVarSet` qtvs @@ -2087,6 +2088,7 @@ isImprovementPred ty EqPred ReprEq _ _ -> False ClassPred cls _ -> classHasFds cls IrredPred {} -> True -- Might have equalities after reduction? + ForAllPred {} -> False {- Note [Expanding superclasses] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Wed Jan 31 13:24:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 13:24:42 +0000 (UTC) Subject: [commit: ghc] master: More tc-tracing (0f43d0d) Message-ID: <20180131132442.C750E3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f43d0dba3da7b16f6d3fd2e7cb6e62ac524eb04/ghc >--------------------------------------------------------------- commit 0f43d0dba3da7b16f6d3fd2e7cb6e62ac524eb04 Author: Simon Peyton Jones Date: Wed Jan 31 13:03:37 2018 +0000 More tc-tracing >--------------------------------------------------------------- 0f43d0dba3da7b16f6d3fd2e7cb6e62ac524eb04 compiler/typecheck/TcInteract.hs | 11 +++++++++-- compiler/typecheck/TcRnTypes.hs | 2 +- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 39424de..59eea70 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1117,12 +1117,19 @@ addFunDepWork inerts work_ev cls add_fds inert_ct | isImprovable inert_ev - = emitFunDepDeriveds $ + = do { traceTcS "addFunDepWork" (vcat + [ ppr work_ev + , pprCtLoc work_loc, ppr (isGivenLoc work_loc) + , pprCtLoc inert_loc, ppr (isGivenLoc inert_loc) + , pprCtLoc derived_loc, ppr (isGivenLoc derived_loc) ]) ; + + emitFunDepDeriveds $ improveFromAnother derived_loc inert_pred work_pred -- We don't really rewrite tys2, see below _rewritten_tys2, so that's ok -- NB: We do create FDs for given to report insoluble equations that arise -- from pairs of Givens, and also because of floating when we approximate -- implications. The relevant test is: typecheck/should_fail/FDsFromGivens.hs + } | otherwise = return () where @@ -1739,7 +1746,7 @@ emitFunDepDeriveds fd_eqns where do_one_FDEqn (FDEqn { fd_qtvs = tvs, fd_eqs = eqs, fd_loc = loc }) | null tvs -- Common shortcut - = do { traceTcS "emitFunDepDeriveds 1" (ppr (ctl_depth loc) $$ ppr eqs) + = do { traceTcS "emitFunDepDeriveds 1" (ppr (ctl_depth loc) $$ ppr eqs $$ ppr (isGivenLoc loc)) ; mapM_ (unifyDerived loc Nominal) eqs } | otherwise = do { traceTcS "emitFunDepDeriveds 2" (ppr (ctl_depth loc) $$ ppr eqs) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 13391d6..5e52496 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -96,7 +96,7 @@ module TcRnTypes( bumpSubGoalDepth, subGoalDepthExceeded, CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin, ctLocTypeOrKind_maybe, - ctLocDepth, bumpCtLocDepth, + ctLocDepth, bumpCtLocDepth, isGivenLoc, setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan, CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin, isVisibleOrigin, toInvisibleOrigin, From git at git.haskell.org Wed Jan 31 13:24:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 13:24:46 +0000 (UTC) Subject: [commit: ghc] master: Prioritise equalities when solving, incl deriveds (efba054) Message-ID: <20180131132446.D94A83A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/efba054640d3418d7477316ae0c1e992d0aa0f22/ghc >--------------------------------------------------------------- commit efba054640d3418d7477316ae0c1e992d0aa0f22 Author: Simon Peyton Jones Date: Wed Jan 31 13:05:13 2018 +0000 Prioritise equalities when solving, incl deriveds We already prioritise equalities when solving, but Trac #14723 showed that we were not doing so consistently enough, and as a result the type checker could go into a loop. Yikes. See Note [Prioritise equalities] in TcSMonad. Fixng this bug changed the solve order enough to demonstrate a problem with fundeps: Trac #14745. >--------------------------------------------------------------- efba054640d3418d7477316ae0c1e992d0aa0f22 compiler/typecheck/TcSMonad.hs | 93 +++++++++++++++++----- testsuite/tests/polykinds/T14723.hs | 70 ++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + testsuite/tests/typecheck/should_compile/T13651.hs | 21 +++++ .../tests/typecheck/should_compile/T13651.stderr | 16 ++++ .../should_compile/{T13651.hs => T13651a.hs} | 4 +- testsuite/tests/typecheck/should_compile/all.T | 3 +- 7 files changed, 184 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc efba054640d3418d7477316ae0c1e992d0aa0f22 From git at git.haskell.org Wed Jan 31 14:28:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 14:28:19 +0000 (UTC) Subject: [commit: ghc] master: Look inside implications in simplifyRule (e9ae0ca) Message-ID: <20180131142819.9F75A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9ae0cae9eb6a340473b339b5711ae76c6bdd045/ghc >--------------------------------------------------------------- commit e9ae0cae9eb6a340473b339b5711ae76c6bdd045 Author: Simon Peyton Jones Date: Wed Jan 31 14:25:50 2018 +0000 Look inside implications in simplifyRule Trac #14732 was a perpelexing bug in which -fdefer-typed-holes caused a mysterious type error in a RULE. This turned out to be because we are more aggressive about creating implications when deferring (see TcUnify.implicationNeeded), and the rule mechanism hadn't caught up. This fixes it. >--------------------------------------------------------------- e9ae0cae9eb6a340473b339b5711ae76c6bdd045 compiler/typecheck/TcRules.hs | 105 +++++++++++++++------ testsuite/tests/typecheck/should_compile/T14732.hs | 34 +++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 109 insertions(+), 31 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e9ae0cae9eb6a340473b339b5711ae76c6bdd045 From git at git.haskell.org Wed Jan 31 18:52:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 18:52:48 +0000 (UTC) Subject: [commit: nofib] master: Fix fannkuch-redux for GHC<=8.2 (40748b3) Message-ID: <20180131185248.E193D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/40748b305de4197ba8cfe178cea87a8234cf534b/nofib >--------------------------------------------------------------- commit 40748b305de4197ba8cfe178cea87a8234cf534b Author: Ömer Sinan Ağacan Date: Wed Jan 17 14:39:10 2018 +0300 Fix fannkuch-redux for GHC<=8.2 Reviewers: O26 nofib Differential Revision: https://phabricator.haskell.org/D4320 >--------------------------------------------------------------- 40748b305de4197ba8cfe178cea87a8234cf534b shootout/fannkuch-redux/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/shootout/fannkuch-redux/Main.hs b/shootout/fannkuch-redux/Main.hs index b920e9f..c2705ba 100644 --- a/shootout/fannkuch-redux/Main.hs +++ b/shootout/fannkuch-redux/Main.hs @@ -23,6 +23,7 @@ instance Semigroup F where instance Monoid F where mempty = F 0 0 + mappend = (<>) incPtr = (`advancePtr` 1) decPtr = (`advancePtr` (-1)) From git at git.haskell.org Wed Jan 31 23:41:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 23:41:17 +0000 (UTC) Subject: [commit: ghc] master: appveyor: Don't install gcc (b37dc23) Message-ID: <20180131234117.7808F3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b37dc232288f3d8ace44f7799ca7a258964bf7bf/ghc >--------------------------------------------------------------- commit b37dc232288f3d8ace44f7799ca7a258964bf7bf Author: Ben Gamari Date: Wed Jan 31 18:18:40 2018 -0500 appveyor: Don't install gcc We use GHC's toolchain anyways. >--------------------------------------------------------------- b37dc232288f3d8ace44f7799ca7a258964bf7bf appveyor.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/appveyor.yml b/appveyor.yml index 8ded95d..0af5304 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -19,7 +19,7 @@ install: - cmd: | SET "PATH=C:\%MSYS2_DIR%\%MSYSTEM%\bin;C:\%MSYS2_DIR%\usr\bin;%PATH%" bash -lc "pacman --noconfirm -Syuu" - bash -lc "pacman --noconfirm -S --needed git tar bsdtar binutils autoconf make xz curl libtool automake python python2 p7zip patch mingw-w64-$(uname -m)-gcc mingw-w64-$(uname -m)-python3-sphinx mingw-w64-$(uname -m)-tools-git" + bash -lc "pacman --noconfirm -S --needed git tar bsdtar binutils autoconf make xz curl libtool automake python python2 p7zip patch mingw-w64-$(uname -m)-python3-sphinx mingw-w64-$(uname -m)-tools-git" bash -lc "cd $APPVEYOR_BUILD_FOLDER; git config remote.origin.url git://github.com/ghc/ghc.git" bash -lc "cd $APPVEYOR_BUILD_FOLDER; git config --global url.\"git://github.com/ghc/packages-\".insteadOf git://github.com/ghc/packages/" bash -lc "cd $APPVEYOR_BUILD_FOLDER; git submodule init" From git at git.haskell.org Wed Jan 31 23:41:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 23:41:20 +0000 (UTC) Subject: [commit: ghc] master: circleci: Add Dockerfile for x86_64-linux (370b167) Message-ID: <20180131234120.9454F3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/370b1672dc73d58895af6ed7cb5ffe7477d9673a/ghc >--------------------------------------------------------------- commit 370b1672dc73d58895af6ed7cb5ffe7477d9673a Author: Ben Gamari Date: Wed Jan 31 16:41:44 2018 -0500 circleci: Add Dockerfile for x86_64-linux >--------------------------------------------------------------- 370b1672dc73d58895af6ed7cb5ffe7477d9673a .circleci/images/x86_64-linux/Dockerfile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.circleci/images/x86_64-linux/Dockerfile b/.circleci/images/x86_64-linux/Dockerfile new file mode 100644 index 0000000..aa8813f --- /dev/null +++ b/.circleci/images/x86_64-linux/Dockerfile @@ -0,0 +1,3 @@ +FROM haskell:8.2 +RUN adduser ghc --gecos 'GHC builds' --disabled-password +USER ghc From git at git.haskell.org Wed Jan 31 23:41:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Jan 2018 23:41:23 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark scc001 and T5363 as broken due to #14705 (55aea8f) Message-ID: <20180131234123.65E5E3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/55aea8fda42dfa29face29292b298994fabfb962/ghc >--------------------------------------------------------------- commit 55aea8fda42dfa29face29292b298994fabfb962 Author: Ben Gamari Date: Wed Jan 31 15:40:01 2018 -0500 testsuite: Mark scc001 and T5363 as broken due to #14705 These two tests have been failing on CircleCI. >--------------------------------------------------------------- 55aea8fda42dfa29face29292b298994fabfb962 testsuite/tests/profiling/should_run/all.T | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 7d14f77..4c4822c 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -38,7 +38,9 @@ test('T3001-2', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], # As with ioprof001, the unoptimised profile is different but # not badly wrong (CAF attribution is different). -test('scc001', expect_broken_for_10037, compile_and_run, +test('scc001', + [expect_broken_for_10037, expect_broken_for(14705, ['ghci-ext-prof'])], + compile_and_run, ['-fno-state-hack -fno-full-laziness']) # Note [consistent stacks] test('scc002', [], compile_and_run, ['']) @@ -106,7 +108,9 @@ test('callstack002', ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) # Should not stack overflow with -prof -fprof-auto -test('T5363', [], compile_and_run, ['']) +test('T5363', + [expect_broken_for(14705, ['ghci-ext-prof'])], + compile_and_run, ['']) test('profinline001', [], compile_and_run, [''])