From git at git.haskell.org Sat Oct 1 04:24:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 04:24:22 +0000 (UTC) Subject: [commit: ghc] master: Implement deriving strategies (9e86276) Message-ID: <20161001042422.C7F0D3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e862765ffe161da8a4fd9cd67b0a600874feaa9/ghc >--------------------------------------------------------------- commit 9e862765ffe161da8a4fd9cd67b0a600874feaa9 Author: Ryan Scott Date: Fri Sep 30 20:15:25 2016 -0400 Implement deriving strategies Allows users to explicitly request which approach to `deriving` to use via keywords, e.g., ``` newtype Foo = Foo Bar deriving Eq deriving stock Ord deriving newtype Show ``` Fixes #10598. Updates haddock submodule. Test Plan: ./validate Reviewers: hvr, kosmikus, goldfire, alanz, bgamari, simonpj, austin, erikd, simonmar Reviewed By: alanz, bgamari, simonpj Subscribers: thomie, mpickering, oerjan Differential Revision: https://phabricator.haskell.org/D2280 GHC Trac Issues: #10598 >--------------------------------------------------------------- 9e862765ffe161da8a4fd9cd67b0a600874feaa9 compiler/basicTypes/BasicTypes.hs | 26 + compiler/deSugar/DsMeta.hs | 57 ++- compiler/hsSyn/Convert.hs | 27 +- compiler/hsSyn/HsDecls.hs | 89 +++- compiler/main/DynFlags.hs | 1 + compiler/main/HscStats.hs | 8 +- compiler/parser/ApiAnnotation.hs | 4 +- compiler/parser/Lexer.x | 4 + compiler/parser/Parser.y | 126 +++-- compiler/prelude/THNames.hs | 151 +++--- compiler/rename/RnSource.hs | 45 +- compiler/rename/RnTypes.hs | 4 +- compiler/typecheck/TcDeriv.hs | 554 +++++++++++++++------ compiler/typecheck/TcGenDeriv.hs | 21 +- compiler/typecheck/TcInstDcls.hs | 10 +- docs/users_guide/8.2.1-notes.rst | 4 + docs/users_guide/glasgow_exts.rst | 62 ++- docs/users_guide/safe_haskell.rst | 7 +- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + libraries/ghci/GHCi/TH/Binary.hs | 2 + libraries/template-haskell/Language/Haskell/TH.hs | 13 +- .../template-haskell/Language/Haskell/TH/Lib.hs | 32 +- .../template-haskell/Language/Haskell/TH/Ppr.hs | 29 +- .../template-haskell/Language/Haskell/TH/Syntax.hs | 40 +- libraries/template-haskell/changelog.md | 3 + testsuite/driver/extra_files.py | 1 + .../tests/deriving/should_fail/T10598_fail1.hs | 11 + .../tests/deriving/should_fail/T10598_fail1.stderr | 17 + .../tests/deriving/should_fail/T10598_fail2.hs | 5 + .../tests/deriving/should_fail/T10598_fail2.stderr | 12 + .../tests/deriving/should_fail/T10598_fail3.hs | 8 + .../tests/deriving/should_fail/T10598_fail3.stderr | 5 + .../tests/deriving/should_fail/T10598_fail4.hs | 4 + .../tests/deriving/should_fail/T10598_fail4.stderr | 4 + .../tests/deriving/should_fail/T10598_fail5.hs | 5 + .../tests/deriving/should_fail/T10598_fail5.stderr | 4 + .../tests/deriving/should_fail/T10598_fail6.hs | 5 + .../tests/deriving/should_fail/T10598_fail6.stderr | 6 + testsuite/tests/deriving/should_fail/T3833.stderr | 2 +- testsuite/tests/deriving/should_fail/T3834.stderr | 2 +- testsuite/tests/deriving/should_fail/T9600.stderr | 2 +- testsuite/tests/deriving/should_fail/T9968a.stderr | 2 +- testsuite/tests/deriving/should_fail/all.T | 6 + .../tests/deriving/should_fail/drvfail008.stderr | 2 +- testsuite/tests/deriving/should_run/T10598_bug.hs | 9 + .../tests/deriving/should_run/T10598_bug.stdout | 1 + testsuite/tests/deriving/should_run/T10598_run.hs | 24 + .../tests/deriving/should_run/T10598_run.stdout | 2 + testsuite/tests/deriving/should_run/all.T | 2 + testsuite/tests/driver/T4437.hs | 3 +- testsuite/tests/generics/T5462No1.stderr | 6 +- testsuite/tests/ghc-api/annotations/Makefile | 4 + testsuite/tests/ghc-api/annotations/T10598.stdout | 36 ++ testsuite/tests/ghc-api/annotations/Test10598.hs | 18 + testsuite/tests/ghc-api/annotations/all.T | 1 + testsuite/tests/module/mod53.stderr | 2 +- .../tests/parser/should_fail/readFail039.stderr | 2 +- testsuite/tests/rts/T7919A.hs | 2 +- testsuite/tests/safeHaskell/ghci/p16.stderr | 2 +- testsuite/tests/th/T10598_TH.hs | 42 ++ testsuite/tests/th/T10598_TH.stderr | 41 ++ testsuite/tests/th/T10697_sourceUtil.hs | 2 +- testsuite/tests/th/T10819.hs | 3 +- testsuite/tests/th/T8100.hs | 4 +- testsuite/tests/th/TH_dataD1.hs | 2 +- testsuite/tests/th/all.T | 1 + utils/haddock | 2 +- utils/mkUserGuidePart/Options/Language.hs | 7 + 68 files changed, 1236 insertions(+), 405 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 9e862765ffe161da8a4fd9cd67b0a600874feaa9 From git at git.haskell.org Sat Oct 1 21:00:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:00:35 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: incomplete bytecode support (7e3aec1) Message-ID: <20161001210035.DC7493A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/7e3aec1b62e2a81f35e391fe36dfd9642b0e5761/ghc >--------------------------------------------------------------- commit 7e3aec1b62e2a81f35e391fe36dfd9642b0e5761 Author: Joachim Breitner Date: Fri Sep 30 00:10:39 2016 -0400 ConApp: incomplete bytecode support >--------------------------------------------------------------- 7e3aec1b62e2a81f35e391fe36dfd9642b0e5761 compiler/ghci/ByteCodeGen.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 90e2174..33607bd 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -157,6 +157,7 @@ simpleFreeVars = go . freeVars go' (AnnLit lit) = AnnLit lit go' (AnnLam bndr body) = AnnLam bndr (go body) go' (AnnApp fun arg) = AnnApp (go fun) (go arg) + go' (AnnConApp dc args) = AnnConApp dc (map go args) go' (AnnCase scrut bndr ty alts) = AnnCase (go scrut) bndr ty (map go_alt alts) go' (AnnLet bind body) = AnnLet (go_bind bind) (go body) go' (AnnCast expr (ann, co)) = AnnCast (go expr) (freeVarsOfAnn ann, co) @@ -420,6 +421,7 @@ schemeE d s p e -- Delegate tail-calls to schemeT. schemeE d s p e@(AnnApp _ _) = schemeT d s p e +schemeE d s p e@(AnnConApp _ _) = schemeT d s p e schemeE d s p e@(AnnLit lit) = returnUnboxedAtom d s p e (typeArgRep (literalType lit)) schemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e V @@ -432,6 +434,7 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) | (AnnVar v, args_r_to_l) <- splitApp rhs, Just data_con <- isDataConWorkId_maybe v, dataConRepArity data_con == length args_r_to_l + -- TODO #12618 remove eventually = do -- Special case for a non-recursive let whose RHS is a -- saturatred constructor application. -- Just allocate the constructor and carry on @@ -439,6 +442,14 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) body_code <- schemeE (d+1) s (Map.insert x d p) body return (alloc_code `appOL` body_code) +schemeE d s p (AnnLet (AnnNonRec x (_,AnnConApp dc args)) (_,body)) + = do -- Special case for a non-recursive let whose RHS is a + -- saturatred constructor application. + -- Just allocate the constructor and carry on + alloc_code <- mkConAppCode d s p dc (map snd (reverse args)) + body_code <- schemeE (d+1) s (Map.insert x d p) body + return (alloc_code `appOL` body_code) + -- General case for let. Generates correct, if inefficient, code in -- all situations. schemeE d s p (AnnLet binds (_,body)) = do @@ -624,6 +635,21 @@ schemeT :: Word -- Stack depth -> AnnExpr' Id DVarSet -> BcM BCInstrList +schemeT d s p (AnnConApp dc args') + | isUnboxedTupleCon dc + = case args of + [_,_,arg2,arg1] | isVAtom arg1 -> + unboxedTupleReturn d s p arg2 + [_,_,arg2,arg1] | isVAtom arg2 -> + unboxedTupleReturn d s p arg1 + _other -> multiValException + | otherwise + = do alloc_con <- mkConAppCode d s p dc (reverse args) + return (alloc_con `appOL` + mkSLIDE 1 (d - s) `snocOL` + ENTER) + where args = map snd args' + schemeT d s p app -- | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False @@ -1605,6 +1631,7 @@ bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) -- d) ticks (but not breakpoints) -- Type lambdas *can* occur in random expressions, -- whereas value lambdas cannot; that is why they are nuked here +-- TODO #12618: what to do with data con apps here? Keep types or not? bcView (AnnCast (_,e) _) = Just e bcView (AnnLam v (_,e)) | isTyVar v = Just e bcView (AnnApp (_,e) (_, AnnType _)) = Just e From git at git.haskell.org Sat Oct 1 21:00:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:00:38 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Add DataCon.dataConRepFullArity (0a9e260) Message-ID: <20161001210038.CA33F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/0a9e26077c1192bd88b6e856dc9ed04465632460/ghc >--------------------------------------------------------------- commit 0a9e26077c1192bd88b6e856dc9ed04465632460 Author: Joachim Breitner Date: Fri Sep 30 20:48:33 2016 -0400 Add DataCon.dataConRepFullArity which is the number of arguments expected by the data constructor worker, including type argument, and hence the list of an (uncompressed) argument list in ConApp. >--------------------------------------------------------------- 0a9e26077c1192bd88b6e856dc9ed04465632460 compiler/basicTypes/DataCon.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 6fda33a..47b05c9 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -39,7 +39,7 @@ module DataCon ( dataConInstOrigArgTys, dataConRepArgTys, dataConFieldLabels, dataConFieldType, dataConSrcBangs, - dataConSourceArity, dataConRepArity, + dataConSourceArity, dataConRepArity, dataConRepFullArity, dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, @@ -385,8 +385,10 @@ data DataCon -- Cached; see Note [DataCon arities] -- INVARIANT: dcRepArity == length dataConRepArgTys -- INVARIANT: dcSourceArity == length dcOrigArgTys - dcRepArity :: Arity, - dcSourceArity :: Arity, + -- INVARIANT: dcRepFullArity == length univ_tvs + length ex_tvs + dcRepArity + dcRepArity :: Arity, + dcSourceArity :: Arity, + dcRepFullArity :: Arity, -- Result type of constructor is T t1..tn dcRepTyCon :: TyCon, -- Result tycon, T @@ -799,6 +801,7 @@ mkDataCon name declared_infix prom_info dcRep = rep, dcSourceArity = length orig_arg_tys, dcRepArity = length rep_arg_tys, + dcRepFullArity = length univ_tvs + length ex_tvs + dcRepArity con, dcPromoted = promoted } -- The 'arg_stricts' passed to mkDataCon are simply those for the @@ -995,6 +998,11 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity +-- | Gives the number of arguments expected in ConApp: the universal type +-- variables, the existential type variables, the value arguments +dataConRepFullArity :: DataCon -> Arity +dataConRepFullArity (MkData { dcRepFullArity = arity }) = arity + -- | Return whether there are any argument types for this 'DataCon's original source type -- See Note [DataCon arities] isNullarySrcDataCon :: DataCon -> Bool From git at git.haskell.org Sat Oct 1 21:00:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:00:41 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (c172582) Message-ID: <20161001210041.A5A473A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/c1725826af7b892066c551eb207af40231d6a82a/ghc >--------------------------------------------------------------- commit c1725826af7b892066c551eb207af40231d6a82a Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- c1725826af7b892066c551eb207af40231d6a82a compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 11 +++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 49 ++++++++++++++-------- compiler/coreSyn/CoreSyn.hs | 4 ++ compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 3 ++ compiler/coreSyn/PprCore.hs | 4 ++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 4 ++ compiler/specialise/Rules.hs | 2 + compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 25 ++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ 36 files changed, 349 insertions(+), 90 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 c1725826af7b892066c551eb207af40231d6a82a From git at git.haskell.org Sat Oct 1 21:00:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:00:44 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: Lint check to ensure arity matches (a736cb9) Message-ID: <20161001210044.8E3093A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/a736cb9eb9124bc102b5653003a067bdf440e92e/ghc >--------------------------------------------------------------- commit a736cb9eb9124bc102b5653003a067bdf440e92e Author: Joachim Breitner Date: Thu Sep 29 17:41:20 2016 -0400 ConApp: Lint check to ensure arity matches >--------------------------------------------------------------- a736cb9eb9124bc102b5653003a067bdf440e92e compiler/coreSyn/CoreLint.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 502030a..3b1fdf9 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -706,6 +706,8 @@ lintCoreExpr e@(ConApp dc args) when (lf_check_static_ptrs lf && dataConName dc == staticPtrDataConName) $ failWithL $ text "Found StaticPtr nested in an expression: " <+> ppr e + when (length args /= dataConRepFullArity dc) $ + failWithL $ hang (text "Un-saturated data con application") 2 (ppr e) let dc_ty = dataConRepType dc addLoc (AnExpr e) $ foldM lintCoreArg dc_ty args From git at git.haskell.org Sat Oct 1 21:00:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:00:47 +0000 (UTC) Subject: [commit: ghc] wip/T12618: mkCoreConApp: Ensure let/app invariant (9baa076) Message-ID: <20161001210047.6B83C3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/9baa07611e29c5e34a153c3c7b0cba228fb1c36d/ghc >--------------------------------------------------------------- commit 9baa07611e29c5e34a153c3c7b0cba228fb1c36d Author: Joachim Breitner Date: Sat Oct 1 14:02:16 2016 -0400 mkCoreConApp: Ensure let/app invariant This requires case-binding all affected arguments around the whole ConApp application, which is slightly more complicated than the App case. In particular, we need to juggle more than one unique. Therefore, I am adding another class of uniques. >--------------------------------------------------------------- 9baa07611e29c5e34a153c3c7b0cba228fb1c36d compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 27 ++++++++++++++++++++++++--- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 43 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 3861513..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -152,12 +152,13 @@ mkCoreApps orig_fun orig_args mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr mkCoreConApps con args | length args >= dataConRepFullArity con - = mkCoreApps (ConApp con conArgs) extraArgs - -- TODO #12618: Do we need to check needsCaseBinding? + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args where -- TODO #12618: Can there ever be more than dataConRepArity con arguments -- in a type-safe program? - (conArgs, extraArgs) = splitAt (dataConRepFullArity con) args + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) mkCoreConApps con args -- Unsaturated application. TODO #12618 Use wrapper. = mkCoreApps (Var (dataConWorkId con)) args @@ -184,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Sat Oct 1 21:00:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:00:50 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (e6c6550) Message-ID: <20161001210050.6B8B33A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/e6c65509594f4f2ef97862558ff43acf12e50e14/ghc >--------------------------------------------------------------- commit e6c65509594f4f2ef97862558ff43acf12e50e14 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- e6c65509594f4f2ef97862558ff43acf12e50e14 compiler/coreSyn/MkCore.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..3861513 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,17 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = mkCoreApps (ConApp con conArgs) extraArgs + -- TODO #12618: Do we need to check needsCaseBinding? + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (conArgs, extraArgs) = splitAt (dataConRepFullArity con) args +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), From git at git.haskell.org Sat Oct 1 21:33:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:22 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcSMonad: Introduce tcLookupId (08c0a50) Message-ID: <20161001213322.4BA9A3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/08c0a5098a5bcb897375e4b873b761b70184c367/ghc >--------------------------------------------------------------- commit 08c0a5098a5bcb897375e4b873b761b70184c367 Author: Ben Gamari Date: Sun Jan 31 17:42:57 2016 +0100 TcSMonad: Introduce tcLookupId >--------------------------------------------------------------- 08c0a5098a5bcb897375e4b873b761b70184c367 compiler/typecheck/TcSMonad.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index fb03ec2..c6b92a9 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -43,7 +43,7 @@ module TcSMonad ( getTopEnv, getGblEnv, getLclEnv, getTcEvBinds, getTcEvBindsFromVar, getTcLevel, getTcEvBindsMap, - tcLookupClass, + tcLookupClass, tcLookupId, -- Inerts InertSet(..), InertCans(..), @@ -122,7 +122,7 @@ import FamInstEnv import qualified TcRnMonad as TcM import qualified TcMType as TcM import qualified TcEnv as TcM - ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass ) + ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass, tcLookupId ) import Kind import TcType import DynFlags @@ -2732,6 +2732,9 @@ getLclEnv = wrapTcS $ TcM.getLclEnv tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c +tcLookupId :: Name -> TcS Id +tcLookupId n = wrapTcS $ TcM.tcLookupId 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 Sat Oct 1 21:33:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:24 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: HACK: CoreLint: Kill unsaturated unlifted types check (122da81) Message-ID: <20161001213324.F0A423A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/122da81a3d0195f143d00b7966df50e4774dc30a/ghc >--------------------------------------------------------------- commit 122da81a3d0195f143d00b7966df50e4774dc30a Author: Ben Gamari Date: Sat Jan 30 19:53:05 2016 +0100 HACK: CoreLint: Kill unsaturated unlifted types check >--------------------------------------------------------------- 122da81a3d0195f143d00b7966df50e4774dc30a compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 74f8a61..f4c0646 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1084,7 +1084,7 @@ lintType ty@(TyConApp tc tys) = lintType ty' -- Expand type synonyms, so that we do not bogusly complain -- about un-saturated type synonyms - | isUnliftedTyCon tc || isTypeSynonymTyCon tc || isTypeFamilyTyCon tc + | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc -- Also type synonyms and type families , length tys < tyConArity tc = failWithL (hang (text "Un-saturated type application") 2 (ppr ty)) From git at git.haskell.org Sat Oct 1 21:33:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:27 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: CoreLint: Improve debug output (f11a313) Message-ID: <20161001213327.B0D9C3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f11a31346384342fbf32a3710c71a4a8b3ad3f1c/ghc >--------------------------------------------------------------- commit f11a31346384342fbf32a3710c71a4a8b3ad3f1c Author: Ben Gamari Date: Sun Jan 31 21:35:20 2016 +0100 CoreLint: Improve debug output >--------------------------------------------------------------- f11a31346384342fbf32a3710c71a4a8b3ad3f1c compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index f4c0646..b5ecb58 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -860,7 +860,7 @@ lintTyKind tyvar arg_ty -- and then apply it to both boxed and unboxed types. = do { arg_kind <- lintType arg_ty ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "xx" <+> ppr arg_kind))) } + (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } where tyvar_kind = tyVarKind tyvar From git at git.haskell.org Sat Oct 1 21:33:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:30 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix rebase (4579316) Message-ID: <20161001213330.743753A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4579316af47390b4188fa0f199251d338dbcaf9a/ghc >--------------------------------------------------------------- commit 4579316af47390b4188fa0f199251d338dbcaf9a Author: Ben Gamari Date: Fri Mar 11 17:23:30 2016 +0100 Fix rebase >--------------------------------------------------------------- 4579316af47390b4188fa0f199251d338dbcaf9a compiler/prelude/PrelNames.hs | 38 +++++++++++++-------------- compiler/typecheck/TcInteract.hs | 14 +++++----- libraries/base/Data/Typeable/Internal.hs | 44 ++++++++++++++++---------------- 3 files changed, 48 insertions(+), 48 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 4579316af47390b4188fa0f199251d338dbcaf9a From git at git.haskell.org Sat Oct 1 21:33:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:33 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add quick compatibility note (724c585) Message-ID: <20161001213333.23C543A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/724c5853c18e20b45a3c6a28b836dd707e753566/ghc >--------------------------------------------------------------- commit 724c5853c18e20b45a3c6a28b836dd707e753566 Author: Ben Gamari Date: Fri Mar 11 17:32:13 2016 +0100 Add quick compatibility note >--------------------------------------------------------------- 724c5853c18e20b45a3c6a28b836dd707e753566 libraries/base/Data/Typeable.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index f33ac48..486c5b8 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -28,6 +28,11 @@ -- -- == Compatibility Notes -- +-- Since GHC 8.2, GHC has supported type-indexed type representations. +-- "Data.Typeable" provides type representations which are qualified over this +-- index, providing an interface very similar to the "Typeable" notion seen in +-- previous releases. For the type-indexed interface, see "Data.Reflection". +-- -- Since GHC 7.8, 'Typeable' is poly-kinded. The changes required for this might -- break some old programs involving 'Typeable'. More details on this, including -- how to fix your code, can be found on the From git at git.haskell.org Sat Oct 1 21:33:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:36 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Start implementing library side of TTypeable (6bf102c) Message-ID: <20161001213336.7C1F13A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6bf102c4693eb238970208e23c1a1a51f833d3a1/ghc >--------------------------------------------------------------- commit 6bf102c4693eb238970208e23c1a1a51f833d3a1 Author: Ben Gamari Date: Sat Jan 30 00:04:54 2016 +0100 Start implementing library side of TTypeable >--------------------------------------------------------------- 6bf102c4693eb238970208e23c1a1a51f833d3a1 compiler/deSugar/DsBinds.hs | 79 +++-- compiler/prelude/PrelNames.hs | 72 +++-- compiler/typecheck/TcEvidence.hs | 20 +- compiler/typecheck/TcHsSyn.hs | 8 +- compiler/typecheck/TcInteract.hs | 65 +++- compiler/utils/Binary.hs | 55 +++- libraries/Win32 | 2 +- libraries/array | 2 +- libraries/base/Data/Dynamic.hs | 51 +-- libraries/base/Data/Type/Equality.hs | 6 + libraries/base/Data/Typeable.hs | 192 ++++++++---- libraries/base/Data/Typeable/Internal.hs | 518 +++++++++++++++++-------------- libraries/base/GHC/Conc/Sync.hs | 4 - libraries/base/GHC/Show.hs | 2 +- libraries/base/Type/Reflection.hs | 43 +++ libraries/base/Type/Reflection/Unsafe.hs | 20 ++ libraries/base/base.cabal | 4 +- libraries/binary | 2 +- libraries/bytestring | 2 +- libraries/deepseq | 2 +- libraries/directory | 2 +- libraries/ghc-boot/GHC/Serialized.hs | 16 +- libraries/ghc-prim/GHC/Types.hs | 15 +- libraries/ghci/GHCi/TH/Binary.hs | 57 ++++ libraries/haskeline | 2 +- libraries/hpc | 2 +- libraries/pretty | 2 +- libraries/time | 2 +- libraries/unix | 2 +- nofib | 2 +- utils/haddock | 2 +- utils/hsc2hs | 2 +- 32 files changed, 810 insertions(+), 445 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 6bf102c4693eb238970208e23c1a1a51f833d3a1 From git at git.haskell.org Sat Oct 1 21:33:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:39 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Various fixes (2f2e044) Message-ID: <20161001213339.3148A3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2f2e044b3d3e06fb0527292302b8079a0468e88e/ghc >--------------------------------------------------------------- commit 2f2e044b3d3e06fb0527292302b8079a0468e88e Author: Ben Gamari Date: Fri Mar 11 19:16:55 2016 +0100 Various fixes >--------------------------------------------------------------- 2f2e044b3d3e06fb0527292302b8079a0468e88e compiler/utils/Binary.hs | 6 +++--- libraries/ghci/GHCi/TH/Binary.hs | 14 +++++++------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index db70b04..92997b9 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -81,7 +81,7 @@ import Data.Time #if MIN_VERSION_base(4,9,0) import Type.Reflection import Type.Reflection.Unsafe -import GHC.Exts ( TYPE, Levity(..) ) +import Data.Kind (Type) #else import Data.Typeable #endif @@ -605,7 +605,7 @@ getTypeRepX bh = do case tag of 0 -> do con <- get bh TypeRepX rep_k <- getTypeRepX bh - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep (TYPE 'Lifted)) + Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) pure $ TypeRepX $ mkTrCon con rep_k 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh @@ -619,7 +619,7 @@ instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep get bh = do TypeRepX rep <- getTypeRepX bh - case rep `eqTypeRep` typeRep of + case rep `eqTypeRep` (typeRep :: TypeRep a) of Just HRefl -> pure rep Nothing -> fail "Binary: Type mismatch" diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 7851e33..2a8432b 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,10 +14,10 @@ import qualified Data.ByteString as B import Control.Monad (when) import Type.Reflection import Type.Reflection.Unsafe +import Data.Kind (Type) #else import Data.Typeable #endif -import GHC.Exts (TYPE, Levity(..)) import GHC.Serialized import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -97,11 +97,11 @@ getTypeRepX = do tag <- get :: Get Word8 case tag of 0 -> do con <- get :: Get TyCon - TypeRep rep_k <- getTypeRepX - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep (TYPE 'Lifted)) + TypeRepX rep_k <- getTypeRepX + Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) pure $ TypeRepX $ mkTrCon con rep_k - 1 -> do TypeRep f <- getTypeRepX - TypeRep x <- getTypeRepX + 1 -> do TypeRepX f <- getTypeRepX + TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> do Just HRefl <- pure $ eqTypeRep arg x @@ -112,13 +112,13 @@ instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep get = do TypeRepX rep <- getTypeRepX - case rep `eqTypeRep` typeRef of + case rep `eqTypeRep` (typeRep :: TypeRep a) of Just HRefl -> pure rep Nothing -> fail "Binary: Type mismatch" instance Binary TypeRepX where put (TypeRepX rep) = putTypeRep rep - get = getTypeRep + get = getTypeRepX #else instance Binary TyCon where put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) From git at git.haskell.org Sat Oct 1 21:33:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:41 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: More serialization (41612a8) Message-ID: <20161001213341.D29053A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/41612a8de1c29dd9130e0ed2ca5c62bf92b1b726/ghc >--------------------------------------------------------------- commit 41612a8de1c29dd9130e0ed2ca5c62bf92b1b726 Author: Ben Gamari Date: Wed Mar 16 10:33:37 2016 +0100 More serialization >--------------------------------------------------------------- 41612a8de1c29dd9130e0ed2ca5c62bf92b1b726 compiler/utils/Binary.hs | 14 +++++++++----- libraries/base/Data/Typeable.hs | 20 +++++++++++++------- libraries/ghci/GHCi/TH/Binary.hs | 13 ++++++++----- 3 files changed, 30 insertions(+), 17 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 1fbe19a..d0cbae5 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -598,12 +598,13 @@ putTypeRep bh (TRApp f x) = do put_ bh (1 :: Word8) putTypeRep bh f putTypeRep bh x +putTypeRep _ _ = fail "putTypeRep: Impossible" getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> do con <- get bh + 0 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k @@ -613,10 +614,13 @@ getTypeRepX bh = do TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + case (typeRep :: TypeRep Type) `eqTypeRep` arg of + Just HRefl -> -- FIXME: Generalize (->) + case x `eqTypeRep` arg of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + Nothing -> fail "getTypeRepX: Arrow of non-Type argument" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "Binary: Invalid TypeRepX" diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 7718cf3..21f93d2 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -154,13 +154,19 @@ typeRepTyCon = I.typeRepXTyCon -- represents a function of type @t -> u@ and the second argument represents a -- function of type @t at . Otherwise, returns @Nothing at . funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep -funResultTy (I.TypeRepX f) (I.TypeRepX x) - | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f - , I.TRFun arg res <- f - , Just HRefl <- arg `I.eqTypeRep` x - = Just (I.TypeRepX res) - | otherwise - = Nothing +{- +funResultTy (I.TypeRepX f) (I.TypeRepX x) = + case (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f of + Just HRefl -> + case f of + I.TRFun arg res -> + case arg `I.eqTypeRep` x of + Just HRefl -> Just (I.TypeRepX res) + Nothing -> Nothing + _ -> Nothing + Nothing -> Nothing +-} +funResultTy _ _ = Nothing -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 7ecc746..8d297a1 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -11,7 +11,6 @@ module GHCi.TH.Binary () where import Data.Binary import qualified Data.ByteString as B #if MIN_VERSION_base(4,9,0) -import Control.Monad (when) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -91,6 +90,7 @@ putTypeRep (TRApp f x) = do put (1 :: Word8) putTypeRep f putTypeRep x +putTypeRep _ = fail "putTypeRep: Impossible" getTypeRepX :: Get TypeRepX getTypeRepX = do @@ -106,10 +106,13 @@ getTypeRepX = do TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + case (typeRep :: TypeRep Type) `eqTypeRep` arg of + Just HRefl -> -- FIXME: Generalize (->) + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Arrow of non-Type argument" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" From git at git.haskell.org Sat Oct 1 21:33:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:44 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Binary: More explicit pattern matching (1c0a5fd) Message-ID: <20161001213344.8496F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/1c0a5fde1399f3d3c00aed58558fb6729d3fa02a/ghc >--------------------------------------------------------------- commit 1c0a5fde1399f3d3c00aed58558fb6729d3fa02a Author: Ben Gamari Date: Wed Mar 16 09:40:54 2016 +0100 Binary: More explicit pattern matching >--------------------------------------------------------------- 1c0a5fde1399f3d3c00aed58558fb6729d3fa02a compiler/utils/Binary.hs | 9 ++++++--- libraries/ghci/GHCi/TH/Binary.hs | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index dadca68..1fbe19a 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -612,9 +612,12 @@ getTypeRepX bh = do 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of - TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + TRFun arg _ -> + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "Binary: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 9a4d314..7ecc746 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -105,9 +105,12 @@ getTypeRepX = do 1 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of - TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + TRFun arg _ -> + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where From git at git.haskell.org Sat Oct 1 21:33:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:47 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix warnings (ded63e2) Message-ID: <20161001213347.68F123A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ded63e20db30273f8e8db451844e407d0e1414b8/ghc >--------------------------------------------------------------- commit ded63e20db30273f8e8db451844e407d0e1414b8 Author: Ben Gamari Date: Fri Mar 11 17:51:26 2016 +0100 Fix warnings >--------------------------------------------------------------- ded63e20db30273f8e8db451844e407d0e1414b8 libraries/base/Data/Typeable/Internal.hs | 17 ++++++++++++----- libraries/ghc-boot/GHC/Serialized.hs | 1 - 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index c72a6f6..fc425a0 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -68,7 +68,7 @@ module Data.Typeable.Internal ( -- * Construction -- | These are for internal use only - mkTrCon, mkTrApp, mkTyCon, + mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, -- * Representations for primitive types @@ -223,6 +223,7 @@ mkTrCon tc kind = TrTyCon fpr tc kind fpr = fingerprintFingerprints [fpr_tc, fpr_k] -- | Construct a representation for a type application. +-- TODO: Is this necessary? mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) @@ -253,7 +254,7 @@ pattern TRCon con <- TrTyCon _ con _ -- | Splits a type application. splitApp :: TypeRep a -> Maybe (AppResult a) -splitApp (TrTyCon _ a _) = Nothing +splitApp (TrTyCon _ _ _) = Nothing splitApp (TrApp _ f x) = Just $ App f x ----------------- Observation --------------------- @@ -262,7 +263,9 @@ typeRepKind :: forall k (a :: k). TypeRep a -> TypeRep k typeRepKind (TrTyCon _ _ k) = k typeRepKind (TrApp _ f _) = case typeRepKind f of - TRFun arg res -> res + TRFun _arg res -> res + -- TODO: why is this case needed? + _ -> error "typeRepKind: impossible" -- | Observe the type constructor of a quantified type representation. typeRepXTyCon :: TypeRepX -> TyCon @@ -320,14 +323,17 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t -- | @since 2.01 instance Show (TypeRep a) where - showsPrec p (TrTyCon _ tycon _) = shows tycon - showsPrec p (TrApp _ f x) = shows f . showString " " . shows x + showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec p (TrApp _ f x) = showsPrec p f . showString " " . showsPrec p x + -- TODO: Reconsider precedence -- | @since 4.10.0.0 instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty -- Some (Show.TypeRepX) helpers: +{- +-- FIXME: Handle tuples, etc. showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a @@ -337,6 +343,7 @@ showTuple :: [TypeRepX] -> ShowS showTuple args = showChar '(' . showArgs (showChar ',') args . showChar ')' +-} -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation -- diff --git a/libraries/ghc-boot/GHC/Serialized.hs b/libraries/ghc-boot/GHC/Serialized.hs index 7f86df9..8653049 100644 --- a/libraries/ghc-boot/GHC/Serialized.hs +++ b/libraries/ghc-boot/GHC/Serialized.hs @@ -22,7 +22,6 @@ module GHC.Serialized ( import Data.Bits import Data.Word ( Word8 ) import Data.Data -import Data.Typeable -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types From git at git.haskell.org Sat Oct 1 21:33:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:50 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Implement Data.Typeable.funResultTy (be801fc) Message-ID: <20161001213350.2796D3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/be801fcbabd10919cb6ccb0c122cfd26682229e4/ghc >--------------------------------------------------------------- commit be801fcbabd10919cb6ccb0c122cfd26682229e4 Author: Ben Gamari Date: Tue Mar 15 16:21:58 2016 +0100 Implement Data.Typeable.funResultTy >--------------------------------------------------------------- be801fcbabd10919cb6ccb0c122cfd26682229e4 libraries/base/Data/Typeable.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 486c5b8..7718cf3 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -69,6 +69,9 @@ module Data.Typeable , rnfTypeRep , showsTypeRep + -- * Observing type representations + , funResultTy + -- * Type constructors , I.TyCon -- abstract, instance of: Eq, Show, Typeable -- For now don't export Module to avoid name clashes @@ -147,6 +150,18 @@ gcast2 x = fmap (\Refl -> x) (eqT :: Maybe (t :~: t')) typeRepTyCon :: TypeRep -> TyCon typeRepTyCon = I.typeRepXTyCon +-- | Applies a type to a function type. Returns: @Just u@ if the first argument +-- represents a function of type @t -> u@ and the second argument represents a +-- function of type @t at . Otherwise, returns @Nothing at . +funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep +funResultTy (I.TypeRepX f) (I.TypeRepX x) + | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f + , I.TRFun arg res <- f + , Just HRefl <- arg `I.eqTypeRep` x + = Just (I.TypeRepX res) + | otherwise + = Nothing + -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () rnfTypeRep = I.rnfTypeRepX From git at git.haskell.org Sat Oct 1 21:33:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:52 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix serialization (cd17075) Message-ID: <20161001213352.CFE083A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/cd170751dce19005082e4497168101ccaa3f7d23/ghc >--------------------------------------------------------------- commit cd170751dce19005082e4497168101ccaa3f7d23 Author: Ben Gamari Date: Fri Mar 11 19:23:16 2016 +0100 Fix serialization >--------------------------------------------------------------- cd170751dce19005082e4497168101ccaa3f7d23 compiler/utils/Binary.hs | 12 +++++++----- libraries/ghci/GHCi/TH/Binary.hs | 14 ++++++++------ 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 92997b9..dadca68 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -605,14 +605,16 @@ getTypeRepX bh = do case tag of 0 -> do con <- get bh TypeRepX rep_k <- getTypeRepX bh - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) - pure $ TypeRepX $ mkTrCon con rep_k + case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k + Nothing -> fail "getTypeRepX: Kind mismatch" + 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of - TRFun arg _ -> do - Just HRefl <- pure $ eqTypeRep arg x - pure $ TypeRepX $ mkTrApp f x + TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "Binary: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 2a8432b..9a4d314 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -98,15 +98,17 @@ getTypeRepX = do case tag of 0 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) - pure $ TypeRepX $ mkTrCon con rep_k + case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k + Nothing -> fail "getTypeRepX: Kind mismatch" + 1 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of - TRFun arg _ -> do - Just HRefl <- pure $ eqTypeRep arg x - pure $ TypeRepX $ mkTrApp f x - _ -> fail "Binary: Invalid TTypeRep" + TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep From git at git.haskell.org Sat Oct 1 21:33:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:55 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcInteract: Unused parameter (85a7fe6) Message-ID: <20161001213355.834B83A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/85a7fe6b3222ba501229be6ff0668294106de29e/ghc >--------------------------------------------------------------- commit 85a7fe6b3222ba501229be6ff0668294106de29e Author: Ben Gamari Date: Wed Mar 16 11:04:54 2016 +0100 TcInteract: Unused parameter >--------------------------------------------------------------- 85a7fe6b3222ba501229be6ff0668294106de29e compiler/typecheck/TcInteract.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index a588f3a..f5ef7fa 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2022,7 +2022,7 @@ matchTypeable clas [k,t] -- clas = Typeable | t `eqType` liftedTypeKind = doPrimRep trTYPE'PtrRepLiftedName t | t `eqType` runtimeRepTy = doPrimRep trRuntimeRepName t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] - , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks + , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret | Just (f,kt) <- splitAppTy_maybe t = doTyApp clas t f kt @@ -2057,8 +2057,8 @@ doPrimRep rep_name ty -- kind variables have been instantiated). -- -- TODO: Do we want to encode the applied kinds in the representation? -doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcS LookupInstResult -doTyConApp clas ty tc ks +doTyConApp :: Class -> Type -> TyCon -> TcS LookupInstResult +doTyConApp clas ty tc = return $ GenInst [mk_typeable_pred clas $ typeKind ty] (\[ev] -> EvTypeable ty $ EvTypeableTyCon tc ev) True From git at git.haskell.org Sat Oct 1 21:33:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:33:58 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Message: Import Data.Typeable.TypeRep (709b923) Message-ID: <20161001213358.3B0193A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/709b9233d086b4080bb859239cfba963c868877d/ghc >--------------------------------------------------------------- commit 709b9233d086b4080bb859239cfba963c868877d Author: Ben Gamari Date: Wed Mar 16 10:35:59 2016 +0100 Message: Import Data.Typeable.TypeRep >--------------------------------------------------------------- 709b9233d086b4080bb859239cfba963c868877d libraries/ghci/GHCi/Message.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index 4d0417e..b5558be 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, +{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, CPP, GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} @@ -37,6 +37,10 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic +#if MIN_VERSION_base(4,9,0) +-- Previously this was re-exported by Data.Dynamic +import Data.Typeable (TypeRep) +#endif import Data.IORef import Data.Map (Map) import GHC.Generics From git at git.haskell.org Sat Oct 1 21:34:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:00 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Don't generate bindings for special primitive tycons (9818753) Message-ID: <20161001213400.E8CDA3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/9818753df3ecbbc5199f78681b4c9d46b5f29e23/ghc >--------------------------------------------------------------- commit 9818753df3ecbbc5199f78681b4c9d46b5f29e23 Author: Ben Gamari Date: Wed Mar 16 15:34:03 2016 +0100 TcTypeable: Don't generate bindings for special primitive tycons >--------------------------------------------------------------- 9818753df3ecbbc5199f78681b4c9d46b5f29e23 compiler/typecheck/TcTypeable.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 04d07d1..cb79e08 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -13,7 +13,8 @@ import IfaceEnv( newGlobalBinder ) import TcEnv import TcRnMonad import PrelNames -import TysPrim ( primTyCons ) +import TysPrim ( primTyCons, tYPETyConName, funTyConName ) +import TysWiredIn ( runtimeRepTyCon ) import Id import Type import TyCon @@ -21,6 +22,7 @@ import DataCon import Name( getOccName ) import OccName import Module +import NameSet import HsSyn import DynFlags import Bag @@ -166,6 +168,17 @@ mkTypeableTyConBinds tycons ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv ; return (gbl_env `addTypecheckedBinds` tc_binds) } +-- | The names of the 'TyCon's which we handle explicitly in "Data.Typeable.Internal" +-- and should not generate bindings for in "GHC.Types". +-- +-- See Note [Mutually recursive representations of primitive types] +specialPrimTyCons :: NameSet +specialPrimTyCons = mkNameSet + [ tYPETyConName + , tyConName runtimeRepTyCon + , funTyConName + ] + -- | Generate bindings for the type representation of a wired-in TyCon defined -- by the virtual "GHC.Prim" module. This is where we inject the representation -- bindings for primitive types into "GHC.Types" @@ -209,7 +222,9 @@ ghcPrimTypeableBinds stuff where all_prim_tys :: [TyCon] all_prim_tys = [ tc' | tc <- funTyCon : primTyCons - , tc' <- tc : tyConATs tc ] + , tc' <- tc : tyConATs tc + , not $ tyConName tc' `elemNameSet` specialPrimTyCons + ] mkBind :: TyCon -> LHsBinds Id mkBind = mk_typeable_binds stuff From git at git.haskell.org Sat Oct 1 21:34:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:03 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Another recursive serialization case (01820df) Message-ID: <20161001213403.9D5E03A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/01820df734a204f1e824547ac1c39178cb0c97b8/ghc >--------------------------------------------------------------- commit 01820df734a204f1e824547ac1c39178cb0c97b8 Author: Ben Gamari Date: Wed Mar 16 14:05:43 2016 +0100 Another recursive serialization case >--------------------------------------------------------------- 01820df734a204f1e824547ac1c39178cb0c97b8 compiler/utils/Binary.hs | 14 +++++++++----- libraries/ghci/GHCi/TH/Binary.hs | 14 +++++++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 366fb26..23b90f5 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -591,19 +591,22 @@ instance Binary TyCon where #if MIN_VERSION_base(4,9,0) putTypeRep :: BinHandle -> TypeRep a -> IO () --- Special handling for Type and RuntimeRep due to recursive kind relations. +-- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep bh rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put_ bh (1 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->)) + = put_ bh (2 :: Word8) putTypeRep bh rep@(TRCon con) = do - put_ bh (2 :: Word8) + put_ bh (3 :: Word8) put_ bh con putTypeRep bh (typeRepKind rep) putTypeRep bh (TRApp f x) = do - put_ bh (3 :: Word8) + put_ bh (4 :: Word8) putTypeRep bh f putTypeRep bh x putTypeRep _ _ = fail "putTypeRep: Impossible" @@ -614,13 +617,14 @@ getTypeRepX bh = do case tag of 0 -> return $ TypeRepX (typeRep :: TypeRep Type) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) - 2 -> do con <- get bh :: IO TyCon + 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) + 3 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 3 -> do TypeRepX f <- getTypeRepX bh + 4 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index bcf58bb..c351cd1 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -83,19 +83,22 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put --- Special handling for Type and RuntimeRep due to recursive kind relations. +-- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put (1 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->)) + = put (2 :: Word8) putTypeRep rep@(TRCon con) = do - put (2 :: Word8) + put (3 :: Word8) put con putTypeRep (typeRepKind rep) putTypeRep (TRApp f x) = do - put (3 :: Word8) + put (4 :: Word8) putTypeRep f putTypeRep x putTypeRep _ = fail "putTypeRep: Impossible" @@ -106,13 +109,14 @@ getTypeRepX = do case tag of 0 -> return $ TypeRepX (typeRep :: TypeRep Type) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) - 2 -> do con <- get :: Get TyCon + 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) + 3 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 3 -> do TypeRepX f <- getTypeRepX + 4 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> From git at git.haskell.org Sat Oct 1 21:34:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Break recursive loop in serialization (bab42dd) Message-ID: <20161001213406.585DD3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/bab42dd75c453979360640db10b56dd8984eec4e/ghc >--------------------------------------------------------------- commit bab42dd75c453979360640db10b56dd8984eec4e Author: Ben Gamari Date: Wed Mar 16 13:01:45 2016 +0100 Break recursive loop in serialization >--------------------------------------------------------------- bab42dd75c453979360640db10b56dd8984eec4e compiler/utils/Binary.hs | 18 ++++++++++++++---- libraries/ghci/GHCi/TH/Binary.hs | 18 ++++++++++++++---- 2 files changed, 28 insertions(+), 8 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index c5fc8cb..366fb26 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -82,6 +82,7 @@ import Data.Time import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) +import GHC.Exts (RuntimeRep) #else import Data.Typeable #endif @@ -590,12 +591,19 @@ instance Binary TyCon where #if MIN_VERSION_base(4,9,0) putTypeRep :: BinHandle -> TypeRep a -> IO () +-- Special handling for Type and RuntimeRep due to recursive kind relations. +-- See Note [Mutually recursive representations of primitive types] +putTypeRep bh rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put_ bh (0 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) + = put_ bh (1 :: Word8) putTypeRep bh rep@(TRCon con) = do - put_ bh (0 :: Word8) + put_ bh (2 :: Word8) put_ bh con putTypeRep bh (typeRepKind rep) putTypeRep bh (TRApp f x) = do - put_ bh (1 :: Word8) + put_ bh (3 :: Word8) putTypeRep bh f putTypeRep bh x putTypeRep _ _ = fail "putTypeRep: Impossible" @@ -604,13 +612,15 @@ getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> do con <- get bh :: IO TyCon + 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) + 2 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 1 -> do TypeRepX f <- getTypeRepX bh + 3 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 573a9e4..bcf58bb 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,6 +14,7 @@ import qualified Data.ByteString as B import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) +import GHC.Exts (RuntimeRep) #else import Data.Typeable #endif @@ -82,12 +83,19 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put +-- Special handling for Type and RuntimeRep due to recursive kind relations. +-- See Note [Mutually recursive representations of primitive types] +putTypeRep rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put (0 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) + = put (1 :: Word8) putTypeRep rep@(TRCon con) = do - put (0 :: Word8) + put (2 :: Word8) put con putTypeRep (typeRepKind rep) putTypeRep (TRApp f x) = do - put (1 :: Word8) + put (3 :: Word8) putTypeRep f putTypeRep x putTypeRep _ = fail "putTypeRep: Impossible" @@ -96,13 +104,15 @@ getTypeRepX :: Get TypeRepX getTypeRepX = do tag <- get :: Get Word8 case tag of - 0 -> do con <- get :: Get TyCon + 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) + 2 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 1 -> do TypeRepX f <- getTypeRepX + 3 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> From git at git.haskell.org Sat Oct 1 21:34:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:09 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Finally serialization is both general and correct (8a893ff) Message-ID: <20161001213409.1B7EB3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8a893ff81366cd3ff581db54fe94330ae5f2bc54/ghc >--------------------------------------------------------------- commit 8a893ff81366cd3ff581db54fe94330ae5f2bc54 Author: Ben Gamari Date: Wed Mar 16 12:16:20 2016 +0100 Finally serialization is both general and correct >--------------------------------------------------------------- 8a893ff81366cd3ff581db54fe94330ae5f2bc54 compiler/utils/Binary.hs | 13 +++++-------- libraries/ghci/GHCi/TH/Binary.hs | 11 ++++------- 2 files changed, 9 insertions(+), 15 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index d0cbae5..c5fc8cb 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -614,15 +614,12 @@ getTypeRepX bh = do TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> - case (typeRep :: TypeRep Type) `eqTypeRep` arg of - Just HRefl -> -- FIXME: Generalize (->) - case x `eqTypeRep` arg of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - Nothing -> fail "getTypeRepX: Arrow of non-Type argument" + case arg `eqTypeRep` typeRepKind x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "getTypeRepX: Applied non-arrow type" - _ -> fail "Binary: Invalid TypeRepX" + _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 8d297a1..573a9e4 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -106,13 +106,10 @@ getTypeRepX = do TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> - case (typeRep :: TypeRep Type) `eqTypeRep` arg of - Just HRefl -> -- FIXME: Generalize (->) - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - _ -> fail "getTypeRepX: Arrow of non-Type argument" + case arg `eqTypeRep` typeRepKind x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" From git at git.haskell.org Sat Oct 1 21:34:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:11 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix a few TTypeRep references (c02f748) Message-ID: <20161001213411.C2F233A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/c02f74887977ec22ded807ffe7838a54c2580141/ghc >--------------------------------------------------------------- commit c02f74887977ec22ded807ffe7838a54c2580141 Author: Ben Gamari Date: Wed Mar 16 11:51:00 2016 +0100 Fix a few TTypeRep references >--------------------------------------------------------------- c02f74887977ec22ded807ffe7838a54c2580141 compiler/deSugar/DsBinds.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index beca463..4d5561e 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1139,10 +1139,10 @@ type TypeRepExpr = CoreExpr ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr ds_ev_typeable ty (EvTypeableTyCon tc kind_ev) = do { mkTrCon <- dsLookupGlobalId mkTrConName - -- mkTrCon :: forall k (a :: k). TyCon -> TTypeRep k -> TTypeRep a + -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a ; tc_rep <- tyConRep tc -- :: TyCon - ; kind_rep <- getRep kind_ev (typeKind ty) -- :: TTypeRep k + ; kind_rep <- getRep kind_ev (typeKind ty) -- :: TypeRep k -- Note that we use the kind of the type, not the TyCon from which it is -- constructed since the latter may be kind polymorphic whereas the @@ -1173,8 +1173,8 @@ ds_ev_typeable ty (EvTypeableTyLit ev) ty_kind = typeKind ty -- tr_fun is the Name of - -- typeNatTypeRep :: KnownNat a => Proxy# a -> TTypeRep a - -- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TTypeRep a + -- typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep a + -- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a tr_fun | ty_kind `eqType` typeNatKind = typeNatTypeRepName | ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepName | otherwise = panic "dsEvTypeable: unknown type lit kind" @@ -1188,10 +1188,10 @@ ds_ev_typeable ty ev getRep :: EvTerm -- ^ EvTerm for @Typeable ty@ -> Type -- ^ The type @ty@ - -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TTypeRep ty@ + -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@ -- namely @typeRep# dict@ -- Remember that --- typeRep# :: forall k (a::k). Typeable k a -> TTypeRep a +-- typeRep# :: forall k (a::k). Typeable k a -> TypeRep a getRep ev ty = do { typeable_expr <- dsEvTerm ev ; typeRepId <- dsLookupGlobalId typeRepIdName From git at git.haskell.org Sat Oct 1 21:34:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Move special tycons (59ea724) Message-ID: <20161001213414.7BA033A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/59ea72428c70282cd9715b956cb8d37bc56c0018/ghc >--------------------------------------------------------------- commit 59ea72428c70282cd9715b956cb8d37bc56c0018 Author: Ben Gamari Date: Wed Mar 16 17:51:01 2016 +0100 Move special tycons >--------------------------------------------------------------- 59ea72428c70282cd9715b956cb8d37bc56c0018 compiler/prelude/TysPrim.hs | 16 +++++++++++++++- compiler/typecheck/TcTypeable.hs | 18 +++--------------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 7430ec8..b8f57c4 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -31,6 +31,7 @@ module TysPrim( funTyCon, funTyConName, primTyCons, + primTypeableTyCons, charPrimTyCon, charPrimTy, intPrimTyCon, intPrimTy, @@ -81,7 +82,7 @@ module TysPrim( #include "HsVersions.h" import {-# SOURCE #-} TysWiredIn - ( runtimeRepTy, liftedTypeKind + ( runtimeRepTyCon, runtimeRepTy, liftedTypeKind , vecRepDataConTyCon, ptrRepUnliftedDataConTyCon , voidRepDataConTy, intRepDataConTy , wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy @@ -95,6 +96,7 @@ import {-# SOURCE #-} TysWiredIn import Var ( TyVar, mkTyVar ) import Name +import NameEnv import TyCon import SrcLoc import Unique @@ -157,6 +159,18 @@ primTyCons #include "primop-vector-tycons.hs-incl" ] +-- | The names of the 'TyCon's which we define 'Typeable' bindings for +-- explicitly in "Data.Typeable.Internal" +-- and should not generate bindings for in "GHC.Types". +-- +-- See Note [Mutually recursive representations of primitive types] +primTypeableTyCons :: NameEnv TyConRepName +primTypeableTyCons = mkNameEnv + [ (tYPETyConName, trTYPEName) + , (tyConName runtimeRepTyCon, trRuntimeRepName) + , (funTyConName, trArrowName) + ] + mkPrimTc :: FastString -> Unique -> TyCon -> Name mkPrimTc fs unique tycon = mkWiredInName gHC_PRIM (mkTcOccFS fs) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index cb79e08..061d22f 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -13,8 +13,7 @@ import IfaceEnv( newGlobalBinder ) import TcEnv import TcRnMonad import PrelNames -import TysPrim ( primTyCons, tYPETyConName, funTyConName ) -import TysWiredIn ( runtimeRepTyCon ) +import TysPrim ( primTyCons, primTypeableTyCons ) import Id import Type import TyCon @@ -22,7 +21,7 @@ import DataCon import Name( getOccName ) import OccName import Module -import NameSet +import NameEnv import HsSyn import DynFlags import Bag @@ -168,17 +167,6 @@ mkTypeableTyConBinds tycons ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv ; return (gbl_env `addTypecheckedBinds` tc_binds) } --- | The names of the 'TyCon's which we handle explicitly in "Data.Typeable.Internal" --- and should not generate bindings for in "GHC.Types". --- --- See Note [Mutually recursive representations of primitive types] -specialPrimTyCons :: NameSet -specialPrimTyCons = mkNameSet - [ tYPETyConName - , tyConName runtimeRepTyCon - , funTyConName - ] - -- | Generate bindings for the type representation of a wired-in TyCon defined -- by the virtual "GHC.Prim" module. This is where we inject the representation -- bindings for primitive types into "GHC.Types" @@ -223,7 +211,7 @@ ghcPrimTypeableBinds stuff all_prim_tys :: [TyCon] all_prim_tys = [ tc' | tc <- funTyCon : primTyCons , tc' <- tc : tyConATs tc - , not $ tyConName tc' `elemNameSet` specialPrimTyCons + , not $ tyConName tc' `elemNameEnv` primTypeableTyCons ] mkBind :: TyCon -> LHsBinds Id From git at git.haskell.org Sat Oct 1 21:34:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:17 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix recursive fingerprints (0d28ee9) Message-ID: <20161001213417.340393A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0d28ee91e4e388b606fb1030da65fd0ba1056ba3/ghc >--------------------------------------------------------------- commit 0d28ee91e4e388b606fb1030da65fd0ba1056ba3 Author: Ben Gamari Date: Wed Mar 16 11:53:01 2016 +0100 Fix recursive fingerprints >--------------------------------------------------------------- 0d28ee91e4e388b606fb1030da65fd0ba1056ba3 libraries/base/Data/Typeable/Internal.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index fc425a0..0d69f7a 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -434,11 +434,20 @@ For this reason we are forced to define their representations manually. -} +-- | We can't use 'mkTrCon' here as it requires the fingerprint of the kind +-- which is knot-tied. +mkPrimTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a +mkPrimTrCon tc kind = TrTyCon fpr tc kind + where + fpr_tc = tyConFingerprint tc + fpr_tag = fingerprintString "prim" + fpr = fingerprintFingerprints [fpr_tag, fpr_tc] + mkPrimTyCon :: String -> TyCon mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim" trTYPE :: TypeRep TYPE -trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type +trTYPE = mkPrimTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type where runtimeRep_arr :: TypeRep ((->) RuntimeRep) runtimeRep_arr = mkTrApp trArrow trRuntimeRep @@ -447,10 +456,10 @@ trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type runtimeRep_arr_type = mkTrApp runtimeRep_arr star trRuntimeRep :: TypeRep RuntimeRep -trRuntimeRep = mkTrCon (mkPrimTyCon "RuntimeRep") star +trRuntimeRep = mkPrimTrCon (mkPrimTyCon "RuntimeRep") star tr'PtrRepLifted :: TypeRep 'PtrRepLifted -tr'PtrRepLifted = mkTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep +tr'PtrRepLifted = mkPrimTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep trTYPE'PtrRepLifted :: TypeRep (TYPE 'PtrRepLifted) trTYPE'PtrRepLifted = mkTrApp trTYPE tr'PtrRepLifted @@ -459,7 +468,7 @@ trArrowTyCon :: TyCon trArrowTyCon = mkPrimTyCon "->" trArrow :: TypeRep (->) -trArrow = mkTrCon trArrowTyCon star_arr_star_arr_star +trArrow = mkPrimTrCon trArrowTyCon star_arr_star_arr_star -- Some useful aliases star :: TypeRep (TYPE 'PtrRepLifted) From git at git.haskell.org Sat Oct 1 21:34:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:19 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up representation pretty-printer (4f02585) Message-ID: <20161001213419.EC4BF3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4f0258554128f60bc7a727a20af18ecbd6621d29/ghc >--------------------------------------------------------------- commit 4f0258554128f60bc7a727a20af18ecbd6621d29 Author: Ben Gamari Date: Wed Mar 16 13:36:30 2016 +0100 Fix up representation pretty-printer >--------------------------------------------------------------- 4f0258554128f60bc7a727a20af18ecbd6621d29 libraries/base/Data/Typeable/Internal.hs | 44 +++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 11612fd..ce028e3 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -321,29 +321,49 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- -- | @since 2.01 -instance Show (TypeRep a) where +instance Show (TypeRep (a :: k)) where + showsPrec _ rep + | isListTyCon tc, [ty] <- tys = + showChar '[' . shows ty . showChar ']' + | isTupleTyCon tc = + showChar '(' . showArgs (showChar ',') tys . showChar ')' + where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon - showsPrec p (TrApp _ f x) = showsPrec p f . showString " " . showsPrec p x - -- TODO: Reconsider precedence + showsPrec p (TrApp _ f x) + | Just HRefl <- f `eqTypeRep` (typeRep :: TypeRep (->)) = + shows x . showString " -> " + | otherwise = + showsPrec p f . space . showParen need_parens (showsPrec 10 x) + where + space = showChar ' ' + need_parens = case x of + TrApp {} -> True + TrTyCon {} -> False -- | @since 4.10.0.0 instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty --- Some (Show.TypeRepX) helpers: -{- --- FIXME: Handle tuples, etc. +splitApps :: TypeRep a -> (TyCon, [TypeRepX]) +splitApps = go [] + where + go :: [TypeRepX] -> TypeRep a -> (TyCon, [TypeRepX]) + go xs (TrTyCon _ tc _) = (tc, xs) + go xs (TrApp _ f x) = go (TypeRepX x : xs) f + +isListTyCon :: TyCon -> Bool +isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) + +isTupleTyCon :: TyCon -> Bool +isTupleTyCon tc + | ('(':',':_) <- tyConName tc = True + | otherwise = False + showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as -showTuple :: [TypeRepX] -> ShowS -showTuple args = showChar '(' - . showArgs (showChar ',') args - . showChar ')' --} - -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation -- -- @since 4.8.0.0 From git at git.haskell.org Sat Oct 1 21:34:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:22 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill todo (c06f90d) Message-ID: <20161001213422.AC4813A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/c06f90dca8519d67f081e6ff154d02e4b638824c/ghc >--------------------------------------------------------------- commit c06f90dca8519d67f081e6ff154d02e4b638824c Author: Ben Gamari Date: Wed Mar 16 13:36:24 2016 +0100 Kill todo >--------------------------------------------------------------- c06f90dca8519d67f081e6ff154d02e4b638824c libraries/base/Data/Typeable/Internal.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 0d69f7a..11612fd 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -264,8 +264,7 @@ typeRepKind (TrTyCon _ _ k) = k typeRepKind (TrApp _ f _) = case typeRepKind f of TRFun _arg res -> res - -- TODO: why is this case needed? - _ -> error "typeRepKind: impossible" + _ -> error "typeRepKind: impossible" -- | Observe the type constructor of a quantified type representation. typeRepXTyCon :: TypeRepX -> TyCon From git at git.haskell.org Sat Oct 1 21:34:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:25 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Accept easy test output (054318e) Message-ID: <20161001213425.60C993A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/054318ec6f6b901883d6a135e379068f87efade3/ghc >--------------------------------------------------------------- commit 054318ec6f6b901883d6a135e379068f87efade3 Author: Ben Gamari Date: Wed Mar 16 22:58:53 2016 +0100 Accept easy test output >--------------------------------------------------------------- 054318ec6f6b901883d6a135e379068f87efade3 testsuite/tests/ghci.debugger/scripts/print019.stderr | 6 +++--- testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index cc62fa1..c266bc8 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -5,10 +5,10 @@ Use :print or :force to determine these types Relevant bindings include it :: a1 (bound at :10:1) These potential instances exist: - instance Show TypeRep -- Defined in ‘Data.Typeable.Internal’ instance Show Ordering -- Defined in ‘GHC.Show’ instance Show TyCon -- Defined in ‘GHC.Show’ - ...plus 30 others - ...plus 10 instances involving out-of-scope types + instance Show Integer -- Defined in ‘GHC.Show’ + ...plus 29 others + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index e6e637c..b48d63f 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -1,13 +1,13 @@ TcStaticPointersFail02.hs:9:6: error: - • No instance for (Data.Typeable.Internal.Typeable b) + • No instance for (base-4.9.0.0:Data.Typeable.Internal.Typeable b) arising from a static form • In the expression: static (undefined :: (forall a. a -> a) -> b) In an equation for ‘f1’: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - • No instance for (Data.Typeable.Internal.Typeable + • No instance for (base-4.9.0.0:Data.Typeable.Internal.Typeable (Monad m => a -> m a)) arising from a static form (maybe you haven't applied a function to enough arguments?) From git at git.haskell.org Sat Oct 1 21:34:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:28 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: More test fixes (94572f7) Message-ID: <20161001213428.274193A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/94572f72784e4ed6b236861651223343ee7e17e4/ghc >--------------------------------------------------------------- commit 94572f72784e4ed6b236861651223343ee7e17e4 Author: Ben Gamari Date: Wed Mar 16 23:15:48 2016 +0100 More test fixes >--------------------------------------------------------------- 94572f72784e4ed6b236861651223343ee7e17e4 libraries/base/tests/dynamic002.hs | 5 +++++ libraries/base/tests/dynamic004.hs | 1 - 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/tests/dynamic002.hs b/libraries/base/tests/dynamic002.hs index 6d53d2e..fff14ec 100644 --- a/libraries/base/tests/dynamic002.hs +++ b/libraries/base/tests/dynamic002.hs @@ -1,7 +1,12 @@ +{-# LANGUAGE CPP #-} + -- !!! Testing Typeable instances module Main(main) where import Data.Dynamic +#if MIN_VERSION_base(4,9,0) +import Data.Typeable (TypeCon, TypeRep) +#endif import Data.Array import Data.Array.MArray import Data.Array.ST diff --git a/libraries/base/tests/dynamic004.hs b/libraries/base/tests/dynamic004.hs index e6b7a82..2091646 100644 --- a/libraries/base/tests/dynamic004.hs +++ b/libraries/base/tests/dynamic004.hs @@ -1,7 +1,6 @@ module Main where import Data.Typeable -import Data.Typeable.Internal import GHC.Fingerprint import Text.Printf From git at git.haskell.org Sat Oct 1 21:34:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:30 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Inline space (1b7d4be) Message-ID: <20161001213430.CF8B03A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/1b7d4be261460fa5c73448bf0ea671a053ec8774/ghc >--------------------------------------------------------------- commit 1b7d4be261460fa5c73448bf0ea671a053ec8774 Author: Ben Gamari Date: Wed Mar 16 22:10:16 2016 +0100 Inline space >--------------------------------------------------------------- 1b7d4be261460fa5c73448bf0ea671a053ec8774 libraries/base/Data/Typeable/Internal.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index f671f0b..8e1c565 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -340,10 +340,8 @@ instance Show (TypeRep (a :: k)) where | otherwise = showParen (p > 9) $ showsPrec 8 f . - space . + showChar ' ' . showsPrec 9 x - where - space = showChar ' ' -- | @since 4.10.0.0 instance Show TypeRepX where From git at git.haskell.org Sat Oct 1 21:34:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:33 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix primitive types (da824f2) Message-ID: <20161001213433.897263A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/da824f2e5fe3c16ce001d921aab2bb7edbc18866/ghc >--------------------------------------------------------------- commit da824f2e5fe3c16ce001d921aab2bb7edbc18866 Author: Ben Gamari Date: Wed Mar 16 19:52:17 2016 +0100 Fix primitive types >--------------------------------------------------------------- da824f2e5fe3c16ce001d921aab2bb7edbc18866 compiler/prelude/TysPrim.hs | 2 +- compiler/typecheck/TcInteract.hs | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index b8f57c4..f5c80ca 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -24,7 +24,7 @@ module TysPrim( openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, -- Kind constructors... - tYPETyConName, unliftedTypeKindTyConName, + tYPETyCon, tYPETyConName, unliftedTypeKindTyConName, -- Kinds tYPE, diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index f5ef7fa..8282312 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -24,10 +24,10 @@ import Name import PrelNames ( knownNatClassName, knownSymbolClassName, typeableClassName, coercibleTyConKey, heqTyConKey, ipClassKey, - trTYPE'PtrRepLiftedName, trRuntimeRepName, trArrowName ) + trTYPEName, trTYPE'PtrRepLiftedName, trRuntimeRepName, trArrowName ) import TysWiredIn ( typeNatKind, typeSymbolKind, heqDataCon, coercibleDataCon, runtimeRepTy ) -import TysPrim ( eqPrimTyCon, eqReprPrimTyCon ) +import TysPrim ( eqPrimTyCon, eqReprPrimTyCon, tYPETyCon ) import Id( idType ) import CoAxiom ( Eqn, CoAxiom(..), CoAxBranch(..), fromBranches ) import Class @@ -2020,7 +2020,9 @@ matchTypeable clas [k,t] -- clas = Typeable | k `eqType` typeNatKind = doTyLit knownNatClassName t | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t | t `eqType` liftedTypeKind = doPrimRep trTYPE'PtrRepLiftedName t + | t `eqType` mkTyConTy tYPETyCon = doPrimRep trTYPEName t | t `eqType` runtimeRepTy = doPrimRep trRuntimeRepName t + | t `eqType` mkTyConTy funTyCon = doPrimRep trArrowName t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret From git at git.haskell.org Sat Oct 1 21:34:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:36 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Internal things (55e057e) Message-ID: <20161001213436.3EF3E3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/55e057e3fb2f478402a599c234c3ebcab8da5392/ghc >--------------------------------------------------------------- commit 55e057e3fb2f478402a599c234c3ebcab8da5392 Author: Ben Gamari Date: Wed Mar 16 17:51:27 2016 +0100 Internal things >--------------------------------------------------------------- 55e057e3fb2f478402a599c234c3ebcab8da5392 libraries/base/Data/Typeable/Internal.hs | 35 ++++++++++++++++++++++++++------ libraries/base/Type/Reflection.hs | 1 + 2 files changed, 30 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index ce028e3..d879905 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -71,6 +71,8 @@ module Data.Typeable.Internal ( mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, + debugShow, + -- * Representations for primitive types trTYPE, trTYPE'PtrRepLifted, @@ -320,6 +322,22 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- +debugShow :: TypeRep a -> String +debugShow rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = "Type" + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = "RuntimeRep" + | (tc, _) <- splitApps rep + , isArrowTyCon tc = "Arrow" +debugShow (TrApp _ f x) = "App ("++debugShow f++") ("++debugShow x++")" +debugShow (TrTyCon _ x k) + | isArrowTyCon x = "Arrow" + | "->" <- show x = "Arrow #" ++ show ( tyConFingerprint x + , tyConFingerprint trArrowTyCon + , tyConFingerprint $ typeRepTyCon (typeRep :: TypeRep (->)) + , typeRepTyCon (typeRep :: TypeRep (->)) + ) + | otherwise = show x++" :: "++debugShow k + -- | @since 2.01 instance Show (TypeRep (a :: k)) where showsPrec _ rep @@ -329,16 +347,18 @@ instance Show (TypeRep (a :: k)) where showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec _ (TrApp _ (TrTyCon _ tycon _) x) + | isArrowTyCon tycon = + shows x . showString " ->" + showsPrec p (TrApp _ f x) - | Just HRefl <- f `eqTypeRep` (typeRep :: TypeRep (->)) = - shows x . showString " -> " | otherwise = - showsPrec p f . space . showParen need_parens (showsPrec 10 x) + showParen (p > 9) $ + showsPrec p f . + space . + showsPrec 9 x where space = showChar ' ' - need_parens = case x of - TrApp {} -> True - TrTyCon {} -> False -- | @since 4.10.0.0 instance Show TypeRepX where @@ -351,6 +371,9 @@ splitApps = go [] go xs (TrTyCon _ tc _) = (tc, xs) go xs (TrApp _ f x) = go (TypeRepX x : xs) f +isArrowTyCon :: TyCon -> Bool +isArrowTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep (->)) + isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 8057a2e..480e148 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -37,6 +37,7 @@ module Type.Reflection , I.tyConModule , I.tyConName , I.rnfTyCon + , I.debugShow ) where import qualified Data.Typeable.Internal as I From git at git.haskell.org Sat Oct 1 21:34:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:38 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill debugShow (7661ba2) Message-ID: <20161001213438.E631C3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/7661ba2290146174222c75d4119b37066cd96241/ghc >--------------------------------------------------------------- commit 7661ba2290146174222c75d4119b37066cd96241 Author: Ben Gamari Date: Wed Mar 16 22:08:49 2016 +0100 Kill debugShow >--------------------------------------------------------------- 7661ba2290146174222c75d4119b37066cd96241 libraries/base/Data/Typeable/Internal.hs | 19 ------------------- libraries/base/Type/Reflection.hs | 1 - 2 files changed, 20 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index a2431ac..f671f0b 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -71,8 +71,6 @@ module Data.Typeable.Internal ( mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, - debugShow, - -- * Representations for primitive types trTYPE, trTYPE'PtrRepLifted, @@ -322,23 +320,6 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- -debugShow :: TypeRep a -> String -debugShow rep - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = "Type" - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = "RuntimeRep" - | (tc, _) <- splitApps rep - , isArrowTyCon tc = "Arrow" -debugShow (TrApp _ f x) = "App ("++debugShow f++") ("++debugShow x++")" -debugShow (TrTyCon _ x k) - | isArrowTyCon x = "Arrow" - | "->" <- show x = "Arrow #" ++ show ( tyConFingerprint x - , tyConFingerprint trArrowTyCon - , tyConFingerprint $ typeRepTyCon (typeRep :: TypeRep (->)) - , typeRepTyCon (typeRep :: TypeRep (->)) - ) - | otherwise = show x++" :: "++debugShow k - --- | @since 2.01 instance Show (TypeRep (a :: k)) where showsPrec _ rep | isListTyCon tc, [ty] <- tys = diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 480e148..8057a2e 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -37,7 +37,6 @@ module Type.Reflection , I.tyConModule , I.tyConName , I.rnfTyCon - , I.debugShow ) where import qualified Data.Typeable.Internal as I From git at git.haskell.org Sat Oct 1 21:34:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:41 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix pretty-printer (8ff0010) Message-ID: <20161001213441.9A3F03A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8ff0010ef16f81cf8ac39548f3e90948bb661940/ghc >--------------------------------------------------------------- commit 8ff0010ef16f81cf8ac39548f3e90948bb661940 Author: Ben Gamari Date: Wed Mar 16 22:07:23 2016 +0100 Fix pretty-printer >--------------------------------------------------------------- 8ff0010ef16f81cf8ac39548f3e90948bb661940 libraries/base/Data/Typeable/Internal.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index d879905..a2431ac 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -347,14 +347,18 @@ instance Show (TypeRep (a :: k)) where showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon - showsPrec _ (TrApp _ (TrTyCon _ tycon _) x) + --showsPrec p (TRFun x r) = + -- showParen (p > 8) $ + -- showsPrec 9 x . showString " -> " . showsPrec 8 r + showsPrec p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) | isArrowTyCon tycon = - shows x . showString " ->" + showParen (p > 8) $ + showsPrec 9 x . showString " -> " . showsPrec p r showsPrec p (TrApp _ f x) | otherwise = showParen (p > 9) $ - showsPrec p f . + showsPrec 8 f . space . showsPrec 9 x where From git at git.haskell.org Sat Oct 1 21:34:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:44 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add mkFunTy (bf7f460) Message-ID: <20161001213444.4E0E73A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/bf7f460f2daea26407cab144f2c3278cb4754ff6/ghc >--------------------------------------------------------------- commit bf7f460f2daea26407cab144f2c3278cb4754ff6 Author: Ben Gamari Date: Wed Mar 16 23:15:36 2016 +0100 Add mkFunTy >--------------------------------------------------------------- bf7f460f2daea26407cab144f2c3278cb4754ff6 libraries/base/Data/Typeable.hs | 14 ++++++++++++++ libraries/base/Data/Typeable/Internal.hs | 3 ++- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 21f93d2..3eb53c5 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -68,6 +68,7 @@ module Data.Typeable , typeRepTyCon , rnfTypeRep , showsTypeRep + , mkFunTy -- * Observing type representations , funResultTy @@ -168,6 +169,19 @@ funResultTy (I.TypeRepX f) (I.TypeRepX x) = -} funResultTy _ _ = Nothing +-- | Build a function type. +mkFunTy :: TypeRep -> TypeRep -> TypeRep +mkFunTy (I.TypeRepX arg) (I.TypeRepX res) + | Just HRefl <- arg `I.eqTypeRep` liftedTy + , Just HRefl <- res `I.eqTypeRep` liftedTy + = I.TypeRepX (I.TRFun arg res) + | otherwise + = error $ "mkFunTy: Attempted to construct function type from non-lifted "++ + "type: arg="++show arg++", res="++show res + where liftedTy = I.typeRep :: I.TypeRep * + -- TODO: We should be able to support this but the kind of (->) must be + -- generalized + -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () rnfTypeRep = I.rnfTypeRepX diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8e1c565..108aa71 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -190,7 +190,8 @@ pattern TRFun :: forall fun. () => TypeRep arg -> TypeRep res -> TypeRep fun -pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res +pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res where + TRFun arg res = mkTrApp (mkTrApp trArrow arg) res decomposeFun :: forall fun r. TypeRep fun From git at git.haskell.org Sat Oct 1 21:34:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:47 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Internal: Rename type variable (84d6743) Message-ID: <20161001213447.0522A3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/84d6743221af009de1b54c763fe262ac68f71c9e/ghc >--------------------------------------------------------------- commit 84d6743221af009de1b54c763fe262ac68f71c9e Author: Ben Gamari Date: Fri Mar 18 11:49:43 2016 +0100 Internal: Rename type variable >--------------------------------------------------------------- 84d6743221af009de1b54c763fe262ac68f71c9e libraries/base/Data/Typeable/Internal.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8a58d4e..b2d7726 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -240,9 +240,9 @@ data AppResult (t :: k) where App :: TypeRep a -> TypeRep b -> AppResult (a b) -- | Pattern match on a type application -pattern TRApp :: forall k2 (fun :: k2). () - => forall k1 (a :: k1 -> k2) (b :: k1). (fun ~ a b) - => TypeRep a -> TypeRep b -> TypeRep fun +pattern TRApp :: forall k2 (t :: k2). () + => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) + => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x withTypeable :: TypeRep a -> (Typeable a => b) -> b From git at git.haskell.org Sat Oct 1 21:34:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:49 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix T8132 (5f7f46f) Message-ID: <20161001213449.DE6F53A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/5f7f46f9937f1dadcf5e999d8dc4e95d69d1617f/ghc >--------------------------------------------------------------- commit 5f7f46f9937f1dadcf5e999d8dc4e95d69d1617f Author: Ben Gamari Date: Wed Mar 16 23:22:32 2016 +0100 Fix T8132 >--------------------------------------------------------------- 5f7f46f9937f1dadcf5e999d8dc4e95d69d1617f testsuite/tests/polykinds/T8132.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/polykinds/T8132.hs b/testsuite/tests/polykinds/T8132.hs index 337e288..cdbfd7f 100644 --- a/testsuite/tests/polykinds/T8132.hs +++ b/testsuite/tests/polykinds/T8132.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash #-} -import Data.Typeable.Internal +import Data.Typeable data K = K -instance Typeable K where typeRep# _ = undefined +-- This used to have a RHS but now we hide typeRep# +instance Typeable K -- where typeRep# _ = undefined From git at git.haskell.org Sat Oct 1 21:34:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:52 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Implement withTypeable (980221b) Message-ID: <20161001213452.903DB3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/980221b1fb60a2ce907da42ba217dc799d33ff8c/ghc >--------------------------------------------------------------- commit 980221b1fb60a2ce907da42ba217dc799d33ff8c Author: Ben Gamari Date: Wed Apr 13 00:02:51 2016 +0200 Implement withTypeable >--------------------------------------------------------------- 980221b1fb60a2ce907da42ba217dc799d33ff8c libraries/base/Data/Typeable/Internal.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index b2d7726..c72e41a 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -85,6 +85,7 @@ import Data.Type.Equality import GHC.Word import GHC.Show import GHC.TypeLits( KnownNat, KnownSymbol, natVal', symbolVal' ) +import Unsafe.Coerce import GHC.Fingerprint.Type import {-# SOURCE #-} GHC.Fingerprint @@ -245,8 +246,11 @@ pattern TRApp :: forall k2 (t :: k2). () => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x +-- | Use a 'TypeRep' as 'Typeable' evidence. withTypeable :: TypeRep a -> (Typeable a => b) -> b -withTypeable = undefined +withTypeable rep f = f' rep + where f' :: TypeRep a -> b + f' = unsafeCoerce rep -- | Pattern match on a type constructor -- TODO: do we want to expose kinds in these patterns? From git at git.haskell.org Sat Oct 1 21:34:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:55 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Render TYPE 'PtrRepLifted as * (2b229e8) Message-ID: <20161001213455.41DE03A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2b229e8ee33e5a5e114623d167e319b94bc2ae07/ghc >--------------------------------------------------------------- commit 2b229e8ee33e5a5e114623d167e319b94bc2ae07 Author: Ben Gamari Date: Thu Mar 17 01:02:39 2016 +0100 Render TYPE 'PtrRepLifted as * >--------------------------------------------------------------- 2b229e8ee33e5a5e114623d167e319b94bc2ae07 libraries/base/Data/Typeable/Internal.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 108aa71..8a58d4e 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -323,6 +323,8 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t instance Show (TypeRep (a :: k)) where showsPrec _ rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = + showChar '*' | isListTyCon tc, [ty] <- tys = showChar '[' . shows ty . showChar ']' | isTupleTyCon tc = From git at git.haskell.org Sat Oct 1 21:34:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:34:57 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix withTypeable (6573b08) Message-ID: <20161001213457.E85CC3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6573b0846964970c1ebddadc783adf9fbb91d385/ghc >--------------------------------------------------------------- commit 6573b0846964970c1ebddadc783adf9fbb91d385 Author: Ben Gamari Date: Fri May 20 18:07:01 2016 +0200 Fix withTypeable >--------------------------------------------------------------- 6573b0846964970c1ebddadc783adf9fbb91d385 libraries/base/Data/Typeable/Internal.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index c72e41a..8c225a7 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -247,10 +247,13 @@ pattern TRApp :: forall k2 (t :: k2). () pattern TRApp f x <- TrApp _ f x -- | Use a 'TypeRep' as 'Typeable' evidence. -withTypeable :: TypeRep a -> (Typeable a => b) -> b -withTypeable rep f = f' rep - where f' :: TypeRep a -> b - f' = unsafeCoerce rep +withTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r +withTypeable rep k = unsafeCoerce k' rep + where k' :: Gift a r + k' = Gift k + +-- | A helper to satisfy the type checker in 'withTypeable'. +newtype Gift a r = Gift (Typeable a => r) -- | Pattern match on a type constructor -- TODO: do we want to expose kinds in these patterns? From git at git.haskell.org Sat Oct 1 21:35:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:00 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Bump base to 4.10.0 (75646c4) Message-ID: <20161001213500.9A8A23A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/75646c4928df091d8df5ef3de2da9ad0dbfd793b/ghc >--------------------------------------------------------------- commit 75646c4928df091d8df5ef3de2da9ad0dbfd793b Author: Ben Gamari Date: Fri May 20 16:53:57 2016 +0200 Bump base to 4.10.0 >--------------------------------------------------------------- 75646c4928df091d8df5ef3de2da9ad0dbfd793b compiler/utils/Binary.hs | 6 +++--- libraries/base/base.cabal | 2 +- libraries/base/tests/dynamic002.hs | 2 +- libraries/ghc-boot/GHC/Serialized.hs | 2 +- libraries/ghci/GHCi/Message.hs | 2 +- libraries/ghci/GHCi/TH/Binary.hs | 4 ++-- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 23b90f5..41abb0d 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -78,7 +78,7 @@ import qualified Data.ByteString.Unsafe as BS import Data.IORef import Data.Char ( ord, chr ) import Data.Time -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -583,13 +583,13 @@ instance Binary TyCon where p <- get bh m <- get bh n <- get bh -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) return (mkTyCon p m n) #else return (mkTyCon3 p m n) #endif -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) putTypeRep :: BinHandle -> TypeRep a -> IO () -- Special handling for Type, (->), and RuntimeRep due to recursive kind -- relations. diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index e8899fb..45b152b 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -1,5 +1,5 @@ name: base -version: 4.9.0.0 +version: 4.10.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE diff --git a/libraries/base/tests/dynamic002.hs b/libraries/base/tests/dynamic002.hs index fff14ec..560c4b4 100644 --- a/libraries/base/tests/dynamic002.hs +++ b/libraries/base/tests/dynamic002.hs @@ -4,7 +4,7 @@ module Main(main) where import Data.Dynamic -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Data.Typeable (TypeCon, TypeRep) #endif import Data.Array diff --git a/libraries/ghc-boot/GHC/Serialized.hs b/libraries/ghc-boot/GHC/Serialized.hs index 8653049..42a9604 100644 --- a/libraries/ghc-boot/GHC/Serialized.hs +++ b/libraries/ghc-boot/GHC/Serialized.hs @@ -36,7 +36,7 @@ toSerialized serialize what = Serialized rep (serialize what) -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that. -- Otherwise return @Nothing at . fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) fromSerialized deserialize (Serialized the_type bytes) | the_type == rep = Just (deserialize bytes) | otherwise = Nothing diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index b5558be..3eaab62 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -37,7 +37,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) -- Previously this was re-exported by Data.Dynamic import Data.Typeable (TypeRep) #endif diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index c351cd1..c60b513 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -10,7 +10,7 @@ module GHCi.TH.Binary () where import Data.Binary import qualified Data.ByteString as B -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -77,7 +77,7 @@ instance Binary TH.PatSynArgs -- We need Binary TypeRep for serializing annotations -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) instance Binary TyCon where put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) get = mkTyCon <$> get <*> get <*> get From git at git.haskell.org Sat Oct 1 21:35:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:03 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Bump base (ae53687) Message-ID: <20161001213503.57C663A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ae53687f2aa06128cc7dd7eafdaab4e0497225e0/ghc >--------------------------------------------------------------- commit ae53687f2aa06128cc7dd7eafdaab4e0497225e0 Author: Ben Gamari Date: Sat Jun 4 09:48:57 2016 +0200 Bump base >--------------------------------------------------------------- ae53687f2aa06128cc7dd7eafdaab4e0497225e0 libraries/ghc-boot-th/ghc-boot-th.cabal.in | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/template-haskell/template-haskell.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/ghc-boot-th/ghc-boot-th.cabal.in b/libraries/ghc-boot-th/ghc-boot-th.cabal.in index 3aebfbf..50b07db 100644 --- a/libraries/ghc-boot-th/ghc-boot-th.cabal.in +++ b/libraries/ghc-boot-th/ghc-boot-th.cabal.in @@ -34,4 +34,4 @@ Library GHC.LanguageExtensions.Type GHC.Lexeme - build-depends: base >= 4.7 && < 4.10 + build-depends: base >= 4.7 && < 4.11 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index eed11e3..4d162f0 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -44,7 +44,7 @@ Library GHC.LanguageExtensions.Type, GHC.Lexeme - build-depends: base >= 4.7 && < 4.10, + build-depends: base >= 4.7 && < 4.11, binary == 0.8.*, bytestring == 0.10.*, directory == 1.2.*, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index 547374a..32ebb99 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -58,7 +58,7 @@ library Build-Depends: array == 0.5.*, - base == 4.9.*, + base == 4.10.*, binary == 0.8.*, bytestring == 0.10.*, containers == 0.5.*, diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index 0d9f468..b90f53d 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -49,7 +49,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base >= 4.8 && < 4.10, + base >= 4.8 && < 4.11, ghc-boot-th == 8.1, pretty == 1.1.* From git at git.haskell.org Sat Oct 1 21:35:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Rework Show (1b2f6a3) Message-ID: <20161001213506.0CC5F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/1b2f6a397add531bcff19a0b57b744b294c043ef/ghc >--------------------------------------------------------------- commit 1b2f6a397add531bcff19a0b57b744b294c043ef Author: Ben Gamari Date: Mon Jul 4 14:43:40 2016 +0200 Rework Show >--------------------------------------------------------------- 1b2f6a397add531bcff19a0b57b744b294c043ef libraries/base/Data/Typeable/Internal.hs | 48 +++++++++++++++++++------------- 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8c225a7..e73fee6 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -329,29 +329,37 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- instance Show (TypeRep (a :: k)) where - showsPrec _ rep - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = - showChar '*' - | isListTyCon tc, [ty] <- tys = - showChar '[' . shows ty . showChar ']' - | isTupleTyCon tc = - showChar '(' . showArgs (showChar ',') tys . showChar ')' - where (tc, tys) = splitApps rep - showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec = showTypeable + +showTypeable :: Int -> TypeRep (a :: k) -> ShowS +showTypeable p rep = + showParen (p > 9) $ + showTypeable' 8 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) + +showTypeable' :: Int -> TypeRep (a :: k) -> ShowS +showTypeable' _ rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = + showChar '*' + | isListTyCon tc, [ty] <- tys = + showChar '[' . shows ty . showChar ']' + | isTupleTyCon tc = + showChar '(' . showArgs (showChar ',') tys . showChar ')' + where (tc, tys) = splitApps rep +showTypeable' p (TrTyCon _ tycon _) = showsPrec p tycon --showsPrec p (TRFun x r) = -- showParen (p > 8) $ -- showsPrec 9 x . showString " -> " . showsPrec 8 r - showsPrec p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) - | isArrowTyCon tycon = - showParen (p > 8) $ - showsPrec 9 x . showString " -> " . showsPrec p r - - showsPrec p (TrApp _ f x) - | otherwise = - showParen (p > 9) $ - showsPrec 8 f . - showChar ' ' . - showsPrec 9 x +showTypeable' p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) + | isArrowTyCon tycon = + showParen (p > 8) $ + showsPrec 9 x . showString " -> " . showsPrec p r + +showTypeable' p (TrApp _ f x) + | otherwise = + showParen (p > 9) $ + showsPrec 8 f . + showChar ' ' . + showsPrec 9 x -- | @since 4.10.0.0 instance Show TypeRepX where From git at git.haskell.org Sat Oct 1 21:35:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:08 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: testsuite: Bump base version (0d27bb9) Message-ID: <20161001213508.BC0EF3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0d27bb971a2985ce76e324b1d91fd3434282539d/ghc >--------------------------------------------------------------- commit 0d27bb971a2985ce76e324b1d91fd3434282539d Author: Ben Gamari Date: Sat Jun 4 09:58:08 2016 +0200 testsuite: Bump base version >--------------------------------------------------------------- 0d27bb971a2985ce76e324b1d91fd3434282539d testsuite/tests/ado/ado004.stderr | 2 +- testsuite/tests/ghci/scripts/ghci008.stdout | 4 ++-- .../tests/indexed-types/should_compile/T3017.stderr | 2 +- .../tests/partial-sigs/should_compile/ADT.stderr | 2 +- .../partial-sigs/should_compile/AddAndOr1.stderr | 4 ++-- .../partial-sigs/should_compile/AddAndOr2.stderr | 4 ++-- .../partial-sigs/should_compile/AddAndOr3.stderr | 4 ++-- .../partial-sigs/should_compile/AddAndOr4.stderr | 4 ++-- .../partial-sigs/should_compile/AddAndOr5.stderr | 4 ++-- .../partial-sigs/should_compile/AddAndOr6.stderr | 4 ++-- .../partial-sigs/should_compile/BoolToBool.stderr | 4 ++-- .../should_compile/DataFamilyInstanceLHS.stderr | 2 +- .../should_compile/Defaulting1MROn.stderr | 4 ++-- .../should_compile/Defaulting2MROff.stderr | 2 +- .../should_compile/Defaulting2MROn.stderr | 2 +- .../tests/partial-sigs/should_compile/Either.stderr | 2 +- .../should_compile/EqualityConstraint.stderr | 2 +- .../tests/partial-sigs/should_compile/Every.stderr | 4 ++-- .../partial-sigs/should_compile/EveryNamed.stderr | 2 +- .../partial-sigs/should_compile/ExpressionSig.stderr | 4 ++-- .../should_compile/ExpressionSigNamed.stderr | 4 ++-- .../should_compile/ExtraConstraints1.stderr | 2 +- .../should_compile/ExtraConstraints2.stderr | 4 ++-- .../should_compile/ExtraConstraints3.stderr | 20 ++++++++++++++++++++ .../should_compile/ExtraNumAMROff.stderr | 4 ++-- .../partial-sigs/should_compile/ExtraNumAMROn.stderr | 2 +- .../tests/partial-sigs/should_compile/Forall1.stderr | 4 ++-- .../partial-sigs/should_compile/GenNamed.stderr | 4 ++-- .../partial-sigs/should_compile/HigherRank1.stderr | 4 ++-- .../partial-sigs/should_compile/HigherRank2.stderr | 4 ++-- .../should_compile/LocalDefinitionBug.stderr | 4 ++-- .../partial-sigs/should_compile/Meltdown.stderr | 2 +- .../should_compile/MonoLocalBinds.stderr | 4 ++-- .../partial-sigs/should_compile/NamedTyVar.stderr | 2 +- .../NamedWildcardInDataFamilyInstanceLHS.stderr | 2 +- .../NamedWildcardInTypeFamilyInstanceLHS.stderr | 2 +- .../should_compile/ParensAroundContext.stderr | 4 ++-- .../tests/partial-sigs/should_compile/PatBind.stderr | 4 ++-- .../partial-sigs/should_compile/PatBind2.stderr | 2 +- .../partial-sigs/should_compile/PatternSig.stderr | 4 ++-- .../partial-sigs/should_compile/Recursive.stderr | 4 ++-- .../should_compile/ScopedNamedWildcards.stderr | 4 ++-- .../should_compile/ScopedNamedWildcardsGood.stderr | 4 ++-- .../partial-sigs/should_compile/ShowNamed.stderr | 2 +- .../partial-sigs/should_compile/SimpleGen.stderr | 2 +- .../partial-sigs/should_compile/SkipMany.stderr | 2 +- .../should_compile/SomethingShowable.stderr | 2 +- .../should_compile/TypeFamilyInstanceLHS.stderr | 2 +- .../tests/partial-sigs/should_compile/Uncurry.stderr | 2 +- .../partial-sigs/should_compile/UncurryNamed.stderr | 2 +- .../WarningWildcardInstantiations.stderr | 2 +- testsuite/tests/polykinds/T8132.stderr | 2 +- testsuite/tests/rename/should_fail/rnfail040.stderr | 4 ++-- testsuite/tests/roles/should_compile/Roles1.stderr | 2 +- testsuite/tests/roles/should_compile/Roles14.stderr | 2 +- testsuite/tests/roles/should_compile/Roles2.stderr | 2 +- testsuite/tests/roles/should_compile/Roles3.stderr | 2 +- testsuite/tests/roles/should_compile/Roles4.stderr | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 2 +- testsuite/tests/safeHaskell/check/Check01.stderr | 4 ++-- testsuite/tests/safeHaskell/check/Check06.stderr | 4 ++-- testsuite/tests/safeHaskell/check/Check08.stderr | 4 ++-- testsuite/tests/safeHaskell/check/Check09.stderr | 8 ++++---- .../tests/safeHaskell/check/pkg01/ImpSafe01.stderr | 4 ++-- .../tests/safeHaskell/check/pkg01/ImpSafe04.stderr | 4 ++-- testsuite/tests/safeHaskell/flags/SafeFlags17.stderr | 4 ++-- .../tests/typecheck/should_compile/tc231.stderr | 2 +- .../should_fail/TcStaticPointersFail02.stderr | 4 ++-- .../tests/typecheck/should_fail/tcfail182.stderr | 4 ++-- 69 files changed, 126 insertions(+), 106 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 0d27bb971a2985ce76e324b1d91fd3434282539d From git at git.haskell.org Sat Oct 1 21:35:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:11 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add TRArrow pattern synonym (a05f387) Message-ID: <20161001213511.75BA23A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/a05f387d3c6c160471829d50d26adf6e56e7504a/ghc >--------------------------------------------------------------- commit a05f387d3c6c160471829d50d26adf6e56e7504a Author: Ben Gamari Date: Sun Jul 10 10:51:33 2016 +0200 Add TRArrow pattern synonym >--------------------------------------------------------------- a05f387d3c6c160471829d50d26adf6e56e7504a libraries/base/Data/Typeable/Internal.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8213c12..702616f 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -186,13 +186,17 @@ instance Ord TypeRepX where TypeRepX a `compare` TypeRepX b = typeRepFingerprint a `compare` typeRepFingerprint b +--pattern TRArrow :: TypeRep (->) +pattern TRArrow <- (eqTypeRep trArrow -> Just HRefl) + where TRArrow = trArrow + pattern TRFun :: forall fun. () => forall arg res. (fun ~ (arg -> res)) => TypeRep arg -> TypeRep res -> TypeRep fun -pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res where - TRFun arg res = mkTrApp (mkTrApp trArrow arg) res +pattern TRFun arg res <- TRApp (TRApp TRArrow arg) res + where TRFun arg res = mkTrApp (mkTrApp trArrow arg) res decomposeFun :: forall fun r. TypeRep fun From git at git.haskell.org Sat Oct 1 21:35:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up type printer (317be40) Message-ID: <20161001213514.28BDF3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/317be404cc1818c4a510c3eee20daf8770769ec0/ghc >--------------------------------------------------------------- commit 317be404cc1818c4a510c3eee20daf8770769ec0 Author: Ben Gamari Date: Sun Jul 10 10:51:56 2016 +0200 Fix up type printer >--------------------------------------------------------------- 317be404cc1818c4a510c3eee20daf8770769ec0 libraries/base/Data/Typeable/Internal.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 702616f..6e5242b 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -333,13 +333,17 @@ instance Show (TypeRep (a :: k)) where showsPrec = showTypeable showTypeable :: Int -> TypeRep (a :: k) -> ShowS -showTypeable p rep = +showTypeable p rep + | Just HRefl <- star `eqTypeRep` rep = + showTypeable' 9 rep + + | otherwise = showParen (p > 9) $ - showTypeable' 8 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) + showTypeable' 9 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) showTypeable' :: Int -> TypeRep (a :: k) -> ShowS showTypeable' _ rep - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = showChar '*' | isListTyCon tc, [ty] <- tys = showChar '[' . shows ty . showChar ']' From git at git.haskell.org Sat Oct 1 21:35:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:16 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill redundant comment (7f5e6f2) Message-ID: <20161001213516.DA3533A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/7f5e6f2445e97e24d33c8b96b0d9380dc30559d0/ghc >--------------------------------------------------------------- commit 7f5e6f2445e97e24d33c8b96b0d9380dc30559d0 Author: Ben Gamari Date: Fri Jul 8 17:07:12 2016 +0200 Kill redundant comment >--------------------------------------------------------------- 7f5e6f2445e97e24d33c8b96b0d9380dc30559d0 libraries/base/Data/Typeable/Internal.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index e73fee6..9e22c22 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -292,12 +292,6 @@ eqTypeRep a b | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# HRefl) | otherwise = Nothing -{- ********************************************************************* -* * - The Typeable class -* * -********************************************************************* -} - ------------------------------------------------------------- -- -- The Typeable class and friends From git at git.haskell.org Sat Oct 1 21:35:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:19 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Note need for mkTrApp (ac91bb2) Message-ID: <20161001213519.A5B763A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ac91bb2c216df2d1fdc52f6b3c640cffd992c9bf/ghc >--------------------------------------------------------------- commit ac91bb2c216df2d1fdc52f6b3c640cffd992c9bf Author: Ben Gamari Date: Fri Jul 8 23:10:45 2016 +0200 Note need for mkTrApp >--------------------------------------------------------------- ac91bb2c216df2d1fdc52f6b3c640cffd992c9bf libraries/base/Data/Typeable/Internal.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 9e22c22..25c7399 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -225,7 +225,9 @@ mkTrCon tc kind = TrTyCon fpr tc kind fpr = fingerprintFingerprints [fpr_tc, fpr_k] -- | Construct a representation for a type application. --- TODO: Is this necessary? +-- +-- Note that this is known-key to the compiler, which uses it in desugar +-- 'Typeable' evidence. mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) From git at git.haskell.org Sat Oct 1 21:35:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:22 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Testsuite updates (ed2e97e) Message-ID: <20161001213522.6210E3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ed2e97ec50f131b11d5f0d7021567173528d0c85/ghc >--------------------------------------------------------------- commit ed2e97ec50f131b11d5f0d7021567173528d0c85 Author: Ben Gamari Date: Mon Jul 4 14:43:50 2016 +0200 Testsuite updates >--------------------------------------------------------------- ed2e97ec50f131b11d5f0d7021567173528d0c85 compiler/typecheck/TcInteract.hs | 4 +- libraries/base/tests/T11334a.stdout | 6 +- libraries/base/tests/dynamic002.hs | 2 +- testsuite/tests/cabal/cabal09/reexport.cabal | 2 +- .../tests/dependent/should_compile/RaeJobTalk.hs | 2 +- .../tests/determinism/determ021/determ021.stdout | 4 +- testsuite/tests/ghc-api/T10508_api.stdout | 6 +- .../ghc-api/dynCompileExpr/dynCompileExpr.stdout | 2 +- .../should_compile/ExtraConstraints3.stderr | 20 -- .../partial-sigs/should_compile/Uncurry.stderr | 2 +- .../tests/safeHaskell/unsafeLibs/GoodImport03.hs | 2 +- .../tests/stranal/should_compile/T10482a.stderr | 324 +++++++++++++++++++++ .../tests/typecheck/should_fail/tcfail182.stderr | 2 +- testsuite/tests/typecheck/should_run/TypeOf.stdout | 27 +- .../tests/typecheck/should_run/TypeRep.stdout | 22 +- utils/haddock | 2 +- 16 files changed, 366 insertions(+), 63 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 ed2e97ec50f131b11d5f0d7021567173528d0c85 From git at git.haskell.org Sat Oct 1 21:35:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:25 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Make TRApp bidirectional (30301c6) Message-ID: <20161001213525.14A5C3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/30301c6d6cd640b8a1426e9263d0758b40a7f27c/ghc >--------------------------------------------------------------- commit 30301c6d6cd640b8a1426e9263d0758b40a7f27c Author: Ben Gamari Date: Sun Jul 10 10:51:23 2016 +0200 Make TRApp bidirectional >--------------------------------------------------------------- 30301c6d6cd640b8a1426e9263d0758b40a7f27c libraries/base/Data/Typeable/Internal.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 25c7399..8213c12 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -247,6 +247,7 @@ pattern TRApp :: forall k2 (t :: k2). () => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x + where TRApp f x = mkTrApp f x -- | Use a 'TypeRep' as 'Typeable' evidence. withTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r From git at git.haskell.org Sat Oct 1 21:35:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:27 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: submodule changes (b05e83c) Message-ID: <20161001213527.B9DB73A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/b05e83c07a7c1f2d10055dde08bcc988279f8406/ghc >--------------------------------------------------------------- commit b05e83c07a7c1f2d10055dde08bcc988279f8406 Author: Ben Gamari Date: Sun Jul 10 10:54:02 2016 +0200 submodule changes >--------------------------------------------------------------- b05e83c07a7c1f2d10055dde08bcc988279f8406 libraries/hpc | 2 +- libraries/unix | 2 +- utils/haddock | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/hpc b/libraries/hpc index 0741f65..956887d 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 0741f656fdadc14960f55e1970080d4699371055 +Subproject commit 956887d4a15de3e68aae82b14bfa1630c8149649 diff --git a/libraries/unix b/libraries/unix index 861ad25..40820da 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 861ad256e0a5337a1a685b1cd50ae91ee9374cab +Subproject commit 40820da5fb35c53aed53c211277c3e6077c1ddf9 diff --git a/utils/haddock b/utils/haddock index 375a8d8..008e61d 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 375a8d8c7203857863992483df9f9d24ec93ecab +Subproject commit 008e61d0c4b10713751c2a1de4958acc75367396 From git at git.haskell.org Sat Oct 1 21:35:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:30 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Clarify serialization errors (051c277) Message-ID: <20161001213530.75D203A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/051c27766dd2b2c5f0e8c6b97276f042ea15ff3b/ghc >--------------------------------------------------------------- commit 051c27766dd2b2c5f0e8c6b97276f042ea15ff3b Author: Ben Gamari Date: Fri Jul 8 14:56:38 2016 +0200 Clarify serialization errors >--------------------------------------------------------------- 051c27766dd2b2c5f0e8c6b97276f042ea15ff3b compiler/utils/Binary.hs | 33 ++++++++++++++++++++++++++------- libraries/ghci/GHCi/TH/Binary.hs | 33 ++++++++++++++++++++++++++------- 2 files changed, 52 insertions(+), 14 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 41abb0d..4ada423 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -609,7 +609,7 @@ putTypeRep bh (TRApp f x) = do put_ bh (4 :: Word8) putTypeRep bh f putTypeRep bh x -putTypeRep _ _ = fail "putTypeRep: Impossible" +putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do @@ -622,7 +622,10 @@ getTypeRepX bh = do TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k - Nothing -> fail "getTypeRepX: Kind mismatch" + Nothing -> failure "Kind mismatch in constructor application" + [ " Type constructor: " ++ show con + , " Applied to type : " ++ show rep_k + ] 4 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh @@ -631,17 +634,33 @@ getTypeRepX bh = do case arg `eqTypeRep` typeRepKind x of Just HRefl -> pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - _ -> fail "getTypeRepX: Applied non-arrow type" - _ -> fail "getTypeRepX: Invalid TypeRepX" + _ -> failure "Kind mismatch in type application" + [ " Found argument of kind: " ++ show (typeRepKind x) + , " Where the constructor: " ++ show f + , " Expects kind: " ++ show arg + ] + _ -> failure "Applied non-arrow" + [ " Applied type: " ++ show f + , " To argument: " ++ show x + ] + _ -> failure "Invalid TypeRepX" [] + where + failure description info = + fail $ unlines $ [ "Binary.getTypeRepX: "++description ] + ++ map (" "++) info instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep get bh = do TypeRepX rep <- getTypeRepX bh - case rep `eqTypeRep` (typeRep :: TypeRep a) of + case rep `eqTypeRep` expected of Just HRefl -> pure rep - Nothing -> fail "Binary: Type mismatch" + Nothing -> fail $ unlines + [ "Binary: Type mismatch" + , " Deserialized type: " ++ show rep + , " Expected type: " ++ show expected + ] + where expected = typeRep :: TypeRep a instance Binary TypeRepX where put_ bh (TypeRepX rep) = putTypeRep bh rep diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index c60b513..e8a7a77 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -101,7 +101,7 @@ putTypeRep (TRApp f x) = do put (4 :: Word8) putTypeRep f putTypeRep x -putTypeRep _ = fail "putTypeRep: Impossible" +putTypeRep _ = fail "GHCi.TH.Binary.putTypeRep: Impossible" getTypeRepX :: Get TypeRepX getTypeRepX = do @@ -114,7 +114,10 @@ getTypeRepX = do TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k - Nothing -> fail "getTypeRepX: Kind mismatch" + Nothing -> failure "Kind mismatch" + [ "Type constructor: " ++ show con + , "Applied to type: " ++ show rep_k + ] 4 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX @@ -123,17 +126,33 @@ getTypeRepX = do case arg `eqTypeRep` typeRepKind x of Just HRefl -> pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - _ -> fail "getTypeRepX: Applied non-arrow type" - _ -> fail "getTypeRepX: Invalid TypeRepX" + _ -> failure "Kind mismatch" + [ "Found argument of kind: " ++ show (typeRepKind x) + , "Where the constructor: " ++ show f + , "Expects an argument of kind: " ++ show arg + ] + _ -> failure "Applied non-arrow type" + [ "Applied type: " ++ show f + , "To argument: " ++ show x + ] + _ -> failure "Invalid TypeRepX" [] + where + failure description info = + fail $ unlines $ [ "GHCi.TH.Binary.getTypeRepX: "++description ] + ++ map (" "++) info instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep get = do TypeRepX rep <- getTypeRepX - case rep `eqTypeRep` (typeRep :: TypeRep a) of + case rep `eqTypeRep` expected of Just HRefl -> pure rep - Nothing -> fail "Binary: Type mismatch" + Nothing -> fail $ unlines + [ "GHCi.TH.Binary: Type mismatch" + , " Deserialized type: " ++ show rep + , " Expected type: " ++ show expected + ] + where expected = typeRep :: TypeRep a instance Binary TypeRepX where put (TypeRepX rep) = putTypeRep rep From git at git.haskell.org Sat Oct 1 21:35:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:33 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: testsuite/TypeRep: Add test for #12409 (45f2605) Message-ID: <20161001213533.23F7A3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/45f2605385c66b920229d501e2d925d0537dafff/ghc >--------------------------------------------------------------- commit 45f2605385c66b920229d501e2d925d0537dafff Author: Ben Gamari Date: Tue Jul 19 10:57:48 2016 +0200 testsuite/TypeRep: Add test for #12409 >--------------------------------------------------------------- 45f2605385c66b920229d501e2d925d0537dafff testsuite/tests/typecheck/should_run/TypeRep.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_run/TypeRep.hs b/testsuite/tests/typecheck/should_run/TypeRep.hs index 3ae9577..e466de5 100644 --- a/testsuite/tests/typecheck/should_run/TypeRep.hs +++ b/testsuite/tests/typecheck/should_run/TypeRep.hs @@ -1,5 +1,9 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeInType #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} @@ -30,6 +34,12 @@ main = do print $ rep @Bool print $ rep @Ordering print $ rep @(Int -> Int) + print $ rep @((Eq Int, Eq String) :: Constraint) + + -- Unboxed things (#12049) + print $ rep @Int# + print $ rep @(##) + print $ rep @(# Int#, Int #) -- Various instantiations of a kind-polymorphic type print $ rep @(Proxy (Eq Int)) @@ -45,4 +55,4 @@ main = do print $ rep @(Proxy 'PtrRepLifted) -- Something lifted and primitive - print $ rep @RealWorld + print $ rep @RealWorld -- #12132 From git at git.haskell.org Sat Oct 1 21:35:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:35 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix showTypeable (16cdaa1) Message-ID: <20161001213535.D1E963A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/16cdaa1734577e8a5663840440e5bbca7a061d2e/ghc >--------------------------------------------------------------- commit 16cdaa1734577e8a5663840440e5bbca7a061d2e Author: Ben Gamari Date: Fri Jul 15 01:00:20 2016 +0200 Fix showTypeable >--------------------------------------------------------------- 16cdaa1734577e8a5663840440e5bbca7a061d2e libraries/base/Data/Typeable/Internal.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6e5242b..6237d25 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -334,7 +334,7 @@ instance Show (TypeRep (a :: k)) where showTypeable :: Int -> TypeRep (a :: k) -> ShowS showTypeable p rep - | Just HRefl <- star `eqTypeRep` rep = + | Just HRefl <- star `eqTypeRep` typeRepKind rep = showTypeable' 9 rep | otherwise = @@ -351,14 +351,13 @@ showTypeable' _ rep showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showTypeable' p (TrTyCon _ tycon _) = showsPrec p tycon - --showsPrec p (TRFun x r) = - -- showParen (p > 8) $ - -- showsPrec 9 x . showString " -> " . showsPrec 8 r +--showTypeable' p (TRFun x r) = +-- showParen (p > 8) $ +-- showsPrec 9 x . showString " -> " . showsPrec 8 r showTypeable' p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) | isArrowTyCon tycon = showParen (p > 8) $ - showsPrec 9 x . showString " -> " . showsPrec p r - + showsPrec 9 x . showString " -> " . showsPrec 8 r showTypeable' p (TrApp _ f x) | otherwise = showParen (p > 9) $ From git at git.haskell.org Sat Oct 1 21:35:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:38 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Give unboxed tuples type representations (c1a6541) Message-ID: <20161001213538.85F7C3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/c1a65417b061c8fd8c944d959967fbbd57d7b89d/ghc >--------------------------------------------------------------- commit c1a65417b061c8fd8c944d959967fbbd57d7b89d Author: Ben Gamari Date: Tue Jul 19 11:59:32 2016 +0200 Give unboxed tuples type representations This fixes #12409. Ultimately this was a bit of a toss-up between 1. keeping unboxed tuples unrepresentable and improving the error offered by the solver, and 2. allowing unboxed tuples to be representable Ultimately it seemed easier (and perhaps more useful) to do (2), so that's what this patch does. >--------------------------------------------------------------- c1a65417b061c8fd8c944d959967fbbd57d7b89d compiler/prelude/TysWiredIn.hs | 2 +- compiler/typecheck/TcTypeable.hs | 25 +++++++++++++++++++++---- compiler/types/TyCon.hs | 4 +++- 3 files changed, 25 insertions(+), 6 deletions(-) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index b334967..9091005 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -800,7 +800,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con) | otherwise = unboxedTupleKind tc_arity = arity * 2 - flavour = UnboxedAlgTyCon + flavour = UnboxedAlgTyCon (mkPrelTyConRepName tc_name) dc_tvs = binderVars tc_binders dc_arg_tys = mkTyVarTys (drop arity dc_tvs) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 0502f51..89d5586 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -14,6 +14,7 @@ import TcEnv import TcRnMonad import PrelNames import TysPrim ( primTyCons, primTypeableTyCons ) +import TysWiredIn ( tupleTyCon ) import Id import Type import TyCon @@ -25,6 +26,8 @@ import NameEnv import HsSyn import DynFlags import Bag +import BasicTypes ( Boxity(..) ) +import Constants ( mAX_TUPLE_SIZE ) import Fingerprint(Fingerprint(..), fingerprintString) import Outputable import FastString ( FastString, mkFastString ) @@ -197,6 +200,22 @@ mkPrimTypeableBinds } where +-- | This is the list of primitive 'TyCon's for which we must generate bindings +-- in "GHC.Types". This should include all types defined in "GHC.Prim". +-- +-- The majority of the types we need here are contained in 'primTyCons'. +-- However, not all of them: in particular unboxed tuples are absent since we +-- don't want to include them in the original name cache. See +-- Note [Built-in syntax and the OrigNameCache] in IfaceEnv for more. +ghcPrimTypeableTyCons :: [TyCon] +ghcPrimTypeableTyCons = filter (not . definedManually) $ concat + [ [funTyCon, tupleTyCon Unboxed 0] + , map (tupleTyCon Unboxed) [2..mAX_TUPLE_SIZE] + , primTyCons + ] + where + definedManually tc = tyConName tc `elemNameEnv` primTypeableTcCons + -- | Generate bindings for the type representation of the wired-in TyCons defined -- by the virtual "GHC.Prim" module. This differs from the usual -- @mkTypeableBinds@ path in that here we need to lie to 'mk_typeable_binds' @@ -209,10 +228,8 @@ ghcPrimTypeableBinds stuff = unionManyBags (map mkBind all_prim_tys) where all_prim_tys :: [TyCon] - all_prim_tys = [ tc' | tc <- funTyCon : primTyCons - , tc' <- tc : tyConATs tc - , not $ tyConName tc' `elemNameEnv` primTypeableTyCons - ] + all_prim_tys = [ tc' | tc <- ghcPrimTypeableTyCons + , tc' <- tc : tyConATs tc ] mkBind :: TyCon -> LHsBinds Id mkBind = mk_typeable_binds stuff diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index d0ecb70..a6b2f8a 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -824,6 +824,7 @@ data AlgTyConFlav -- | An unboxed type constructor. Note that this carries no TyConRepName -- as it is not representable. | UnboxedAlgTyCon + TyConRepName -- | Type constructors representing a class dictionary. -- See Note [ATyCon for classes] in TyCoRep @@ -877,7 +878,7 @@ instance Outputable AlgTyConFlav where -- name, if any okParent :: Name -> AlgTyConFlav -> Bool okParent _ (VanillaAlgTyCon {}) = True -okParent _ (UnboxedAlgTyCon) = True +okParent _ (UnboxedAlgTyCon {}) = True okParent tc_name (ClassTyCon cls _) = tc_name == tyConName (classTyCon cls) okParent _ (DataFamInstTyCon _ fam_tc tys) = tyConArity fam_tc == length tys @@ -1087,6 +1088,7 @@ tyConRepName_maybe (PrimTyCon { primRepName = mb_rep_nm }) tyConRepName_maybe (AlgTyCon { algTcParent = parent }) | VanillaAlgTyCon rep_nm <- parent = Just rep_nm | ClassTyCon _ rep_nm <- parent = Just rep_nm + | UnboxedAlgTyCon rep_nm <- parent = Just rep_nm tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm }) = Just rep_nm tyConRepName_maybe (PromotedDataCon { tcRepName = rep_nm }) From git at git.haskell.org Sat Oct 1 21:35:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:41 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcInteract: Fix something (38bf32d) Message-ID: <20161001213541.357BF3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/38bf32d8c598e2f2d88be0108d2febfa0a29d792/ghc >--------------------------------------------------------------- commit 38bf32d8c598e2f2d88be0108d2febfa0a29d792 Author: Ben Gamari Date: Fri Jul 15 00:59:57 2016 +0200 TcInteract: Fix something >--------------------------------------------------------------- 38bf32d8c598e2f2d88be0108d2febfa0a29d792 compiler/typecheck/TcInteract.hs | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Sat Oct 1 21:35:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:44 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: testsuite: Add test of Typeable Binary instances (3b67166) Message-ID: <20161001213544.5D2093A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/3b671663ba7ef3f6a3234525dcf6e5b8571dd316/ghc >--------------------------------------------------------------- commit 3b671663ba7ef3f6a3234525dcf6e5b8571dd316 Author: Ben Gamari Date: Fri Jul 22 13:13:36 2016 +0200 testsuite: Add test of Typeable Binary instances >--------------------------------------------------------------- 3b671663ba7ef3f6a3234525dcf6e5b8571dd316 .../typecheck/should_run/TestTypeableBinary.hs | 37 ++++++++++++++++++++++ .../typecheck/should_run/TestTypeableBinary.stdout | 15 +++++++++ testsuite/tests/typecheck/should_run/all.T | 1 + 3 files changed, 53 insertions(+) diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs new file mode 100644 index 0000000..e427c13 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + +import qualified Data.ByteString as BS +import Type.Reflection +import Data.Binary +import GHCi.TH.Binary () + +import GHC.Exts +import Data.Kind +import Data.Proxy + +testRoundtrip :: Typeable a => TypeRep a -> IO () +testRoundtrip rep + | rep /= rep' = putStrLn $ "bad: " ++ show rep ++ " /= " ++ show rep' + | otherwise = putStrLn $ "good: " ++ show rep + where + rep' = decode (encode rep) + +main :: IO () +main = do + testRoundtrip (typeRep :: TypeRep Int) + testRoundtrip (typeRep :: TypeRep Int#) + testRoundtrip (typeRep :: TypeRep IO) + testRoundtrip (typeRep :: TypeRep Maybe) + testRoundtrip (typeRep :: TypeRep TYPE) + testRoundtrip (typeRep :: TypeRep RuntimeRep) + testRoundtrip (typeRep :: TypeRep 'IntRep) + testRoundtrip (typeRep :: TypeRep (->)) + testRoundtrip (typeRep :: TypeRep (Proxy Int)) + testRoundtrip (typeRep :: TypeRep (Proxy Int#)) + testRoundtrip (typeRep :: TypeRep Type) + testRoundtrip (typeRep :: TypeRep (Int -> Int)) + testRoundtrip (typeRep :: TypeRep 5) + testRoundtrip (typeRep :: TypeRep "hello world") + testRoundtrip (typeRep :: TypeRep ('Just 5)) diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout new file mode 100644 index 0000000..7e32096 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout @@ -0,0 +1,15 @@ +good: (Int) +good: Int# :: ((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep))) +good: IO :: ((*) -> (*)) +good: Maybe :: ((*) -> (*)) +good: TYPE :: ((RuntimeRep) -> (*)) +good: (RuntimeRep) +good: 'IntRep :: (RuntimeRep) +good: -> :: ((*) -> ((*) -> (*))) +good: ((Proxy :: ((*) -> (*))) (Int)) +good: ((Proxy :: (((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep))) -> (*))) (Int# :: ((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep))))) +good: (*) +good: ((Int) -> (Int)) +good: 5 :: (Nat) +good: "hello world" :: (Symbol) +good: ('Just :: ((Nat) -> ((Maybe :: ((*) -> (*))) (Nat)))) (5 :: (Nat)) :: ((Maybe :: ((*) -> (*))) (Nat)) diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index c2b277d..f51dbe3 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -117,3 +117,4 @@ test('TypeOf', normal, compile_and_run, ['']) test('TypeRep', normal, compile_and_run, ['']) test('T11120', normal, compile_and_run, ['']) test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) +test('TestTypeableBinary', normal, compile_and_run, ['']) From git at git.haskell.org Sat Oct 1 21:35:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:47 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Clarify comments (082104d) Message-ID: <20161001213547.124113A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/082104d03ca025e85bfeb67f507d06429b04bbc8/ghc >--------------------------------------------------------------- commit 082104d03ca025e85bfeb67f507d06429b04bbc8 Author: Ben Gamari Date: Sun Jul 17 22:02:55 2016 +0200 Clarify comments >--------------------------------------------------------------- 082104d03ca025e85bfeb67f507d06429b04bbc8 compiler/prelude/TysPrim.hs | 7 ++++--- compiler/typecheck/TcTypeable.hs | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index f5c80ca..f6808da 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -160,10 +160,11 @@ primTyCons ] -- | The names of the 'TyCon's which we define 'Typeable' bindings for --- explicitly in "Data.Typeable.Internal" --- and should not generate bindings for in "GHC.Types". +-- explicitly in "Data.Typeable.Internal" and should not generate representation +-- bindings for in "GHC.Types". -- --- See Note [Mutually recursive representations of primitive types] +-- See Note [Mutually recursive representations of primitive types] in +-- "Data.Typeable.Internal" and Note [Grand plan for Typeable] in "TcTypeable". primTypeableTyCons :: NameEnv TyConRepName primTypeableTyCons = mkNameEnv [ (tYPETyConName, trTYPEName) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 061d22f..0502f51 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -167,9 +167,9 @@ mkTypeableTyConBinds tycons ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv ; return (gbl_env `addTypecheckedBinds` tc_binds) } --- | Generate bindings for the type representation of a wired-in TyCon defined +-- | Generate bindings for the type representation of a wired-in 'TyCon's defined -- by the virtual "GHC.Prim" module. This is where we inject the representation --- bindings for primitive types into "GHC.Types" +-- bindings for these primitive types into "GHC.Types" -- -- See Note [Grand plan for Typeable] in this module. mkPrimTypeableBinds :: TcM TcGblEnv From git at git.haskell.org Sat Oct 1 21:35:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:49 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix serialization (6dcb726) Message-ID: <20161001213549.E307A3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6dcb726a09bdbf8150a92cb19e912915dbd21e8a/ghc >--------------------------------------------------------------- commit 6dcb726a09bdbf8150a92cb19e912915dbd21e8a Author: Ben Gamari Date: Sun Jul 17 21:09:57 2016 +0200 Fix serialization >--------------------------------------------------------------- 6dcb726a09bdbf8150a92cb19e912915dbd21e8a compiler/utils/Binary.hs | 2 +- libraries/ghci/GHCi/TH/Binary.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 4ada423..1e10b2a 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -620,7 +620,7 @@ getTypeRepX bh = do 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh - case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + case typeRepKind rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> failure "Kind mismatch in constructor application" [ " Type constructor: " ++ show con diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index e8a7a77..5e052f7 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -112,7 +112,7 @@ getTypeRepX = do 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX - case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + case typeRepKind rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> failure "Kind mismatch" [ "Type constructor: " ++ show con From git at git.haskell.org Sat Oct 1 21:35:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:52 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Binary: Simple serialization test works (6fad3f8) Message-ID: <20161001213552.92DC13A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6fad3f8cea6599dc9f1ea39241358df2ab454a29/ghc >--------------------------------------------------------------- commit 6fad3f8cea6599dc9f1ea39241358df2ab454a29 Author: Ben Gamari Date: Sun Jul 17 23:55:02 2016 +0200 Binary: Simple serialization test works >--------------------------------------------------------------- 6fad3f8cea6599dc9f1ea39241358df2ab454a29 compiler/utils/Binary.hs | 9 ++++++--- libraries/ghci/GHCi/TH/Binary.hs | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 1e10b2a..d0175b7 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -82,7 +82,7 @@ import Data.Time import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) -import GHC.Exts (RuntimeRep) +import GHC.Exts (TYPE, RuntimeRep) #else import Data.Typeable #endif @@ -591,11 +591,13 @@ instance Binary TyCon where #if MIN_VERSION_base(4,10,0) putTypeRep :: BinHandle -> TypeRep a -> IO () --- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind -- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep bh rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put_ bh (5 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep TYPE) = put_ bh (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put_ bh (1 :: Word8) @@ -615,7 +617,8 @@ getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 5 -> return $ TypeRepX (typeRep :: TypeRep Type) + 0 -> return $ TypeRepX (typeRep :: TypeRep TYPE) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get bh :: IO TyCon diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 5e052f7..5710555 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,7 +14,7 @@ import qualified Data.ByteString as B import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) -import GHC.Exts (RuntimeRep) +import GHC.Exts (TYPE, RuntimeRep) #else import Data.Typeable #endif @@ -83,11 +83,13 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put --- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind -- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put (5 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep TYPE) = put (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put (1 :: Word8) @@ -107,7 +109,8 @@ getTypeRepX :: Get TypeRepX getTypeRepX = do tag <- get :: Get Word8 case tag of - 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 5 -> return $ TypeRepX (typeRep :: TypeRep Type) + 0 -> return $ TypeRepX (typeRep :: TypeRep TYPE) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get :: Get TyCon From git at git.haskell.org Sat Oct 1 21:35:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:55 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Update submodules (4ff0352) Message-ID: <20161001213555.482FD3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4ff035211c7e17f4d6c0516d0ab3605dfd159bcd/ghc >--------------------------------------------------------------- commit 4ff035211c7e17f4d6c0516d0ab3605dfd159bcd Author: Ben Gamari Date: Fri Jul 29 18:10:39 2016 +0200 Update submodules >--------------------------------------------------------------- 4ff035211c7e17f4d6c0516d0ab3605dfd159bcd libraries/Cabal | 2 +- libraries/array | 2 +- libraries/deepseq | 2 +- libraries/directory | 2 +- libraries/dph | 2 +- libraries/filepath | 2 +- libraries/haskeline | 2 +- libraries/hoopl | 2 +- libraries/hpc | 2 +- libraries/parallel | 2 +- libraries/process | 2 +- libraries/stm | 2 +- libraries/terminfo | 2 +- libraries/unix | 2 +- utils/haddock | 2 +- utils/hsc2hs | 2 +- 16 files changed, 16 insertions(+), 16 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index f8d6f17..40d6f0a 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit f8d6f17a09d14e3f1851190f18fefa23be2ae02f +Subproject commit 40d6f0afd5b86d698abb876d4f5ed0bb452b0c4b diff --git a/libraries/array b/libraries/array index 6551ad9..87489f1 160000 --- a/libraries/array +++ b/libraries/array @@ -1 +1 @@ -Subproject commit 6551ad9edaca1634a8149ad9c27a72feb456d4e1 +Subproject commit 87489f1c64bf495d2a814f2ed82ede9893611969 diff --git a/libraries/deepseq b/libraries/deepseq index c3a0a16..161e313 160000 --- a/libraries/deepseq +++ b/libraries/deepseq @@ -1 +1 @@ -Subproject commit c3a0a16f17e593cb6a64b01a22015497738bfed6 +Subproject commit 161e313a0dbe3705992491aa948d1bb810c7fa5c diff --git a/libraries/directory b/libraries/directory index 33ce1ca..673ed69 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 33ce1ca6bef97b60957e4763b046eac9a982ead0 +Subproject commit 673ed6967fe2a55270fdba955379829c5df1f0a5 diff --git a/libraries/dph b/libraries/dph index 64eca66..33eb2fb 160000 --- a/libraries/dph +++ b/libraries/dph @@ -1 +1 @@ -Subproject commit 64eca669f13f4d216af9024474a3fc73ce101793 +Subproject commit 33eb2fb7e178c18f2afd0d537d791d021ff75231 diff --git a/libraries/filepath b/libraries/filepath index f510e50..2055aff 160000 --- a/libraries/filepath +++ b/libraries/filepath @@ -1 +1 @@ -Subproject commit f510e50feefe9995334769dd5e26c79edbe6fdc1 +Subproject commit 2055aff234c47f6a6ea130436b86c1434cd03d50 diff --git a/libraries/haskeline b/libraries/haskeline index 8dd9e8b..006ab37 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 8dd9e8be13b364048f57cc276be6ad5fb66fad21 +Subproject commit 006ab377525b2bf3844fd1127bfe2df8a7af2e52 diff --git a/libraries/hoopl b/libraries/hoopl index 67dff9a..5c450e2 160000 --- a/libraries/hoopl +++ b/libraries/hoopl @@ -1 +1 @@ -Subproject commit 67dff9a7db8e103d379068df0323bbc97452e769 +Subproject commit 5c450e22588cc148d8faa56c1a53b15ddfec522c diff --git a/libraries/hpc b/libraries/hpc index 956887d..f5f2848 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 956887d4a15de3e68aae82b14bfa1630c8149649 +Subproject commit f5f28486446fdc691cfbb9c5611c0f78e8d010af diff --git a/libraries/parallel b/libraries/parallel index ec04d05..829ff3a 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit ec04d059b13fc348789d87adfbabb9351f8574db +Subproject commit 829ff3ae248fe05b74bfea30e285dd0ff50424ea diff --git a/libraries/process b/libraries/process index 296cbce..a97ddce 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 296cbce6294316d6534b4449fc7ab0f0d3f5775b +Subproject commit a97ddce1a61d53e498addbbec10a694f31aa48b2 diff --git a/libraries/stm b/libraries/stm index fe88993..f549f65 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit fe8899331e6ca7bdf80d57cf77dd597023ae4718 +Subproject commit f549f65a2fcc85b7ff8648bed2543e8b192ea27d diff --git a/libraries/terminfo b/libraries/terminfo index 140ca44..d9c6c52 160000 --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 140ca44db6fc734cfc0388e82f9e5270f31475d8 +Subproject commit d9c6c5257bf392fb4bca92ad0777a719b57a2794 diff --git a/libraries/unix b/libraries/unix index 40820da..901b0b9 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 40820da5fb35c53aed53c211277c3e6077c1ddf9 +Subproject commit 901b0b9c2faa2d48a68861c5277774e1a540e1cb diff --git a/utils/haddock b/utils/haddock index 008e61d..0a85208 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 008e61d0c4b10713751c2a1de4958acc75367396 +Subproject commit 0a852086f784168ee1a8b441028067b33d831510 diff --git a/utils/hsc2hs b/utils/hsc2hs index d9c13cb..f5ae016 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit d9c13cb8f5be89a030783d758fcf7c077351c6a9 +Subproject commit f5ae016e5a69ebf42d612805e51afd9227df9389 From git at git.haskell.org Sat Oct 1 21:35:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:35:57 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add a TestEquality TypeRep instance (ae3464e) Message-ID: <20161001213557.EAE673A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ae3464e2ce039a4a3d32b410efb428c421534205/ghc >--------------------------------------------------------------- commit ae3464e2ce039a4a3d32b410efb428c421534205 Author: Ben Gamari Date: Thu Sep 1 12:47:38 2016 -0400 Add a TestEquality TypeRep instance >--------------------------------------------------------------- ae3464e2ce039a4a3d32b410efb428c421534205 libraries/base/Data/Typeable/Internal.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6237d25..bc10e36 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -85,6 +85,7 @@ import Data.Type.Equality import GHC.Word import GHC.Show import GHC.TypeLits( KnownNat, KnownSymbol, natVal', symbolVal' ) +import Data.Type.Equality import Unsafe.Coerce import GHC.Fingerprint.Type @@ -168,6 +169,11 @@ on f g = \ x y -> g x `f` g y instance Eq (TypeRep a) where (==) = (==) `on` typeRepFingerprint +instance TestEquality TypeRep where + testEquality a b + | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# Refl) + | otherwise = Nothing + -- | @since 4.4.0.0 instance Ord (TypeRep a) where compare = compare `on` typeRepFingerprint From git at git.haskell.org Sat Oct 1 21:36:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:36:00 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Temporarily override submodule upstream repo paths (083e183) Message-ID: <20161001213600.995B83A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/083e183a22665057c8b49292cb7e3ee07d17b9aa/ghc >--------------------------------------------------------------- commit 083e183a22665057c8b49292cb7e3ee07d17b9aa Author: Ben Gamari Date: Fri Jul 29 18:24:26 2016 +0200 Temporarily override submodule upstream repo paths >--------------------------------------------------------------- 083e183a22665057c8b49292cb7e3ee07d17b9aa .gitmodules | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/.gitmodules b/.gitmodules index 783c568..d2eda81 100644 --- a/.gitmodules +++ b/.gitmodules @@ -16,7 +16,7 @@ ignore = untracked [submodule "libraries/haskeline"] path = libraries/haskeline - url = ../packages/haskeline.git + url = git://github.com/bgamari/haskeline ignore = untracked [submodule "libraries/pretty"] path = libraries/pretty @@ -24,7 +24,7 @@ ignore = untracked [submodule "libraries/terminfo"] path = libraries/terminfo - url = ../packages/terminfo.git + url = git://github.com/bgamari/packages-terminfo ignore = untracked [submodule "libraries/transformers"] path = libraries/transformers @@ -56,43 +56,43 @@ ignore = untracked [submodule "libraries/array"] path = libraries/array - url = ../packages/array.git + url = git://github.com/bgamari/array ignore = none [submodule "libraries/deepseq"] path = libraries/deepseq - url = ../packages/deepseq.git + url = git://github.com/bgamari/deepseq ignore = none [submodule "libraries/directory"] path = libraries/directory - url = ../packages/directory.git + url = git://github.com/bgamari/directory ignore = none [submodule "libraries/filepath"] path = libraries/filepath - url = ../packages/filepath.git + url = git://github.com/bgamari/filepath ignore = none [submodule "libraries/hoopl"] path = libraries/hoopl - url = ../packages/hoopl.git + url = git://github.com/bgamari/hoopl ignore = none [submodule "libraries/hpc"] path = libraries/hpc - url = ../packages/hpc.git + url = git://github.com/bgamari/hpc ignore = none [submodule "libraries/process"] path = libraries/process - url = ../packages/process.git + url = git://github.com/bgamari/process ignore = none [submodule "libraries/unix"] path = libraries/unix - url = ../packages/unix.git + url = git://github.com/bgamari/unix ignore = none [submodule "libraries/parallel"] path = libraries/parallel - url = ../packages/parallel.git + url = git://github.com/bgamari/parallel ignore = none [submodule "libraries/stm"] path = libraries/stm - url = ../packages/stm.git + url = git://github.com/bgamari/packages-stm ignore = none [submodule "libraries/dph"] path = libraries/dph @@ -100,7 +100,7 @@ ignore = none [submodule "utils/haddock"] path = utils/haddock - url = ../haddock.git + url = git://github.com/bgamari/haddock ignore = none branch = ghc-head [submodule "nofib"] From git at git.haskell.org Sat Oct 1 21:36:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:36:03 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Debug (05c1608) Message-ID: <20161001213603.4DF093A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/05c160895638238189d44cc6ed23b5451d2c1a54/ghc >--------------------------------------------------------------- commit 05c160895638238189d44cc6ed23b5451d2c1a54 Author: Ben Gamari Date: Mon Sep 5 21:51:34 2016 -0400 Debug >--------------------------------------------------------------- 05c160895638238189d44cc6ed23b5451d2c1a54 libraries/base/Data/Typeable/Internal.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index bc10e36..870189a 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -338,14 +338,18 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t instance Show (TypeRep (a :: k)) where showsPrec = showTypeable +fpr _ = id +--fpr rep = showString " (" . shows (typeRepFingerprint rep) . showString ")" + showTypeable :: Int -> TypeRep (a :: k) -> ShowS showTypeable p rep | Just HRefl <- star `eqTypeRep` typeRepKind rep = - showTypeable' 9 rep + showParen True $ + showTypeable' 1 rep . fpr (typeRepKind rep) . fpr rep | otherwise = - showParen (p > 9) $ - showTypeable' 9 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) + showParen (p > 1) $ + showTypeable' 1 rep . showString " :: " . showParen True (showTypeable' 0 (typeRepKind rep) . fpr (typeRepKind rep)) . fpr rep showTypeable' :: Int -> TypeRep (a :: k) -> ShowS showTypeable' _ rep @@ -356,10 +360,9 @@ showTypeable' _ rep | isTupleTyCon tc = showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep -showTypeable' p (TrTyCon _ tycon _) = showsPrec p tycon ---showTypeable' p (TRFun x r) = --- showParen (p > 8) $ --- showsPrec 9 x . showString " -> " . showsPrec 8 r +showTypeable' p (TrTyCon _ tycon _) = + showParen (p > 9) $ + showsPrec p tycon showTypeable' p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) | isArrowTyCon tycon = showParen (p > 8) $ From git at git.haskell.org Sat Oct 1 21:36:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:36:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix submodules (594e948) Message-ID: <20161001213606.13A513A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/594e9480fcf07b7fe6bf4c3c51918e8797b79ade/ghc >--------------------------------------------------------------- commit 594e9480fcf07b7fe6bf4c3c51918e8797b79ade Author: Ben Gamari Date: Sun Sep 25 19:44:51 2016 -0400 Fix submodules >--------------------------------------------------------------- 594e9480fcf07b7fe6bf4c3c51918e8797b79ade libraries/Cabal | 2 +- libraries/Win32 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 40d6f0a..f8d6f17 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 40d6f0afd5b86d698abb876d4f5ed0bb452b0c4b +Subproject commit f8d6f17a09d14e3f1851190f18fefa23be2ae02f diff --git a/libraries/Win32 b/libraries/Win32 index fec966e6..bb9469e 160000 --- a/libraries/Win32 +++ b/libraries/Win32 @@ -1 +1 @@ -Subproject commit fec966e6d77a5e7f4a586de6096954137a1fe914 +Subproject commit bb9469ece0b882017fa7f3b51e8db1d2985d6720 From git at git.haskell.org Sat Oct 1 21:36:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:36:08 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Clarify comment (8fd5510) Message-ID: <20161001213608.B61FC3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8fd551051fd2457bba4fa0bb23416bffc5f75051/ghc >--------------------------------------------------------------- commit 8fd551051fd2457bba4fa0bb23416bffc5f75051 Author: Ben Gamari Date: Fri Jul 22 13:16:05 2016 +0200 TcTypeable: Clarify comment >--------------------------------------------------------------- 8fd551051fd2457bba4fa0bb23416bffc5f75051 compiler/typecheck/TcTypeable.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 89d5586..a68d51c 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -214,7 +214,11 @@ ghcPrimTypeableTyCons = filter (not . definedManually) $ concat , primTyCons ] where - definedManually tc = tyConName tc `elemNameEnv` primTypeableTcCons + -- Some things, like TYPE, have mutually recursion kind relationships and + -- therefore have manually-defined representations. See Note [Mutually + -- recursive representations of primitive types] in Data.Typeable.Internal + -- and Note [Grand plan for Typeable] for details. + definedManually tc = tyConName tc `elemNameEnv` primTypeableTyCons -- | Generate bindings for the type representation of the wired-in TyCons defined -- by the virtual "GHC.Prim" module. This differs from the usual From git at git.haskell.org Sat Oct 1 21:36:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:36:12 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable's head updated: Fix submodules (594e948) Message-ID: <20161001213612.7C87A3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/ttypeable' now includes: 9031382 MkCore: Fix some note names a6819a0 base: Add release date to changelog bf7cbe7 users-guide: Note multiple pattern signature change in relnotes afec447 testsuite: Add testcase for #12355 2a3af15 Treat duplicate pattern synonym signatures as an error 3b2deca users-guide: Remove static field type from rts-flag 331febf CallArity: Use not . null instead of length > 0 0bd7c4b Enum: Ensure that operations on Word fuse 18e71e4 Revert "Fix 32-bit build failures" 890ec98 Revert "Linker: some extra debugging / logging" e10497b Kill some varEnvElts 85aa6ef Check generic-default method for ambiguity 1267048 Extra ASSERTs for nameModule 55e43a6 Use DVarEnv for vectInfoVar 5f79394 Delete out-of-date comment 895eefa Make unique auxiliary function names in deriving cbe30fd Tidy up tidying f2d36ea White space only 6cedef0 Test Trac #12133 27fc75b Document codegen nondeterminism 18b782e Kill varEnvElts in zonkEnvIds 1b058d4 Remove varEnvElts b7b130c Fix GetTime.c on Darwin with clock_gettime f560a03 Adds x86_64-apple-darwin14 target. 567dbd9 Have addModFinalizer expose the local type environment. 56f47d4 Mention addModFinalizer changes in release notes. 672314c Switch to LLVM version 3.8 b9cea81 Show testcase where demand analysis abortion code fails 979baec --without-libcharset disables the use of libcharset bedd620 Style changes for UniqFM 6ed7c47 Document some codegen nondeterminism 9858552 Use deterministic maps for FamInstEnv 34085b5 Correct the message displayed for syntax error (#12146) 64bce8c Add Note [FamInstEnv determinism] 6e280c2 Utils: Fix `lengthIs` and `lengthExceeds` for negative args 0481324 Use UniqDFM for InstEnv b8cd94d GHC.Stack.CCS: Fix typo in Haddocks 91fd87e FastString: Reduce allocations of concatFS 15751f2 FastString: Add IsString instance c4a9dca FastString: Supply mconcat implementation fc53d36 OccName: Implement startsWithUnderscore in terms of headFS eb3d659 OccName: Avoid re-encoding derived OccNames 4f21a51 Kill eltsUFM in classifyTyCons 6c7c193 DsExpr: Remove usage of concatFS in fingerprintName 0177c85 Testsuite: expose TEST_CC (path to gcc) f53d761 TysWiredIn: Use UniqFM lookup for built-in OccNames 9a3df1f check-api-annotations utility loads by filename 17d0b84 Add -package-env to the flags reference 372dbc4 Pretty: delete really old changelog 45d8f4e Demand analyser: Implement LetUp rule (#12370) 18ac80f tidyType: Rename variables of nested forall at once cd0750e tidyOccNames: Rename variables fairly 37aeff6 Added type family dependency to Data.Type.Bool.Not b35e01c Bring comments in TcGenGenerics up to date a9bc547 Log heap profiler samples to event log ffe4660 IfaceEnv: Only check for built-in OccNames if mod is GHC.Types 24f5f36 Binary: Use ByteString's copy in getBS 0f0cdb6 Bugfix for bug 11632: `readLitChar` should consume null characters 1ba79fa CodeGen: Way to dump cmm only once (#11717) 89a8be7 Pretty: remove a harmful $! (#12227) 5df92f6 hp2ps: fix invalid PostScript for names with parentheses d213ab3 Fix misspellings of the word "instance" in comments 3fa3fe8 Make DeriveFunctor work with unboxed tuples 514c4a4 Fix Template Haskell reification of unboxed tuple types 1fc41d3 Make okConIdOcc recognize unboxed tuples 0df3f4c Fix PDF build for the User's Guide. 98b2c50 Support SCC pragmas in declaration context e46b768 Make Data.{Bifoldable,Bitraversable} -XSafe 908f8e2 TcInteract: Add braces to matchClassInst trace output 8de6e13 Fix bytecode generator panic cac3fb0 Cleanup PosixSource.h a0f83a6 Data.Either: Add fromLeft and fromRight (#12402) 627c767 Update docs for partial type signatures (#12365) ed48098 InstEnv: Ensure that instance visibility check is lazy 9513fe6 Clean up interaction between name cache and built-in syntax a4f2b76 testsuite: Add regression test for #12381 93acc02 Add another testcase for #12082 cf989ff Compact Regions 83e4f49 Revert "Clean up interaction between name cache and built-in syntax" 714bebf Implement unboxed sum primitive type a09c0e3 Comments only 9c54185 Comments + tiny refactor of isNullarySrcDataCon 8d4760f Comments re ApThunks + small refactor in mkRhsClosure 6a4dc89 Bump Haddock submodule 8265c78 Fix and document Unique generation for sum TyCon and DataCons e710f8f Correct a few mistyped words in prose/comments bbf36f8 More typos in comments fb34b27 Revert "Cleanup PosixSource.h" 86b1522 Unboxed sums: More unit tests bfef2eb StgCmmBind: Some minor simplifications c4f3d91 Add deepseq dependency and a few NFData instances 648fd73 Squash space leaks in the result of byteCodeGen 7f0f1d7 -fprof-auto-top 1fe5c89 UNPACK the size field of SizedSeq d068220 Fix the non-Linux build 4036c1f Testsuite: fix T10482a 1967d74 Some typos in comments a9251c6 MonadUtils: Typos in comments 1783011 Fix productivity calculation (#12424) 9d62f0d Accept better stats for T9675 8f63ba3 Compute boot-defined TyCon names from ModIface. b0a5144 Add mblocks_allocated to GC stats API e98edbd Move stat_startGCSync d3feb16 Make Unique a newtype c06e3f4 Add atomic operations to package.conf.in 89ae1e8 Relevant Bindings no longer reports shadowed bindings (fixes #12176) 750553a Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) 2078909 Typo in comment 36565a9 ForeignCall.hs: Remove DrIFT directives 55f5aed Track the lengths of the thread queues 988ad8b Fix to thread migration d1fe08e Only trace cap/capset events if we're tracing anything else 4dcbbd1 Remove the DEBUG_ variables, use RtsFlags directly 9df9490 StgSyn: Remove unused StgLiveVars types 2f79e79 Add comment about lexing of INLINE and INLINABLE pragma 0c37aef Update old comment InlinePragma b1e6415 More comments about InlinePragmas 7a06b22 Typo in comment [skip ci] 7a8ef01 Remove `setUnfoldingInfoLazily` a13fda7 Clarify comment on makeCorePair d85b26d CmmLive: Remove some redundant exports 8ecac25 CmmLayoutStack: Minor simplification fc66415 Replace an unsafeCoerce with coerce db5a226 Fix omission in haddock instance head 1101045 Trim all spaces after 'version:' fe4008f Remove identity update of field componentsConfigs f09d654 check that the number of parallel build is greater than 0 e3e2e49 codeGen: Remove binutils<2.17 hack, fixes T11758 ca7e1ad Expanded abbreviations in Haddock documentation ce13a9a Fix an assertion that could randomly fail 89fa4e9 Another try to get thread migration right 8fe1672 Bump `hoopl` submodule, mostly cosmetics 253fc38 Temporarily mark T1969 perf test as broken (#12437) 7354f93 StgCmm: Remove unused Bool field of Return sequel 02614fd Replace some `length . filter` with `count` 9aa5d87 Util.count: Implement as a left-fold instead of a right-fold affcec7 rts/Printer.h: fix constness of argument declaration 03af399 AsmCodeGen: Give linear-scan and coloring reg. allocators different cc names 3bfe6a5 RegAlloc: Remove duplicate seqList (use seqList from Util) bd51064 RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps 7a2e933 Use Data.Functor.Const to implement Data.Data internals 6fe2355 configure.ac: Remove checks for bug 9439 773e3aa T1969: Enable it again but bump the max residency temporarily 4d9c22d Fix typo in Data.Bitraversable Haddocks fe19be2 Cabal submodule update. dd23a4c Actually update haddock.Cabal stats. e79bb2c Fix a bug in unboxed sum layout generation 9684dbb Remove StgRubbishArg and CmmArg ac0e112 Improve missing-sig warning bd0c310 Fix GHCi perf-llvm build on x86_64 37a7bcb Update `nofib` submodule to newest commit 7ad3b49 Misspellings in comments [skip ci] 18f0687 Fix configure detection. ffd4029 fix compilation failure on OpenBSD with system supplied GNU C 4.2.1 fc1432a Update hoopl submodule (extra .gitignore entry) 3551e62 refactor test for __builtin_unreachable into Rts.h macro RTS_UNREACHABLE da99a7f Darwin: Detect broken NM program at configure time f9a11a2 When in sanity mode, un-zero malloc'd memory; fix uninitialized memory bugs. d331ace Minor typofix. b222ef7 Typofix in System.Environment docs. 34da8e5 Typo in comment efc0372 Not-in-scope variables are always errors f352e5c Keep the bindings local during defaultCallStacks 58e7316 Refactor nestImplicTcS d610274 Revert "T1969: Enable it again but bump the max residency temporarily" 113d50b Add gcoerceWith to Data.Type.Coercion b2c5e4c Revert "codeGen: Remove binutils<2.17 hack, fixes T11758" 896d216 Annotate initIfaceCheck with usage information. e907e1f Axe initIfaceTc, tie the knot through HPT (or if_rec_types). 704913c Support for noinline magic function. 1f1bd92 Introduce BootUnfolding, set when unfolding is absent due to hs-boot file. 5a8fa2e When a value Id comes from hi-boot, insert noinline. Fixes #10083. 8fd1848 Retypecheck both before and after finishing hs-boot loops in --make. e528061 We also need to retypecheck before when we do parallel make. 0d3bf62 Fix #12472 by looking for noinline/lazy inside oversaturated applications. f9aa996 pass -z wxneeded or -Wl,-zwxneeded for linking on OpenBSD fb0d87f Splice singleton unboxed tuples correctly with Template Haskell 1f75440 Extra comments, as per SPJ in #12035. acdbd16 Move #12403, #12513 users guide notes to 8.2.1 release notes 89facad Add T12520 as a test 1766bb3 RtClosureInspect: Fix off-by-one error in cvReconstructType 613d745 Template Haskell support for unboxed sums 7a86f58 Comments only: Refer to actually existing Notes 8d92b88 DmdAnal: Add a final, safe iteration d6fd2e3 DmdAnal: Testcase about splitFVs and dmdFix abortion ec7fcfd Degrade "case scrutinee not known to diverge for sure" Lint error to warning faaf313 WwLib: Add strictness signature to "let x = absentError …" 1083f45 Fix doc build inconsistency ae66f35 Allow typed holes to be levity-polymorphic a60ea70 Move import to avoid warning 0050aff Fix scoping of type variables in instances ca8c0e2 Typofix in docs. 983f660 Template Haskell support for TypeApplications 822af41 Fix broken Haddock comment f4384ef Remove unused DerivInst constructor for DerivStuff 21c2ebf Missing stderr for T12531. 9d17560 GhcMake: limit Capability count to CPU count in parallel mode a5d26f2 rts: enable parallel GC scan of large (32M+) allocation area 044e81b OccName: Remove unused DrIFT directive ff1931e TcGenDeriv: Typofix d168c41 Fix and complete runghc documentation 6781f37 Clarify pkg selection when multiple versions are available 83b326c Fix binary-trees regression from unnecessary floating in CorePrep. a25bf26 Tag pointers in interpreted constructors ef784c5 Fix handling of package-db entries in .ghc.environment files, etc. 2ee1db6 Fixes #12504: Double-escape paths used to build call to hsc_line 28b71c5 users_guide: More capabilities than processors considered harmful 0e74925 GHC: Expose installSignalHandlers, withCleanupSession 3005fa5 iserv: Show usage message on argument parse failure d790cb9 Bump the default allocation area size to 1MB d40d6df StgCmmPrim: Add missing MO_WriteBarrier d1f2239 Clarify scope of `getQ`/`putQ` state. 22259c1 testsuite: Failing testcase for #12091 2d22026 ErrUtils: Expose accessors of ErrDoc and ErrMsg a07a3ff A failing testcase for T12485 9306db0 TysWiredIn: Use dataConWorkerUnique instead of incrUnique 9cfef16 Add Read1/Read2 methods defined in terms of ReadPrec 1ad770f Add -flocal-ghci-history flag (#9089). 010b07a PPC NCG: Implement minimal stack frame header. ca6d0eb testsuite: Update bytes allocated of parsing001 75321ff Add -fdefer-out-of-scope-variables flag (#12170). e9b0bf4 Remove redundant-constraints from -Wall (#10635) 043604c RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax dad6a88 LoadIFace: Show known names on inconsistent interface file 3fb8f48 Revert "testsuite: Update bytes allocated of parsing001" a69371c users_guide: Document removal of -Wredundant-constraints from -Wall ad1e072 users_guide: Move addModFinalizer mention to 8.0.2 release notes 1f5d4a3 users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes da920f6 users_guide: Move initGhcMonad note to 8.0.2 relnotes a48de37 restore -fmax-worker-args handling (Trac #11565) 1e39c29 Kill vestiages of DEFAULT_TMPDIR 8d35e18 Fix startsVarSym and refactor operator predicates (fixes #4239) b946cf3 Revert "Fix startsVarSym and refactor operator predicates (fixes #4239)" f233f00 Fix startsVarSym and refactor operator predicates (fixes #4239) e5ecb20 Added support for deprecated POSIX functions on Windows. 0cc3931 configure.ac: fix --host= handling 818760d Fix #10923 by fingerprinting optimization level. 36bba47 Typos in notes 33d3527 Protect StablPtr dereference with the StaticPtr table lock. 133a5cc ghc-cabal: accept EXTRA_HC_OPTS make variable f93c363 extend '-fmax-worker-args' limit to specialiser (Trac #11565) ac2ded3 Typo in comment 57aa6bb Fix comment about result f8b139f test #12567: add new testcase with expected plugin behaviour 1805754 accept current (problematic) output cdbb9da cleanup: drop 11 years old performance hack 71dd6e4 Don't ignore addTopDecls in module finalizers. 6ea6242 Turn divInt# and modInt# into bitwise operations when possible 8d00175 Less scary arity mismatch error message when deriving 4ff4929 Make generated Ord instances smaller (per #10858). 34010db Derive the Generic instance in perf/compiler/T5642 05b497e distrib: Fix libdw bindist check a7a960e Make the test for #11108 less fragile dcc4904 Add failing testcase for #12433 feaa31f Remove references to -XRelaxedPolyRec 5eab6a0 Document meaning of order of --package-db flags, fixes #12485. a8238a4 Update unix submodule to latest HEAD. 65d9597 Add hook for creating ghci external interpreter 1b5f920 Make start address of `osReserveHeapMemory` tunable via command line -xb 7b4bb40 Remove -flocal-ghci-history from default flags 710f21c Add platform warning to Foreign.C.Types 158288b Generalise type of mkMatchGroup to unify with mkMatchGroupName 04184a2 Remove uses of mkMatchGroupName 7b7ea8f Fix derived Ix instances for one-constructor GADTs 0e7ccf6 Fix TH ppr output for list comprehensions with only one Stmt 454033b Add hs_try_putmvar() 03541cb Be less picky about reporing inaccessible code 21d0bfe Remove unused exports 35086d4 users_guide: Fix Docbook remnant b451fef users_guide: #8761 is now fixed c6ac1e5 users_guide: TH now partially supports typed holes 6555c6b rts: Disable -hb with multiple capabilities 5eeabe2 Test wibbles for commit 03541cba ec3edd5 Testsuite wibbles, to the same files 505a518 Comments and white space only 8074e03 Comments and white space only 876b00b Comments and white space 86836a2 Fix codegen bug in PIC version of genSwitch (#12433) 9123845 tryGrabCapability should be using TRY_ACQUIRE_LOCK 626db8f Unify CallStack handling in ghc a001299 Comments only a72d798 Comments in TH.Syntax (Trac #12596) 97b47d2 Add test case for #7611 ea310f9 Remove directories from include paths 14c2e8e Codegen for case: Remove redundant void id checks 6886bba Bump Haddock submodule to fix rendering of class methods 8bd3d41 Fix failing test T12504 9cbcdb4 shutdownHaskellAndExit: just do a normal hs_exit() (#5402) 74c4ca0 Expose hs_exit_(rtsFalse) as hs_exit_nowait() 3a17916 Improved documentation for Foreign.Concurrent (#12547) 9766b0c Fix #12442. 122da81 HACK: CoreLint: Kill unsaturated unlifted types check 08c0a50 TcSMonad: Introduce tcLookupId f11a313 CoreLint: Improve debug output 6bf102c Start implementing library side of TTypeable 4579316 Fix rebase 724c585 Add quick compatibility note ded63e2 Fix warnings 2f2e044 Various fixes cd17075 Fix serialization be801fc Implement Data.Typeable.funResultTy 1c0a5fd Binary: More explicit pattern matching 41612a8 More serialization 709b923 Message: Import Data.Typeable.TypeRep 85a7fe6 TcInteract: Unused parameter c02f748 Fix a few TTypeRep references 0d28ee9 Fix recursive fingerprints 8a893ff Finally serialization is both general and correct bab42dd Break recursive loop in serialization c06f90d Kill todo 4f02585 Fix up representation pretty-printer 01820df Another recursive serialization case 9818753 TcTypeable: Don't generate bindings for special primitive tycons 59ea724 Move special tycons 55e057e Internal things da824f2 Fix primitive types 8ff0010 Fix pretty-printer 7661ba2 Kill debugShow 1b7d4be Inline space 054318e Accept easy test output bf7f460 Add mkFunTy 94572f7 More test fixes 5f7f46f Fix T8132 2b229e8 Render TYPE 'PtrRepLifted as * 84d6743 Internal: Rename type variable 980221b Implement withTypeable 75646c4 Bump base to 4.10.0 6573b08 Fix withTypeable ae53687 Bump base 0d27bb9 testsuite: Bump base version 1b2f6a3 Rework Show ed2e97e Testsuite updates 051c277 Clarify serialization errors 7f5e6f2 Kill redundant comment ac91bb2 Note need for mkTrApp 30301c6 Make TRApp bidirectional a05f387 Add TRArrow pattern synonym 317be40 Fix up type printer b05e83c submodule changes 38bf32d TcInteract: Fix something 16cdaa1 Fix showTypeable 6dcb726 Fix serialization 082104d Clarify comments 6fad3f8 Binary: Simple serialization test works c1a6541 Give unboxed tuples type representations 45f2605 testsuite/TypeRep: Add test for #12409 3b67166 testsuite: Add test of Typeable Binary instances 8fd5510 TcTypeable: Clarify comment 4ff0352 Update submodules 083e183 Temporarily override submodule upstream repo paths ae3464e Add a TestEquality TypeRep instance 05c1608 Debug 594e948 Fix submodules From git at git.haskell.org Sat Oct 1 21:50:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:50:37 +0000 (UTC) Subject: [commit: ghc] master: CodeGen X86: fix unsafe foreign calls wrt inlining (b61b7c2) Message-ID: <20161001215037.52B503A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b61b7c2462b919de7eb4c373e2e2145c6d78d04c/ghc >--------------------------------------------------------------- commit b61b7c2462b919de7eb4c373e2e2145c6d78d04c Author: Sylvain HENRY Date: Sat Oct 1 00:25:49 2016 -0400 CodeGen X86: fix unsafe foreign calls wrt inlining Foreign calls (unsafe and safe) interact badly with inlining and register passing ABIs (see #11792 and #12614): the inlined code to compute a parameter of the call may overwrite a register already set to pass a preceding parameter. With this patch, we compute all parameters which are not simple expressions before assigning them to fixed registers required by the ABI. Test Plan: - Add test (test both reg and stack parameters) - Validate Reviewers: osa1, bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2263 GHC Trac Issues: #11792, #12614 >--------------------------------------------------------------- b61b7c2462b919de7eb4c373e2e2145c6d78d04c compiler/nativeGen/X86/CodeGen.hs | 111 ++++++++++++++++++--------- testsuite/tests/ffi/should_run/T12614.hs | 22 ++++++ testsuite/tests/ffi/should_run/T12614.stdout | 6 ++ testsuite/tests/ffi/should_run/T12614_c.c | 5 ++ testsuite/tests/ffi/should_run/all.T | 5 ++ 5 files changed, 113 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 b61b7c2462b919de7eb4c373e2e2145c6d78d04c From git at git.haskell.org Sat Oct 1 21:50:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:50:40 +0000 (UTC) Subject: [commit: ghc] master: GHCi: Don't remove shadowed bindings from typechecker scope. (59d7ee5) Message-ID: <20161001215040.95B153A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59d7ee53906b9cee7f279c1f9567af7b930f8636/ghc >--------------------------------------------------------------- commit 59d7ee53906b9cee7f279c1f9567af7b930f8636 Author: mniip Date: Sat Oct 1 00:26:04 2016 -0400 GHCi: Don't remove shadowed bindings from typechecker scope. The shadowed out bindings are accessible via qualified names like Ghci1.foo. Since they are accessable in the renamer the typechecker should be able to see them too. As a consequence they show up in :show bindings. This fixes T11547 Test Plan: Fixed current tests to accomodate to new stuff in :show bindings Added a test that verifies that the typechecker doesn't crash Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2447 GHC Trac Issues: #11547 >--------------------------------------------------------------- 59d7ee53906b9cee7f279c1f9567af7b930f8636 compiler/main/HscTypes.hs | 13 ++----------- testsuite/tests/ghci.debugger/scripts/break011.stdout | 7 +++++++ testsuite/tests/ghci.debugger/scripts/hist001.stdout | 4 ++++ testsuite/tests/ghci/scripts/T11547.script | 9 +++++++++ testsuite/tests/ghci/scripts/T11547.stdout | 5 +++++ testsuite/tests/ghci/scripts/T2976.stdout | 2 ++ testsuite/tests/ghci/scripts/all.T | 1 + 7 files changed, 30 insertions(+), 11 deletions(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index ddeee33..127775e 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1522,7 +1522,7 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults = ictxt { ic_mod_index = ic_mod_index ictxt + 1 -- Always bump this; even instances should create -- a new mod_index (Trac #9426) - , ic_tythings = new_tythings ++ old_tythings + , ic_tythings = new_tythings ++ ic_tythings ictxt , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings , ic_instances = ( new_cls_insts ++ old_cls_insts , new_fam_insts ++ old_fam_insts ) @@ -1530,8 +1530,6 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults , ic_fix_env = fix_env -- See Note [Fixity declarations in GHCi] } where - new_ids = [id | AnId id <- new_tythings] - old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt) -- Discard old instances that have been fully overrridden -- See Note [Override identical instances in GHCi] @@ -1544,17 +1542,10 @@ extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveCont extendInteractiveContextWithIds ictxt new_ids | null new_ids = ictxt | otherwise = ictxt { ic_mod_index = ic_mod_index ictxt + 1 - , ic_tythings = new_tythings ++ old_tythings + , ic_tythings = new_tythings ++ ic_tythings ictxt , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings } where new_tythings = map AnId new_ids - old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt) - -shadowed_by :: [Id] -> TyThing -> Bool -shadowed_by ids = shadowed - where - shadowed id = getOccName id `elemOccSet` new_occs - new_occs = mkOccSet (map getOccName ids) setInteractivePackage :: HscEnv -> HscEnv -- Set the 'thisPackage' DynFlag to 'interactive' diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index 47fb7b1..ac5b7e3 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -23,6 +23,13 @@ _exception = SomeException "foo" "CallStack (from HasCallStack): error, called at Test7.hs:2:18 in main:Main") +Ghci1._exception :: SomeException = SomeException + (ErrorCallWithLocation + "foo" + "CallStack (from HasCallStack): + error, called at Test7.hs:: in :Main") +Ghci2._result :: a = _ +Ghci3._result :: IO a = _ _result :: a = _ _exception :: SomeException = SomeException (ErrorCallWithLocation diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist001.stdout index a19a34f..523605b 100644 --- a/testsuite/tests/ghci.debugger/scripts/hist001.stdout +++ b/testsuite/tests/ghci.debugger/scripts/hist001.stdout @@ -12,6 +12,7 @@ Logged breakpoint at Test3.hs:2:22-31 _result :: [a] f :: t -> a xs :: [t] +Ghci1._result :: [a] = _ xs :: [t] = [] f :: t -> a = _ _result :: [a] = _ @@ -19,7 +20,10 @@ Logged breakpoint at Test3.hs:2:18-20 _result :: a f :: Integer -> a x :: Integer +Ghci1._result :: [a] = _ xs :: [t] = [] +Ghci2.f :: t -> a = _ +Ghci2._result :: [a] = _ x :: Integer = 2 f :: Integer -> a = _ _result :: a = _ diff --git a/testsuite/tests/ghci/scripts/T11547.script b/testsuite/tests/ghci/scripts/T11547.script new file mode 100644 index 0000000..c4c15d6 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T11547.script @@ -0,0 +1,9 @@ +foo = foo +:t Ghci1.foo +foo = foo +:t Ghci2.foo +:t Ghci1.foo +data Foo = Foo | Bar +data Foo = Bar +:t Foo +:t Ghci3.Bar diff --git a/testsuite/tests/ghci/scripts/T11547.stdout b/testsuite/tests/ghci/scripts/T11547.stdout new file mode 100644 index 0000000..6f2a833 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T11547.stdout @@ -0,0 +1,5 @@ +Ghci1.foo :: t +Ghci2.foo :: t +Ghci1.foo :: t +Foo :: Ghci3.Foo +Ghci3.Bar :: Ghci3.Foo diff --git a/testsuite/tests/ghci/scripts/T2976.stdout b/testsuite/tests/ghci/scripts/T2976.stdout index 9fdc110..de31112 100644 --- a/testsuite/tests/ghci/scripts/T2976.stdout +++ b/testsuite/tests/ghci/scripts/T2976.stdout @@ -1,6 +1,8 @@ test :: Integer = 0 test = 0 test :: Integer = 0 +Ghci1.test :: Integer = 0 test :: [Char] = _ test = "test" +Ghci1.test :: Integer = 0 test :: [Char] = "test" diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 9e36567..20888ae 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -258,6 +258,7 @@ test('T11376', normal, ghci_script, ['T11376.script']) test('T12007', normal, ghci_script, ['T12007.script']) test('T11975', normal, ghci_script, ['T11975.script']) test('T10963', normal, ghci_script, ['T10963.script']) +test('T11547', normal, ghci_script, ['T11547.script']) test('T12520', normal, ghci_script, ['T12520.script']) test('T12091', [expect_broken(12091), extra_run_opts('-fobject-code')], From git at git.haskell.org Sat Oct 1 21:50:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:50:43 +0000 (UTC) Subject: [commit: ghc] master: Support more than 64 logical processors on Windows (3c17905) Message-ID: <20161001215043.4E58E3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c1790546953b6db90fe7676e53b626722df8c61/ghc >--------------------------------------------------------------- commit 3c1790546953b6db90fe7676e53b626722df8c61 Author: Tamar Christina Date: Sat Oct 1 00:26:52 2016 -0400 Support more than 64 logical processors on Windows Windows support for more than 64 logical processors are implemented using processor groups. Essentially what it's doing is keeping the existing maximum of 64 processors and keeping the affinity mask a 64 bit value, but adds an hierarchy above that. This support was added to Windows 7 and so we need to at runtime detect if the APIs are still there due to our minimum supported version being Windows Vista. The Maximum number of groups supported at this time is 4, so 256 logical cores. The group indices are 0 based. One thread can have affinity with multiple groups. See https://msdn.microsoft.com/en-us/library/windows/desktop/ms684251.aspx and particularly helpful is the whitepaper: 'Supporting Systems that have more than 64 processors' at https://msdn.microsoft.com/en-us/library/windows/hardware/dn653313.aspx Processor groups are not guaranteed to be uniformly distributed nor guaranteed to be filled before a next group is needed. The OS will assign processors to groups based on physical proximity and will never partially assign cores from one physical cpu to more than one group. If one has two 48 core CPUs then you'd end up with two groups of 48 logical cpus. Now add a 3rd CPU with 10 cores and the group it is assigned to depends where the socket is on the board. Test Plan: ./validate or make test -c . in the rts test folder. This tests for regressions, to test this particular functionality itself: +RTS -N -qa -RTS Test is detailed in description. Reviewers: bgamari, simonmar, austin, erikd Reviewed By: simonmar Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2533 GHC Trac Issues: #11054 >--------------------------------------------------------------- 3c1790546953b6db90fe7676e53b626722df8c61 docs/users_guide/8.2.1-notes.rst | 4 + includes/rts/OSThreads.h | 5 + rts/RtsStartup.c | 5 + rts/posix/OSThreads.c | 5 + rts/win32/OSThreads.c | 298 +++++++++++++++++++++++++++++++++++++-- 5 files changed, 305 insertions(+), 12 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 3c1790546953b6db90fe7676e53b626722df8c61 From git at git.haskell.org Sat Oct 1 21:50:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:50:45 +0000 (UTC) Subject: [commit: ghc] master: Move -dno-debug-output to the end of the test flags (f869b23) Message-ID: <20161001215045.EF8873A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f869b23e9ac910720047b8ec078b52c3c2641627/ghc >--------------------------------------------------------------- commit f869b23e9ac910720047b8ec078b52c3c2641627 Author: Matthew Pickering Date: Sat Oct 1 00:28:43 2016 -0400 Move -dno-debug-output to the end of the test flags It is often convenient to copy the test invocation and remove this flag in order to see compiler traces. Moving it to the end makes it easier to remove. Remove trailing whitespace Reviewers: austin, thomie, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D2543 >--------------------------------------------------------------- f869b23e9ac910720047b8ec078b52c3c2641627 testsuite/mk/test.mk | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 7defc68..d4bd5fe 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -34,9 +34,7 @@ endif # TEST_HC_OPTS is passed to every invocation of TEST_HC # in nested Makefiles -TEST_HC_OPTS = -dcore-lint -dcmm-lint -dno-debug-output -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) - -TEST_HC_OPTS_INTERACTIVE = $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci -fno-ghci-history +TEST_HC_OPTS = -dcore-lint -dcmm-lint -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) ifeq "$(MinGhcVersion711)" "YES" # Don't warn about missing specialisations. They can only occur with `-O`, but @@ -45,6 +43,13 @@ TEST_HC_OPTS += -fno-warn-missed-specialisations TEST_HC_OPTS += -fshow-warning-groups endif +# Add the no-debug-output last as it is often convenient to copy the test invocation +# removing this line. +TEST_HC_OPTS += -dno-debug-output + +TEST_HC_OPTS_INTERACTIVE = $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci -fno-ghci-history + + RUNTEST_OPTS = ifeq "$(filter $(TargetOS_CPP), cygwin32 mingw32)" "" From git at git.haskell.org Sat Oct 1 21:50:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:50:48 +0000 (UTC) Subject: [commit: ghc] master: Recognise US spelling for specialisation flags. (151edd8) Message-ID: <20161001215048.B55F43A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/151edd89045c2aed20534c6826711db6a3f253c9/ghc >--------------------------------------------------------------- commit 151edd89045c2aed20534c6826711db6a3f253c9 Author: Tim McGilchrist Date: Sat Oct 1 00:28:26 2016 -0400 Recognise US spelling for specialisation flags. The user guide says that we allow the user to use `specialise` or `specialize` interchangeably but this wasn't the case for the relevant flags. This patch adds aliases for the flags which control specialisation. Reviewers: erikd, austin, mpickering, bgamari Reviewed By: mpickering, bgamari Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2542 GHC Trac Issues: #12575 >--------------------------------------------------------------- 151edd89045c2aed20534c6826711db6a3f253c9 compiler/main/DynFlags.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index a972716..cc11d3d 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3296,7 +3296,9 @@ wWarningFlagsDeps = [ flagSpec "overflowed-literals" Opt_WarnOverflowedLiterals, flagSpec "overlapping-patterns" Opt_WarnOverlappingPatterns, flagSpec "missed-specialisations" Opt_WarnMissedSpecs, + flagSpec "missed-specializations" Opt_WarnMissedSpecs, flagSpec "all-missed-specialisations" Opt_WarnAllMissedSpecs, + flagSpec "all-missed-specializations" Opt_WarnAllMissedSpecs, flagSpec' "safe" Opt_WarnSafe setWarnSafe, flagSpec "trustworthy-safe" Opt_WarnTrustworthySafe, flagSpec "tabs" Opt_WarnTabs, @@ -3429,8 +3431,11 @@ fFlagsDeps = [ flagSpec "shared-implib" Opt_SharedImplib, flagSpec "spec-constr" Opt_SpecConstr, flagSpec "specialise" Opt_Specialise, + flagSpec "specialize" Opt_Specialise, flagSpec "specialise-aggressively" Opt_SpecialiseAggressively, + flagSpec "specialize-aggressively" Opt_SpecialiseAggressively, flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, + flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, flagSpec "strictness" Opt_Strictness, flagSpec "use-rpaths" Opt_RPath, From git at git.haskell.org Sat Oct 1 21:50:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:50:51 +0000 (UTC) Subject: [commit: ghc] master: Mark T11978a as broken due to #12019 (d1b4fec) Message-ID: <20161001215051.6783D3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1b4fec12250e608ca8a863ba4ef911084c468ef/ghc >--------------------------------------------------------------- commit d1b4fec12250e608ca8a863ba4ef911084c468ef Author: Ben Gamari Date: Sat Oct 1 17:02:49 2016 -0400 Mark T11978a as broken due to #12019 Test Plan: `validate --slow` Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2536 GHC Trac Issues: #12019 >--------------------------------------------------------------- d1b4fec12250e608ca8a863ba4ef911084c468ef testsuite/tests/profiling/should_run/all.T | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 7aa7977..151b75b 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -110,7 +110,9 @@ test('T11627b', [ extra_run_opts('+RTS -i0 -RTS') # census after each GC , ['']) test('T11978a', - [only_ways(['profthreaded']), extra_run_opts('+RTS -hb -N10')], + [only_ways(['profthreaded']), + extra_run_opts('+RTS -hb -N10'), + expect_broken(12019)], compile_and_run, ['']) test('toplevel_scc_1', From git at git.haskell.org Sat Oct 1 21:52:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:52:42 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: incomplete bytecode support (a184113) Message-ID: <20161001215242.72A783A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/a184113d96e7e2315c5cf3f800bba3dc2073681e/ghc >--------------------------------------------------------------- commit a184113d96e7e2315c5cf3f800bba3dc2073681e Author: Joachim Breitner Date: Fri Sep 30 00:10:39 2016 -0400 ConApp: incomplete bytecode support >--------------------------------------------------------------- a184113d96e7e2315c5cf3f800bba3dc2073681e compiler/ghci/ByteCodeGen.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 90e2174..33607bd 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -157,6 +157,7 @@ simpleFreeVars = go . freeVars go' (AnnLit lit) = AnnLit lit go' (AnnLam bndr body) = AnnLam bndr (go body) go' (AnnApp fun arg) = AnnApp (go fun) (go arg) + go' (AnnConApp dc args) = AnnConApp dc (map go args) go' (AnnCase scrut bndr ty alts) = AnnCase (go scrut) bndr ty (map go_alt alts) go' (AnnLet bind body) = AnnLet (go_bind bind) (go body) go' (AnnCast expr (ann, co)) = AnnCast (go expr) (freeVarsOfAnn ann, co) @@ -420,6 +421,7 @@ schemeE d s p e -- Delegate tail-calls to schemeT. schemeE d s p e@(AnnApp _ _) = schemeT d s p e +schemeE d s p e@(AnnConApp _ _) = schemeT d s p e schemeE d s p e@(AnnLit lit) = returnUnboxedAtom d s p e (typeArgRep (literalType lit)) schemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e V @@ -432,6 +434,7 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) | (AnnVar v, args_r_to_l) <- splitApp rhs, Just data_con <- isDataConWorkId_maybe v, dataConRepArity data_con == length args_r_to_l + -- TODO #12618 remove eventually = do -- Special case for a non-recursive let whose RHS is a -- saturatred constructor application. -- Just allocate the constructor and carry on @@ -439,6 +442,14 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) body_code <- schemeE (d+1) s (Map.insert x d p) body return (alloc_code `appOL` body_code) +schemeE d s p (AnnLet (AnnNonRec x (_,AnnConApp dc args)) (_,body)) + = do -- Special case for a non-recursive let whose RHS is a + -- saturatred constructor application. + -- Just allocate the constructor and carry on + alloc_code <- mkConAppCode d s p dc (map snd (reverse args)) + body_code <- schemeE (d+1) s (Map.insert x d p) body + return (alloc_code `appOL` body_code) + -- General case for let. Generates correct, if inefficient, code in -- all situations. schemeE d s p (AnnLet binds (_,body)) = do @@ -624,6 +635,21 @@ schemeT :: Word -- Stack depth -> AnnExpr' Id DVarSet -> BcM BCInstrList +schemeT d s p (AnnConApp dc args') + | isUnboxedTupleCon dc + = case args of + [_,_,arg2,arg1] | isVAtom arg1 -> + unboxedTupleReturn d s p arg2 + [_,_,arg2,arg1] | isVAtom arg2 -> + unboxedTupleReturn d s p arg1 + _other -> multiValException + | otherwise + = do alloc_con <- mkConAppCode d s p dc (reverse args) + return (alloc_con `appOL` + mkSLIDE 1 (d - s) `snocOL` + ENTER) + where args = map snd args' + schemeT d s p app -- | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False @@ -1605,6 +1631,7 @@ bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) -- d) ticks (but not breakpoints) -- Type lambdas *can* occur in random expressions, -- whereas value lambdas cannot; that is why they are nuked here +-- TODO #12618: what to do with data con apps here? Keep types or not? bcView (AnnCast (_,e) _) = Just e bcView (AnnLam v (_,e)) | isTyVar v = Just e bcView (AnnApp (_,e) (_, AnnType _)) = Just e From git at git.haskell.org Sat Oct 1 21:52:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:52:45 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (b055290) Message-ID: <20161001215245.4D7923A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/b055290df73b4fc38c41622ab6381b0349046547/ghc >--------------------------------------------------------------- commit b055290df73b4fc38c41622ab6381b0349046547 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- b055290df73b4fc38c41622ab6381b0349046547 compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 11 +++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 49 ++++++++++++++-------- compiler/coreSyn/CoreSyn.hs | 4 ++ compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 3 ++ compiler/coreSyn/PprCore.hs | 4 ++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 4 ++ compiler/specialise/Rules.hs | 2 + compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 25 ++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ 36 files changed, 349 insertions(+), 90 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 b055290df73b4fc38c41622ab6381b0349046547 From git at git.haskell.org Sat Oct 1 21:52:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:52:48 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Add DataCon.dataConRepFullArity (ea5fa8a) Message-ID: <20161001215248.3401F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/ea5fa8afdc8d40a77f7909cbc0b8d5abd943aa7a/ghc >--------------------------------------------------------------- commit ea5fa8afdc8d40a77f7909cbc0b8d5abd943aa7a Author: Joachim Breitner Date: Fri Sep 30 20:48:33 2016 -0400 Add DataCon.dataConRepFullArity which is the number of arguments expected by the data constructor worker, including type argument, and hence the list of an (uncompressed) argument list in ConApp. >--------------------------------------------------------------- ea5fa8afdc8d40a77f7909cbc0b8d5abd943aa7a compiler/basicTypes/DataCon.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 6fda33a..47b05c9 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -39,7 +39,7 @@ module DataCon ( dataConInstOrigArgTys, dataConRepArgTys, dataConFieldLabels, dataConFieldType, dataConSrcBangs, - dataConSourceArity, dataConRepArity, + dataConSourceArity, dataConRepArity, dataConRepFullArity, dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, @@ -385,8 +385,10 @@ data DataCon -- Cached; see Note [DataCon arities] -- INVARIANT: dcRepArity == length dataConRepArgTys -- INVARIANT: dcSourceArity == length dcOrigArgTys - dcRepArity :: Arity, - dcSourceArity :: Arity, + -- INVARIANT: dcRepFullArity == length univ_tvs + length ex_tvs + dcRepArity + dcRepArity :: Arity, + dcSourceArity :: Arity, + dcRepFullArity :: Arity, -- Result type of constructor is T t1..tn dcRepTyCon :: TyCon, -- Result tycon, T @@ -799,6 +801,7 @@ mkDataCon name declared_infix prom_info dcRep = rep, dcSourceArity = length orig_arg_tys, dcRepArity = length rep_arg_tys, + dcRepFullArity = length univ_tvs + length ex_tvs + dcRepArity con, dcPromoted = promoted } -- The 'arg_stricts' passed to mkDataCon are simply those for the @@ -995,6 +998,11 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity +-- | Gives the number of arguments expected in ConApp: the universal type +-- variables, the existential type variables, the value arguments +dataConRepFullArity :: DataCon -> Arity +dataConRepFullArity (MkData { dcRepFullArity = arity }) = arity + -- | Return whether there are any argument types for this 'DataCon's original source type -- See Note [DataCon arities] isNullarySrcDataCon :: DataCon -> Bool From git at git.haskell.org Sat Oct 1 21:52:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:52:50 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: Lint check to ensure arity matches (d5ea9b2) Message-ID: <20161001215250.E7DD73A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/d5ea9b23640a988e369dff8189c2f4c170eed3bf/ghc >--------------------------------------------------------------- commit d5ea9b23640a988e369dff8189c2f4c170eed3bf Author: Joachim Breitner Date: Thu Sep 29 17:41:20 2016 -0400 ConApp: Lint check to ensure arity matches >--------------------------------------------------------------- d5ea9b23640a988e369dff8189c2f4c170eed3bf compiler/coreSyn/CoreLint.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 502030a..3b1fdf9 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -706,6 +706,8 @@ lintCoreExpr e@(ConApp dc args) when (lf_check_static_ptrs lf && dataConName dc == staticPtrDataConName) $ failWithL $ text "Found StaticPtr nested in an expression: " <+> ppr e + when (length args /= dataConRepFullArity dc) $ + failWithL $ hang (text "Un-saturated data con application") 2 (ppr e) let dc_ty = dataConRepType dc addLoc (AnExpr e) $ foldM lintCoreArg dc_ty args From git at git.haskell.org Sat Oct 1 21:52:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:52:53 +0000 (UTC) Subject: [commit: ghc] wip/T12618: mkCoreConApp: Ensure let/app invariant (5b14d2a) Message-ID: <20161001215253.978AE3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/5b14d2a8d08eeca1ac74459c1b6872093536a133/ghc >--------------------------------------------------------------- commit 5b14d2a8d08eeca1ac74459c1b6872093536a133 Author: Joachim Breitner Date: Sat Oct 1 14:02:16 2016 -0400 mkCoreConApp: Ensure let/app invariant This requires case-binding all affected arguments around the whole ConApp application, which is slightly more complicated than the App case. In particular, we need to juggle more than one unique. Therefore, I am adding another class of uniques. >--------------------------------------------------------------- 5b14d2a8d08eeca1ac74459c1b6872093536a133 compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 27 ++++++++++++++++++++++++--- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 43 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 3861513..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -152,12 +152,13 @@ mkCoreApps orig_fun orig_args mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr mkCoreConApps con args | length args >= dataConRepFullArity con - = mkCoreApps (ConApp con conArgs) extraArgs - -- TODO #12618: Do we need to check needsCaseBinding? + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args where -- TODO #12618: Can there ever be more than dataConRepArity con arguments -- in a type-safe program? - (conArgs, extraArgs) = splitAt (dataConRepFullArity con) args + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) mkCoreConApps con args -- Unsaturated application. TODO #12618 Use wrapper. = mkCoreApps (Var (dataConWorkId con)) args @@ -184,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Sat Oct 1 21:52:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 21:52:56 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (3ed1a8b) Message-ID: <20161001215256.4C1BD3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/3ed1a8b5f5affcdee19bf456c1c6d23044e0d34f/ghc >--------------------------------------------------------------- commit 3ed1a8b5f5affcdee19bf456c1c6d23044e0d34f Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- 3ed1a8b5f5affcdee19bf456c1c6d23044e0d34f compiler/coreSyn/MkCore.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..3861513 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,17 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = mkCoreApps (ConApp con conArgs) extraArgs + -- TODO #12618: Do we need to check needsCaseBinding? + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (conArgs, extraArgs) = splitAt (dataConRepFullArity con) args +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), From git at git.haskell.org Sat Oct 1 22:01:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 22:01:54 +0000 (UTC) Subject: [commit: ghc] master: Use check stacking on Windows. (1e795a0) Message-ID: <20161001220154.10D143A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1e795a008da8ab2ae88cca04aca01c50967b4397/ghc >--------------------------------------------------------------- commit 1e795a008da8ab2ae88cca04aca01c50967b4397 Author: Tamar Christina Date: Sat Sep 17 22:25:00 2016 +0100 Use check stacking on Windows. Summary: #8870 added as a temporary work around a much higher initial reserve and committed stack space of 2mb. This is causing problems with other windows applications. The hack was supposed to be temporary untill we could emit `__chkstk` instructions. But GCC can emit stack checks automatically for us if `-fstack-check` is passed. This will then emit calls to `___chkstk_ms` before stack allocations. ``` 633de0: 48 83 e0 f0 and $0xfffffffffffffff0,%rax 633de4: e8 07 0c 0d 00 callq 7049f0 <___chkstk_ms> 633de9: 48 29 c4 sub %rax,%rsp ``` The hack is now no longer needed. Test Plan: ./validate Reviewers: austin, erikd, awson, bgamari Reviewed By: bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2535 GHC Trac Issues: #12186 >--------------------------------------------------------------- 1e795a008da8ab2ae88cca04aca01c50967b4397 compiler/main/SysTools.hs | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 6cdb07e..e40b1d6 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -644,7 +644,7 @@ figureLlvmVersion dflags = do {- Note [Windows stack usage] -See: Trac #8870 (and #8834 for related info) +See: Trac #8870 (and #8834 for related info) and #12186 On Windows, occasionally we need to grow the stack. In order to do this, we would normally just bump the stack pointer - but there's a @@ -665,17 +665,11 @@ stack space in GHC itself. In the x86 codegen, we needed approximately ~12kb of stack space in one go, which caused the process to segfault, as the intervening pages were not committed. -In the future, we should do the same thing, to make the problem -completely go away. In the mean time, we're using a workaround: we -instruct the linker to specify the generated PE as having an initial -reserved stack size of 8mb, as well as a initial *committed* stack -size of 8mb. The default committed size was previously only 4k. +GCC can emit such a check for us automatically but only when the flag +-fstack-check is used. -Theoretically it's possible to still hit this problem if you request a -stack bump of more than 8mb in one go. But the amount of code -necessary is quite large, and 8mb "should be more than enough for -anyone" right now (he said, before millions of lines of code cried out -in terror). +See https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html +for more information. -} @@ -828,11 +822,12 @@ getLinkerInfo' dflags = do [ -- Reduce ld memory usage "-Wl,--hash-size=31" , "-Wl,--reduce-memory-overheads" - -- Increase default stack, see + -- Emit gcc stack checks -- Note [Windows stack usage] + , "-fstack-check" -- Force static linking of libGCC -- Note [Windows static libGCC] - , "-Xlinker", "--stack=0x800000,0x800000", "-static-libgcc" ] + , "-static-libgcc" ] _ -> do -- In practice, we use the compiler as the linker here. Pass -- -Wl,--version to get linker version info. From git at git.haskell.org Sat Oct 1 22:20:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Oct 2016 22:20:14 +0000 (UTC) Subject: [commit: ghc] master: Add NUMA support for Windows (c93813d) Message-ID: <20161001222014.B692F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c93813d96b1da53a2ebd9c9ac5af6cc3e3443c43/ghc >--------------------------------------------------------------- commit c93813d96b1da53a2ebd9c9ac5af6cc3e3443c43 Author: Tamar Christina Date: Sun Sep 25 20:00:31 2016 +0100 Add NUMA support for Windows Summary: NOTE: I have been able to do simple testing on emulated NUMA nodes. Real hardware would be needed for a proper test. D2199 Added NUMA support for Linux, I have just filled in the missing pieces following the description of the Linux APIs. Test Plan: Use `bcdedit.exe /set groupsize 2` to modify the kernel again (Similar to D2533). This generates some NUMA nodes: ``` Logical Processor to NUMA Node Map: NUMA Node 0: ** -- NUMA Node 1: -- ** Approximate Cross-NUMA Node Access Cost (relative to fastest): 00 01 00: 1.1 1.1 01: 1.0 1.0 ``` run ` ../test-numa.exe +RTS --numa -RTS` and check PerfMon for NUMA allocations. Reviewers: simonmar, erikd, bgamari, austin Reviewed By: simonmar Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2534 GHC Trac Issues: #12602 >--------------------------------------------------------------- c93813d96b1da53a2ebd9c9ac5af6cc3e3443c43 docs/users_guide/8.2.1-notes.rst | 2 + rts/win32/OSMem.c | 81 ++++++++++++++++++++++++++++++++++++---- rts/win32/OSThreads.c | 45 +++++++++++++++++++++- 3 files changed, 118 insertions(+), 10 deletions(-) diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index 033f8da..2147dbc 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -71,6 +71,8 @@ Runtime system event log, allowing heap profiles to be correlated with other tracing events (see :ghc-ticket:`11094`). +- Added NUMA support to Windows. + - Added processor group support for Windows. This allows the runtime to allocate threads to all cores in systems which have multiple processor groups. (e.g. > 64 cores, see :ghc-ticket:`11054`) diff --git a/rts/win32/OSMem.c b/rts/win32/OSMem.c index 3d9a304..b43636c 100644 --- a/rts/win32/OSMem.c +++ b/rts/win32/OSMem.c @@ -11,9 +11,7 @@ #include "sm/HeapAlloc.h" #include "RtsUtils.h" -#if HAVE_WINDOWS_H #include -#endif typedef struct alloc_rec_ { char* base; // non-aligned base address, directly from VirtualAlloc @@ -39,11 +37,28 @@ static alloc_rec* allocs = NULL; /* free_blocks are kept in ascending order, and adjacent blocks are merged */ static block_rec* free_blocks = NULL; +/* Mingw-w64 does not currently have this in their header. So we have to import it.*/ +typedef LPVOID(WINAPI *VirtualAllocExNumaProc)(HANDLE, LPVOID, SIZE_T, DWORD, DWORD, DWORD); + +/* Cache NUMA API call. */ +VirtualAllocExNumaProc VirtualAllocExNuma; + void osMemInit(void) { allocs = NULL; free_blocks = NULL; + + /* Resolve and cache VirtualAllocExNuma. */ + if (osNumaAvailable() && RtsFlags.GcFlags.numa) + { + VirtualAllocExNuma = (VirtualAllocExNumaProc)GetProcAddress(GetModuleHandleW(L"kernel32"), "VirtualAllocExNuma"); + if (!VirtualAllocExNuma) + { + sysErrorBelch( + "osBindMBlocksToNode: VirtualAllocExNuma does not exist. How did you get this far?"); + } + } } static @@ -486,22 +501,72 @@ void osReleaseHeapMemory (void) rtsBool osNumaAvailable(void) { - return rtsFalse; + return osNumaNodes() > 1; } uint32_t osNumaNodes(void) { - return 1; + /* Cache the amount of NUMA values. */ + static ULONG numNumaNodes = 0; + + /* Cache the amount of NUMA nodes. */ + if (!numNumaNodes && !GetNumaHighestNodeNumber(&numNumaNodes)) + { + numNumaNodes = 1; + } + + return numNumaNodes; } StgWord osNumaMask(void) { - return 1; + StgWord numaMask; + if (!GetNumaNodeProcessorMask(0, &numaMask)) + { + return 1; + } + return numaMask; } void osBindMBlocksToNode( - void *addr STG_UNUSED, - StgWord size STG_UNUSED, - uint32_t node STG_UNUSED) + void *addr, + StgWord size, + uint32_t node) { + if (osNumaAvailable()) + { + void* temp; + if (RtsFlags.GcFlags.numa) { + /* Note [base memory] + I would like to use addr here to specify the base + memory of allocation. The problem is that the address + we are requesting is too high. I can't figure out if it's + because of my NUMA-emulation or a bug in the code. + + On windows also -xb is broken, it does nothing so that can't + be used to tweak it (see #12577). So for now, just let the OS decide. + */ + temp = VirtualAllocExNuma( + GetCurrentProcess(), + NULL, // addr? See base memory + size, + MEM_RESERVE | MEM_COMMIT, + PAGE_READWRITE, + node + ); + + if (!temp) { + if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) { + errorBelch("out of memory"); + } + else { + sysErrorBelch( + "osBindMBlocksToNode: VirtualAllocExNuma MEM_RESERVE %llu bytes " + "at address %p bytes failed", + size, addr); + } + stg_exit(EXIT_FAILURE); + } + } + } } diff --git a/rts/win32/OSThreads.c b/rts/win32/OSThreads.c index c9b594a..b36c3e5 100644 --- a/rts/win32/OSThreads.c +++ b/rts/win32/OSThreads.c @@ -9,6 +9,7 @@ #include "Rts.h" #include +#include "sm/OSMem.h" #if defined(THREADED_RTS) #include "RtsUtils.h" @@ -572,8 +573,48 @@ interruptOSThread (OSThreadId id) CloseHandle(hdl); } -void setThreadNode (uint32_t node STG_UNUSED) { /* nothing */ } -void releaseThreadNode (void) { /* nothing */ } +void setThreadNode (uint32_t node) +{ + if (osNumaAvailable()) + { + StgWord mask = 0; + mask |= 1 << node; + if (!SetThreadAffinityMask(GetCurrentThread(), mask)) + { + sysErrorBelch( + "setThreadNode: Error setting affinity of thread to NUMA node `%u': %lu.", + node, GetLastError()); + stg_exit(EXIT_FAILURE); + } + } +} + +void releaseThreadNode (void) +{ + if (osNumaAvailable()) + { + StgWord processMask; + StgWord systemMask; + if (!GetProcessAffinityMask(GetCurrentProcess(), + &processMask, + &systemMask)) + { + sysErrorBelch( + "releaseThreadNode: Error resetting affinity of thread: %lu", + GetLastError()); + stg_exit(EXIT_FAILURE); + } + + if (!SetThreadAffinityMask(GetCurrentThread(), processMask)) + { + sysErrorBelch( + "releaseThreadNode: Error reseting NUMA affinity mask of thread: %lu.", + GetLastError()); + stg_exit(EXIT_FAILURE); + } + + } +} #else /* !defined(THREADED_RTS) */ From git at git.haskell.org Sun Oct 2 00:02:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:00 +0000 (UTC) Subject: [commit: ghc] master: ghc-pkg: Allow unregistering multiple packages in one call (0014fa5) Message-ID: <20161002000200.5FC403A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0014fa56e9f2fe936da85627c92a288037c8c19b/ghc >--------------------------------------------------------------- commit 0014fa56e9f2fe936da85627c92a288037c8c19b Author: Niklas Hambüchen Date: Sat Oct 1 17:57:32 2016 -0400 ghc-pkg: Allow unregistering multiple packages in one call Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2550 GHC Trac Issues: #12637 >--------------------------------------------------------------- 0014fa56e9f2fe936da85627c92a288037c8c19b utils/ghc-pkg/Main.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 399522a..91eaeec 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -226,8 +226,8 @@ usageHeader prog = substProg prog $ " Register the package, overwriting any other package with the\n" ++ " same name. The input file should be encoded in UTF-8.\n" ++ "\n" ++ - " $p unregister {pkg-id}\n" ++ - " Unregister the specified package.\n" ++ + " $p unregister [pkg-id] \n" ++ + " Unregister the specified packages in the order given.\n" ++ "\n" ++ " $p expose {pkg-id}\n" ++ " Expose the specified package.\n" ++ @@ -422,9 +422,10 @@ runit verbosity cli nonopts = do registerPackage filename verbosity cli multi_instance expand_env_vars True force - ["unregister", pkgarg_str] -> do - pkgarg <- readPackageArg as_arg pkgarg_str - unregisterPackage pkgarg verbosity cli force + "unregister" : pkgarg_strs@(_:_) -> do + forM_ pkgarg_strs $ \pkgarg_str -> do + pkgarg <- readPackageArg as_arg pkgarg_str + unregisterPackage pkgarg verbosity cli force ["expose", pkgarg_str] -> do pkgarg <- readPackageArg as_arg pkgarg_str exposePackage pkgarg verbosity cli force From git at git.haskell.org Sun Oct 2 00:02:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:03 +0000 (UTC) Subject: [commit: ghc] master: Do not warn about unused underscore-prefixed fields (fixes Trac #12609) (48ff084) Message-ID: <20161002000203.9333B3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48ff0843eee29313cc2da14c04dc57f6589ab040/ghc >--------------------------------------------------------------- commit 48ff0843eee29313cc2da14c04dc57f6589ab040 Author: Adam Gundry Date: Sat Oct 1 17:56:58 2016 -0400 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) When DuplicateRecordFields is enabled, the mangling of selector names was causing them to be reported as unused even if prefixed by an underscore. This corrects the OccName used by the check. Test Plan: New test overloadedrecflds/should_compile/T12609 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2549 GHC Trac Issues: #12609 >--------------------------------------------------------------- 48ff0843eee29313cc2da14c04dc57f6589ab040 compiler/rename/RnEnv.hs | 13 ++++++++----- testsuite/tests/overloadedrecflds/should_compile/T12609.hs | 8 ++++++++ testsuite/tests/overloadedrecflds/should_compile/all.T | 1 + 3 files changed, 17 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 37e389e..b1cb7fe 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -2145,7 +2145,7 @@ warnUnused flag names = do warnUnused1 :: WarningFlag -> NameEnv (FieldLabelString, Name) -> Name -> RnM () warnUnused1 flag fld_env name - = when (reportable name) $ + = when (reportable name occ) $ addUnusedWarning flag occ (nameSrcSpan name) (text "Defined but not used") @@ -2158,7 +2158,7 @@ warnUnusedGRE :: GlobalRdrElt -> RnM () warnUnusedGRE gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = is }) | lcl = do fld_env <- mkFieldEnv <$> getGlobalRdrEnv warnUnused1 Opt_WarnUnusedTopBinds fld_env name - | otherwise = when (reportable name) (mapM_ warn is) + | otherwise = when (reportable name occ) (mapM_ warn is) where occ = greOccName gre warn spec = addUnusedWarning Opt_WarnUnusedTopBinds occ span msg @@ -2176,12 +2176,15 @@ mkFieldEnv rdr_env = mkNameEnv [ (gre_name gre, (lbl, par_is (gre_par gre))) , Just lbl <- [greLabel gre] ] -reportable :: Name -> Bool -reportable name +-- | Should we report the fact that this 'Name' is unused? The +-- 'OccName' may differ from 'nameOccName' due to +-- DuplicateRecordFields. +reportable :: Name -> OccName -> Bool +reportable name occ | isWiredInName name = False -- Don't report unused wired-in names -- Otherwise we get a zillion warnings -- from Data.Tuple - | otherwise = not (startsWithUnderscore (nameOccName name)) + | otherwise = not (startsWithUnderscore occ) addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM () addUnusedWarning flag occ span msg diff --git a/testsuite/tests/overloadedrecflds/should_compile/T12609.hs b/testsuite/tests/overloadedrecflds/should_compile/T12609.hs new file mode 100644 index 0000000..7b8205b --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/T12609.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# OPTIONS_GHC -Werror -Wunused-top-binds #-} +module Main (main, T(MkT)) where + +data T = MkT { _x :: Int } + +main :: IO () +main = return () diff --git a/testsuite/tests/overloadedrecflds/should_compile/all.T b/testsuite/tests/overloadedrecflds/should_compile/all.T index ea5baf8..264fa11 100644 --- a/testsuite/tests/overloadedrecflds/should_compile/all.T +++ b/testsuite/tests/overloadedrecflds/should_compile/all.T @@ -1 +1,2 @@ test('T11173', extra_clean(['T11173a.hi', 'T11173a.o']), multimod_compile, ['T11173', '-v0']) +test('T12609', normal, compile, ['']) From git at git.haskell.org Sun Oct 2 00:02:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:06 +0000 (UTC) Subject: [commit: ghc] master: Fix interaction of record pattern synonyms and record wildcards (2d6642b) Message-ID: <20161002000206.D6BAF3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d6642bd1956edf8b842c07d78e83c500246998a/ghc >--------------------------------------------------------------- commit 2d6642bd1956edf8b842c07d78e83c500246998a Author: Matthew Pickering Date: Sat Oct 1 17:55:04 2016 -0400 Fix interaction of record pattern synonyms and record wildcards We were missing an appropiate *ConLike lookup in the case when the pattern synonym was defined in a different module. Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2544 GHC Trac Issues: #11987 >--------------------------------------------------------------- 2d6642bd1956edf8b842c07d78e83c500246998a compiler/rename/RnEnv.hs | 4 ++-- testsuite/tests/patsyn/should_compile/T11987.hs | 12 ++++++++++++ testsuite/tests/patsyn/should_compile/T11987a.hs | 9 +++++++++ testsuite/tests/patsyn/should_compile/all.T | 3 ++- 4 files changed, 25 insertions(+), 3 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 63b1f1f..37e389e 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -462,9 +462,9 @@ lookupConstructorFields con_name ; traceTc "lookupCF" (ppr con_name $$ ppr (lookupNameEnv field_env con_name) $$ ppr field_env) ; return (lookupNameEnv field_env con_name `orElse` []) } else - do { con <- tcLookupDataCon con_name + do { con <- tcLookupConLike con_name ; traceTc "lookupCF 2" (ppr con) - ; return (dataConFieldLabels con) } } + ; return (conLikeFieldLabels con) } } ----------------------------------------------- -- Used for record construction and pattern matching diff --git a/testsuite/tests/patsyn/should_compile/T11987.hs b/testsuite/tests/patsyn/should_compile/T11987.hs new file mode 100644 index 0000000..eab3316 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T11987.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NamedFieldPuns, PatternSynonyms, RecordWildCards #-} +module T11987 where + +import T11987a + +-- works +namedFieldPuns :: (Int,Int) +namedFieldPuns = let { x = 1; y = 2 } in Point { x, y } + +-- error: Pattern synonym ‘Point’ used as a data constructor +recordWildCards :: (Int,Int) +recordWildCards = let { x = 1; y = 2 } in Point { .. } diff --git a/testsuite/tests/patsyn/should_compile/T11987a.hs b/testsuite/tests/patsyn/should_compile/T11987a.hs new file mode 100644 index 0000000..c381c2b --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T11987a.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NamedFieldPuns, PatternSynonyms, RecordWildCards #-} +module T11987a where + +pattern Point :: Int -> Int -> (Int, Int) +pattern Point{x, y} = (x, y) + +-- works +sameFile :: (Int,Int) +sameFile = let { x = 1; y = 2 } in Point { .. } diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 7551eb9..1297d8c 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -58,4 +58,5 @@ test('T12094', normal, compile, ['']) test('T11977', normal, compile, ['']) test('T12108', normal, compile, ['']) test('T12484', normal, compile, ['']) -test('T12489', normal, compile, ['']) +test('T11987', normal, multimod_compile, ['T11987', '-v0']) + From git at git.haskell.org Sun Oct 2 00:02:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:09 +0000 (UTC) Subject: [commit: ghc] master: Turn `__GLASGOW_HASKELL_LLVM__` into an integer again (b0d53a8) Message-ID: <20161002000209.8B3183A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0d53a839da0149e0142da036b6ebf5a01b3216f/ghc >--------------------------------------------------------------- commit b0d53a839da0149e0142da036b6ebf5a01b3216f Author: Nicolas Trangez Date: Sat Oct 1 17:58:11 2016 -0400 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again In GHC < 8.0.1, the value of `__GLASGOW_HASKELL_LLVM__`, exposed through the preprocessor when compiled with `-fllvm`, was an integer value, encoded according to some rules specified in the user guide. Due to an oversight, in GHC 8.0.1 the value of this define became a tuple, exposed as e.g. `(3, 7)`. This was an unintended regression. This patch turns the value of the `__GLASGOW_HASKELL_LLVM__` definition into a single integer again, but changes the formatting of said number slightly. Before, any LLVM version where the major or minor component >= 10 would cause ambiguous values for `__GLASGOW_HASKELL_LLVM__`. With this patch, the value is in line with `__GLASGOW_HASKELL__`, adding a padding `0` in-between major and minor component if applicable (we assume no minors >= 100 will ever exist). The documentation in the user guide is updated accordingly, and a reference is made in the 8.0.2 release notes. Test Plan: validate Reviewers: bgamari, erikd Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2552 GHC Trac Issues: #12628 >--------------------------------------------------------------- b0d53a839da0149e0142da036b6ebf5a01b3216f compiler/main/DriverPipeline.hs | 6 +++++- docs/users_guide/8.0.2-notes.rst | 6 ++++++ docs/users_guide/phases.rst | 4 +++- 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 5d648e6..6e61d20 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2099,8 +2099,12 @@ getBackendDefs :: DynFlags -> IO [String] getBackendDefs dflags | hscTarget dflags == HscLlvm = do llvmVer <- figureLlvmVersion dflags return $ case llvmVer of - Just n -> [ "-D__GLASGOW_HASKELL_LLVM__="++show n ] + Just n -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format n ] _ -> [] + where + format (major, minor) + | minor >= 100 = error "getBackendDefs: Unsupported minor version" + | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int getBackendDefs _ = return [] diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 43c9562..82c214e 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -40,6 +40,12 @@ Compiler defaulting to decimal, hexadecimal if the address starts with `0x`, and octal if the address starts with `0`. +- Due to an oversight in GHC 8.0.1, the value of the preprocessor macro + ``__GLASGOW_HASKELL_LLVM__``, which exposes the LLVM version used by GHC, was + no longer an integer. This value is now turned into an integer again, but the + formatting is changed to be in line with ``__GLASGOW_HASKELL__`` + (:ghc-ticket:`12628`). + Runtime system ~~~~~~~~~~~~~~ diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index 0c3b59f..01c2e1f 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -291,7 +291,9 @@ defined by your local GHC installation, the following trick is useful: Only defined when ``-fllvm`` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the - integer ⟨xy⟩. + integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero + is added, so for example when using version 3.7 of LLVM, + ``__GLASGOW_HASKELL_LLVM__==307``). ``__PARALLEL_HASKELL__`` .. index:: From git at git.haskell.org Sun Oct 2 00:02:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:12 +0000 (UTC) Subject: [commit: ghc] master: Eliminate some unsafeCoerce#s with deriving strategies (f547b44) Message-ID: <20161002000212.37A3F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f547b444fdaf1c86abede42bf4c4b1037f50f588/ghc >--------------------------------------------------------------- commit f547b444fdaf1c86abede42bf4c4b1037f50f588 Author: Ryan Scott Date: Sat Oct 1 17:58:27 2016 -0400 Eliminate some unsafeCoerce#s with deriving strategies Currently, `Foreign.C.Types`, `Foreign.Ptr`, and `System.Posix.Types` define `Read` and `Show` instances for the newtypes in those modules by using `unsafeCoerce#`. We can clean up this hack by using the `newtype` deriving strategy. Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2556 >--------------------------------------------------------------- f547b444fdaf1c86abede42bf4c4b1037f50f588 libraries/base/Foreign/C/Types.hs | 8 ++++++-- libraries/base/Foreign/Ptr.hs | 8 ++++++-- libraries/base/System/Posix/Types.hs | 12 ++++++------ libraries/base/include/CTypes.h | 31 ++++++++----------------------- 4 files changed, 26 insertions(+), 33 deletions(-) diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs index 6d084bf..f76ff1c 100644 --- a/libraries/base/Foreign/C/Types.hs +++ b/libraries/base/Foreign/C/Types.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, GeneralizedNewtypeDeriving, - StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-unused-binds #-} -- XXX -Wno-unused-binds stops us warning about unused constructors, -- but really we should just remove them if we don't want them diff --git a/libraries/base/Foreign/Ptr.hs b/libraries/base/Foreign/Ptr.hs index 5e6bccf..45e6cf5 100644 --- a/libraries/base/Foreign/Ptr.hs +++ b/libraries/base/Foreign/Ptr.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, GeneralizedNewtypeDeriving, - StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/System/Posix/Types.hs b/libraries/base/System/Posix/Types.hs index 52fce87..67c38aa 100644 --- a/libraries/base/System/Posix/Types.hs +++ b/libraries/base/System/Posix/Types.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP - , NoImplicitPrelude - , MagicHash - , GeneralizedNewtypeDeriving - #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/include/CTypes.h b/libraries/base/include/CTypes.h index d821d66..9cee4f7 100644 --- a/libraries/base/include/CTypes.h +++ b/libraries/base/include/CTypes.h @@ -21,34 +21,19 @@ #define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat #define ARITHMETIC_TYPE(T,B) \ -newtype T = T B deriving (ARITHMETIC_CLASSES); \ -INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); +newtype T = T B deriving (ARITHMETIC_CLASSES) \ + deriving newtype (Read, Show); #define INTEGRAL_TYPE(T,B) \ -newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \ -INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); +newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES) \ + deriving newtype (Read, Show); #define INTEGRAL_TYPE_WITH_CTYPE(T,THE_CTYPE,B) \ -newtype {-# CTYPE "THE_CTYPE" #-} T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \ -INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); +newtype {-# CTYPE "THE_CTYPE" #-} T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES) \ + deriving newtype (Read, Show); #define FLOATING_TYPE(T,B) \ -newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \ -INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); - -#define INSTANCE_READ(T,B) \ -instance Read T where { \ - readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \ - readList = unsafeCoerce# (readList :: ReadS [B]); } - -#define INSTANCE_SHOW(T,B) \ -instance Show T where { \ - showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \ - show = unsafeCoerce# (show :: B -> String); \ - showList = unsafeCoerce# (showList :: [B] -> ShowS); } +newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES) \ + deriving newtype (Read, Show); #endif From git at git.haskell.org Sun Oct 2 00:02:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:14 +0000 (UTC) Subject: [commit: ghc] master: PPC/CodeGen: fix lwa instruction generation (ce3370e) Message-ID: <20161002000214.DE86B3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce3370e06165690e79a8eb22e5229b515157e00f/ghc >--------------------------------------------------------------- commit ce3370e06165690e79a8eb22e5229b515157e00f Author: Peter Trommler Date: Sat Oct 1 17:56:31 2016 -0400 PPC/CodeGen: fix lwa instruction generation Opcode lwa is a 64-bit opcode and allows a DS-form only. This patch generates lwa opcodes only when the offset is a multiple of 4. Fixes #12621 Test Plan: validate Reviewers: erikd, hvr, simonmar, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2547 GHC Trac Issues: #12621 >--------------------------------------------------------------- ce3370e06165690e79a8eb22e5229b515157e00f compiler/nativeGen/PPC/CodeGen.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index d03a6e5..ead122b 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -9,9 +9,8 @@ ----------------------------------------------------------------------------- -- This is a big module, but, if you pay attention to --- (a) the sectioning, (b) the type signatures, and --- (c) the #if blah_TARGET_ARCH} things, the --- structure should not be too overwhelming. +-- (a) the sectioning, and (b) the type signatures, +-- the structure should not be too overwhelming. module PPC.CodeGen ( cmmTopCodeGen, @@ -471,7 +470,8 @@ getRegister' _ (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad mem _]) = do return (Any II64 (\dst -> addr_code `snocOL` LD II32 dst addr)) getRegister' _ (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad mem _]) = do - Amode addr addr_code <- getAmode D mem + -- lwa is DS-form. See Note [Power instruction format] + Amode addr addr_code <- getAmode DS mem return (Any II64 (\dst -> addr_code `snocOL` LA II32 dst addr)) getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps @@ -742,6 +742,14 @@ temporary, then do the other computation, and then use the temporary: ... (tmp) ... -} +{- Note [Power instruction format] +In some instructions the 16 bit offset must be a multiple of 4, i.e. +the two least significant bits mus be zero. The "Power ISA" specification +calls these instruction formats "DS-FORM" and the instructions with +arbitrary 16 bit offsets are "D-FORM". + +The Power ISA specification document can be obtained from www.power.org. +-} data InstrForm = D | DS getAmode :: InstrForm -> CmmExpr -> NatM Amode From git at git.haskell.org Sun Oct 2 00:02:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:18 +0000 (UTC) Subject: [commit: ghc] master: Don't warn about name shadowing when renaming the patten in a PatSyn decl (1851349) Message-ID: <20161002000218.39F023A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1851349acd9e73f1c18d68f70d5cf7b46a843cb5/ghc >--------------------------------------------------------------- commit 1851349acd9e73f1c18d68f70d5cf7b46a843cb5 Author: Matthew Pickering Date: Sat Oct 1 17:55:26 2016 -0400 Don't warn about name shadowing when renaming the patten in a PatSyn decl Previously the renamer assumed that *any* time we renamed a pattern, the pattern was introducing new binders. This isn't true in pattern synonym declarations where the pattern is used as part of a definition. We add a special case to not warn in this situation. Reviewers: simonpj, austin, bgamari Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2545 GHC Trac Issues: #12615 >--------------------------------------------------------------- 1851349acd9e73f1c18d68f70d5cf7b46a843cb5 compiler/hsSyn/HsExpr.hs | 6 +++++ compiler/rename/RnPat.hs | 30 +++++++++++++++++++++---- testsuite/tests/patsyn/should_compile/T12615.hs | 12 ++++++++++ testsuite/tests/patsyn/should_compile/all.T | 2 +- 4 files changed, 45 insertions(+), 5 deletions(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 1ff204b..fdce60a 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -2277,6 +2277,12 @@ data HsMatchContext id deriving Functor deriving instance (DataIdPost id) => Data (HsMatchContext id) +isPatSynCtxt :: HsMatchContext id -> Bool +isPatSynCtxt ctxt = + case ctxt of + PatSyn -> True + _ -> False + -- | Haskell Statement Context data HsStmtContext id = ListComp diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 7e41bec..e67be63 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -62,7 +62,7 @@ import TysWiredIn ( nilDataCon ) import DataCon import qualified GHC.LanguageExtensions as LangExt -import Control.Monad ( when, liftM, ap ) +import Control.Monad ( when, liftM, ap, unless ) import Data.Ratio {- @@ -248,6 +248,25 @@ We want to "see" this use, and in let-bindings we collect all uses and report unused variables at the binding level. So we must use bindLocalNames here, *not* bindLocalNameFV. Trac #3943. + +Note: [Don't report shadowing for pattern synonyms] +There is one special context where a pattern doesn't introduce any new binders - +pattern synonym declarations. Therefore we don't check to see if pattern +variables shadow existing identifiers as they are never bound to anything +and have no scope. + +Without this check, there would be quite a cryptic warning that the `x` +in the RHS of the pattern synonym declaration shadowed the top level `x`. + +``` +x :: () +x = () + +pattern P x = Just x +``` + +See #12615 for some more examples. + ********************************************************* * * External entry points @@ -293,9 +312,12 @@ rnPats ctxt pats thing_inside -- check incrementally for duplicates; -- Nor can we check incrementally for shadowing, else we'll -- complain *twice* about duplicates e.g. f (x,x) = ... - ; addErrCtxt doc_pat $ - checkDupAndShadowedNames envs_before $ - collectPatsBinders pats' + -- + -- See note [Don't report shadowing for pattern synonyms] + ; unless (isPatSynCtxt ctxt) + (addErrCtxt doc_pat $ + checkDupAndShadowedNames envs_before $ + collectPatsBinders pats') ; thing_inside pats' } } where doc_pat = text "In" <+> pprMatchContext ctxt diff --git a/testsuite/tests/patsyn/should_compile/T12615.hs b/testsuite/tests/patsyn/should_compile/T12615.hs new file mode 100644 index 0000000..1405525 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12615.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude, PatternSynonyms #-} +{-# OPTIONS_GHC -Wall #-} +module Test where + +x :: () +x = () + +pattern Point2 :: () -> () -> ((), ()) +pattern Point2 x y = (x, y) + +pattern Point :: () -> () -> ((), ()) +pattern Point{x1, y1} = (x1, y1) diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 1297d8c..d26fc84 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -59,4 +59,4 @@ test('T11977', normal, compile, ['']) test('T12108', normal, compile, ['']) test('T12484', normal, compile, ['']) test('T11987', normal, multimod_compile, ['T11987', '-v0']) - +test('T12615', normal, compile, ['']) From git at git.haskell.org Sun Oct 2 00:02:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 00:02:21 +0000 (UTC) Subject: [commit: ghc] master: Disallow standalone deriving declarations involving unboxed tuples or sums (23cf32d) Message-ID: <20161002000221.87CB83A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23cf32da76fe6ed29fa141047749d390df763f94/ghc >--------------------------------------------------------------- commit 23cf32da76fe6ed29fa141047749d390df763f94 Author: Ryan Scott Date: Sat Oct 1 17:58:44 2016 -0400 Disallow standalone deriving declarations involving unboxed tuples or sums There was an awful leak where GHC permitted standalone `deriving` declarations to create instances for unboxed sum or tuple types. This fortifies the checks that GHC performs to catch this scenario and give an appropriate error message. Fixes #11509. Test Plan: ./validate Reviewers: goldfire, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2557 GHC Trac Issues: #11509 >--------------------------------------------------------------- 23cf32da76fe6ed29fa141047749d390df763f94 compiler/typecheck/TcDeriv.hs | 16 ++++++++++++++-- testsuite/tests/deriving/should_fail/T12512.hs | 14 ++++++++++++++ testsuite/tests/deriving/should_fail/T12512.stderr | 10 ++++++++++ testsuite/tests/deriving/should_fail/all.T | 1 + 4 files changed, 39 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index c47b00b..3fcc80d 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -591,12 +591,21 @@ deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode)) , text "class types:" <+> ppr cls_tys , text "type:" <+> ppr inst_ty ] + ; let bale_out msg = failWithTc (derivingThingErr False cls cls_tys + inst_ty deriv_strat msg) + ; case tcSplitTyConApp_maybe inst_ty of Just (tc, tc_args) | className cls == typeableClassName -> do warnUselessTypeable return [] + | isUnboxedTupleTyCon tc + -> bale_out $ unboxedTyConErr "tuple" + + | isUnboxedSumTyCon tc + -> bale_out $ unboxedTyConErr "sum" + | isAlgTyCon tc || isDataFamilyTyCon tc -- All other classes -> do { spec <- mkEqnHelp (fmap unLoc overlap_mode) tvs cls cls_tys tc tc_args @@ -604,8 +613,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode)) ; return [spec] } _ -> -- Complain about functions, primitive types, etc, - failWithTc $ derivingThingErr False cls cls_tys - inst_ty deriv_strat $ + bale_out $ text "The last argument of the instance must be a data or newtype application" } @@ -2672,3 +2680,7 @@ standaloneCtxt ty = hang (text "In the stand-alone deriving instance for") derivInstCtxt :: PredType -> MsgDoc derivInstCtxt pred = text "When deriving the instance for" <+> parens (ppr pred) + +unboxedTyConErr :: String -> MsgDoc +unboxedTyConErr thing = + text "The last argument of the instance cannot be an unboxed" <+> text thing diff --git a/testsuite/tests/deriving/should_fail/T12512.hs b/testsuite/tests/deriving/should_fail/T12512.hs new file mode 100644 index 0000000..87c3d66 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T12512.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} +module T12512 where + +import GHC.Exts + +class Wat1 (a :: TYPE 'UnboxedTupleRep) +deriving instance Wat1 (# a, b #) + +class Wat2 (a :: TYPE 'UnboxedSumRep) +deriving instance Wat2 (# a | b #) diff --git a/testsuite/tests/deriving/should_fail/T12512.stderr b/testsuite/tests/deriving/should_fail/T12512.stderr new file mode 100644 index 0000000..48f0eae --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T12512.stderr @@ -0,0 +1,10 @@ + +T12512.hs:11:1: error: + • Can't make a derived instance of ‘Wat1 (# a, b #)’: + The last argument of the instance cannot be an unboxed tuple + • In the stand-alone deriving instance for ‘Wat1 (# a, b #)’ + +T12512.hs:14:1: error: + • Can't make a derived instance of ‘Wat2 (# a | b #)’: + The last argument of the instance cannot be an unboxed sum + • In the stand-alone deriving instance for ‘Wat2 (# a | b #)’ diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index aebfa9e..ce0cc0f 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -65,3 +65,4 @@ test('T10598_fail4', normal, compile_fail, ['']) test('T10598_fail5', normal, compile_fail, ['']) test('T10598_fail6', normal, compile_fail, ['']) test('T12163', normal, compile_fail, ['']) +test('T12512', omit_ways(['ghci']), compile_fail, ['']) From git at git.haskell.org Sun Oct 2 01:04:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:04:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Bump Haddock submodule (46dc885) Message-ID: <20161002010418.0613C3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/46dc8854b4ff2a8f1a9ca9aa2d0a8271d5bc4ff6/ghc >--------------------------------------------------------------- commit 46dc8854b4ff2a8f1a9ca9aa2d0a8271d5bc4ff6 Author: Ben Gamari Date: Tue Sep 27 17:33:24 2016 -0400 Bump Haddock submodule Fixes #12519. >--------------------------------------------------------------- 46dc8854b4ff2a8f1a9ca9aa2d0a8271d5bc4ff6 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 08aa479..240bc38 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 08aa47916d6bb5a0f65d4da1021e0700b30b4b3b +Subproject commit 240bc38b94ed2d0af27333b23392d03eeb615e82 From git at git.haskell.org Sun Oct 2 01:04:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:04:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: CodeGen X86: fix unsafe foreign calls wrt inlining (aec4a51) Message-ID: <20161002010421.B69153A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/aec4a514857d051f5eeb15b9cbc8e6dd29850c5f/ghc >--------------------------------------------------------------- commit aec4a514857d051f5eeb15b9cbc8e6dd29850c5f Author: Sylvain HENRY Date: Sat Oct 1 00:25:49 2016 -0400 CodeGen X86: fix unsafe foreign calls wrt inlining Foreign calls (unsafe and safe) interact badly with inlining and register passing ABIs (see #11792 and #12614): the inlined code to compute a parameter of the call may overwrite a register already set to pass a preceding parameter. With this patch, we compute all parameters which are not simple expressions before assigning them to fixed registers required by the ABI. Test Plan: - Add test (test both reg and stack parameters) - Validate Reviewers: osa1, bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2263 GHC Trac Issues: #11792, #12614 (cherry picked from commit b61b7c2462b919de7eb4c373e2e2145c6d78d04c) >--------------------------------------------------------------- aec4a514857d051f5eeb15b9cbc8e6dd29850c5f compiler/nativeGen/X86/CodeGen.hs | 111 ++++++++++++++++++--------- testsuite/tests/ffi/should_run/T12614.hs | 22 ++++++ testsuite/tests/ffi/should_run/T12614.stdout | 6 ++ testsuite/tests/ffi/should_run/T12614_c.c | 5 ++ testsuite/tests/ffi/should_run/all.T | 5 ++ 5 files changed, 113 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 aec4a514857d051f5eeb15b9cbc8e6dd29850c5f From git at git.haskell.org Sun Oct 2 01:04:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:04:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: PPC/CodeGen: fix lwa instruction generation (e7201e8) Message-ID: <20161002010424.6CF283A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e7201e86eeb0f294600ff9523f042905351efad2/ghc >--------------------------------------------------------------- commit e7201e86eeb0f294600ff9523f042905351efad2 Author: Peter Trommler Date: Sat Oct 1 17:56:31 2016 -0400 PPC/CodeGen: fix lwa instruction generation Opcode lwa is a 64-bit opcode and allows a DS-form only. This patch generates lwa opcodes only when the offset is a multiple of 4. Fixes #12621 Test Plan: validate Reviewers: erikd, hvr, simonmar, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2547 GHC Trac Issues: #12621 (cherry picked from commit ce3370e06165690e79a8eb22e5229b515157e00f) >--------------------------------------------------------------- e7201e86eeb0f294600ff9523f042905351efad2 compiler/nativeGen/PPC/CodeGen.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 4b9a180..df76211 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -9,9 +9,8 @@ ----------------------------------------------------------------------------- -- This is a big module, but, if you pay attention to --- (a) the sectioning, (b) the type signatures, and --- (c) the #if blah_TARGET_ARCH} things, the --- structure should not be too overwhelming. +-- (a) the sectioning, and (b) the type signatures, +-- the structure should not be too overwhelming. module PPC.CodeGen ( cmmTopCodeGen, @@ -471,7 +470,8 @@ getRegister' _ (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad mem _]) = do return (Any II64 (\dst -> addr_code `snocOL` LD II32 dst addr)) getRegister' _ (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad mem _]) = do - Amode addr addr_code <- getAmode D mem + -- lwa is DS-form. See Note [Power instruction format] + Amode addr addr_code <- getAmode DS mem return (Any II64 (\dst -> addr_code `snocOL` LA II32 dst addr)) getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps @@ -733,6 +733,14 @@ temporary, then do the other computation, and then use the temporary: ... (tmp) ... -} +{- Note [Power instruction format] +In some instructions the 16 bit offset must be a multiple of 4, i.e. +the two least significant bits mus be zero. The "Power ISA" specification +calls these instruction formats "DS-FORM" and the instructions with +arbitrary 16 bit offsets are "D-FORM". + +The Power ISA specification document can be obtained from www.power.org. +-} data InstrForm = D | DS getAmode :: InstrForm -> CmmExpr -> NatM Amode From git at git.haskell.org Sun Oct 2 01:04:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:04:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Don't warn about name shadowing when renaming the patten in a PatSyn decl (0c2b766) Message-ID: <20161002010428.1F55F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/0c2b766d5961562cc8e8603d12399db279ac7e51/ghc >--------------------------------------------------------------- commit 0c2b766d5961562cc8e8603d12399db279ac7e51 Author: Matthew Pickering Date: Sat Oct 1 17:55:26 2016 -0400 Don't warn about name shadowing when renaming the patten in a PatSyn decl Previously the renamer assumed that *any* time we renamed a pattern, the pattern was introducing new binders. This isn't true in pattern synonym declarations where the pattern is used as part of a definition. We add a special case to not warn in this situation. Reviewers: simonpj, austin, bgamari Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2545 GHC Trac Issues: #12615 (cherry picked from commit 1851349acd9e73f1c18d68f70d5cf7b46a843cb5) >--------------------------------------------------------------- 0c2b766d5961562cc8e8603d12399db279ac7e51 compiler/hsSyn/HsExpr.hs | 6 +++++ compiler/rename/RnPat.hs | 30 +++++++++++++++++++++---- testsuite/tests/patsyn/should_compile/T12615.hs | 12 ++++++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 4 files changed, 45 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index ee64c0c..6b9774b 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -2208,6 +2208,12 @@ data HsMatchContext id -- Context of a Match | PatSyn -- A pattern synonym declaration deriving (Data, Typeable) +isPatSynCtxt :: HsMatchContext id -> Bool +isPatSynCtxt ctxt = + case ctxt of + PatSyn -> True + _ -> False + data HsStmtContext id = ListComp | MonadComp diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 39ecdb0..bda186b 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -62,7 +62,7 @@ import TysWiredIn ( nilDataCon ) import DataCon import qualified GHC.LanguageExtensions as LangExt -import Control.Monad ( when, liftM, ap ) +import Control.Monad ( when, liftM, ap, unless ) import Data.Ratio {- @@ -249,6 +249,25 @@ We want to "see" this use, and in let-bindings we collect all uses and report unused variables at the binding level. So we must use bindLocalNames here, *not* bindLocalNameFV. Trac #3943. + +Note: [Don't report shadowing for pattern synonyms] +There is one special context where a pattern doesn't introduce any new binders - +pattern synonym declarations. Therefore we don't check to see if pattern +variables shadow existing identifiers as they are never bound to anything +and have no scope. + +Without this check, there would be quite a cryptic warning that the `x` +in the RHS of the pattern synonym declaration shadowed the top level `x`. + +``` +x :: () +x = () + +pattern P x = Just x +``` + +See #12615 for some more examples. + ********************************************************* * * External entry points @@ -294,9 +313,12 @@ rnPats ctxt pats thing_inside -- check incrementally for duplicates; -- Nor can we check incrementally for shadowing, else we'll -- complain *twice* about duplicates e.g. f (x,x) = ... - ; addErrCtxt doc_pat $ - checkDupAndShadowedNames envs_before $ - collectPatsBinders pats' + -- + -- See note [Don't report shadowing for pattern synonyms] + ; unless (isPatSynCtxt ctxt) + (addErrCtxt doc_pat $ + checkDupAndShadowedNames envs_before $ + collectPatsBinders pats') ; thing_inside pats' } } where doc_pat = text "In" <+> pprMatchContext ctxt diff --git a/testsuite/tests/patsyn/should_compile/T12615.hs b/testsuite/tests/patsyn/should_compile/T12615.hs new file mode 100644 index 0000000..1405525 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12615.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude, PatternSynonyms #-} +{-# OPTIONS_GHC -Wall #-} +module Test where + +x :: () +x = () + +pattern Point2 :: () -> () -> ((), ()) +pattern Point2 x y = (x, y) + +pattern Point :: () -> () -> ((), ()) +pattern Point{x1, y1} = (x1, y1) diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 9bb4f59..8afa2b6 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -55,3 +55,4 @@ test('T12094', normal, compile, ['']) test('T12484', normal, compile, ['']) test('T12489', normal, compile, ['']) test('T11959', expect_broken(11959), multimod_compile, ['T11959', '-v0']) +test('T12615', normal, compile, ['']) From git at git.haskell.org Sun Oct 2 01:04:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:04:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Do not warn about unused underscore-prefixed fields (fixes Trac #12609) (63ce9ba) Message-ID: <20161002010431.434353A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/63ce9ba2f439f4e295ff0791d783eb2103d89843/ghc >--------------------------------------------------------------- commit 63ce9ba2f439f4e295ff0791d783eb2103d89843 Author: Adam Gundry Date: Sat Oct 1 17:56:58 2016 -0400 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) When DuplicateRecordFields is enabled, the mangling of selector names was causing them to be reported as unused even if prefixed by an underscore. This corrects the OccName used by the check. Test Plan: New test overloadedrecflds/should_compile/T12609 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2549 GHC Trac Issues: #12609 (cherry picked from commit 48ff0843eee29313cc2da14c04dc57f6589ab040) >--------------------------------------------------------------- 63ce9ba2f439f4e295ff0791d783eb2103d89843 compiler/rename/RnEnv.hs | 13 ++++++++----- testsuite/tests/overloadedrecflds/should_compile/T12609.hs | 8 ++++++++ testsuite/tests/overloadedrecflds/should_compile/all.T | 1 + 3 files changed, 17 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 046983a..f8f6eea 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -2112,7 +2112,7 @@ warnUnused flag names = do warnUnused1 :: WarningFlag -> NameEnv (FieldLabelString, Name) -> Name -> RnM () warnUnused1 flag fld_env name - = when (reportable name) $ + = when (reportable name occ) $ addUnusedWarning flag occ (nameSrcSpan name) (text "Defined but not used") @@ -2125,7 +2125,7 @@ warnUnusedGRE :: GlobalRdrElt -> RnM () warnUnusedGRE gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = is }) | lcl = do fld_env <- mkFieldEnv <$> getGlobalRdrEnv warnUnused1 Opt_WarnUnusedTopBinds fld_env name - | otherwise = when (reportable name) (mapM_ warn is) + | otherwise = when (reportable name occ) (mapM_ warn is) where occ = greOccName gre warn spec = addUnusedWarning Opt_WarnUnusedTopBinds occ span msg @@ -2143,12 +2143,15 @@ mkFieldEnv rdr_env = mkNameEnv [ (gre_name gre, (lbl, par_is (gre_par gre))) , Just lbl <- [greLabel gre] ] -reportable :: Name -> Bool -reportable name +-- | Should we report the fact that this 'Name' is unused? The +-- 'OccName' may differ from 'nameOccName' due to +-- DuplicateRecordFields. +reportable :: Name -> OccName -> Bool +reportable name occ | isWiredInName name = False -- Don't report unused wired-in names -- Otherwise we get a zillion warnings -- from Data.Tuple - | otherwise = not (startsWithUnderscore (nameOccName name)) + | otherwise = not (startsWithUnderscore occ) addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM () addUnusedWarning flag occ span msg diff --git a/testsuite/tests/overloadedrecflds/should_compile/T12609.hs b/testsuite/tests/overloadedrecflds/should_compile/T12609.hs new file mode 100644 index 0000000..7b8205b --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/T12609.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# OPTIONS_GHC -Werror -Wunused-top-binds #-} +module Main (main, T(MkT)) where + +data T = MkT { _x :: Int } + +main :: IO () +main = return () diff --git a/testsuite/tests/overloadedrecflds/should_compile/all.T b/testsuite/tests/overloadedrecflds/should_compile/all.T index ea5baf8..264fa11 100644 --- a/testsuite/tests/overloadedrecflds/should_compile/all.T +++ b/testsuite/tests/overloadedrecflds/should_compile/all.T @@ -1 +1,2 @@ test('T11173', extra_clean(['T11173a.hi', 'T11173a.o']), multimod_compile, ['T11173', '-v0']) +test('T12609', normal, compile, ['']) From git at git.haskell.org Sun Oct 2 01:04:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:04:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix interaction of record pattern synonyms and record wildcards (50e7157) Message-ID: <20161002010435.0DD0F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/50e7157b97bf9bd06508fec656836b92668a859c/ghc >--------------------------------------------------------------- commit 50e7157b97bf9bd06508fec656836b92668a859c Author: Matthew Pickering Date: Sat Oct 1 17:55:04 2016 -0400 Fix interaction of record pattern synonyms and record wildcards We were missing an appropiate *ConLike lookup in the case when the pattern synonym was defined in a different module. Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2544 GHC Trac Issues: #11987 (cherry picked from commit 2d6642bd1956edf8b842c07d78e83c500246998a) >--------------------------------------------------------------- 50e7157b97bf9bd06508fec656836b92668a859c compiler/rename/RnEnv.hs | 4 ++-- testsuite/tests/patsyn/should_compile/T11987.hs | 12 ++++++++++++ testsuite/tests/patsyn/should_compile/T11987a.hs | 9 +++++++++ testsuite/tests/patsyn/should_compile/all.T | 2 ++ 4 files changed, 25 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index f8f6eea..100a0ef 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -458,9 +458,9 @@ lookupConstructorFields con_name ; traceTc "lookupCF" (ppr con_name $$ ppr (lookupNameEnv field_env con_name) $$ ppr field_env) ; return (lookupNameEnv field_env con_name `orElse` []) } else - do { con <- tcLookupDataCon con_name + do { con <- tcLookupConLike con_name ; traceTc "lookupCF 2" (ppr con) - ; return (dataConFieldLabels con) } } + ; return (conLikeFieldLabels con) } } ----------------------------------------------- -- Used for record construction and pattern matching diff --git a/testsuite/tests/patsyn/should_compile/T11987.hs b/testsuite/tests/patsyn/should_compile/T11987.hs new file mode 100644 index 0000000..eab3316 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T11987.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NamedFieldPuns, PatternSynonyms, RecordWildCards #-} +module T11987 where + +import T11987a + +-- works +namedFieldPuns :: (Int,Int) +namedFieldPuns = let { x = 1; y = 2 } in Point { x, y } + +-- error: Pattern synonym ‘Point’ used as a data constructor +recordWildCards :: (Int,Int) +recordWildCards = let { x = 1; y = 2 } in Point { .. } diff --git a/testsuite/tests/patsyn/should_compile/T11987a.hs b/testsuite/tests/patsyn/should_compile/T11987a.hs new file mode 100644 index 0000000..c381c2b --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T11987a.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NamedFieldPuns, PatternSynonyms, RecordWildCards #-} +module T11987a where + +pattern Point :: Int -> Int -> (Int, Int) +pattern Point{x, y} = (x, y) + +-- works +sameFile :: (Int,Int) +sameFile = let { x = 1; y = 2 } in Point { .. } diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 8afa2b6..0300915 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -56,3 +56,5 @@ test('T12484', normal, compile, ['']) test('T12489', normal, compile, ['']) test('T11959', expect_broken(11959), multimod_compile, ['T11959', '-v0']) test('T12615', normal, compile, ['']) +test('T11987', normal, multimod_compile, ['T11987', '-v0']) + From git at git.haskell.org Sun Oct 2 01:04:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:04:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix desugaring of pattern bindings (again) (d2695b8) Message-ID: <20161002010438.645A13A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d2695b842dc8ba94fbfb8527f13c7fd14611facb/ghc >--------------------------------------------------------------- commit d2695b842dc8ba94fbfb8527f13c7fd14611facb Author: Simon Peyton Jones Date: Fri Sep 16 22:33:20 2016 +0100 Fix desugaring of pattern bindings (again) This patch fixes Trac #12595. The problem was with a pattern binding like !x = e For a start it's silly to match that pattern and build a unit tuple (the General Case of mkSelectorBinds); but that's what was happening because the bang fell through to the general case. But for a variable pattern building any auxiliary bindings is stupid. So the patch introduces a new case in mkSelectorBinds for variable patterns. Then it turned out that if 'e' was a plain variable, and moreover was imported GlobalId, then matchSinglePat made it a /bound/ variable, which should never happen. That ultimately caused a linker error, but the original bug was much earlier. (cherry picked from commit 2fbfbca2d12a8e9a09627529cf4f8284b19023ff) >--------------------------------------------------------------- d2695b842dc8ba94fbfb8527f13c7fd14611facb compiler/deSugar/DsBinds.hs | 3 +- compiler/deSugar/DsUtils.hs | 136 ++++++++++++--------- compiler/deSugar/Match.hs | 21 +++- testsuite/tests/deSugar/should_run/T12595.hs | 10 ++ .../tests/deSugar/should_run/T12595.stdout | 0 testsuite/tests/deSugar/should_run/all.T | 1 + 6 files changed, 109 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 d2695b842dc8ba94fbfb8527f13c7fd14611facb From git at git.haskell.org Sun Oct 2 01:42:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:42:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix layout of MultiWayIf expressions (#10807) (cb03d1c) Message-ID: <20161002014205.7C2FF3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/cb03d1ccd87a683cb7816a9d2d89a7722040c614/ghc >--------------------------------------------------------------- commit cb03d1ccd87a683cb7816a9d2d89a7722040c614 Author: Ömer Sinan Ağacan Date: Mon Sep 26 17:09:01 2016 -0400 Fix layout of MultiWayIf expressions (#10807) With this patch we stop generating virtual semicolons in MultiWayIf guards. Fixes #10807. Test Plan: Reviewers: simonmar, austin, bgamari Reviewed By: simonmar Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2524 GHC Trac Issues: #10807 (cherry picked from commit c36904d66f30d4386a231ce365a056962a881767) >--------------------------------------------------------------- cb03d1ccd87a683cb7816a9d2d89a7722040c614 compiler/parser/Lexer.x | 63 +++++++++++++--------- compiler/parser/Parser.y | 14 ++--- testsuite/tests/parser/should_run/T10807.hs | 43 +++++++++++++++ .../should_run/T10807.stdout} | 2 + testsuite/tests/parser/should_run/all.T | 1 + 5 files changed, 87 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 cb03d1ccd87a683cb7816a9d2d89a7722040c614 From git at git.haskell.org Sun Oct 2 01:42:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:42:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Disallow standalone deriving declarations involving unboxed tuples or sums (c448d55) Message-ID: <20161002014208.B76173A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c448d5513d68da7077b2b4d3adadda93120d8504/ghc >--------------------------------------------------------------- commit c448d5513d68da7077b2b4d3adadda93120d8504 Author: Ryan Scott Date: Sat Oct 1 17:58:44 2016 -0400 Disallow standalone deriving declarations involving unboxed tuples or sums There was an awful leak where GHC permitted standalone `deriving` declarations to create instances for unboxed sum or tuple types. This fortifies the checks that GHC performs to catch this scenario and give an appropriate error message. Fixes #11509. Test Plan: ./validate Reviewers: goldfire, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2557 GHC Trac Issues: #11509 (cherry picked from commit 23cf32da76fe6ed29fa141047749d390df763f94) >--------------------------------------------------------------- c448d5513d68da7077b2b4d3adadda93120d8504 compiler/typecheck/TcDeriv.hs | 15 ++++++++++++++- testsuite/tests/deriving/should_fail/T12512.hs | 14 ++++++++++++++ testsuite/tests/deriving/should_fail/T12512.stderr | 10 ++++++++++ testsuite/tests/deriving/should_fail/all.T | 2 +- 4 files changed, 39 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index f4069b5..113890a 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -583,12 +583,21 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode)) , text "class types:" <+> ppr cls_tys , text "type:" <+> ppr inst_ty ] + ; let bale_out msg = failWithTc (derivingThingErr False cls cls_tys + inst_ty deriv_strat msg) + ; case tcSplitTyConApp_maybe inst_ty of Just (tc, tc_args) | className cls == typeableClassName -> do warnUselessTypeable return [] + | isUnboxedTupleTyCon tc + -> bale_out $ unboxedTyConErr "tuple" + + | isUnboxedSumTyCon tc + -> bale_out $ unboxedTyConErr "sum" + | isAlgTyCon tc || isDataFamilyTyCon tc -- All other classes -> do { spec <- mkEqnHelp (fmap unLoc overlap_mode) tvs cls cls_tys tc tc_args @@ -596,7 +605,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode)) ; return [spec] } _ -> -- Complain about functions, primitive types, etc, - failWithTc $ derivingThingErr False cls cls_tys inst_ty $ + bale_out $ text "The last argument of the instance must be a data or newtype application" } @@ -2438,3 +2447,7 @@ standaloneCtxt ty = hang (text "In the stand-alone deriving instance for") derivInstCtxt :: PredType -> MsgDoc derivInstCtxt pred = text "When deriving the instance for" <+> parens (ppr pred) + +unboxedTyConErr :: String -> MsgDoc +unboxedTyConErr thing = + text "The last argument of the instance cannot be an unboxed" <+> text thing diff --git a/testsuite/tests/deriving/should_fail/T12512.hs b/testsuite/tests/deriving/should_fail/T12512.hs new file mode 100644 index 0000000..87c3d66 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T12512.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} +module T12512 where + +import GHC.Exts + +class Wat1 (a :: TYPE 'UnboxedTupleRep) +deriving instance Wat1 (# a, b #) + +class Wat2 (a :: TYPE 'UnboxedSumRep) +deriving instance Wat2 (# a | b #) diff --git a/testsuite/tests/deriving/should_fail/T12512.stderr b/testsuite/tests/deriving/should_fail/T12512.stderr new file mode 100644 index 0000000..48f0eae --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T12512.stderr @@ -0,0 +1,10 @@ + +T12512.hs:11:1: error: + • Can't make a derived instance of ‘Wat1 (# a, b #)’: + The last argument of the instance cannot be an unboxed tuple + • In the stand-alone deriving instance for ‘Wat1 (# a, b #)’ + +T12512.hs:14:1: error: + • Can't make a derived instance of ‘Wat2 (# a | b #)’: + The last argument of the instance cannot be an unboxed sum + • In the stand-alone deriving instance for ‘Wat2 (# a | b #)’ diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index e0c6e62..cca26bf 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -58,4 +58,4 @@ test('T9687', normal, compile_fail, ['']) test('T8984', normal, compile_fail, ['']) test('T9968a', normal, compile_fail, ['']) - +test('T12512', omit_ways(['ghci']), compile_fail, ['']) From git at git.haskell.org Sun Oct 2 01:42:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 01:42:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Print foralls in user format (906ea04) Message-ID: <20161002014211.E2E4F3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/906ea0445deab65f4dfcba7473593db048cbacab/ghc >--------------------------------------------------------------- commit 906ea0445deab65f4dfcba7473593db048cbacab Author: Simon Peyton Jones Date: Mon Sep 26 08:37:47 2016 +0100 Print foralls in user format This fixes Trac #12597: in RnNames.warnMissingSignatures, use pprSigmaType not pprType (cherry picked from commit 796f0f2ad7eefd1c9af5a7ef9bf56848067e85b1) >--------------------------------------------------------------- 906ea0445deab65f4dfcba7473593db048cbacab compiler/rename/RnNames.hs | 2 +- compiler/types/TyCoRep.hs | 2 ++ testsuite/tests/driver/werror.stderr | 3 +-- testsuite/tests/indexed-types/should_compile/T8889.stderr | 4 +--- testsuite/tests/parser/should_compile/read014.stderr | 2 +- testsuite/tests/rename/should_compile/T12597.hs | 5 +++++ testsuite/tests/rename/should_compile/T12597.stderr | 3 +++ testsuite/tests/rename/should_compile/all.T | 1 + testsuite/tests/typecheck/should_compile/T10971a.stderr | 6 +++--- testsuite/tests/typecheck/should_compile/tc243.stderr | 2 +- testsuite/tests/warnings/should_compile/T11077.stderr | 2 +- 11 files changed, 20 insertions(+), 12 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 4c2d4f1..6ab51d9 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1617,7 +1617,7 @@ warnMissingSignatures gbl_env = do { env <- tcInitTidyEnv -- Why not use emptyTidyEnv? ; let name = idName id (_, ty) = tidyOpenType env (idType id) - ty_msg = ppr ty + ty_msg = pprSigmaType ty ; add_warn name $ hang (text "Top-level binding with no type signature:") 2 (pprPrefixName name <+> dcolon <+> ty_msg) } diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 7743a91..fc2ac90 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -2652,6 +2652,8 @@ ppr_fun_tail (ForAllTy (Anon ty1) ty2) ppr_fun_tail other_ty = [ppr_type TopPrec other_ty] pprSigmaType :: Type -> SDoc +-- Prints a top-level type for the user; in particular +-- top-level foralls are omitted unless you use -fprint-explicit-foralls pprSigmaType ty = sdocWithDynFlags $ \dflags -> eliminateRuntimeRep (ppr_sigma_type dflags False) ty diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr index 8f2e603..436c980 100644 --- a/testsuite/tests/driver/werror.stderr +++ b/testsuite/tests/driver/werror.stderr @@ -17,8 +17,7 @@ werror.hs:10:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)] Defined but not used: ‘f’ werror.hs:10:1: warning: [-Wmissing-signatures (in -Wall)] - Top-level binding with no type signature: - f :: forall t t1. [t1] -> [t] + Top-level binding with no type signature: f :: [t1] -> [t] werror.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive diff --git a/testsuite/tests/indexed-types/should_compile/T8889.stderr b/testsuite/tests/indexed-types/should_compile/T8889.stderr index 81359b2..cef00df 100644 --- a/testsuite/tests/indexed-types/should_compile/T8889.stderr +++ b/testsuite/tests/indexed-types/should_compile/T8889.stderr @@ -1,6 +1,4 @@ T8889.hs:12:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: - f :: forall (f :: * -> *) b a. - (C f, C_fmap f a) => - (a -> b) -> f a -> f b + f :: (C f, C_fmap f a) => (a -> b) -> f a -> f b diff --git a/testsuite/tests/parser/should_compile/read014.stderr b/testsuite/tests/parser/should_compile/read014.stderr index d7c43e5..09e79ee 100644 --- a/testsuite/tests/parser/should_compile/read014.stderr +++ b/testsuite/tests/parser/should_compile/read014.stderr @@ -1,7 +1,7 @@ read014.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: - ng1 :: forall a t. Num a => t -> a -> a + ng1 :: Num a => t -> a -> a read014.hs:4:5: warning: [-Wunused-matches (in -Wextra)] Defined but not used: ‘x’ diff --git a/testsuite/tests/rename/should_compile/T12597.hs b/testsuite/tests/rename/should_compile/T12597.hs new file mode 100644 index 0000000..12769e4 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T12597.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -Wmissing-signatures #-} + +module T12597 where + +f x = x diff --git a/testsuite/tests/rename/should_compile/T12597.stderr b/testsuite/tests/rename/should_compile/T12597.stderr new file mode 100644 index 0000000..8364fd0 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T12597.stderr @@ -0,0 +1,3 @@ + +T12597.hs:5:1: warning: [-Wmissing-signatures (in -Wall)] + Top-level binding with no type signature: f :: t -> t diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 8819fd2..023c2eb 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -242,3 +242,4 @@ test('T12127', multimod_compile, ['T12127', '-v0']) test('T12533', normal, compile, ['']) +test('T12597', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_compile/T10971a.stderr b/testsuite/tests/typecheck/should_compile/T10971a.stderr index bfcc3ff..96330fd 100644 --- a/testsuite/tests/typecheck/should_compile/T10971a.stderr +++ b/testsuite/tests/typecheck/should_compile/T10971a.stderr @@ -1,6 +1,6 @@ T10971a.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] - Top-level binding with no type signature: f :: forall a. [a] -> Int + Top-level binding with no type signature: f :: [a] -> Int T10971a.hs:7:11: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraint to type ‘[]’ @@ -11,7 +11,7 @@ T10971a.hs:7:11: warning: [-Wtype-defaults (in -Wall)] T10971a.hs:8:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: - g :: forall b a. (a -> b) -> [a] -> [b] + g :: (a -> b) -> [a] -> [b] T10971a.hs:8:6: warning: [-Wname-shadowing (in -Wall)] This binding for ‘f’ shadows the existing binding @@ -26,7 +26,7 @@ T10971a.hs:8:13: warning: [-Wtype-defaults (in -Wall)] T10971a.hs:9:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: - h :: forall b a. (a -> b) -> [a] -> ([b], Int) + h :: (a -> b) -> [a] -> ([b], Int) T10971a.hs:9:6: warning: [-Wname-shadowing (in -Wall)] This binding for ‘f’ shadows the existing binding diff --git a/testsuite/tests/typecheck/should_compile/tc243.stderr b/testsuite/tests/typecheck/should_compile/tc243.stderr index f96fede..5c5e9b2 100644 --- a/testsuite/tests/typecheck/should_compile/tc243.stderr +++ b/testsuite/tests/typecheck/should_compile/tc243.stderr @@ -1,3 +1,3 @@ tc243.hs:10:1: warning: [-Wmissing-signatures (in -Wall)] - Top-level binding with no type signature: (.+.) :: forall a. a + Top-level binding with no type signature: (.+.) :: a diff --git a/testsuite/tests/warnings/should_compile/T11077.stderr b/testsuite/tests/warnings/should_compile/T11077.stderr index fcaa385..ba7d4d8 100644 --- a/testsuite/tests/warnings/should_compile/T11077.stderr +++ b/testsuite/tests/warnings/should_compile/T11077.stderr @@ -1,3 +1,3 @@ T11077.hs:3:1: warning: [-Wmissing-exported-sigs] - Top-level binding with no type signature: foo :: forall a. a + Top-level binding with no type signature: foo :: a From git at git.haskell.org Sun Oct 2 03:04:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 03:04:25 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: Lint check to ensure arity matches (2e27274) Message-ID: <20161002030425.3D06B3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/2e2727431d634e3a974a9c2d7e48362a5ad19a7d/ghc >--------------------------------------------------------------- commit 2e2727431d634e3a974a9c2d7e48362a5ad19a7d Author: Joachim Breitner Date: Thu Sep 29 17:41:20 2016 -0400 ConApp: Lint check to ensure arity matches >--------------------------------------------------------------- 2e2727431d634e3a974a9c2d7e48362a5ad19a7d compiler/coreSyn/CoreLint.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 502030a..3b1fdf9 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -706,6 +706,8 @@ lintCoreExpr e@(ConApp dc args) when (lf_check_static_ptrs lf && dataConName dc == staticPtrDataConName) $ failWithL $ text "Found StaticPtr nested in an expression: " <+> ppr e + when (length args /= dataConRepFullArity dc) $ + failWithL $ hang (text "Un-saturated data con application") 2 (ppr e) let dc_ty = dataConRepType dc addLoc (AnExpr e) $ foldM lintCoreArg dc_ty args From git at git.haskell.org Sun Oct 2 03:04:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 03:04:27 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: incomplete bytecode support (2365a9e) Message-ID: <20161002030427.E0BFE3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/2365a9e0bdf6fc95c73f8ef6aed866de048325b3/ghc >--------------------------------------------------------------- commit 2365a9e0bdf6fc95c73f8ef6aed866de048325b3 Author: Joachim Breitner Date: Fri Sep 30 00:10:39 2016 -0400 ConApp: incomplete bytecode support >--------------------------------------------------------------- 2365a9e0bdf6fc95c73f8ef6aed866de048325b3 compiler/ghci/ByteCodeGen.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 90e2174..33607bd 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -157,6 +157,7 @@ simpleFreeVars = go . freeVars go' (AnnLit lit) = AnnLit lit go' (AnnLam bndr body) = AnnLam bndr (go body) go' (AnnApp fun arg) = AnnApp (go fun) (go arg) + go' (AnnConApp dc args) = AnnConApp dc (map go args) go' (AnnCase scrut bndr ty alts) = AnnCase (go scrut) bndr ty (map go_alt alts) go' (AnnLet bind body) = AnnLet (go_bind bind) (go body) go' (AnnCast expr (ann, co)) = AnnCast (go expr) (freeVarsOfAnn ann, co) @@ -420,6 +421,7 @@ schemeE d s p e -- Delegate tail-calls to schemeT. schemeE d s p e@(AnnApp _ _) = schemeT d s p e +schemeE d s p e@(AnnConApp _ _) = schemeT d s p e schemeE d s p e@(AnnLit lit) = returnUnboxedAtom d s p e (typeArgRep (literalType lit)) schemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e V @@ -432,6 +434,7 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) | (AnnVar v, args_r_to_l) <- splitApp rhs, Just data_con <- isDataConWorkId_maybe v, dataConRepArity data_con == length args_r_to_l + -- TODO #12618 remove eventually = do -- Special case for a non-recursive let whose RHS is a -- saturatred constructor application. -- Just allocate the constructor and carry on @@ -439,6 +442,14 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) body_code <- schemeE (d+1) s (Map.insert x d p) body return (alloc_code `appOL` body_code) +schemeE d s p (AnnLet (AnnNonRec x (_,AnnConApp dc args)) (_,body)) + = do -- Special case for a non-recursive let whose RHS is a + -- saturatred constructor application. + -- Just allocate the constructor and carry on + alloc_code <- mkConAppCode d s p dc (map snd (reverse args)) + body_code <- schemeE (d+1) s (Map.insert x d p) body + return (alloc_code `appOL` body_code) + -- General case for let. Generates correct, if inefficient, code in -- all situations. schemeE d s p (AnnLet binds (_,body)) = do @@ -624,6 +635,21 @@ schemeT :: Word -- Stack depth -> AnnExpr' Id DVarSet -> BcM BCInstrList +schemeT d s p (AnnConApp dc args') + | isUnboxedTupleCon dc + = case args of + [_,_,arg2,arg1] | isVAtom arg1 -> + unboxedTupleReturn d s p arg2 + [_,_,arg2,arg1] | isVAtom arg2 -> + unboxedTupleReturn d s p arg1 + _other -> multiValException + | otherwise + = do alloc_con <- mkConAppCode d s p dc (reverse args) + return (alloc_con `appOL` + mkSLIDE 1 (d - s) `snocOL` + ENTER) + where args = map snd args' + schemeT d s p app -- | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False @@ -1605,6 +1631,7 @@ bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) -- d) ticks (but not breakpoints) -- Type lambdas *can* occur in random expressions, -- whereas value lambdas cannot; that is why they are nuked here +-- TODO #12618: what to do with data con apps here? Keep types or not? bcView (AnnCast (_,e) _) = Just e bcView (AnnLam v (_,e)) | isTyVar v = Just e bcView (AnnApp (_,e) (_, AnnType _)) = Just e From git at git.haskell.org Sun Oct 2 03:04:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 03:04:30 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (52567b0) Message-ID: <20161002030430.BE9C03A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/52567b0515f29b4c9926e21a33bff943d7bc2710/ghc >--------------------------------------------------------------- commit 52567b0515f29b4c9926e21a33bff943d7bc2710 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 52567b0515f29b4c9926e21a33bff943d7bc2710 compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 11 +++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 49 ++++++++++++++-------- compiler/coreSyn/CoreSyn.hs | 4 ++ compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 3 ++ compiler/coreSyn/PprCore.hs | 4 ++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 4 ++ compiler/specialise/Rules.hs | 2 + compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 25 ++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ 36 files changed, 349 insertions(+), 90 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 52567b0515f29b4c9926e21a33bff943d7bc2710 From git at git.haskell.org Sun Oct 2 03:04:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 03:04:33 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Add DataCon.dataConRepFullArity (ab1f38d) Message-ID: <20161002030433.7D9043A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/ab1f38d4749024bf90d6b5c891bf36ce94605fca/ghc >--------------------------------------------------------------- commit ab1f38d4749024bf90d6b5c891bf36ce94605fca Author: Joachim Breitner Date: Fri Sep 30 20:48:33 2016 -0400 Add DataCon.dataConRepFullArity which is the number of arguments expected by the data constructor worker, including type argument, and hence the list of an (uncompressed) argument list in ConApp. >--------------------------------------------------------------- ab1f38d4749024bf90d6b5c891bf36ce94605fca compiler/basicTypes/DataCon.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 6fda33a..47b05c9 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -39,7 +39,7 @@ module DataCon ( dataConInstOrigArgTys, dataConRepArgTys, dataConFieldLabels, dataConFieldType, dataConSrcBangs, - dataConSourceArity, dataConRepArity, + dataConSourceArity, dataConRepArity, dataConRepFullArity, dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, @@ -385,8 +385,10 @@ data DataCon -- Cached; see Note [DataCon arities] -- INVARIANT: dcRepArity == length dataConRepArgTys -- INVARIANT: dcSourceArity == length dcOrigArgTys - dcRepArity :: Arity, - dcSourceArity :: Arity, + -- INVARIANT: dcRepFullArity == length univ_tvs + length ex_tvs + dcRepArity + dcRepArity :: Arity, + dcSourceArity :: Arity, + dcRepFullArity :: Arity, -- Result type of constructor is T t1..tn dcRepTyCon :: TyCon, -- Result tycon, T @@ -799,6 +801,7 @@ mkDataCon name declared_infix prom_info dcRep = rep, dcSourceArity = length orig_arg_tys, dcRepArity = length rep_arg_tys, + dcRepFullArity = length univ_tvs + length ex_tvs + dcRepArity con, dcPromoted = promoted } -- The 'arg_stricts' passed to mkDataCon are simply those for the @@ -995,6 +998,11 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity +-- | Gives the number of arguments expected in ConApp: the universal type +-- variables, the existential type variables, the value arguments +dataConRepFullArity :: DataCon -> Arity +dataConRepFullArity (MkData { dcRepFullArity = arity }) = arity + -- | Return whether there are any argument types for this 'DataCon's original source type -- See Note [DataCon arities] isNullarySrcDataCon :: DataCon -> Bool From git at git.haskell.org Sun Oct 2 03:04:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 03:04:36 +0000 (UTC) Subject: [commit: ghc] wip/T12618: mkCoreConApp: Ensure let/app invariant (3ec078c) Message-ID: <20161002030436.38F863A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/3ec078cd18a83946d9d2c532137d9639ec5c2fc4/ghc >--------------------------------------------------------------- commit 3ec078cd18a83946d9d2c532137d9639ec5c2fc4 Author: Joachim Breitner Date: Sat Oct 1 14:02:16 2016 -0400 mkCoreConApp: Ensure let/app invariant This requires case-binding all affected arguments around the whole ConApp application, which is slightly more complicated than the App case. In particular, we need to juggle more than one unique. Therefore, I am adding another class of uniques. >--------------------------------------------------------------- 3ec078cd18a83946d9d2c532137d9639ec5c2fc4 compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 27 ++++++++++++++++++++++++--- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 43 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 3861513..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -152,12 +152,13 @@ mkCoreApps orig_fun orig_args mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr mkCoreConApps con args | length args >= dataConRepFullArity con - = mkCoreApps (ConApp con conArgs) extraArgs - -- TODO #12618: Do we need to check needsCaseBinding? + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args where -- TODO #12618: Can there ever be more than dataConRepArity con arguments -- in a type-safe program? - (conArgs, extraArgs) = splitAt (dataConRepFullArity con) args + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) mkCoreConApps con args -- Unsaturated application. TODO #12618 Use wrapper. = mkCoreApps (Var (dataConWorkId con)) args @@ -184,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Sun Oct 2 03:04:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 03:04:38 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (ddee160) Message-ID: <20161002030438.E770C3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/ddee1604a0ac0aa4eabc5ed62c44039ed71c4f1d/ghc >--------------------------------------------------------------- commit ddee1604a0ac0aa4eabc5ed62c44039ed71c4f1d Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- ddee1604a0ac0aa4eabc5ed62c44039ed71c4f1d compiler/coreSyn/MkCore.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..3861513 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,17 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = mkCoreApps (ConApp con conArgs) extraArgs + -- TODO #12618: Do we need to check needsCaseBinding? + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (conArgs, extraArgs) = splitAt (dataConRepFullArity con) args +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), From git at git.haskell.org Sun Oct 2 04:35:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 04:35:31 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (ceca9a4) Message-ID: <20161002043531.52F3D3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/ceca9a43e97bcda3d71b4334258b013d843f27ab/ghc >--------------------------------------------------------------- commit ceca9a43e97bcda3d71b4334258b013d843f27ab Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- ceca9a43e97bcda3d71b4334258b013d843f27ab compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 35 +++++++++++++++++++++++++++++++++-- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 52 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,18 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), @@ -174,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Sun Oct 2 04:35:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 04:35:34 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (1f4b38a) Message-ID: <20161002043534.2ED493A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/1f4b38a5172b3aaa4311edefcdfa6788a9c05c53/ghc >--------------------------------------------------------------- commit 1f4b38a5172b3aaa4311edefcdfa6788a9c05c53 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 1f4b38a5172b3aaa4311edefcdfa6788a9c05c53 compiler/basicTypes/DataCon.hs | 14 +++++-- compiler/basicTypes/Demand.hs | 17 +++++++- compiler/basicTypes/MkId.hs | 43 +++++++++---------- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 13 ++++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 42 +++++++++++-------- compiler/coreSyn/CoreSyn.hs | 4 ++ compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 55 +++++++++++++++++-------- compiler/coreSyn/PprCore.hs | 4 ++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/ghci/ByteCodeGen.hs | 27 ++++++++++++ compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 18 ++++++++ compiler/specialise/Rules.hs | 2 + compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 33 +++++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ 40 files changed, 477 insertions(+), 132 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 1f4b38a5172b3aaa4311edefcdfa6788a9c05c53 From git at git.haskell.org Sun Oct 2 15:31:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 15:31:29 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (2ff3c49) Message-ID: <20161002153129.47F193A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/2ff3c49ecbd2c6bcdc34a3965c908204caa53dbb/ghc >--------------------------------------------------------------- commit 2ff3c49ecbd2c6bcdc34a3965c908204caa53dbb Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- 2ff3c49ecbd2c6bcdc34a3965c908204caa53dbb compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 35 +++++++++++++++++++++++++++++++++-- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 52 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,18 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), @@ -174,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Sun Oct 2 15:31:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 15:31:32 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (9e9470e) Message-ID: <20161002153132.22A5B3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/9e9470edefa4b9edf450faf8c91bcd0b2fcc5edd/ghc >--------------------------------------------------------------- commit 9e9470edefa4b9edf450faf8c91bcd0b2fcc5edd Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 9e9470edefa4b9edf450faf8c91bcd0b2fcc5edd compiler/basicTypes/DataCon.hs | 14 +++++-- compiler/basicTypes/Demand.hs | 17 +++++++- compiler/basicTypes/MkId.hs | 43 +++++++++---------- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 13 ++++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 42 +++++++++++-------- compiler/coreSyn/CoreSyn.hs | 4 ++ compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 55 +++++++++++++++++-------- compiler/coreSyn/PprCore.hs | 10 +++++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/ghci/ByteCodeGen.hs | 27 ++++++++++++ compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 18 ++++++++ compiler/specialise/Rules.hs | 2 + compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 33 +++++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ 40 files changed, 483 insertions(+), 132 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 9e9470edefa4b9edf450faf8c91bcd0b2fcc5edd From git at git.haskell.org Sun Oct 2 16:04:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 16:04:58 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (e0219c0) Message-ID: <20161002160458.2F3EF3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/e0219c08d5519d694266bbcad65cd34e97d81b26/ghc >--------------------------------------------------------------- commit e0219c08d5519d694266bbcad65cd34e97d81b26 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- e0219c08d5519d694266bbcad65cd34e97d81b26 compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 35 +++++++++++++++++++++++++++++++++-- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 52 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,18 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), @@ -174,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Sun Oct 2 16:05:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 16:05:01 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (b4fd3bc) Message-ID: <20161002160501.0B6773A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/b4fd3bcb6af2335078c708dd9398578fea108f8d/ghc >--------------------------------------------------------------- commit b4fd3bcb6af2335078c708dd9398578fea108f8d Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- b4fd3bcb6af2335078c708dd9398578fea108f8d compiler/basicTypes/DataCon.hs | 14 +++++-- compiler/basicTypes/Demand.hs | 17 +++++++- compiler/basicTypes/MkId.hs | 43 +++++++++---------- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 13 ++++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 42 +++++++++++-------- compiler/coreSyn/CoreSyn.hs | 4 ++ compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 55 +++++++++++++++++-------- compiler/coreSyn/PprCore.hs | 10 +++++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/ghci/ByteCodeGen.hs | 27 ++++++++++++ compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 18 ++++++++ compiler/specialise/Rules.hs | 13 ++++++ compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 33 +++++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ 40 files changed, 494 insertions(+), 132 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 b4fd3bcb6af2335078c708dd9398578fea108f8d From git at git.haskell.org Sun Oct 2 18:53:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 18:53:52 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Kill off redundant SigTv check in occurCheckExpand (11f9bff) Message-ID: <20161002185352.3BF813A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/11f9bffb11462f0bed3881e160968bf024466bdc/ghc >--------------------------------------------------------------- commit 11f9bffb11462f0bed3881e160968bf024466bdc Author: Simon Peyton Jones Date: Mon May 16 22:08:08 2016 +0100 Kill off redundant SigTv check in occurCheckExpand This patch simply deletes code, the SigTv check in occurCheckExpand. As the new comment says In the past we also rejected a SigTv matched with a non-tyvar But it is wrong to reject that for Givens; and SigTv is in any case handled separately by - TcUnify.checkTauTvUpdate (on-the-fly unifier) - TcInteract.canSolveByUnification (main constraint solver) (cherry picked from commit d25cb61a1c2a135a2564143a332f8b2962f134bc) >--------------------------------------------------------------- 11f9bffb11462f0bed3881e160968bf024466bdc compiler/typecheck/TcType.hs | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index a949938..b5cafac 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1536,7 +1536,6 @@ See also Note [occurCheckExpand] in TcCanonical data OccCheckResult a = OC_OK a | OC_Forall - | OC_NonTyVar | OC_Occurs instance Functor OccCheckResult where @@ -1550,7 +1549,6 @@ instance Monad OccCheckResult where return = pure OC_OK x >>= k = k x OC_Forall >>= _ = OC_Forall - OC_NonTyVar >>= _ = OC_NonTyVar OC_Occurs >>= _ = OC_Occurs occurCheckExpand :: DynFlags -> TcTyVar -> Type -> OccCheckResult Type @@ -1558,17 +1556,19 @@ occurCheckExpand :: DynFlags -> TcTyVar -> Type -> OccCheckResult Type -- Check whether -- a) the given variable occurs in the given type. -- b) there is a forall in the type (unless we have -XImpredicativeTypes) --- c) if it's a SigTv, ty should be a tyvar -- -- We may have needed to do some type synonym unfolding in order to -- get rid of the variable (or forall), so we also return the unfolded -- version of the type, which is guaranteed to be syntactically free -- of the given type variable. If the type is already syntactically -- free of the variable, then the same type is returned. - +-- +-- NB: in the past we also rejected a SigTv matched with a non-tyvar +-- But it is wrong to reject that for Givens; +-- and SigTv is in any case handled separately by +-- - TcUnify.checkTauTvUpdate (on-the-fly unifier) +-- - TcInteract.canSolveByUnification (main constraint solver) occurCheckExpand dflags tv ty - | MetaTv { mtv_info = SigTv } <- details - = go_sig_tv ty | fast_check ty = return ty | otherwise = go emptyVarEnv ty where @@ -1576,14 +1576,6 @@ occurCheckExpand dflags tv ty impredicative = canUnifyWithPolyType dflags details - -- Check 'ty' is a tyvar, or can be expanded into one - go_sig_tv ty@(TyVarTy tv') - | fast_check (tyVarKind tv') = return ty - | otherwise = do { k' <- go emptyVarEnv (tyVarKind tv') - ; return (mkTyVarTy (setTyVarKind tv' k')) } - go_sig_tv ty | Just ty' <- coreView ty = go_sig_tv ty' - go_sig_tv _ = OC_NonTyVar - -- True => fine fast_check (LitTy {}) = True fast_check (TyVarTy tv') = tv /= tv' && fast_check (tyVarKind tv') From git at git.haskell.org Sun Oct 2 18:53:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 18:53:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix a bug in occurs checking (836f0e2) Message-ID: <20161002185355.D5E653A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/836f0e248b21c4f802b3dce1593f975296e56ba4/ghc >--------------------------------------------------------------- commit 836f0e248b21c4f802b3dce1593f975296e56ba4 Author: Simon Peyton Jones Date: Thu Sep 22 22:18:22 2016 +0100 Fix a bug in occurs checking 1. Trac #12593 exposed a long-standing bug in the occurs checking machinery. When unifying two type variables a ~ b where a /= b, we were assuming that there could be no occurs-check error. But there can: 'a' can occur in b's kind! When the RHS was a non-tyvar we used occurCheckExpand, which /did/ look in kinds, but not when the RHS was a tyvar. This bug has been lurking ever since TypeInType, maybe longer. And it was present both in TcUnify (the on-the-fly unifier), and in TcInteract. I ended up refactoring both so that the tyvar/tyvar path naturally goes through the same occurs-check as non-tyvar rhss. It's simpler and more robust now. One good thing is that both unifiers now share TcType.swapOverVars TcType.canSolveByUnification previously they had different logic for the same goals 2. Fixing this bug exposed another! In T11635 we end up unifying (alpha :: forall k. k->*) ~ (beta :: forall k. k->*) Now that the occurs check is done for tyvars too, we look inside beta's kind. And then reject the program becuase of the forall inside there. But in fact that forall is fine -- it does not count as impredicative polymoprhism. See Note [Checking for foralls] in TcType. 3. All this fuss around occurrence checking forced me to look at TcUnify.checkTauTvUpdate and TcType.occurCheckExpand There's a lot of duplication there, and I managed to elminate quite a bit of it. For example, checkTauTvUpdate called a local 'defer_me'; and then called occurCheckExpand, which then used a very similar 'fast_check'. Things are better, but there is more to do. (cherry picked from commit 66a8c194520aadcaa0482736f3fdd4d2f31a5586) >--------------------------------------------------------------- 836f0e248b21c4f802b3dce1593f975296e56ba4 compiler/typecheck/TcCanonical.hs | 154 ++--------- compiler/typecheck/TcDeriv.hs | 5 +- compiler/typecheck/TcInteract.hs | 66 ++--- compiler/typecheck/TcType.hs | 129 ++++++--- compiler/typecheck/TcUnify.hs | 303 ++++++++++++--------- testsuite/tests/polykinds/T12593.hs | 14 + testsuite/tests/polykinds/T12593.stderr | 31 +++ testsuite/tests/polykinds/all.T | 1 + .../tests/typecheck/should_compile/tc141.stderr | 10 +- testsuite/tests/typecheck/should_fail/T9605.stderr | 6 +- .../tests/typecheck/should_fail/tcfail122.stderr | 2 +- 11 files changed, 371 insertions(+), 350 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 836f0e248b21c4f802b3dce1593f975296e56ba4 From git at git.haskell.org Sun Oct 2 18:53:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 18:53:58 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix T12512 (15df517) Message-ID: <20161002185358.88E903A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/15df51703a45880a794e8d0f6327c57e368d3cb4/ghc >--------------------------------------------------------------- commit 15df51703a45880a794e8d0f6327c57e368d3cb4 Author: Ben Gamari Date: Sat Oct 1 23:19:09 2016 -0400 Fix T12512 >--------------------------------------------------------------- 15df51703a45880a794e8d0f6327c57e368d3cb4 testsuite/tests/deriving/should_fail/T12512.hs | 4 ---- testsuite/tests/deriving/should_fail/T12512.stderr | 7 +------ 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/testsuite/tests/deriving/should_fail/T12512.hs b/testsuite/tests/deriving/should_fail/T12512.hs index 87c3d66..9b64422 100644 --- a/testsuite/tests/deriving/should_fail/T12512.hs +++ b/testsuite/tests/deriving/should_fail/T12512.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-} module T12512 where @@ -9,6 +8,3 @@ import GHC.Exts class Wat1 (a :: TYPE 'UnboxedTupleRep) deriving instance Wat1 (# a, b #) - -class Wat2 (a :: TYPE 'UnboxedSumRep) -deriving instance Wat2 (# a | b #) diff --git a/testsuite/tests/deriving/should_fail/T12512.stderr b/testsuite/tests/deriving/should_fail/T12512.stderr index 48f0eae..a62efc2 100644 --- a/testsuite/tests/deriving/should_fail/T12512.stderr +++ b/testsuite/tests/deriving/should_fail/T12512.stderr @@ -1,10 +1,5 @@ -T12512.hs:11:1: error: +T12512.hs:10:1: error: • Can't make a derived instance of ‘Wat1 (# a, b #)’: The last argument of the instance cannot be an unboxed tuple • In the stand-alone deriving instance for ‘Wat1 (# a, b #)’ - -T12512.hs:14:1: error: - • Can't make a derived instance of ‘Wat2 (# a | b #)’: - The last argument of the instance cannot be an unboxed sum - • In the stand-alone deriving instance for ‘Wat2 (# a | b #)’ From git at git.haskell.org Sun Oct 2 18:54:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 18:54:01 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix T12593 (4557d94) Message-ID: <20161002185401.696BB3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4557d944a61f54fcfe99a40cf7de942568ef22b4/ghc >--------------------------------------------------------------- commit 4557d944a61f54fcfe99a40cf7de942568ef22b4 Author: Ben Gamari Date: Sat Oct 1 23:25:46 2016 -0400 Fix T12593 (cherry picked from commit 779bcc90cf8a52270bcd70a82442d01d35d7c788) >--------------------------------------------------------------- 4557d944a61f54fcfe99a40cf7de942568ef22b4 testsuite/tests/polykinds/T12593.stderr | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/polykinds/T12593.stderr b/testsuite/tests/polykinds/T12593.stderr index 4b55155..2317e97 100644 --- a/testsuite/tests/polykinds/T12593.stderr +++ b/testsuite/tests/polykinds/T12593.stderr @@ -1,7 +1,7 @@ T12593.hs:11:16: error: • Expecting two fewer arguments to ‘Free k k4 k5 p’ - Expected kind ‘k0 -> k1 -> *’, but ‘Free k k4 k5 p’ has kind ‘*’ + Expected kind ‘k3 -> k2 -> *’, but ‘Free k k4 k5 p’ has kind ‘*’ • In the type signature: run :: k2 q => Free k k1 k2 p a b @@ -11,7 +11,7 @@ T12593.hs:12:31: error: • Expecting one more argument to ‘k’ Expected a type, but ‘k’ has kind - ‘(((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *) + ‘(((k3 -> k2 -> *) -> Constraint) -> (k1 -> k0 -> *) -> *) -> Constraint’ • In the kind ‘k’ In the type signature: @@ -23,7 +23,7 @@ T12593.hs:12:40: error: • Expecting two more arguments to ‘k4’ Expected a type, but ‘k4’ has kind - ‘((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *’ + ‘((k3 -> k2 -> *) -> Constraint) -> (k1 -> k0 -> *) -> *’ • In the kind ‘k1’ In the type signature: run :: k2 q => From git at git.haskell.org Sun Oct 2 18:54:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 18:54:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Turn `__GLASGOW_HASKELL_LLVM__` into an integer again (3b13a04) Message-ID: <20161002185404.1F5793A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3b13a0426f59b47fb27646c694caf1df55a684e3/ghc >--------------------------------------------------------------- commit 3b13a0426f59b47fb27646c694caf1df55a684e3 Author: Nicolas Trangez Date: Sat Oct 1 17:58:11 2016 -0400 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again In GHC < 8.0.1, the value of `__GLASGOW_HASKELL_LLVM__`, exposed through the preprocessor when compiled with `-fllvm`, was an integer value, encoded according to some rules specified in the user guide. Due to an oversight, in GHC 8.0.1 the value of this define became a tuple, exposed as e.g. `(3, 7)`. This was an unintended regression. This patch turns the value of the `__GLASGOW_HASKELL_LLVM__` definition into a single integer again, but changes the formatting of said number slightly. Before, any LLVM version where the major or minor component >= 10 would cause ambiguous values for `__GLASGOW_HASKELL_LLVM__`. With this patch, the value is in line with `__GLASGOW_HASKELL__`, adding a padding `0` in-between major and minor component if applicable (we assume no minors >= 100 will ever exist). The documentation in the user guide is updated accordingly, and a reference is made in the 8.0.2 release notes. Test Plan: validate Reviewers: bgamari, erikd Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2552 GHC Trac Issues: #12628 (cherry picked from commit b0d53a839da0149e0142da036b6ebf5a01b3216f) >--------------------------------------------------------------- 3b13a0426f59b47fb27646c694caf1df55a684e3 compiler/main/DriverPipeline.hs | 6 +++++- docs/users_guide/8.0.2-notes.rst | 6 ++++++ docs/users_guide/phases.rst | 4 +++- 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 2f59678..d16afc5 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2100,8 +2100,12 @@ getBackendDefs :: DynFlags -> IO [String] getBackendDefs dflags | hscTarget dflags == HscLlvm = do llvmVer <- figureLlvmVersion dflags return $ case llvmVer of - Just n -> [ "-D__GLASGOW_HASKELL_LLVM__="++show n ] + Just n -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format n ] _ -> [] + where + format (major, minor) + | minor >= 100 = error "getBackendDefs: Unsupported minor version" + | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int getBackendDefs _ = return [] diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 508387e..668474a 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -34,6 +34,12 @@ Compiler defaulting to decimal, hexadecimal if the address starts with `0x`, and octal if the address starts with `0`. +- Due to an oversight in GHC 8.0.1, the value of the preprocessor macro + ``__GLASGOW_HASKELL_LLVM__``, which exposes the LLVM version used by GHC, was + no longer an integer. This value is now turned into an integer again, but the + formatting is changed to be in line with ``__GLASGOW_HASKELL__`` + (:ghc-ticket:`12628`). + Runtime system ~~~~~~~~~~~~~~ diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index 0c3b59f..01c2e1f 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -291,7 +291,9 @@ defined by your local GHC installation, the following trick is useful: Only defined when ``-fllvm`` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the - integer ⟨xy⟩. + integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero + is added, so for example when using version 3.7 of LLVM, + ``__GLASGOW_HASKELL_LLVM__==307``). ``__PARALLEL_HASKELL__`` .. index:: From git at git.haskell.org Sun Oct 2 18:54:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 18:54:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix expected output for T7786 (a24092f) Message-ID: <20161002185406.D2F3D3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a24092ff501028ca1245b508320493f394378495/ghc >--------------------------------------------------------------- commit a24092ff501028ca1245b508320493f394378495 Author: Ben Gamari Date: Sun Oct 2 14:52:27 2016 -0400 Fix expected output for T7786 I believe this is a benign difference between master and ghc-8.0. >--------------------------------------------------------------- a24092ff501028ca1245b508320493f394378495 .../tests/indexed-types/should_fail/T7786.stderr | 38 +++++++++++++++------- 1 file changed, 26 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/indexed-types/should_fail/T7786.stderr b/testsuite/tests/indexed-types/should_fail/T7786.stderr index a58b69e..ca3e9ec 100644 --- a/testsuite/tests/indexed-types/should_fail/T7786.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7786.stderr @@ -1,16 +1,4 @@ -T7786.hs:86:22: error: - • Couldn't match type ‘xxx’ with ‘'Empty’ - Inaccessible code in - a pattern with constructor: Nil :: forall a. Sing 'Empty, - in a pattern binding in - 'do' block - • In the pattern: Nil - In the pattern: Nil :: Sing xxx - In a stmt of a 'do' block: - Nil :: Sing xxx <- return - (buryUnder (dbKeys sub) k Nil `intersectPaths` dbKeys db) - T7786.hs:86:49: error: • Couldn't match type ‘xxx’ with ‘Intersect (BuriedUnder sub k 'Empty) inv’ @@ -34,3 +22,29 @@ T7786.hs:86:49: error: -> Database sub -> Maybe (Database (BuriedUnder sub k inv)) (bound at T7786.hs:86:1) + +T7786.hs:90:31: error: + • Could not deduce: Intersect (BuriedUnder sub k 'Empty) inv + ~ + 'Empty + arising from a use of ‘Sub’ + from the context: xxx ~ 'Empty + bound by a pattern with constructor: Nil :: forall a. Sing 'Empty, + in a pattern binding in + 'do' block + at T7786.hs:86:22-24 + • In the second argument of ‘($)’, namely ‘Sub db k sub’ + In a stmt of a 'do' block: return $ Sub db k sub + In the expression: + do { Nil :: Sing xxx <- return + (buryUnder (dbKeys sub) k Nil `intersectPaths` dbKeys db); + return $ Sub db k sub } + • Relevant bindings include + sub :: Database sub (bound at T7786.hs:86:13) + k :: Sing k (bound at T7786.hs:86:11) + db :: Database inv (bound at T7786.hs:86:8) + addSub :: Database inv + -> Sing k + -> Database sub + -> Maybe (Database (BuriedUnder sub k inv)) + (bound at T7786.hs:86:1) From git at git.haskell.org Sun Oct 2 19:17:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 19:17:21 +0000 (UTC) Subject: [commit: ghc] master: validate: Add --build-only (4d2b15d) Message-ID: <20161002191721.5A59A3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d2b15d5895ea10a64194bffe8c321e447e39683/ghc >--------------------------------------------------------------- commit 4d2b15d5895ea10a64194bffe8c321e447e39683 Author: Ben Gamari Date: Sat Oct 1 20:11:03 2016 -0400 validate: Add --build-only This will allow us to split up Harbormaster output for the build and test stages of validation. Test Plan: `./validate --build-only && ./validate --testsuite-only` Reviewers: thomie, hvr, austin Differential Revision: https://phabricator.haskell.org/D2553 >--------------------------------------------------------------- 4d2b15d5895ea10a64194bffe8c321e447e39683 validate | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/validate b/validate index 9d58bde..cf45648 100755 --- a/validate +++ b/validate @@ -14,6 +14,7 @@ Flags: --no-clean don't make clean first, just carry on from a previous interrupted validation run --testsuite-only don't build the compiler, just run the test suite + --build-only don't test the compiler, just build it --hpc build stage2 with -fhpc, and see how much of the compiler the test suite covers. 2008-07-01: 63% slower than the default. @@ -46,6 +47,7 @@ EOF no_clean=0 testsuite_only=0 +build_only=0 hpc=NO speed=NORMAL use_dph=0 @@ -64,6 +66,9 @@ do --testsuite-only) testsuite_only=1 ;; + --build-only) + build_only=1 + ;; --hpc) hpc=YES ;; @@ -240,6 +245,16 @@ fi # testsuite-only # ----------------------------------------------------------------------------- # Run the testsuite +if [ "$build_only" -eq 1 ]; then + cat < Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/42f1d86770f963cf810aa4d31757dda8a08a52fa/ghc >--------------------------------------------------------------- commit 42f1d86770f963cf810aa4d31757dda8a08a52fa Author: Michael Snoyman Date: Sat Oct 1 21:24:05 2016 -0400 runghc: use executeFile to run ghc process on POSIX This means that, on POSIX systems, there will be only one ghc process used for running scripts, as opposed to the current situation of a runghc process and a ghc process. Beyond minor performance benefits of not having an extra fork and resident process, the more important impact of this is automatically getting proper signal handling. I noticed this problem myself when running runghc as PID1 inside a Docker container. I attempted to create a shim library for executeFile that would work for both POSIX and Windows, but unfortunately I ran into issues with exit codes being propagated correctly (see https://github.com/fpco/replace-process/issues/2). Therefore, this patch leaves the Windows behavior unchanged. Given that signals are a POSIX issue, this isn't too bad a trade-off. If someone has suggestions for better Windows _exec support, please let me know. Reviewers: erikd, austin, bgamari Reviewed By: bgamari Subscribers: Phyx, thomie Differential Revision: https://phabricator.haskell.org/D2538 >--------------------------------------------------------------- 42f1d86770f963cf810aa4d31757dda8a08a52fa testsuite/tests/runghc/Makefile | 3 + testsuite/tests/runghc/T-signals-child.hs | 113 ++++++++++++++++++++++++++++++ testsuite/tests/runghc/T7859.stderr | 2 +- testsuite/tests/runghc/all.T | 5 ++ utils/runghc/Main.hs | 24 +++++-- utils/runghc/runghc.cabal.in | 3 + 6 files changed, 143 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/runghc/Makefile b/testsuite/tests/runghc/Makefile index c414f84..25c2600 100644 --- a/testsuite/tests/runghc/Makefile +++ b/testsuite/tests/runghc/Makefile @@ -22,3 +22,6 @@ T11247: # "foo.bar" -'$(RUNGHC)' foo. -'$(RUNGHC)' foo.bar + +T-signals-child: + -'$(RUNGHC)' T-signals-child.hs --runghc '$(RUNGHC)' diff --git a/testsuite/tests/runghc/T-signals-child.hs b/testsuite/tests/runghc/T-signals-child.hs new file mode 100644 index 0000000..21c1b64 --- /dev/null +++ b/testsuite/tests/runghc/T-signals-child.hs @@ -0,0 +1,113 @@ +import Control.Concurrent.MVar (readMVar) +import System.Environment (getArgs) +import System.Exit (ExitCode (ExitFailure), exitFailure) +import System.IO (hGetLine, hPutStrLn) +import System.Posix.Process (exitImmediately, getProcessID) +import System.Posix.Signals (Handler (Catch), installHandler, sigHUP, + signalProcess) +import System.Process (StdStream (CreatePipe), createProcess, proc, + std_in, std_out, waitForProcess) +import System.Process.Internals (ProcessHandle (..), + ProcessHandle__ (OpenHandle)) + +main :: IO () +main = do + args <- getArgs + case args of + ["--runghc", runghc] -> runParent runghc + ["child"] -> runChild + _ -> error $ "Unknown args: " ++ show args + +runParent :: FilePath -> IO () +runParent runghc = do + (Just inH, Just outH, Nothing, ph@(ProcessHandle mvar _)) <- + createProcess (proc runghc ["T-signals-child.hs", "child"]) + { std_in = CreatePipe + , std_out = CreatePipe + } + + -- Get the PID of the actual child process. This will initially be + -- runghc. If executeFile is used by runghc, that same process + -- will become the ghc process running our code from + -- runChild. Otherwise, runChild will run in a child of this + -- process. + OpenHandle childPid <- readMVar mvar + + -- Get the PID of the process actually running the runChild code, + -- by reading it from its stdout (see runChild below). + pidS <- hGetLine outH + let pid = fromIntegral (read pidS :: Int) + + -- Send the child process the HUP signal. We know this is after + -- the signal handler has been installed, since we already got the + -- PID from the process. + signalProcess sigHUP childPid + + -- Send the child some input so that it will exit if it didn't + -- have a sigHUP handler installed. + hPutStrLn inH "" + + -- Read out the rest of stdout from the child, which will be + -- either "NOSIGNAL\n" or "HUP\n" + rest <- hGetLine outH + + -- Get the exit code of the child + ec <- waitForProcess ph + + -- Check that everything matches + if childPid /= pid || rest /= hupMessage || ec /= hupExitCode + then do + -- Debugging display + putStrLn $ concat + [ "Child process: " + , show childPid + , ", real process: " + , show pid + ] + putStrLn $ concat + [ "Expected " + , show hupMessage + , ", received: " + , show rest + ] + putStrLn $ concat + [ "Expected " + , show hupExitCode + , ", received " + , show ec + ] + exitFailure + else return () + +runChild :: IO () +runChild = do + -- Install our sigHUP handler: print the HUP message and exit with + -- the HUP exit code. + let handler = Catch $ do + putStrLn hupMessage + exitImmediately hupExitCode + _ <- installHandler sigHUP handler Nothing + + -- Get our actual process ID and print it to stdout. + pid <- getProcessID + print (fromIntegral pid :: Int) + + -- Block until we receive input, giving a chance for the signal + -- handler to be triggered, and if the signal handler isn't + -- triggered, gives us an escape route from this function. + _ <- getLine + + -- Reaching this point indicates a failure of the test. Print some + -- non HUP message and exit with a non HUP exit + -- code. Interestingly, in a failure, this exit code will _not_ + -- be received by the parent process, since the runghc process + -- itself will exit with ExitFailure -1, indicating that it was + -- killed by signal 1 (SIGHUP). + putStrLn "No signal received" + exitImmediately $ ExitFailure 41 + +hupExitCode :: ExitCode +hupExitCode = ExitFailure 42 + +hupMessage :: String +hupMessage = "HUP" diff --git a/testsuite/tests/runghc/T7859.stderr b/testsuite/tests/runghc/T7859.stderr index f784874..59348de 100644 --- a/testsuite/tests/runghc/T7859.stderr +++ b/testsuite/tests/runghc/T7859.stderr @@ -1 +1 @@ -runghc: defer-type-errors: rawSystem: runInteractiveProcess: exec: does not exist (No such file or directory) +runghc: defer-type-errors: executeFile: does not exist (No such file or directory) diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index 7c4fad2..0fd1e76 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -8,3 +8,8 @@ test('T11247', [req_interp, expect_broken(11247)], run_command, ['$MAKE --no-print-directory -s T11247']) test('T6132', [], compile, ['']) + +test('T-signals-child', + [when(opsys('mingw32'), skip), req_interp], + run_command, + ['$MAKE --no-print-directory -s T-signals-child']) diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs index 001d902..bcf77e7 100644 --- a/utils/runghc/Main.hs +++ b/utils/runghc/Main.hs @@ -24,11 +24,13 @@ import System.Environment import System.Exit import System.FilePath import System.IO -import System.Process #if defined(mingw32_HOST_OS) +import System.Process (runProcess) import Foreign import Foreign.C.String +#else +import System.Posix.Process (executeFile) #endif #if defined(mingw32_HOST_OS) @@ -141,11 +143,21 @@ doIt ghc ghc_args rest = do else [] c1 = ":set prog " ++ show filename c2 = ":main " ++ show prog_args - res <- rawSystem ghc (["-ignore-dot-ghci"] ++ - xflag ++ - ghc_args ++ - [ "-e", c1, "-e", c2, filename]) - exitWith res + + let cmd = ghc + args = ["-ignore-dot-ghci"] ++ + xflag ++ + ghc_args ++ + [ "-e", c1, "-e", c2, filename] + + +#if defined(mingw32_HOST_OS) + rawSystem cmd args >>= exitWith +#else + -- Passing False to avoid searching the PATH, since the cmd should + -- always be an absolute path to the ghc executable. + executeFile cmd False args Nothing +#endif getGhcArgs :: [String] -> ([String], [String]) getGhcArgs args diff --git a/utils/runghc/runghc.cabal.in b/utils/runghc/runghc.cabal.in index efef5ec..2253292 100644 --- a/utils/runghc/runghc.cabal.in +++ b/utils/runghc/runghc.cabal.in @@ -30,3 +30,6 @@ Executable runghc directory >= 1 && < 1.3, process >= 1 && < 1.5, filepath + + if !os(windows) + build-depends: unix \ No newline at end of file From git at git.haskell.org Sun Oct 2 19:17:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 19:17:27 +0000 (UTC) Subject: [commit: ghc] master: Mark #6132 as broken on OS X (3630ad3) Message-ID: <20161002191727.482193A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3630ad355a5b7be0240d3071bb662fe710909cca/ghc >--------------------------------------------------------------- commit 3630ad355a5b7be0240d3071bb662fe710909cca Author: Ben Gamari Date: Sun Oct 2 11:53:54 2016 -0400 Mark #6132 as broken on OS X It currently fails with, =====> T6132(normal) 1 of 1 [0, 0, 0] cd "./runghc/T6132.run" && "/Users/bgamari/ghc/inplace/test spaces/ghc-stage2" -c T6132.hs -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -dno-debug-output Compile failed (exit code 1) errors were: T6132.hs:1:2: error: parse error on input ‘#!/’ *** unexpected failure for T6132(normal) >--------------------------------------------------------------- 3630ad355a5b7be0240d3071bb662fe710909cca testsuite/tests/runghc/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index 0fd1e76..107f35b 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -7,7 +7,7 @@ test('T8601', req_interp, run_command, test('T11247', [req_interp, expect_broken(11247)], run_command, ['$MAKE --no-print-directory -s T11247']) -test('T6132', [], compile, ['']) +test('T6132', [when(opsys('darwin'), expect_broken(6132))], compile, ['']) test('T-signals-child', [when(opsys('mingw32'), skip), req_interp], From git at git.haskell.org Sun Oct 2 19:17:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 19:17:30 +0000 (UTC) Subject: [commit: ghc] master: Ignore output from derefnull and divbyzero on Darwin (8cab9bd) Message-ID: <20161002191730.34FFD3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8cab9bd5eeb9cdb1afa6be7682c861c8efee475a/ghc >--------------------------------------------------------------- commit 8cab9bd5eeb9cdb1afa6be7682c861c8efee475a Author: Ben Gamari Date: Sun Oct 2 12:01:21 2016 -0400 Ignore output from derefnull and divbyzero on Darwin The output contains the pid and executable path of the bash process which spawned the failing process. It doesn't seem worth the effort to cleanse this output; just ignore it. >--------------------------------------------------------------- 8cab9bd5eeb9cdb1afa6be7682c861c8efee475a testsuite/tests/rts/all.T | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 9692846..fc37f8d 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -25,8 +25,10 @@ test('derefnull', # the right exit code we're OK. when(opsys('linux'), ignore_stderr), # SIGBUS on OX X (PPC and x86 only; amd64 gives SEGV) - when(platform('i386-apple-darwin'), exit_code(138)), - when(platform('powerpc-apple-darwin'), exit_code(138)), + # The output under OS X is too unstable to readily compare + when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(139)]), + when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(139)]), + when(platform('powerpc-apple-darwin'), [ignore_stderr, exit_code(139)]), when(opsys('mingw32'), exit_code(1)), # since these test are supposed to crash the # profile report will be empty always. @@ -47,6 +49,10 @@ test('divbyzero', when(platform('powerpc64-unknown-linux'), exit_code(0)), when(platform('powerpc64le-unknown-linux'), exit_code(0)), when(opsys('mingw32'), exit_code(1)), + # The output under OS X is too unstable to readily compare + when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(136)]), + when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(136)]), + when(platform('powerpc-apple-darwin'), [ignore_stderr, exit_code(136)]), # since these test are supposed to crash the # profile report will be empty always. # so disable the check for profiling From git at git.haskell.org Sun Oct 2 19:17:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 19:17:33 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark test for #12355 as unbroken on Darwin. (eda5a4a) Message-ID: <20161002191733.0A6413A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eda5a4ab6c2032ec13d9cd0aac258bb14f0b2ec9/ghc >--------------------------------------------------------------- commit eda5a4ab6c2032ec13d9cd0aac258bb14f0b2ec9 Author: Ben Gamari Date: Sun Oct 2 13:47:03 2016 -0400 testsuite: Mark test for #12355 as unbroken on Darwin. Somehow this testcase works on Darwin but not on Linux. This deserves further investigation. >--------------------------------------------------------------- eda5a4ab6c2032ec13d9cd0aac258bb14f0b2ec9 testsuite/tests/codeGen/should_compile/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 2fac947..dad755e 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -37,4 +37,4 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], compile, ['-g']) test('T12115', normal, compile, ['']) -test('T12355', expect_broken(12355), compile, ['']) +test('T12355', when(not opsys('darwin'), expect_broken(12355)), compile, ['']) From git at git.haskell.org Sun Oct 2 19:17:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 19:17:35 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: Fix absolute import path to generated header (e9104d4) Message-ID: <20161002191735.B00963A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9104d46eab0a2fbf7af9a299da3763bcf39f148/ghc >--------------------------------------------------------------- commit e9104d46eab0a2fbf7af9a299da3763bcf39f148 Author: Ben Gamari Date: Sun Oct 2 13:46:12 2016 -0400 DynFlags: Fix absolute import path to generated header Test Plan: Validate Reviewers: austin, snowleopard Reviewed By: snowleopard Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2559 GHC Trac Issues: #8040. >--------------------------------------------------------------- e9104d46eab0a2fbf7af9a299da3763bcf39f148 compiler/main/DynFlags.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index cc11d3d..97a6211 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -124,7 +124,7 @@ module DynFlags ( #endif dynamicGhc, -#include "../includes/dist-derivedconstants/header/GHCConstantsHaskellExports.hs" +#include "GHCConstantsHaskellExports.hs" bLOCK_SIZE_W, wORD_SIZE_IN_BITS, tAG_MASK, From git at git.haskell.org Sun Oct 2 22:04:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 22:04:10 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (3fc2e85) Message-ID: <20161002220410.228E63A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/3fc2e85a508ac40664748b44e53ac6a70aea4e67/ghc >--------------------------------------------------------------- commit 3fc2e85a508ac40664748b44e53ac6a70aea4e67 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- 3fc2e85a508ac40664748b44e53ac6a70aea4e67 compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 35 +++++++++++++++++++++++++++++++++-- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 52 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,18 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), @@ -174,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Sun Oct 2 22:04:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 22:04:13 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (503d94c) Message-ID: <20161002220413.02F003A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/503d94ce222dd695c33021b30e836cafc799ac98/ghc >--------------------------------------------------------------- commit 503d94ce222dd695c33021b30e836cafc799ac98 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 503d94ce222dd695c33021b30e836cafc799ac98 compiler/basicTypes/DataCon.hs | 14 +++++-- compiler/basicTypes/Demand.hs | 17 +++++++- compiler/basicTypes/MkId.hs | 43 +++++++++---------- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 13 ++++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 42 +++++++++++-------- compiler/coreSyn/CoreSyn.hs | 11 ++++- compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 55 +++++++++++++++++-------- compiler/coreSyn/PprCore.hs | 10 +++++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/ghci/ByteCodeGen.hs | 26 ++++++++++++ compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 18 ++++++++ compiler/specialise/Rules.hs | 13 ++++++ compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 15 +++++++ compiler/stranal/DmdAnal.hs | 33 +++++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ compiler/vectorise/Vectorise/Utils.hs | 6 --- 41 files changed, 502 insertions(+), 139 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 503d94ce222dd695c33021b30e836cafc799ac98 From git at git.haskell.org Sun Oct 2 22:19:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 22:19:22 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal submodule to latest version. (22c6b7f) Message-ID: <20161002221922.0DF503A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22c6b7f2e5265461128e3a19a01d07341fb29498/ghc >--------------------------------------------------------------- commit 22c6b7f2e5265461128e3a19a01d07341fb29498 Author: Edward Z. Yang Date: Fri Sep 30 16:50:52 2016 -0700 Update Cabal submodule to latest version. Summary: Note that Cabal needs one more bugfix which is in PR to fix GHC bootstrapping. But the rest of the patch is ready for review. Needs a filepath submodule update because cabal check became more strict. This patch handles the abstract-ification of Version and PackageName. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2555 >--------------------------------------------------------------- 22c6b7f2e5265461128e3a19a01d07341fb29498 libraries/Cabal | 2 +- libraries/filepath | 2 +- testsuite/tests/driver/T4437.hs | 1 - testsuite/tests/perf/haddock/all.T | 3 ++- utils/ghc-cabal/Main.hs | 6 ++--- utils/ghc-pkg/Main.hs | 54 ++++++++++++++++++++------------------ 6 files changed, 36 insertions(+), 32 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 22c6b7f2e5265461128e3a19a01d07341fb29498 From git at git.haskell.org Sun Oct 2 23:41:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Oct 2016 23:41:23 +0000 (UTC) Subject: [commit: ghc] master: runghc: Fix import of System.Process on Windows (8952cc3) Message-ID: <20161002234123.578573A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8952cc3e8e36985b06166c23c482174b07ffa66d/ghc >--------------------------------------------------------------- commit 8952cc3e8e36985b06166c23c482174b07ffa66d Author: Ben Gamari Date: Sun Oct 2 19:40:56 2016 -0400 runghc: Fix import of System.Process on Windows This apparently should have been an import of rawSystem instead of runProcess. Oops. Fixes D2538. Test Plan: Validate on Linux and Windows. Reviewers: austin, snowleopard Reviewed By: snowleopard Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2561 >--------------------------------------------------------------- 8952cc3e8e36985b06166c23c482174b07ffa66d utils/runghc/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs index bcf77e7..b5d4a4a 100644 --- a/utils/runghc/Main.hs +++ b/utils/runghc/Main.hs @@ -26,7 +26,7 @@ import System.FilePath import System.IO #if defined(mingw32_HOST_OS) -import System.Process (runProcess) +import System.Process (rawSystem) import Foreign import Foreign.C.String #else From git at git.haskell.org Mon Oct 3 01:20:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Oct 2016 01:20:00 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (a7b2939) Message-ID: <20161003012000.7929B3A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/a7b29397fe04f628df39fb670c48b7b13c4cfaab/ghc >--------------------------------------------------------------- commit a7b29397fe04f628df39fb670c48b7b13c4cfaab Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- a7b29397fe04f628df39fb670c48b7b13c4cfaab compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 35 +++++++++++++++++++++++++++++++++-- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 52 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,18 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), @@ -174,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Mon Oct 3 01:20:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Oct 2016 01:20:03 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (30c432d) Message-ID: <20161003012003.62AF13A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/30c432d615f464a6b21b98198ff2d1428ee4eefb/ghc >--------------------------------------------------------------- commit 30c432d615f464a6b21b98198ff2d1428ee4eefb Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 30c432d615f464a6b21b98198ff2d1428ee4eefb compiler/basicTypes/DataCon.hs | 14 +++++-- compiler/basicTypes/Demand.hs | 17 +++++++- compiler/basicTypes/MkId.hs | 43 +++++++++---------- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 13 ++++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 42 +++++++++++-------- compiler/coreSyn/CoreSyn.hs | 11 ++++- compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 55 +++++++++++++++++-------- compiler/coreSyn/PprCore.hs | 10 +++++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/ghci/ByteCodeGen.hs | 26 ++++++++++++ compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 18 ++++++++ compiler/specialise/Rules.hs | 13 ++++++ compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 33 +++++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ compiler/vectorise/Vectorise/Utils.hs | 6 --- 41 files changed, 499 insertions(+), 139 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 30c432d615f464a6b21b98198ff2d1428ee4eefb From git at git.haskell.org Mon Oct 3 01:20:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Oct 2016 01:20:06 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp bytecode: Add more ASSERT (3909506) Message-ID: <20161003012006.1B0193A33C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/3909506d46a6303f035aa25c228a1bde5b739793/ghc >--------------------------------------------------------------- commit 3909506d46a6303f035aa25c228a1bde5b739793 Author: Joachim Breitner Date: Sun Oct 2 21:19:49 2016 -0400 ConApp bytecode: Add more ASSERT >--------------------------------------------------------------- 3909506d46a6303f035aa25c228a1bde5b739793 compiler/ghci/ByteCodeGen.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 9f336c8..214a0f0 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -635,7 +635,7 @@ schemeT :: Word -- Stack depth -> AnnExpr' Id DVarSet -> BcM BCInstrList -schemeT d s p (AnnConApp dc args') +schemeT d s p (AnnConApp dc all_args) | isUnboxedTupleCon dc = case args of [arg2,arg1] | isVAtom arg1 -> @@ -644,11 +644,12 @@ schemeT d s p (AnnConApp dc args') unboxedTupleReturn d s p arg1 _other -> multiValException | otherwise - = do alloc_con <- mkConAppCode d s p dc (reverse args) + = do ASSERT( dataConRepFullArity dc == length all_args ) return () + alloc_con <- mkConAppCode d s p dc (reverse args) return (alloc_con `appOL` mkSLIDE 1 (d - s) `snocOL` ENTER) - where args = map snd $ dropWhile isAnnTypeArg args' + where args = map snd $ dropWhile isAnnTypeArg all_args schemeT d s p app -- | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False From git at git.haskell.org Tue Oct 4 20:17:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Oct 2016 20:17:10 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (bd6f68d) Message-ID: <20161004201710.14B8E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/bd6f68d11acbb81e008b4f379950714858a11a19/ghc >--------------------------------------------------------------- commit bd6f68d11acbb81e008b4f379950714858a11a19 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- bd6f68d11acbb81e008b4f379950714858a11a19 compiler/basicTypes/DataCon.hs | 14 +++++-- compiler/basicTypes/Demand.hs | 17 +++++++- compiler/basicTypes/MkId.hs | 43 +++++++++---------- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++++++ compiler/coreSyn/CoreLint.hs | 13 ++++++ compiler/coreSyn/CorePrep.hs | 23 +++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 42 +++++++++++-------- compiler/coreSyn/CoreSyn.hs | 11 ++++- compiler/coreSyn/CoreTidy.hs | 15 +++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 55 +++++++++++++++++-------- compiler/coreSyn/PprCore.hs | 10 +++++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++----------- compiler/ghci/ByteCodeGen.hs | 26 ++++++++++++ compiler/iface/IfaceSyn.hs | 46 +++++++++++++-------- compiler/iface/MkIface.hs | 27 +++++++----- compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 + compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 ++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 ++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++++++++--- compiler/simplCore/FloatIn.hs | 19 +++++++++ compiler/simplCore/FloatOut.hs | 8 ++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++++ compiler/simplCore/SAT.hs | 12 ++++++ compiler/simplCore/SetLevels.hs | 6 ++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 18 ++++++++ compiler/specialise/Rules.hs | 13 ++++++ compiler/specialise/SpecConstr.hs | 4 ++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 ++++++ compiler/stranal/DmdAnal.hs | 33 +++++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 ++++++ compiler/vectorise/Vectorise/Utils.hs | 6 --- 41 files changed, 499 insertions(+), 139 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 bd6f68d11acbb81e008b4f379950714858a11a19 From git at git.haskell.org Tue Oct 4 20:17:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Oct 2016 20:17:12 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp bytecode: Add more ASSERT (ef1168b) Message-ID: <20161004201712.B8E213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/ef1168ba59c97608f758768cd081c154ed039514/ghc >--------------------------------------------------------------- commit ef1168ba59c97608f758768cd081c154ed039514 Author: Joachim Breitner Date: Sun Oct 2 21:19:49 2016 -0400 ConApp bytecode: Add more ASSERT >--------------------------------------------------------------- ef1168ba59c97608f758768cd081c154ed039514 compiler/ghci/ByteCodeGen.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 9f336c8..214a0f0 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -635,7 +635,7 @@ schemeT :: Word -- Stack depth -> AnnExpr' Id DVarSet -> BcM BCInstrList -schemeT d s p (AnnConApp dc args') +schemeT d s p (AnnConApp dc all_args) | isUnboxedTupleCon dc = case args of [arg2,arg1] | isVAtom arg1 -> @@ -644,11 +644,12 @@ schemeT d s p (AnnConApp dc args') unboxedTupleReturn d s p arg1 _other -> multiValException | otherwise - = do alloc_con <- mkConAppCode d s p dc (reverse args) + = do ASSERT( dataConRepFullArity dc == length all_args ) return () + alloc_con <- mkConAppCode d s p dc (reverse args) return (alloc_con `appOL` mkSLIDE 1 (d - s) `snocOL` ENTER) - where args = map snd $ dropWhile isAnnTypeArg args' + where args = map snd $ dropWhile isAnnTypeArg all_args schemeT d s p app -- | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False From git at git.haskell.org Tue Oct 4 20:17:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Oct 2016 20:17:15 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (e2bdc4e) Message-ID: <20161004201715.693A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/e2bdc4e993a7b3b6fe0fe499fbacef13ddbb1f13/ghc >--------------------------------------------------------------- commit e2bdc4e993a7b3b6fe0fe499fbacef13ddbb1f13 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- e2bdc4e993a7b3b6fe0fe499fbacef13ddbb1f13 compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 35 +++++++++++++++++++++++++++++++++-- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 52 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,18 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), @@ -174,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Tue Oct 4 20:17:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Oct 2016 20:17:18 +0000 (UTC) Subject: [commit: ghc] master: genapply: update source file in autogenerated text (7a6731c) Message-ID: <20161004201718.1B5BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a6731c200f1fd22f5f12f6a2cbc8a22e5225d84/ghc >--------------------------------------------------------------- commit 7a6731c200f1fd22f5f12f6a2cbc8a22e5225d84 Author: Sergei Trofimovich Date: Tue Oct 4 21:13:51 2016 +0100 genapply: update source file in autogenerated text Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 7a6731c200f1fd22f5f12f6a2cbc8a22e5225d84 utils/genapply/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs index b8208ae..c5752fe 100644 --- a/utils/genapply/Main.hs +++ b/utils/genapply/Main.hs @@ -943,7 +943,7 @@ main = do exitWith (ExitFailure 1) let the_code = vcat [ text "// DO NOT EDIT!", - text "// Automatically generated by GenApply.hs", + text "// Automatically generated by utils/genapply/Main.hs", text "", text "#include \"Cmm.h\"", text "#include \"AutoApply.h\"", From git at git.haskell.org Tue Oct 4 20:17:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Oct 2016 20:17:20 +0000 (UTC) Subject: [commit: ghc] wip/T12618's head updated: ConApp bytecode: Add more ASSERT (ef1168b) Message-ID: <20161004201720.9532A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T12618' now includes: c36904d Fix layout of MultiWayIf expressions (#10807) f897b74 TH: Use atomicModifyIORef' for fresh names 0b6024c Comments and manual only: spelling 13d3b53 Test Trac #12634 f21eedb Check.hs: Use actual import lists instead of comments 0b533a2 A bit of tracing about flattening 2fbfbca Fix desugaring of pattern bindings (again) 66a8c19 Fix a bug in occurs checking 3012c43 Add Outputable Report in TcErrors b612da6 Fix impredicativity (again) fc4ef66 Comments only 5d473cd Add missing stderr file 3f27237 Make tcrun042 fail 28a00ea Correct spelling in note references b3d55e2 Document Safe Haskell restrictions on Generic instances 9e86276 Implement deriving strategies b61b7c2 CodeGen X86: fix unsafe foreign calls wrt inlining 59d7ee5 GHCi: Don't remove shadowed bindings from typechecker scope. 3c17905 Support more than 64 logical processors on Windows 151edd8 Recognise US spelling for specialisation flags. f869b23 Move -dno-debug-output to the end of the test flags d1b4fec Mark T11978a as broken due to #12019 1e795a0 Use check stacking on Windows. c93813d Add NUMA support for Windows 2d6642b Fix interaction of record pattern synonyms and record wildcards 1851349 Don't warn about name shadowing when renaming the patten in a PatSyn decl ce3370e PPC/CodeGen: fix lwa instruction generation 48ff084 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) 0014fa5 ghc-pkg: Allow unregistering multiple packages in one call b0d53a8 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again f547b44 Eliminate some unsafeCoerce#s with deriving strategies 23cf32d Disallow standalone deriving declarations involving unboxed tuples or sums 4d2b15d validate: Add --build-only 42f1d86 runghc: use executeFile to run ghc process on POSIX 3630ad3 Mark #6132 as broken on OS X 8cab9bd Ignore output from derefnull and divbyzero on Darwin e9104d4 DynFlags: Fix absolute import path to generated header eda5a4a testsuite: Mark test for #12355 as unbroken on Darwin. 22c6b7f Update Cabal submodule to latest version. 8952cc3 runghc: Fix import of System.Process on Windows bd6f68d Introduce ConApp to Core (dead code as of yet) e2bdc4e Actually desugar to ConApp ef1168b ConApp bytecode: Add more ASSERT From git at git.haskell.org Tue Oct 4 21:38:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Oct 2016 21:38:10 +0000 (UTC) Subject: [commit: ghc] master: Mark zipWithAndUnzipM as INLINABLE rather than INLINE (c5d6288) Message-ID: <20161004213810.3F2043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5d62883b3a7c93c28017b57f81165b6f71d9340/ghc >--------------------------------------------------------------- commit c5d62883b3a7c93c28017b57f81165b6f71d9340 Author: Matthew Pickering Date: Tue Oct 4 22:36:55 2016 +0100 Mark zipWithAndUnzipM as INLINABLE rather than INLINE It is a self-recursive function and hence a loop-breaker. >--------------------------------------------------------------- c5d62883b3a7c93c28017b57f81165b6f71d9340 compiler/utils/MonadUtils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/MonadUtils.hs b/compiler/utils/MonadUtils.hs index d1c0adb..93a835e 100644 --- a/compiler/utils/MonadUtils.hs +++ b/compiler/utils/MonadUtils.hs @@ -93,7 +93,7 @@ zipWith4M f (x:xs) (y:ys) (z:zs) (a:as) zipWithAndUnzipM :: Monad m => (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d]) -{-# INLINE zipWithAndUnzipM #-} +{-# INLINABLE zipWithAndUnzipM #-} -- See Note [flatten_many performance] in TcFlatten for why this -- pragma is essential. zipWithAndUnzipM f (x:xs) (y:ys) From git at git.haskell.org Wed Oct 5 10:42:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Oct 2016 10:42:17 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch2: Remove accidentally-added file (ea631c4) Message-ID: <20161005104217.996533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch2 Link : http://ghc.haskell.org/trac/ghc/changeset/ea631c458dae8a5ce0e41ee30e8a753ad4c24ec5/ghc >--------------------------------------------------------------- commit ea631c458dae8a5ce0e41ee30e8a753ad4c24ec5 Author: Simon Peyton Jones Date: Wed Oct 5 11:42:07 2016 +0100 Remove accidentally-added file >--------------------------------------------------------------- ea631c458dae8a5ce0e41ee30e8a753ad4c24ec5 testsuite/tests/perf/compiler/stdout | 29 ----------------------------- 1 file changed, 29 deletions(-) diff --git a/testsuite/tests/perf/compiler/stdout b/testsuite/tests/perf/compiler/stdout deleted file mode 100644 index 8059eef..0000000 --- a/testsuite/tests/perf/compiler/stdout +++ /dev/null @@ -1,29 +0,0 @@ -C:\code\HEAD-hadrian\inplace\bin\ghc-stage2.exe -c T5837.hs +RTS -sstdout - 76,674,472 bytes allocated in the heap - 23,932,080 bytes copied during GC - 5,840,888 bytes maximum residency (6 sample(s)) - 114,208 bytes maximum slop - 14 MB total memory in use (0 MB lost due to fragmentation) - - Tot time (elapsed) Avg pause Max pause - Gen 0 46 colls, 0 par 0.031s 0.024s 0.0005s 0.0031s - Gen 1 6 colls, 0 par 0.062s 0.070s 0.0117s 0.0236s - - TASKS: 3 (1 bound, 2 peak workers (2 total), using -N1) - - SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) - - INIT time 0.000s ( 0.001s elapsed) - MUT time 0.031s ( 1.348s elapsed) - GC time 0.094s ( 0.094s elapsed) - EXIT time 0.000s ( 0.004s elapsed) - Total time 0.125s ( 1.446s elapsed) - - Alloc rate 2,453,583,104 bytes per MUT second - - Productivity 25.0% of total user, 93.5% of total elapsed - -gc_alloc_block_sync: 0 -whitehole_spin: 0 -gen[0].sync: 0 -gen[1].sync: 0 From git at git.haskell.org Wed Oct 5 20:15:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Oct 2016 20:15:54 +0000 (UTC) Subject: [commit: ghc] master: Bring Note in TcDeriv up to date (e4cf962) Message-ID: <20161005201554.62EEF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e4cf962385924004b1ca0e39566222661bdde51f/ghc >--------------------------------------------------------------- commit e4cf962385924004b1ca0e39566222661bdde51f Author: Ryan Scott Date: Wed Oct 5 16:13:29 2016 -0400 Bring Note in TcDeriv up to date Comments only. [ci skip] >--------------------------------------------------------------- e4cf962385924004b1ca0e39566222661bdde51f compiler/typecheck/TcDeriv.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 3fcc80d..c5c8387 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -712,6 +712,10 @@ deriveTyData tvs tc tc_args deriv_strat deriv_pred -- do not mention any of the dropped type variables -- newtype T a s = ... deriving( ST s ) -- newtype instance K a a = ... deriving( Monad ) + -- + -- It is vital that the implementation of allDistinctTyVars + -- expand any type synonyms. + -- See Note [Eta-reducing type synonyms] ; spec <- mkEqnHelp Nothing tkvs cls final_cls_tys tc final_tc_args @@ -885,17 +889,8 @@ the eta-reduced type variables are mentioned elsewhere in the declaration. But we need to be careful, because if we don't expand through the Const type synonym, we will mistakenly believe that f is an eta-reduced type variable and fail to derive Functor, even though the code above is correct (see Trac #11416, -where this was first noticed). - -For this reason, we call exactTyCoVarsOfTypes on the eta-reduced types so that -we only consider the type variables that remain after expanding through type -synonyms. - - -- Use exactTyCoVarsOfTypes, not tyCoVarsOfTypes, so that we - -- don't mistakenly grab a type variable mentioned in a type - -- synonym that drops it. - -- See Note [Eta-reducing type synonyms]. - dropped_tvs = exactTyCoVarsOfTypes args_to_drop +where this was first noticed). For this reason, we expand the type synonyms in +the eta-reduced types before doing any analysis. -} mkEqnHelp :: Maybe OverlapMode From git at git.haskell.org Wed Oct 5 21:01:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Oct 2016 21:01:14 +0000 (UTC) Subject: [commit: ghc] master: Improve error handling in TcRnMonad (465c6c5) Message-ID: <20161005210114.DE7043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/465c6c5d15f8fb54afb78408f3a79e75e74d2cd4/ghc >--------------------------------------------------------------- commit 465c6c5d15f8fb54afb78408f3a79e75e74d2cd4 Author: Simon Peyton Jones Date: Wed Oct 5 22:00:02 2016 +0100 Improve error handling in TcRnMonad See Note [Constraints and errors] in TcRnMonad. This patch fixes Trac #12124 in quite a neat way. >--------------------------------------------------------------- 465c6c5d15f8fb54afb78408f3a79e75e74d2cd4 compiler/typecheck/TcRnMonad.hs | 60 +++++++++++++--------- compiler/typecheck/TcSplice.hs | 2 +- .../should_fail/CustomTypeErrors02.stderr | 5 -- testsuite/tests/typecheck/should_fail/T12124.hs | 8 +++ .../should_fail/T12124.srderr} | 0 .../tests/typecheck/should_fail/T12124.stderr | 9 ++++ testsuite/tests/typecheck/should_fail/T8142.stderr | 10 ---- testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 56 insertions(+), 39 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 465c6c5d15f8fb54afb78408f3a79e75e74d2cd4 From git at git.haskell.org Thu Oct 6 13:17:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 13:17:39 +0000 (UTC) Subject: [commit: ghc] master: Remove unused T12124.srderr (58ecdf8) Message-ID: <20161006131739.3F1013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/58ecdf83ff8790b49bdfcba628d189229f81d2a0/ghc >--------------------------------------------------------------- commit 58ecdf83ff8790b49bdfcba628d189229f81d2a0 Author: Ryan Scott Date: Thu Oct 6 09:12:05 2016 -0400 Remove unused T12124.srderr This was (accidentally?) introduced in 465c6c5d15f8fb54afb78408f3a79e75e74d2cd4 >--------------------------------------------------------------- 58ecdf83ff8790b49bdfcba628d189229f81d2a0 testsuite/tests/typecheck/should_fail/T12124.srderr | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_fail/T12124.srderr b/testsuite/tests/typecheck/should_fail/T12124.srderr deleted file mode 100644 index 0519ecb..0000000 --- a/testsuite/tests/typecheck/should_fail/T12124.srderr +++ /dev/null @@ -1 +0,0 @@ - \ No newline at end of file From git at git.haskell.org Thu Oct 6 13:17:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 13:17:43 +0000 (UTC) Subject: [commit: ghc] master: Refactor TcDeriv and TcGenDeriv (4a03012) Message-ID: <20161006131743.300573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a03012aeb4cb6685221b30aea2b1a78145d902b/ghc >--------------------------------------------------------------- commit 4a03012aeb4cb6685221b30aea2b1a78145d902b Author: Ryan Scott Date: Thu Oct 6 09:14:49 2016 -0400 Refactor TcDeriv and TcGenDeriv Summary: Keeping a promise I made to Simon to clean up these modules. This change splits up the massive `TcDeriv` and `TcGenDeriv` modules into somewhat more manageable pieces. The new modules are: * `TcGenFunctor`: This contains the deriving machinery for `Functor`, `Foldable`, and `Traversable` (which all use the same underlying algorithm). * `TcDerivInfer`: This is the new home for `inferConstraints`, `simplifyInstanceContexts`, and related functions, whose role is to come up with the derived instance context and subsequently simplify it. * `TcDerivUtils`: This is a grab-bag module that contains several error-checking utilities originally in `TcDeriv`, as well as some functions that `TcDeriv` and `TcDerivInfer` both need. The end result is that `TcDeriv` is now less than 1,600 SLOC (originally 2,686 SLOC), and `TcGenDeriv` is now about 2,000 SLOC (originally 2,964). In addition, this also implements a couple of tiny refactorings: * I transformed `type Condition = (DynFlags, TyCon) -> Validity` into `type Condition = DynFlags -> TyCon -> Validity` * I killed the `DerivSpecGeneric` constructor for `DerivSpecMechanism`, and merged its functionality into `DerivSpecStock`. In addition, `hasStockDeriving` now contains key-value pairs for `Generic` and `Generic1`, so they're no longer treated as an awkward special case in `TcDeriv`. Test Plan: ./validate Reviewers: simonpj, austin, bgamari Reviewed By: simonpj Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D2568 >--------------------------------------------------------------- 4a03012aeb4cb6685221b30aea2b1a78145d902b compiler/ghc.cabal.in | 3 + compiler/typecheck/TcDeriv.hs | 1168 +---------------------------------- compiler/typecheck/TcDerivInfer.hs | 653 ++++++++++++++++++++ compiler/typecheck/TcDerivUtils.hs | 610 ++++++++++++++++++ compiler/typecheck/TcGenDeriv.hs | 923 +-------------------------- compiler/typecheck/TcGenFunctor.hs | 875 ++++++++++++++++++++++++++ compiler/typecheck/TcGenGenerics.hs | 1 + 7 files changed, 2184 insertions(+), 2049 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 4a03012aeb4cb6685221b30aea2b1a78145d902b From git at git.haskell.org Thu Oct 6 21:48:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 21:48:12 +0000 (UTC) Subject: [commit: ghc] master: RegAlloc: Make some pattern matched complete (a2bedb5) Message-ID: <20161006214812.59BFF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2bedb5c67b8d0d20dfb22fdeac3fcd07fe5452e/ghc >--------------------------------------------------------------- commit a2bedb5c67b8d0d20dfb22fdeac3fcd07fe5452e Author: Joachim Breitner Date: Wed Oct 5 23:37:03 2016 -0400 RegAlloc: Make some pattern matched complete these actually are complete, but due to the use of pattern guards, the compiler does not see that. Refactor the code that it does. Differential Revision: https://phabricator.haskell.org/D2574 >--------------------------------------------------------------- a2bedb5c67b8d0d20dfb22fdeac3fcd07fe5452e compiler/nativeGen/RegAlloc/Graph/Main.hs | 3 +++ compiler/nativeGen/RegAlloc/Liveness.hs | 10 +++++----- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index 97c2b42..e819fe8 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -360,6 +360,9 @@ graphAddCoalesce (r1, r2) graph , RegReal _ <- r2 = graph + | otherwise + = panic "graphAddCoalesce" + -- | Patch registers in code using the reg -> reg mapping in this graph. patchRegsFromGraph diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index ea010a5..988bda0 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -897,12 +897,9 @@ livenessForward livenessForward _ _ [] = [] livenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis) - | Nothing <- mLive - = li : livenessForward platform rsLiveEntry lis - - | Just live <- mLive - , RU _ written <- regUsageOfInstr platform instr + | Just live <- mLive = let + RU _ written = regUsageOfInstr platform instr -- Regs that are written to but weren't live on entry to this instruction -- are recorded as being born here. rsBorn = mkUniqSet @@ -915,6 +912,9 @@ livenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis) in LiveInstr instr (Just live { liveBorn = rsBorn }) : livenessForward platform rsLiveNext lis + | otherwise + = li : livenessForward platform rsLiveEntry lis + -- | Calculate liveness going backwards, -- filling in when regs die, and what regs are live across each instruction From git at git.haskell.org Thu Oct 6 23:19:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:19:59 +0000 (UTC) Subject: [commit: ghc] master,wip/T12618: Remove dead code “mkHsConApp” (57a207c) Message-ID: <20161006231959.2F6A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branches: master,wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/57a207ca53154ad78863a43f1050a3a72e418d93/ghc >--------------------------------------------------------------- commit 57a207ca53154ad78863a43f1050a3a72e418d93 Author: Joachim Breitner Date: Wed Oct 5 16:14:59 2016 -0400 Remove dead code “mkHsConApp” Differential Revision: https://phabricator.haskell.org/D2574 >--------------------------------------------------------------- 57a207ca53154ad78863a43f1050a3a72e418d93 compiler/hsSyn/HsUtils.hs | 9 +-------- compiler/typecheck/TcHsSyn.hs | 2 +- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 07edf0d..903ff38 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -20,7 +20,7 @@ which deal with the instantiated versions are located elsewhere: module HsUtils( -- Terms - mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypeOut, mkHsConApp, mkHsCaseAlt, + mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypeOut, mkHsCaseAlt, mkSimpleMatch, unguardedGRHSs, unguardedRHS, mkMatchGroup, mkMatch, mkHsLam, mkHsIf, mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo, @@ -183,13 +183,6 @@ mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr -mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id --- Used for constructing dictionary terms etc, so no locations -mkHsConApp data_con tys args - = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args - where - mk_app f a = noLoc (HsApp f (noLoc a)) - -- |A simple case alternative with a single pattern, no binds, no guards; -- pre-typechecking mkHsCaseAlt :: LPat id -> (Located (body id)) -> LMatch id (Located (body id)) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 458f965..b444385 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -12,7 +12,7 @@ checker. {-# LANGUAGE CPP, TupleSections #-} module TcHsSyn ( - mkHsConApp, mkHsDictLet, mkHsApp, + mkHsDictLet, mkHsApp, hsLitType, hsLPatType, hsPatType, mkHsAppTy, mkHsCaseAlt, nlHsIntLit, From git at git.haskell.org Thu Oct 6 23:20:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:02 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Actually desugar to ConApp (f17b59e) Message-ID: <20161006232002.01D7A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/f17b59ef00616ac15405cf84b30bf202fc239592/ghc >--------------------------------------------------------------- commit f17b59ef00616ac15405cf84b30bf202fc239592 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. >--------------------------------------------------------------- f17b59ef00616ac15405cf84b30bf202fc239592 compiler/basicTypes/Unique.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 35 +++++++++++++++++++++++++++++++++-- compiler/prelude/PrelNames.hs | 17 ++++++++++++++--- 3 files changed, 52 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..8d4a1d6 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -48,6 +48,7 @@ module Unique ( mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, mkCoVarUnique, + mkCoreConAppUnique, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, @@ -322,6 +323,8 @@ Allocation of unique supply characters: n Native codegen r Hsc name cache s simplifier + c typechecker + a binders for case expressions in mkCoreConApp (desugarer) -} mkAlphaTyVarUnique :: Int -> Unique @@ -335,10 +338,12 @@ mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique +mkCoreConAppUnique :: Int -> Unique mkAlphaTyVarUnique i = mkUnique '1' i mkCoVarUnique i = mkUnique 'g' i mkPreludeClassUnique i = mkUnique '2' i +mkCoreConAppUnique i = mkUnique 'a' i -------------------------------------------------- -- Wired-in type constructor keys occupy *two* slots: diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index e7fc7f9..58f798c 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -150,7 +150,18 @@ mkCoreApps orig_fun orig_args -- expressions to that of a data constructor expression. The leftmost expression -- in the list is applied first mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr -mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +mkCoreConApps con args + | length args >= dataConRepFullArity con + = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args + in mkCoreApps sat_app extra_args + where + -- TODO #12618: Can there ever be more than dataConRepArity con arguments + -- in a type-safe program? + (con_args, extra_args) = splitAt (dataConRepFullArity con) args + res_ty = exprType (ConApp con args) +mkCoreConApps con args + -- Unsaturated application. TODO #12618 Use wrapper. + = mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), @@ -174,6 +185,26 @@ mk_val_app fun arg arg_ty res_ty -- is if you take apart this case expression, and pass a -- fragmet of it as the fun part of a 'mk_val_app'. +mk_val_apps :: Int -> Type -> ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr +-- In the given list of expression, pick those that need a strict binding +-- to ensure the let/app invariant, and wrap them accorindgly +-- See Note [CoreSyn let/app invariant] +mk_val_apps _ _ cont [] = cont [] +mk_val_apps n res_ty cont (Type ty:args) + = mk_val_apps n res_ty (cont . (Type ty:)) args +mk_val_apps n res_ty cont (arg:args) + | not (needsCaseBinding arg_ty arg) + = mk_val_apps n res_ty (cont . (arg:)) args + | otherwise + = let body = mk_val_apps (n+1) res_ty (cont . (Var arg_id:)) args + in Case arg arg_id res_ty [(DEFAULT, [], body)] + where + arg_ty = exprType arg -- TODO # 12618 Do not use exprType here + arg_id = mkLocalIdOrCoVar (coreConAppUnique n) arg_ty + -- Lots of shadowing again. But that is ok, we have our own set of + -- uniques here, and they are only free inside this function + + ----------- mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 558619a..d42314c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -813,6 +813,20 @@ dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) {- ************************************************************************ * * +\subsection{Internal names} +* * +************************************************************************ +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +coreConAppUnique :: Int -> Name +coreConAppUnique n = mkSystemVarName (mkCoreConAppUnique n) (fsLit "x") + +{- +************************************************************************ +* * \subsection{Known-key names} * * ************************************************************************ @@ -825,9 +839,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey From git at git.haskell.org Thu Oct 6 23:20:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:04 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: Include dc worker id in free variables (5a7d036) Message-ID: <20161006232004.A6CF93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/5a7d036452d83c7d456a73b4fc4781aa76c57f62/ghc >--------------------------------------------------------------- commit 5a7d036452d83c7d456a73b4fc4781aa76c57f62 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. >--------------------------------------------------------------- 5a7d036452d83c7d456a73b4fc4781aa76c57f62 compiler/coreSyn/CoreFVs.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index 0856f76..f4fb3af 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -73,7 +73,7 @@ import Var import Type import TyCoRep import TyCon -import DataCon ( dataConRepType ) +import DataCon ( dataConRepType, dataConWorkId ) import CoAxiom import FamInstEnv import TysPrim( funTyConName ) @@ -260,8 +260,8 @@ expr_fvs (Tick t expr) fv_cand in_scope acc = (tickish_fvs t `unionFV` expr_fvs expr) fv_cand in_scope acc expr_fvs (App fun arg) fv_cand in_scope acc = (expr_fvs fun `unionFV` expr_fvs arg) fv_cand in_scope acc -expr_fvs (ConApp _ args) fv_cand in_scope acc = - (mapUnionFV expr_fvs args) fv_cand in_scope acc +expr_fvs (ConApp dc args) fv_cand in_scope acc = + (FV.unitFV (dataConWorkId dc) `unionFV` mapUnionFV expr_fvs args) fv_cand in_scope acc expr_fvs (Lam bndr body) fv_cand in_scope acc = addBndr bndr (expr_fvs body) fv_cand in_scope acc expr_fvs (Cast expr co) fv_cand in_scope acc = From git at git.haskell.org Thu Oct 6 23:20:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:07 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp bytecode: Add more ASSERT (e7d8c5a) Message-ID: <20161006232007.5E27B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/e7d8c5a713218329d52954f99aff60a484e00eed/ghc >--------------------------------------------------------------- commit e7d8c5a713218329d52954f99aff60a484e00eed Author: Joachim Breitner Date: Sun Oct 2 21:19:49 2016 -0400 ConApp bytecode: Add more ASSERT >--------------------------------------------------------------- e7d8c5a713218329d52954f99aff60a484e00eed compiler/ghci/ByteCodeGen.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 9f336c8..214a0f0 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -635,7 +635,7 @@ schemeT :: Word -- Stack depth -> AnnExpr' Id DVarSet -> BcM BCInstrList -schemeT d s p (AnnConApp dc args') +schemeT d s p (AnnConApp dc all_args) | isUnboxedTupleCon dc = case args of [arg2,arg1] | isVAtom arg1 -> @@ -644,11 +644,12 @@ schemeT d s p (AnnConApp dc args') unboxedTupleReturn d s p arg1 _other -> multiValException | otherwise - = do alloc_con <- mkConAppCode d s p dc (reverse args) + = do ASSERT( dataConRepFullArity dc == length all_args ) return () + alloc_con <- mkConAppCode d s p dc (reverse args) return (alloc_con `appOL` mkSLIDE 1 (d - s) `snocOL` ENTER) - where args = map snd $ dropWhile isAnnTypeArg args' + where args = map snd $ dropWhile isAnnTypeArg all_args schemeT d s p app -- | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False From git at git.haskell.org Thu Oct 6 23:20:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:10 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (dead code as of yet) (67814af) Message-ID: <20161006232010.457683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/67814af6d68758eba6d424a4454cef6bd7235127/ghc >--------------------------------------------------------------- commit 67814af6d68758eba6d424a4454cef6bd7235127 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 67814af6d68758eba6d424a4454cef6bd7235127 compiler/basicTypes/DataCon.hs | 14 ++++++-- compiler/basicTypes/Demand.hs | 17 ++++++++- compiler/basicTypes/MkId.hs | 43 +++++++++++----------- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 ++++++++ compiler/coreSyn/CoreLint.hs | 13 +++++++ compiler/coreSyn/CorePrep.hs | 23 ++++++++++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 ++ compiler/coreSyn/CoreSubst.hs | 42 ++++++++++++---------- compiler/coreSyn/CoreSyn.hs | 11 +++++- compiler/coreSyn/CoreTidy.hs | 15 ++++---- compiler/coreSyn/CoreUnfold.hs | 5 +++ compiler/coreSyn/CoreUtils.hs | 55 +++++++++++++++++++--------- compiler/coreSyn/PprCore.hs | 10 ++++++ compiler/coreSyn/TrieMap.hs | 68 ++++++++++++++++++++++------------- compiler/ghci/ByteCodeGen.hs | 26 ++++++++++++++ compiler/iface/IfaceSyn.hs | 46 ++++++++++++++---------- compiler/iface/MkIface.hs | 27 ++++++++------ compiler/iface/TcIface.hs | 3 ++ compiler/main/TidyPgm.hs | 2 ++ compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 ++++++++++---- compiler/simplCore/FloatIn.hs | 19 ++++++++++ compiler/simplCore/FloatOut.hs | 8 +++++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 +++++ compiler/simplCore/SAT.hs | 12 +++++++ compiler/simplCore/SetLevels.hs | 6 +++- compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 18 ++++++++++ compiler/specialise/Rules.hs | 13 +++++++ compiler/specialise/SpecConstr.hs | 4 +++ compiler/specialise/Specialise.hs | 3 ++ compiler/stgSyn/CoreToStg.hs | 12 +++++++ compiler/stranal/DmdAnal.hs | 33 +++++++++++++++++ compiler/stranal/WorkWrap.hs | 3 ++ compiler/vectorise/Vectorise/Exp.hs | 13 +++++++ compiler/vectorise/Vectorise/Utils.hs | 6 ---- 39 files changed, 491 insertions(+), 134 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 67814af6d68758eba6d424a4454cef6bd7235127 From git at git.haskell.org Thu Oct 6 23:20:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:13 +0000 (UTC) Subject: [commit: ghc] wip/T12618: knownCon: Use ConApp in unfolding of scrutinee (c3e1cb0) Message-ID: <20161006232013.233533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/c3e1cb0b94f527d2a488c19b4566a46cd7d780ce/ghc >--------------------------------------------------------------- commit c3e1cb0b94f527d2a488c19b4566a46cd7d780ce Author: Joachim Breitner Date: Tue Oct 4 14:41:54 2016 -0400 knownCon: Use ConApp in unfolding of scrutinee >--------------------------------------------------------------- c3e1cb0b94f527d2a488c19b4566a46cd7d780ce compiler/simplCore/Simplify.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 479b18c..a966986 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -25,7 +25,7 @@ import Name ( Name, mkSystemVarName, isExternalName, getOccFS ) import Coercion hiding ( substCo, substCoVar ) import OptCoercion ( optCoercion ) import FamInstEnv ( topNormaliseType_maybe ) -import DataCon ( DataCon, dataConWorkId, dataConRepStrictness +import DataCon ( DataCon, dataConRepStrictness , isMarkedStrict, dataConRepArgTys ) --, dataConTyCon, dataConTag, fIRST_TAG ) --import TyCon ( isEnumerationTyCon ) -- temporalily commented out. See #8326 import CoreMonad ( Tick(..), SimplifierMode(..) ) @@ -2330,9 +2330,7 @@ knownCon env scrut dc dc_ty_args dc_args bndr bs rhs cont | otherwise = do { dc_args <- mapM (simplVar env) bs -- dc_ty_args are aready OutTypes, -- but bs are InBndrs - ; let con_app = Var (dataConWorkId dc) - `mkTyApps` dc_ty_args - `mkApps` dc_args + ; let con_app = ConApp dc (map Type dc_ty_args ++ dc_args) ; simplNonRecX env bndr con_app } ------------------- From git at git.haskell.org Thu Oct 6 23:20:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:15 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: Include dc worker id in dffvExpr (8fa2420) Message-ID: <20161006232015.C9CA83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/8fa24208a732b877952ded6e2e98f54f526dde19/ghc >--------------------------------------------------------------- commit 8fa24208a732b877952ded6e2e98f54f526dde19 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. >--------------------------------------------------------------- 8fa24208a732b877952ded6e2e98f54f526dde19 compiler/main/TidyPgm.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 6f867d6..f26aae4 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -817,7 +817,7 @@ insert v = DFFV $ \ env (set, ids) -> dffvExpr :: CoreExpr -> DFFV () dffvExpr (Var v) = insert v dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2 -dffvExpr (ConApp _ args) = mapM_ dffvExpr args +dffvExpr (ConApp dc args) = insert (dataConWorkId dc) >> mapM_ dffvExpr args dffvExpr (Lam v e) = extendScope v (dffvExpr e) dffvExpr (Tick (Breakpoint _ ids) e) = mapM_ insert ids >> dffvExpr e dffvExpr (Tick _other e) = dffvExpr e From git at git.haskell.org Thu Oct 6 23:20:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:18 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Use ConApp in tagToEnumRule (8399e73) Message-ID: <20161006232018.803183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/8399e73a44287d5aa6ce6c61620c628f85033392/ghc >--------------------------------------------------------------- commit 8399e73a44287d5aa6ce6c61620c628f85033392 Author: Joachim Breitner Date: Tue Oct 4 14:35:23 2016 -0400 Use ConApp in tagToEnumRule >--------------------------------------------------------------- 8399e73a44287d5aa6ce6c61620c628f85033392 compiler/prelude/PrelRules.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 8868047..197ddb3 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -31,7 +31,7 @@ import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon, unwrapNewTyCon_maybe ) -import DataCon ( dataConTag, dataConTyCon, dataConWorkId ) +import DataCon ( dataConTag, dataConTyCon ) import CoreUtils ( cheapEqExpr, exprIsHNF ) import CoreUnfold ( exprIsConApp_maybe ) import Type @@ -893,7 +893,7 @@ tagToEnumRule = do correct_tag dc = (dataConTag dc - fIRST_TAG) == tag (dc:rest) <- return $ filter correct_tag (tyConDataCons_maybe tycon `orElse` []) ASSERT(null rest) return () - return $ mkTyApps (Var (dataConWorkId dc)) tc_args + return $ ConApp dc (map Type tc_args) -- See Note [tagToEnum#] _ -> WARN( True, text "tagToEnum# on non-enumeration type" <+> ppr ty ) From git at git.haskell.org Thu Oct 6 23:20:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:21 +0000 (UTC) Subject: [commit: ghc] wip/T12618: mkDataConRep: Do not interleave applying arguments and unboxers (f10cbcb) Message-ID: <20161006232021.2CF493A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/f10cbcb7aab88b38ce1dc17568af4454abf624ae/ghc >--------------------------------------------------------------- commit f10cbcb7aab88b38ce1dc17568af4454abf624ae Author: Joachim Breitner Date: Tue Oct 4 14:10:09 2016 -0400 mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). >--------------------------------------------------------------- f10cbcb7aab88b38ce1dc17568af4454abf624ae compiler/basicTypes/MkId.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 8b48aa9..ac07cfd 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -480,8 +480,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con | otherwise = do { wrap_args <- mapM newLocal wrap_arg_tys - ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers) - initial_wrap_app + ; (rep_ids, unbox_fn) <- combine_unboxers (wrap_args `zip` dropList eq_spec unboxers) + ; let wrap_body = unbox_fn $ mkVarApps initial_wrap_app rep_ids ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info wrap_info = noCafIdInfo @@ -581,13 +581,14 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) } go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con) - mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr - mk_rep_app [] con_app - = return con_app - mk_rep_app ((wrap_arg, unboxer) : prs) con_app + combine_unboxers :: [(Id,Unboxer)] -> UniqSM ([Id],CoreExpr -> CoreExpr) + combine_unboxers [] + = return ([],id) + combine_unboxers ((wrap_arg, unboxer) : other_unboxers) = do { (rep_ids, unbox_fn) <- unboxer wrap_arg - ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids) - ; return (unbox_fn expr) } + ; (other_rep_ids, other_unbox_fn) <- combine_unboxers other_unboxers + ; return (rep_ids ++ other_rep_ids, unbox_fn . other_unbox_fn) + } {- Note [Bangs on imported data constructors] From git at git.haskell.org Thu Oct 6 23:20:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:23 +0000 (UTC) Subject: [commit: ghc] wip/T12618: mkCoreConApps: Warn about unsaturated use (6c7668e) Message-ID: <20161006232023.DC0AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/6c7668e65cc1901414aa14a8e9d555082cc2c9f3/ghc >--------------------------------------------------------------- commit 6c7668e65cc1901414aa14a8e9d555082cc2c9f3 Author: Joachim Breitner Date: Tue Oct 4 14:23:43 2016 -0400 mkCoreConApps: Warn about unsaturated use >--------------------------------------------------------------- 6c7668e65cc1901414aa14a8e9d555082cc2c9f3 compiler/coreSyn/MkCore.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 58f798c..79d267d 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -161,7 +161,8 @@ mkCoreConApps con args res_ty = exprType (ConApp con args) mkCoreConApps con args -- Unsaturated application. TODO #12618 Use wrapper. - = mkCoreApps (Var (dataConWorkId con)) args + = WARN ( True, "mkCoreConApps: Unsaturated use." ) + mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), From git at git.haskell.org Thu Oct 6 23:20:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:26 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Get rid of unitDataConId (use ConApp instead) (3733c4d) Message-ID: <20161006232026.8C7873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/3733c4dfc50d578bef3e6a287f28841ce16f309a/ghc >--------------------------------------------------------------- commit 3733c4dfc50d578bef3e6a287f28841ce16f309a Author: Joachim Breitner Date: Tue Oct 4 14:49:40 2016 -0400 Get rid of unitDataConId (use ConApp instead) >--------------------------------------------------------------- 3733c4dfc50d578bef3e6a287f28841ce16f309a compiler/coreSyn/MkCore.hs | 2 +- compiler/deSugar/DsCCall.hs | 2 +- compiler/prelude/TysWiredIn.hs | 5 +---- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 759ba79..b90a17d 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -367,7 +367,7 @@ mkCoreVarTupTy ids = mkBoxedTupleTy (map idType ids) -- | Build a small tuple holding the specified expressions -- One-tuples are flattened; see Note [Flattening one-tuples] mkCoreTup :: [CoreExpr] -> CoreExpr -mkCoreTup [] = Var unitDataConId +mkCoreTup [] = ConApp unitDataCon [] mkCoreTup [c] = c mkCoreTup cs = mkCoreConApps (tupleDataCon Boxed (length cs)) (map (Type . exprType) cs ++ cs) diff --git a/compiler/deSugar/DsCCall.hs b/compiler/deSugar/DsCCall.hs index 0d9bbb4..8f614ba 100644 --- a/compiler/deSugar/DsCCall.hs +++ b/compiler/deSugar/DsCCall.hs @@ -322,7 +322,7 @@ resultWrapper result_ty -- Base case 2: the unit type () | Just (tc,_) <- maybe_tc_app, tc `hasKey` unitTyConKey - = return (Nothing, \_ -> Var unitDataConId) + = return (Nothing, \_ -> ConApp unitDataCon []) -- Base case 3: the boolean type | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index b334967..035ae75 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -70,7 +70,7 @@ module TysWiredIn ( mkTupleTy, mkBoxedTupleTy, tupleTyCon, tupleDataCon, tupleTyConName, promotedTupleDataCon, - unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey, + unitTyCon, unitDataCon, unitTy, unitTyConKey, pairTyCon, unboxedUnitTyCon, unboxedUnitDataCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, @@ -824,9 +824,6 @@ unitTyConKey = getUnique unitTyCon unitDataCon :: DataCon unitDataCon = head (tyConDataCons unitTyCon) -unitDataConId :: Id -unitDataConId = dataConWorkId unitDataCon - pairTyCon :: TyCon pairTyCon = tupleTyCon Boxed 2 From git at git.haskell.org Thu Oct 6 23:20:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:29 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Lint: Complain about saturated uses of the data con worker (a40b103) Message-ID: <20161006232029.3F7543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/a40b10315ca752652e23c15be0e7a1d48807f62f/ghc >--------------------------------------------------------------- commit a40b10315ca752652e23c15be0e7a1d48807f62f Author: Joachim Breitner Date: Tue Oct 4 14:29:17 2016 -0400 Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. >--------------------------------------------------------------- a40b10315ca752652e23c15be0e7a1d48807f62f compiler/coreSyn/CoreLint.hs | 5 +++++ compiler/coreSyn/MkCore.hs | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 3b1fdf9..920580c 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -692,6 +692,11 @@ lintCoreExpr e@(App _ _) -> do failWithL $ text "Found StaticPtr nested in an expression: " <+> ppr e + Var b | Just con <- isDataConWorkId_maybe b + , dataConRepFullArity con <= length args + -> do + failWithL $ text "Found saturated use of data con worker (should use ConApp): " <+> + ppr e _ -> go where go = do { fun_ty <- lintCoreExpr fun diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 79d267d..759ba79 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -161,7 +161,7 @@ mkCoreConApps con args res_ty = exprType (ConApp con args) mkCoreConApps con args -- Unsaturated application. TODO #12618 Use wrapper. - = WARN ( True, "mkCoreConApps: Unsaturated use." ) + = WARN ( True, text "mkCoreConApps: Unsaturated use." $$ ppr con <+> ppr args ) mkCoreApps (Var (dataConWorkId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr From git at git.haskell.org Thu Oct 6 23:20:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:31 +0000 (UTC) Subject: [commit: ghc] wip/T12618: DataCon wrapper: Use ConApp in the body (b486662) Message-ID: <20161006232031.E1FF53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/b486662d3c75ef8a1c96d2d29f8e5ca547c23c25/ghc >--------------------------------------------------------------- commit b486662d3c75ef8a1c96d2d29f8e5ca547c23c25 Author: Joachim Breitner Date: Tue Oct 4 14:20:05 2016 -0400 DataCon wrapper: Use ConApp in the body >--------------------------------------------------------------- b486662d3c75ef8a1c96d2d29f8e5ca547c23c25 compiler/basicTypes/MkId.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index ac07cfd..2267a47 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -481,7 +481,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con | otherwise = do { wrap_args <- mapM newLocal wrap_arg_tys ; (rep_ids, unbox_fn) <- combine_unboxers (wrap_args `zip` dropList eq_spec unboxers) - ; let wrap_body = unbox_fn $ mkVarApps initial_wrap_app rep_ids + ; let wrap_body = unbox_fn $ build_con_app rep_ids ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info wrap_info = noCafIdInfo @@ -557,10 +557,12 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con || isFamInstTyCon tycon -- Cast result || (not $ null eq_spec)) -- GADT - initial_wrap_app = Var (dataConWorkId data_con) - `mkTyApps` res_ty_args - `mkVarApps` ex_tvs - `mkCoApps` map (mkReflCo Nominal . eqSpecType) eq_spec + build_con_app rep_ids = mkConApp data_con $ concat + [ map Type res_ty_args + , map (Type . mkTyVarTy) ex_tvs + , map (Coercion . mkReflCo Nominal . eqSpecType) eq_spec + , map Var rep_ids + ] mk_boxer :: [Boxer] -> DataConBoxer mk_boxer boxers = DCB (\ ty_args src_vars -> @@ -734,9 +736,10 @@ dataConArgUnpack arg_ty ; return (rep_ids, unbox_fn) } , Boxer $ \ subst -> do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys - ; return (rep_ids, Var (dataConWorkId con) - `mkTyApps` (substTysUnchecked subst tc_args) - `mkVarApps` rep_ids ) } ) ) + ; return (rep_ids, ConApp con ( + map Type (substTysUnchecked subst tc_args) ++ + map Var rep_ids)) + })) | otherwise = pprPanic "dataConArgUnpack" (ppr arg_ty) -- An interface file specified Unpacked, but we couldn't unpack it From git at git.haskell.org Thu Oct 6 23:20:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:34 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Always use ConApp in CoreSyn (32b4719) Message-ID: <20161006232034.941D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/32b47198c2f6b365611e144b0730c9dff12ba206/ghc >--------------------------------------------------------------- commit 32b47198c2f6b365611e144b0730c9dff12ba206 Author: Joachim Breitner Date: Tue Oct 4 15:46:59 2016 -0400 Always use ConApp in CoreSyn >--------------------------------------------------------------- 32b47198c2f6b365611e144b0730c9dff12ba206 compiler/coreSyn/CoreSyn.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index fdb9578..b519bdf 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -1193,7 +1193,7 @@ maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args }) - = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args)) + = Just (mkLams bndrs (ConApp con args)) maybeUnfoldingTemplate _ = Nothing @@ -1481,7 +1481,9 @@ mkConApp :: DataCon -> [Arg b] -> Expr b mkApps f args = foldl App f args mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars -mkConApp con args = mkApps (Var (dataConWorkId con)) args +mkConApp con args = + WARN ( dataConRepFullArity con /= length args, text "mkConApp: artiy mismatch" $$ ppr con ) + ConApp con args mkTyApps f args = foldl (\ e a -> App e (typeOrCoercion a)) f args where @@ -1490,9 +1492,7 @@ mkTyApps f args = foldl (\ e a -> App e (typeOrCoercion a)) f args | otherwise = Type ty mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b -mkConApp2 con tys arg_ids = Var (dataConWorkId con) - `mkApps` map Type tys - `mkApps` map varToCoreExpr arg_ids +mkConApp2 con tys arg_ids = mkConApp con (map Type tys ++ map varToCoreExpr arg_ids) -- | Create a machine integer literal expression of type @Int#@ from an @Integer at . From git at git.haskell.org Thu Oct 6 23:20:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:37 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Handle ConApp in "Eliminate Identity Case" (d192218) Message-ID: <20161006232037.4B0583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/d1922185829f5ee2eac8c9797d732aa653b0408d/ghc >--------------------------------------------------------------- commit d1922185829f5ee2eac8c9797d732aa653b0408d Author: Joachim Breitner Date: Wed Oct 5 17:43:05 2016 -0400 Handle ConApp in "Eliminate Identity Case" >--------------------------------------------------------------- d1922185829f5ee2eac8c9797d732aa653b0408d compiler/simplCore/SimplUtils.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 1f27395..5984006 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1820,6 +1820,8 @@ mkCase1 _dflags scrut case_bndr _ alts@((_,_,rhs1) : _) -- Identity case -- See Note [RHS casts] check_eq (Lit lit) (LitAlt lit') _ = lit == lit' check_eq (Var v) _ _ | v == case_bndr = True + check_eq (ConApp con []) (DataAlt con') [] = con == con' + -- Optimisation only check_eq (Var v) (DataAlt con) [] = v == dataConWorkId con -- Optimisation only check_eq (Tick t e) alt args = tickishFloatable t && From git at git.haskell.org Thu Oct 6 23:20:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:39 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Deserialize interface tuples to ConApp (ef7fc1a) Message-ID: <20161006232039.F0E4E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/ef7fc1a15bc64084589d3b63789f2d03f5bf6cf0/ghc >--------------------------------------------------------------- commit ef7fc1a15bc64084589d3b63789f2d03f5bf6cf0 Author: Joachim Breitner Date: Wed Oct 5 17:29:53 2016 -0400 Deserialize interface tuples to ConApp >--------------------------------------------------------------- ef7fc1a15bc64084589d3b63789f2d03f5bf6cf0 compiler/iface/TcIface.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 95c630c..9d1b6e3 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -1088,8 +1088,8 @@ tcIfaceExpr (IfaceTuple sort args) UnboxedTuple -> map (Type . getRuntimeRep "tcIfaceExpr") con_tys ++ some_con_args _ -> some_con_args -- Put the missing type arguments back in - con_id = dataConWorkId (tyConSingleDataCon tc) - ; return (mkApps (Var con_id) con_args) } + dc = tyConSingleDataCon tc + ; return (mkConApp dc con_args) } where arity = length args From git at git.haskell.org Thu Oct 6 23:20:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:42 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Create a simple wrapper for built-in types as well (395db23) Message-ID: <20161006232042.CDBF43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/395db23544dbde568bfaf71966123b7b8388e971/ghc >--------------------------------------------------------------- commit 395db23544dbde568bfaf71966123b7b8388e971 Author: Joachim Breitner Date: Wed Oct 5 17:16:59 2016 -0400 Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) >--------------------------------------------------------------- 395db23544dbde568bfaf71966123b7b8388e971 compiler/basicTypes/MkId.hs | 41 +++++++++++++++++++++++++++++++++++++++- compiler/basicTypes/MkId.hs-boot | 4 +++- compiler/prelude/TysWiredIn.hs | 13 ++++++++----- 3 files changed, 51 insertions(+), 7 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 8f61d96..0601ba4 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -23,7 +23,8 @@ module MkId ( wrapFamInstBody, unwrapFamInstScrut, wrapTypeUnbranchedFamInstBody, unwrapTypeUnbranchedFamInstScrut, - DataConBoxer(..), mkDataConRep, mkDataConWorkId, dataConWorkStrictSig, + DataConBoxer(..), mkDataConRep, mkSimpleDataConRep, + mkDataConWorkId, dataConWorkStrictSig, -- And some particular Ids; see below for why they are wired in wiredInIds, ghcPrimIds, @@ -467,6 +468,44 @@ newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind])) -- Bind these src-level vars, returning the -- rep-level vars to bind in the pattern +unitDataConBoxer :: DataConBoxer +unitDataConBoxer = DCB (\_ vs -> return (vs, [])) + +mkSimpleDataConRep :: Name -> DataCon -> DataConRep +mkSimpleDataConRep wrap_name dc = DCR { dcr_wrap_id = wrap_id + , dcr_boxer = unitDataConBoxer + , dcr_arg_tys = arg_tys + , dcr_stricts = rep_strs + , dcr_bangs = arg_ibangs } + where + wrap_ty = dataConRepType dc + wrap_id = mkGlobalId (DataConWrapId dc) wrap_name wrap_ty wrap_info + (ty_vars, theta , orig_arg_tys, _) = dataConSig dc + arg_tys = theta ++ orig_arg_tys + wrap_args = [ mkSysLocalOrCoVar (fsLit "wa") (mkCoreConAppUnique i) ty + | (i,ty) <- zip [0..] arg_tys ] + + wrap_info = noCafIdInfo + `setArityInfo` wrap_arity + -- It's important to specify the arity, so that partial + -- applications are treated as values + `setInlinePragInfo` alwaysInlinePragma + `setUnfoldingInfo` wrap_unf + `setStrictnessInfo` wrap_sig + wrap_arity = dataConRepArity dc + wrap_unf = mkInlineUnfolding (Just wrap_arity) wrap_rhs + wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR dc) + wrap_arg_dmds = replicate wrap_arity topDmd + rep_strs = [ NotMarkedStrict | _ <- arg_tys ] + arg_ibangs = [ HsLazy | _ <- arg_tys ] + + wrap_rhs = mkLams ty_vars $ + mkLams wrap_args $ + mkConApp dc $ concat + [ map (Type . mkTyVarTy) ty_vars + , map varToCoreExpr wrap_args + ] + mkDataConRep :: DynFlags -> FamInstEnvs -> Name diff --git a/compiler/basicTypes/MkId.hs-boot b/compiler/basicTypes/MkId.hs-boot index 0a9ac2c..238954f 100644 --- a/compiler/basicTypes/MkId.hs-boot +++ b/compiler/basicTypes/MkId.hs-boot @@ -2,11 +2,13 @@ module MkId where import Name( Name ) import Var( Id ) import Class( Class ) -import {-# SOURCE #-} DataCon( DataCon ) +import {-# SOURCE #-} DataCon( DataCon, DataConRep ) import {-# SOURCE #-} PrimOp( PrimOp ) data DataConBoxer +mkSimpleDataConRep :: Name -> DataCon -> DataConRep + mkDataConWorkId :: Name -> DataCon -> Id mkDictSelId :: Name -> Class -> Id diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index b1d0f52..25dd64d 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -122,7 +122,7 @@ module TysWiredIn ( #include "HsVersions.h" #include "MachDeps.h" -import {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId ) +import {-# SOURCE #-} MkId( mkDataConWorkId, mkSimpleDataConRep, mkDictSelId ) -- friends: import PrelNames @@ -505,7 +505,7 @@ pcDataConWithFixity' :: Bool -> Name -> Unique -> Unique -> RuntimeRepInfo -- The Name should be in the DataName name space; it's the name -- of the DataCon itself. -pcDataConWithFixity' declared_infix dc_name wrk_key _wrp_key rri tyvars ex_tyvars arg_tys tycon +pcDataConWithFixity' declared_infix dc_name wrk_key wrp_key rri tyvars ex_tyvars arg_tys tycon = data_con where data_con = mkDataCon dc_name declared_infix prom_info @@ -520,9 +520,7 @@ pcDataConWithFixity' declared_infix dc_name wrk_key _wrp_key rri tyvars ex_tyvar tycon [] -- No stupid theta (mkDataConWorkId wrk_name data_con) - NoDataConRep -- Wired-in types are too simple to need wrappers - -- TODO #12618 should be generating a wrapper - -- here, but we cannot use Core here! + (mkSimpleDataConRep wrp_name data_con) no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict @@ -533,8 +531,13 @@ pcDataConWithFixity' declared_infix dc_name wrk_key _wrp_key rri tyvars ex_tyvar wrk_name = mkWiredInName modu wrk_occ wrk_key (AnId (dataConWorkId data_con)) UserSyntax + wrp_occ = mkDataConWrapperOcc dc_occ + wrp_name = mkWiredInName modu wrp_occ wrp_key + (AnId (dataConWrapId data_con)) UserSyntax + prom_info = mkPrelTyConRepName dc_name + -- used for RuntimeRep and friends pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon pcSpecialDataCon dc_name arg_tys tycon rri From git at git.haskell.org Thu Oct 6 23:20:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:45 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Always build a wrapper for data types (39185a4) Message-ID: <20161006232045.7FFE73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/39185a4af6d85087f2eb42fb02f74e990bcb142d/ghc >--------------------------------------------------------------- commit 39185a4af6d85087f2eb42fb02f74e990bcb142d Author: Joachim Breitner Date: Tue Oct 4 15:14:45 2016 -0400 Always build a wrapper for data types >--------------------------------------------------------------- 39185a4af6d85087f2eb42fb02f74e990bcb142d compiler/basicTypes/MkId.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 2267a47..8f61d96 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -552,10 +552,6 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs) wrapper_reqd = not (isNewTyCon tycon) -- Newtypes have only a worker - && (any isBanged (ev_ibangs ++ arg_ibangs) - -- Some forcing/unboxing (includes eq_spec) - || isFamInstTyCon tycon -- Cast result - || (not $ null eq_spec)) -- GADT build_con_app rep_ids = mkConApp data_con $ concat [ map Type res_ty_args From git at git.haskell.org Thu Oct 6 23:20:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:48 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Desugar: Use Coercible worker, not wrapper (5be97a0c) Message-ID: <20161006232048.321E33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/5be97a0c7aec64260335581ec8de27792be0467a/ghc >--------------------------------------------------------------- commit 5be97a0c7aec64260335581ec8de27792be0467a Author: Joachim Breitner Date: Wed Oct 5 13:21:41 2016 -0400 Desugar: Use Coercible worker, not wrapper >--------------------------------------------------------------- 5be97a0c7aec64260335581ec8de27792be0467a compiler/deSugar/Desugar.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 6a6c012..16fdc5d 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -42,7 +42,6 @@ import TysPrim ( eqReprPrimTyCon ) import Unique ( hasKey ) import Coercion ( mkCoVarCo ) import TysWiredIn ( coercibleDataCon ) -import DataCon ( dataConWrapId ) import MkCore ( mkCoreLet ) import Module import NameSet @@ -642,9 +641,7 @@ unfold_coerce bndrs lhs rhs = do let ty' = mkTyConApp eqReprPrimTyCon [k, k, t1, t2] v' = mkLocalCoVar (mkDerivedInternalName mkRepEqOcc u (getName v)) ty' - box = Var (dataConWrapId coercibleDataCon) `mkTyApps` - [k, t1, t2] `App` - Coercion (mkCoVarCo v') + box = mkConApp coercibleDataCon (map Type [k, t1, t2] ++ [Coercion (mkCoVarCo v')]) (bndrs, wrap) <- go vs return (v':bndrs, mkCoreLet (NonRec v box) . wrap) From git at git.haskell.org Thu Oct 6 23:20:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:50 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Reserve a unique for the wrapper of a wired in DataCon (916c152) Message-ID: <20161006232050.D81F43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/916c15272fffd7d7457c085488051765c6c8146e/ghc >--------------------------------------------------------------- commit 916c15272fffd7d7457c085488051765c6c8146e Author: Joachim Breitner Date: Wed Oct 5 12:50:32 2016 -0400 Reserve a unique for the wrapper of a wired in DataCon >--------------------------------------------------------------- 916c15272fffd7d7457c085488051765c6c8146e compiler/basicTypes/Unique.hs | 17 +++++++++-------- compiler/prelude/TysWiredIn.hs | 16 +++++++++++----- 2 files changed, 20 insertions(+), 13 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index 8d4a1d6..128e7b3 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -55,7 +55,7 @@ module Unique ( mkCostCentreUnique, tyConRepNameUnique, - dataConWorkerUnique, dataConRepNameUnique, + dataConWorkerUnique, dataConWrapperUnique, dataConRepNameUnique, mkBuiltinUnique, mkPseudoUniqueD, @@ -367,12 +367,12 @@ tyConRepNameUnique u = incrUnique u -- Wired-in data constructor keys occupy *three* slots: -- * u: the DataCon itself -- * u+1: its worker Id --- * u+2: the TyConRepName of the promoted TyCon --- Prelude data constructors are too simple to need wrappers. +-- * u+2: its wrapper Id +-- * u+3: the TyConRepName of the promoted TyCon -mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic -mkTupleDataConUnique Boxed a = mkUnique '7' (3*a) -- ditto (*may* be used in C labels) -mkTupleDataConUnique Unboxed a = mkUnique '8' (3*a) +mkPreludeDataConUnique i = mkUnique '6' (4*i) -- Must be alphabetic +mkTupleDataConUnique Boxed a = mkUnique '7' (4*a) -- ditto (*may* be used in C labels) +mkTupleDataConUnique Unboxed a = mkUnique '8' (4*a) -------------------------------------------------- -- Sum arities start from 2. A sum of arity N has N data constructors, so it @@ -402,9 +402,10 @@ sumUniqsOccupied arity {-# INLINE sumUniqsOccupied #-} -------------------------------------------------- -dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique +dataConRepNameUnique, dataConWrapperUnique, dataConWorkerUnique :: Unique -> Unique dataConWorkerUnique u = incrUnique u -dataConRepNameUnique u = stepUnique u 2 +dataConWrapperUnique u = stepUnique u 2 +dataConRepNameUnique u = stepUnique u 3 -------------------------------------------------- mkPrimOpIdUnique op = mkUnique '9' op diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 035ae75..b1d0f52 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -489,22 +489,23 @@ pcDataConWithFixity :: Bool -- ^ declared infix? -> [Type] -- ^ args -> TyCon -> DataCon -pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n)) +pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n)) (dataConWrapperUnique (nameUnique n)) NoRRI --- The Name's unique is the first of two free uniques; +-- The Name's unique is the first of four free uniques; -- the first is used for the datacon itself, -- the second is used for the "worker name" +-- the third is used for the "wrapper name" -- -- To support this the mkPreludeDataConUnique function "allocates" -- one DataCon unique per pair of Ints. -pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo +pcDataConWithFixity' :: Bool -> Name -> Unique -> Unique -> RuntimeRepInfo -> [TyVar] -> [TyVar] -> [Type] -> TyCon -> DataCon -- The Name should be in the DataName name space; it's the name -- of the DataCon itself. -pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys tycon +pcDataConWithFixity' declared_infix dc_name wrk_key _wrp_key rri tyvars ex_tyvars arg_tys tycon = data_con where data_con = mkDataCon dc_name declared_infix prom_info @@ -520,6 +521,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys [] -- No stupid theta (mkDataConWorkId wrk_name data_con) NoDataConRep -- Wired-in types are too simple to need wrappers + -- TODO #12618 should be generating a wrapper + -- here, but we cannot use Core here! no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict @@ -535,7 +538,10 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys -- used for RuntimeRep and friends pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon pcSpecialDataCon dc_name arg_tys tycon rri - = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri + = pcDataConWithFixity' False dc_name + (dataConWorkerUnique (nameUnique dc_name)) + (dataConWrapperUnique (nameUnique dc_name)) + rri [] [] arg_tys tycon {- From git at git.haskell.org Thu Oct 6 23:20:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:53 +0000 (UTC) Subject: [commit: ghc] wip/T12618: CorePrep: Stop creating weird bindings for data constructor workers (36143d4) Message-ID: <20161006232053.86DB13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/36143d401423e7fc427cef6ed71cb9dae3c9d561/ghc >--------------------------------------------------------------- commit 36143d401423e7fc427cef6ed71cb9dae3c9d561 Author: Joachim Breitner Date: Wed Oct 5 13:15:40 2016 -0400 CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. >--------------------------------------------------------------- 36143d401423e7fc427cef6ed71cb9dae3c9d561 compiler/coreSyn/CorePrep.hs | 55 +++----------------------------------------- 1 file changed, 3 insertions(+), 52 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index d321064..fdd6f1b 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -54,8 +54,6 @@ import Outputable import Platform import FastString import Config -import Name ( NamedThing(..), nameSrcSpan ) -import SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) import Data.Bits import MonadUtils ( mapAccumLM ) import Data.List ( mapAccumL ) @@ -168,21 +166,16 @@ type CpeRhs = CoreExpr -- Non-terminal 'rhs' corePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon] -> IO CoreProgram -corePrepPgm hsc_env this_mod mod_loc binds data_tycons = +corePrepPgm hsc_env this_mod _mod_loc binds _data_tycons = withTiming (pure dflags) (text "CorePrep"<+>brackets (ppr this_mod)) (const ()) $ do us <- mkSplitUniqSupply 's' initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env - let implicit_binds = mkDataConWorkers dflags mod_loc data_tycons - -- NB: we must feed mkImplicitBinds through corePrep too - -- so that they are suitably cloned and eta-expanded - - binds_out = initUs_ us $ do + let binds_out = initUs_ us $ do floats1 <- corePrepTopBinds initialCorePrepEnv binds - floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds - return (deFloatTop (floats1 `appendFloats` floats2)) + return (deFloatTop floats1) endPassIO hsc_env alwaysQualify CorePrep binds_out [] return binds_out @@ -208,27 +201,6 @@ corePrepTopBinds initialCorePrepEnv binds binds' <- go env' binds return (bind' `appendFloats` binds') -mkDataConWorkers :: DynFlags -> ModLocation -> [TyCon] -> [CoreBind] --- See Note [Data constructor workers] --- c.f. Note [Injecting implicit bindings] in TidyPgm -mkDataConWorkers dflags mod_loc data_tycons - = [ NonRec id (tick_it (getName data_con) (Var id)) - -- The ice is thin here, but it works - | tycon <- data_tycons, -- CorePrep will eta-expand it - data_con <- tyConDataCons tycon, - let id = dataConWorkId data_con - ] - where - -- If we want to generate debug info, we put a source note on the - -- worker. This is useful, especially for heap profiling. - tick_it name - | debugLevel dflags == 0 = id - | RealSrcSpan span <- nameSrcSpan name = tick span - | Just file <- ml_hs_file mod_loc = tick (span1 file) - | otherwise = tick (span1 "???") - where tick span = Tick (SourceNote span $ showSDoc dflags (ppr name)) - span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1 - {- Note [Floating out of top level bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -281,24 +253,6 @@ out CafInfo later, after CorePrep. We'll do that in due course. Meanwhile this horrible hack works. -Note [Data constructor workers] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Create any necessary "implicit" bindings for data con workers. We -create the rather strange (non-recursive!) binding - - $wC = \x y -> $wC x y - -i.e. a curried constructor that allocates. This means that we can -treat the worker for a constructor like any other function in the rest -of the compiler. The point here is that CoreToStg will generate a -StgConApp for the RHS, rather than a call to the worker (which would -give a loop). As Lennart says: the ice is thin here, but it works. - -Hmm. Should we create bindings for dictionary constructors? They are -always fully applied, and the bindings are just there to support -partial applications. But it's easier to let them through. - - Note [Dead code in CorePrep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Imagine that we got an input program like this (see Trac #4962): @@ -1304,9 +1258,6 @@ allLazyNested is_rec (Floats IfUnboxedOk _) = isNonRec is_rec -- We decided not to adopt this solution to keep the definition -- of 'exprIsTrivial' simple. -- --- There is ONE caveat however: for top-level bindings we have --- to preserve the binding so that we float the (hacky) non-recursive --- binding for data constructors; see Note [Data constructor workers]. -- -- Note [CorePrep inlines trivial CoreExpr not Id] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Thu Oct 6 23:20:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:56 +0000 (UTC) Subject: [commit: ghc] wip/T12618: mkCoreConApps: Do not use ConApp for newtypes (ba8341c) Message-ID: <20161006232056.3D2E93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/ba8341c129bb26e8d92e763dd7de6f0a1e265caf/ghc >--------------------------------------------------------------- commit ba8341c129bb26e8d92e763dd7de6f0a1e265caf Author: Joachim Breitner Date: Wed Oct 5 23:08:34 2016 -0400 mkCoreConApps: Do not use ConApp for newtypes >--------------------------------------------------------------- ba8341c129bb26e8d92e763dd7de6f0a1e265caf compiler/coreSyn/CoreLint.hs | 4 +++- compiler/coreSyn/MkCore.hs | 11 ++++++----- compiler/deSugar/DsBinds.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- 4 files changed, 11 insertions(+), 8 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 1c48dcd..02b2a36 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -715,7 +715,9 @@ lintCoreExpr e@(ConApp dc args) failWithL $ text "Found StaticPtr nested in an expression: " <+> ppr e when (length args /= dataConRepFullArity dc) $ - failWithL $ hang (text "Un-saturated data con application") 2 (ppr e) + addErrL $ hang (text "Un-saturated data con application") 2 (ppr e) + when (isNewTyCon (dataConTyCon dc)) $ + addErrL $ hang (text "ConApp with newtype constructor") 2 (ppr e) let dc_ty = dataConRepType dc addLoc (AnExpr e) $ foldM lintCoreArg dc_ty args diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index a5f0871..01c5104 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,8 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConRepFullArity, dataConWrapId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWrapId, dataConTyCon ) +import TyCon ( isNewTyCon ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -152,17 +153,17 @@ mkCoreApps orig_fun orig_args mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr mkCoreConApps con args | length args >= dataConRepFullArity con + , not (isNewTyCon (dataConTyCon con)) = let sat_app = mk_val_apps 0 res_ty (ConApp con) con_args in mkCoreApps sat_app extra_args + | otherwise + -- Unsaturated or newtype constructor application. + = mkCoreApps (Var (dataConWrapId con)) args where -- TODO #12618: Can there ever be more than dataConRepArity con arguments -- in a type-safe program? (con_args, extra_args) = splitAt (dataConRepFullArity con) args res_ty = exprType (ConApp con args) -mkCoreConApps con args - -- Unsaturated application. TODO #12618 Use wrapper. - = WARN ( True, text "mkCoreConApps: Unsaturated use." $$ ppr con <+> ppr args ) - mkCoreApps (Var (dataConWrapId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 143d209..5c3bfcf 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1138,7 +1138,7 @@ dsEvTypeable ty ev $ mkLams [mkWildValBinder proxyT] (Var repName) -- Package up the method as `Typeable` dictionary - ; return $ mkConApp typeable_data_con [Type kind, Type ty, method] } + ; return $ mkCoreConApps typeable_data_con [Type kind, Type ty, method] } ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 2644cc3..637139c 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -473,7 +473,7 @@ prepareRhs top_lvl env0 id rhs0 = do { (is_exp, env', rhs') <- go n_val_args env rhs ; return (is_exp, env', Cast rhs' co) } go n_val_args env (ConApp dc args) - = ASSERT2( n_val_args == 0, ppr (ConApp dc args) <+> ppr n_val_args ) + = WARN( n_val_args > 0, ppr (ConApp dc args) <+> ppr n_val_args ) do { (env', args') <- makeTrivials top_lvl env (getOccFS id) args ; return (True, env', ConApp dc args') } From git at git.haskell.org Thu Oct 6 23:20:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:20:58 +0000 (UTC) Subject: [commit: ghc] wip/T12618: New Lint Check: No data con workers any more, please (70e58e8) Message-ID: <20161006232058.E55F73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/70e58e8316a138627274160e2fe6972802084fea/ghc >--------------------------------------------------------------- commit 70e58e8316a138627274160e2fe6972802084fea Author: Joachim Breitner Date: Wed Oct 5 23:22:48 2016 -0400 New Lint Check: No data con workers any more, please >--------------------------------------------------------------- 70e58e8316a138627274160e2fe6972802084fea compiler/coreSyn/CoreLint.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 02b2a36..127ae0f 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -624,6 +624,7 @@ lintCoreExpr (Var var) = do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) + ; checkBadDataConWorker var ; checkDeadIdOcc var ; var' <- lookupIdInScope var ; return (idType var') } @@ -898,6 +899,16 @@ checkDeadIdOcc id | otherwise = return () +checkBadDataConWorker :: Id -> LintM () +-- We do not want to see data con workers here, but for newtypes +-- (It should either be a ConApp or a reference to the wrapper) +checkBadDataConWorker id + | Just dc <- isDataConWorkId_maybe id + = checkL (isNewTyCon (dataConTyCon dc)) + (text "data constructor worker found" <+> ppr id) + | otherwise + = return () + {- ************************************************************************ * * From git at git.haskell.org Thu Oct 6 23:21:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:21:01 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Use dataConWrapId in unsaturated uses of mkCoreConApps (1aa69bf) Message-ID: <20161006232101.AD9F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/1aa69bff3624beb966136e70e806dd7c7038a795/ghc >--------------------------------------------------------------- commit 1aa69bff3624beb966136e70e806dd7c7038a795 Author: Joachim Breitner Date: Wed Oct 5 17:50:29 2016 -0400 Use dataConWrapId in unsaturated uses of mkCoreConApps >--------------------------------------------------------------- 1aa69bff3624beb966136e70e806dd7c7038a795 compiler/coreSyn/MkCore.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index b90a17d..a5f0871 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -67,7 +67,7 @@ import TcType ( mkSpecSigmaTy ) import Type import Coercion ( isCoVar ) import TysPrim -import DataCon ( DataCon, dataConRepFullArity, dataConWorkId ) +import DataCon ( DataCon, dataConRepFullArity, dataConWrapId ) import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) import Demand @@ -162,7 +162,7 @@ mkCoreConApps con args mkCoreConApps con args -- Unsaturated application. TODO #12618 Use wrapper. = WARN ( True, text "mkCoreConApps: Unsaturated use." $$ ppr con <+> ppr args ) - mkCoreApps (Var (dataConWorkId con)) args + mkCoreApps (Var (dataConWrapId con)) args mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr -- Build an application (e1 e2), From git at git.haskell.org Thu Oct 6 23:21:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:21:04 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Use ConApp when creating True resp. False (65ba986) Message-ID: <20161006232104.661AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/65ba986828aba20e61ef15b2db09eb40c06259b4/ghc >--------------------------------------------------------------- commit 65ba986828aba20e61ef15b2db09eb40c06259b4 Author: Joachim Breitner Date: Wed Oct 5 23:23:20 2016 -0400 Use ConApp when creating True resp. False >--------------------------------------------------------------- 65ba986828aba20e61ef15b2db09eb40c06259b4 compiler/deSugar/DsCCall.hs | 4 ++-- compiler/deSugar/DsListComp.hs | 8 ++++---- compiler/deSugar/DsUtils.hs | 4 ++-- compiler/prelude/PrelRules.hs | 4 ++-- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/DsCCall.hs b/compiler/deSugar/DsCCall.hs index 8f614ba..a5f8658 100644 --- a/compiler/deSugar/DsCCall.hs +++ b/compiler/deSugar/DsCCall.hs @@ -331,8 +331,8 @@ resultWrapper result_ty return (Just intPrimTy, \e -> mkWildCase e intPrimTy boolTy - [(DEFAULT ,[],Var trueDataConId ), - (LitAlt (mkMachInt dflags 0),[],Var falseDataConId)]) + [(DEFAULT ,[],ConApp trueDataCon []), + (LitAlt (mkMachInt dflags 0),[],ConApp falseDataCon [])]) -- Newtypes | Just (co, rep_ty) <- topNormaliseNewType_maybe result_ty diff --git a/compiler/deSugar/DsListComp.hs b/compiler/deSugar/DsListComp.hs index 45320cc..4a65628 100644 --- a/compiler/deSugar/DsListComp.hs +++ b/compiler/deSugar/DsListComp.hs @@ -491,8 +491,8 @@ dsPArrComp (BindStmt p e _ _ _ : qs) = do filterP <- dsDPHBuiltin filterPVar ce <- dsLExpr e let ety'ce = parrElemType ce - false = Var falseDataConId - true = Var trueDataConId + false = ConApp falseDataCon [] + true = ConApp trueDataCon [] v <- newSysLocalDs ety'ce pred <- matchSimply (Var v) (StmtCtxt PArrComp) p true false let gen | isIrrefutableHsPat p = ce @@ -552,8 +552,8 @@ dePArrComp (BindStmt p e _ _ _ : qs) pa cea = do ce <- dsLExpr e let ety'cea = parrElemType cea ety'ce = parrElemType ce - false = Var falseDataConId - true = Var trueDataConId + false = ConApp falseDataCon [] + true = ConApp trueDataCon [] v <- newSysLocalDs ety'ce pred <- matchSimply (Var v) (StmtCtxt PArrComp) p true false let cef | isIrrefutableHsPat p = ce diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index cc621d5..ebf6aec 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -943,8 +943,8 @@ mkBinaryTickBox ixT ixF e = do this_mod <- getModule let bndr1 = mkSysLocal (fsLit "t1") uq boolTy let - falseBox = Tick (HpcTick this_mod ixF) (Var falseDataConId) - trueBox = Tick (HpcTick this_mod ixT) (Var trueDataConId) + falseBox = Tick (HpcTick this_mod ixF) (ConApp falseDataCon []) + trueBox = Tick (HpcTick this_mod ixT) (ConApp trueDataCon []) -- return $ Case e bndr1 boolTy [ (DataAlt falseDataCon, [], falseBox) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 197ddb3..f637fd3 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -831,8 +831,8 @@ trueValInt dflags = Lit $ onei dflags -- see Note [What's true and false] falseValInt dflags = Lit $ zeroi dflags trueValBool, falseValBool :: Expr CoreBndr -trueValBool = Var trueDataConId -- see Note [What's true and false] -falseValBool = Var falseDataConId +trueValBool = ConApp trueDataCon [] -- see Note [What's true and false] +falseValBool = ConApp falseDataCon [] ltVal, eqVal, gtVal :: Expr CoreBndr ltVal = Var ltDataConId From git at git.haskell.org Thu Oct 6 23:21:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:21:07 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp: More Linting (3f42e87) Message-ID: <20161006232107.1E6D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/3f42e87964b327f4e6b463056727e3de980dfa31/ghc >--------------------------------------------------------------- commit 3f42e87964b327f4e6b463056727e3de980dfa31 Author: Joachim Breitner Date: Wed Oct 5 18:13:33 2016 -0400 ConApp: More Linting >--------------------------------------------------------------- 3f42e87964b327f4e6b463056727e3de980dfa31 compiler/coreSyn/CoreLint.hs | 7 +++++-- compiler/simplCore/Simplify.hs | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 920580c..1c48dcd 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -695,8 +695,11 @@ lintCoreExpr e@(App _ _) Var b | Just con <- isDataConWorkId_maybe b , dataConRepFullArity con <= length args -> do - failWithL $ text "Found saturated use of data con worker (should use ConApp): " <+> - ppr e + addErrL $ text "Found saturated use of data con worker (should use ConApp): " <+> ppr e + go + ConApp _ _ -> do + addErrL $ text "Found ConApp in argument position. Is that possible?" <+> ppr e $$ ppr args + go _ -> go where go = do { fun_ty <- lintCoreExpr fun diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index a966986..2644cc3 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -473,7 +473,7 @@ prepareRhs top_lvl env0 id rhs0 = do { (is_exp, env', rhs') <- go n_val_args env rhs ; return (is_exp, env', Cast rhs' co) } go n_val_args env (ConApp dc args) - = ASSERT( n_val_args == 0 ) + = ASSERT2( n_val_args == 0, ppr (ConApp dc args) <+> ppr n_val_args ) do { (env', args') <- makeTrivials top_lvl env (getOccFS id) args ; return (True, env', ConApp dc args') } From git at git.haskell.org Thu Oct 6 23:21:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:21:09 +0000 (UTC) Subject: [commit: ghc] wip/T12618: mkSimpleDataConRep: No wrapper for newtypes (48877da) Message-ID: <20161006232109.CADF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/48877dad6bfd8a7d5cf47da04fde8e2223530146/ghc >--------------------------------------------------------------- commit 48877dad6bfd8a7d5cf47da04fde8e2223530146 Author: Joachim Breitner Date: Wed Oct 5 18:21:59 2016 -0400 mkSimpleDataConRep: No wrapper for newtypes >--------------------------------------------------------------- 48877dad6bfd8a7d5cf47da04fde8e2223530146 compiler/basicTypes/MkId.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 0601ba4..ba7b633 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -472,11 +472,13 @@ unitDataConBoxer :: DataConBoxer unitDataConBoxer = DCB (\_ vs -> return (vs, [])) mkSimpleDataConRep :: Name -> DataCon -> DataConRep -mkSimpleDataConRep wrap_name dc = DCR { dcr_wrap_id = wrap_id - , dcr_boxer = unitDataConBoxer - , dcr_arg_tys = arg_tys - , dcr_stricts = rep_strs - , dcr_bangs = arg_ibangs } +mkSimpleDataConRep _ dc | isNewTyCon (dataConTyCon dc) = NoDataConRep +mkSimpleDataConRep wrap_name dc + = DCR { dcr_wrap_id = wrap_id + , dcr_boxer = unitDataConBoxer + , dcr_arg_tys = arg_tys + , dcr_stricts = rep_strs + , dcr_bangs = arg_ibangs } where wrap_ty = dataConRepType dc wrap_id = mkGlobalId (DataConWrapId dc) wrap_name wrap_ty wrap_info From git at git.haskell.org Thu Oct 6 23:21:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:21:12 +0000 (UTC) Subject: [commit: ghc] wip/T12618's head updated: Use ConApp when creating True resp. False (65ba986) Message-ID: <20161006232112.3C2F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T12618' now includes: 7a6731c genapply: update source file in autogenerated text c5d6288 Mark zipWithAndUnzipM as INLINABLE rather than INLINE e4cf962 Bring Note in TcDeriv up to date 465c6c5 Improve error handling in TcRnMonad 58ecdf8 Remove unused T12124.srderr 4a03012 Refactor TcDeriv and TcGenDeriv a2bedb5 RegAlloc: Make some pattern matched complete 57a207c Remove dead code “mkHsConApp” 67814af Introduce ConApp to Core (dead code as of yet) f17b59e Actually desugar to ConApp e7d8c5a ConApp bytecode: Add more ASSERT 5a7d036 ConApp: Include dc worker id in free variables 8fa2420 ConApp: Include dc worker id in dffvExpr f10cbcb mkDataConRep: Do not interleave applying arguments and unboxers b486662 DataCon wrapper: Use ConApp in the body 6c7668e mkCoreConApps: Warn about unsaturated use a40b103 Lint: Complain about saturated uses of the data con worker 8399e73 Use ConApp in tagToEnumRule c3e1cb0 knownCon: Use ConApp in unfolding of scrutinee 3733c4d Get rid of unitDataConId (use ConApp instead) 39185a4 Always build a wrapper for data types 32b4719 Always use ConApp in CoreSyn 916c152 Reserve a unique for the wrapper of a wired in DataCon 36143d4 CorePrep: Stop creating weird bindings for data constructor workers 5be97a0c Desugar: Use Coercible worker, not wrapper 395db23 Create a simple wrapper for built-in types as well ef7fc1a Deserialize interface tuples to ConApp d192218 Handle ConApp in "Eliminate Identity Case" 1aa69bf Use dataConWrapId in unsaturated uses of mkCoreConApps 3f42e87 ConApp: More Linting 48877da mkSimpleDataConRep: No wrapper for newtypes ba8341c mkCoreConApps: Do not use ConApp for newtypes 70e58e8 New Lint Check: No data con workers any more, please 65ba986 Use ConApp when creating True resp. False From git at git.haskell.org Thu Oct 6 23:49:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Oct 2016 23:49:33 +0000 (UTC) Subject: [commit: ghc] master: Add compact to packages so it gets cleaned on make clean. (cbe11d5) Message-ID: <20161006234933.C74293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cbe11d5fefefce518c246b470350a5a3bf8efbd6/ghc >--------------------------------------------------------------- commit cbe11d5fefefce518c246b470350a5a3bf8efbd6 Author: Edward Z. Yang Date: Thu Oct 6 16:48:56 2016 -0700 Add compact to packages so it gets cleaned on make clean. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- cbe11d5fefefce518c246b470350a5a3bf8efbd6 packages | 1 + 1 file changed, 1 insertion(+) diff --git a/packages b/packages index f368065..ac4d3e5 100644 --- a/packages +++ b/packages @@ -45,6 +45,7 @@ libraries/array - - - libraries/binary - - https://github.com/kolmodin/binary.git libraries/bytestring - - https://github.com/haskell/bytestring.git libraries/Cabal - - https://github.com/haskell/cabal.git +libraries/compact - - - libraries/containers - - https://github.com/haskell/containers.git libraries/deepseq - - ssh://git at github.com/haskell/deepseq.git libraries/directory - - ssh://git at github.com/haskell/directory.git From git at git.haskell.org Fri Oct 7 10:07:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Oct 2016 10:07:36 +0000 (UTC) Subject: [commit: ghc] master: Fix memory leak from #12664 (e41b9c6) Message-ID: <20161007100736.D9A063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e41b9c614984b63c4660018cecde682453e083e5/ghc >--------------------------------------------------------------- commit e41b9c614984b63c4660018cecde682453e083e5 Author: Bartosz Nitka Date: Thu Oct 6 05:40:24 2016 -0700 Fix memory leak from #12664 This fixes the leak with `setProgArgv`. The problem was that `setProgArgv` would not free the objects pointed to by `prog_argc`, `prog_argv` when the globals were changed resulting in a leak. The only strictly necessary change is in `rts/RtsFlags.c`, but the code in `System.Environment` was a bit confusing and not exception safe, so I refactored it. Test Plan: ./validate Reviewers: simonmar, ezyang, austin, hvr, bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2576 GHC Trac Issues: #12664 >--------------------------------------------------------------- e41b9c614984b63c4660018cecde682453e083e5 libraries/base/GHC/Foreign.hs | 18 ++++++++++++++++ libraries/base/System/Environment.hs | 30 +++++++++++---------------- libraries/base/tests/IO/environment001.hs | 4 ++++ libraries/base/tests/IO/environment001.stdout | 2 ++ rts/RtsFlags.c | 1 + 5 files changed, 37 insertions(+), 18 deletions(-) diff --git a/libraries/base/GHC/Foreign.hs b/libraries/base/GHC/Foreign.hs index e8553d8..7d2f915 100644 --- a/libraries/base/GHC/Foreign.hs +++ b/libraries/base/GHC/Foreign.hs @@ -32,6 +32,7 @@ module GHC.Foreign ( -- withCString, withCStringLen, + withCStringsLen, charIsRepresentable, ) where @@ -134,6 +135,23 @@ withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a withCStringLen enc = withEncodedCString enc False +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f -- | Determines whether a character can be accurately encoded in a 'CString'. -- diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs index 242845a..d8b3e03 100644 --- a/libraries/base/System/Environment.hs +++ b/libraries/base/System/Environment.hs @@ -32,12 +32,14 @@ module System.Environment import Foreign import Foreign.C import System.IO.Error (mkIOError) -import Control.Exception.Base (bracket, throwIO) +import Control.Exception.Base (bracket_, throwIO) +#ifdef mingw32_HOST_OS +import Control.Exception.Base (bracket) +#endif -- import GHC.IO import GHC.IO.Exception import GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC -import Data.List import Control.Monad #ifdef mingw32_HOST_OS import GHC.Environment @@ -369,25 +371,17 @@ withProgArgv :: [String] -> IO a -> IO a withProgArgv new_args act = do pName <- System.Environment.getProgName existing_args <- System.Environment.getArgs - bracket (setProgArgv new_args) - (\argv -> do _ <- setProgArgv (pName:existing_args) - freeProgArgv argv) - (const act) - -freeProgArgv :: Ptr CString -> IO () -freeProgArgv argv = do - size <- lengthArray0 nullPtr argv - sequence_ [ peek (argv `advancePtr` i) >>= free - | i <- [size - 1, size - 2 .. 0]] - free argv - -setProgArgv :: [String] -> IO (Ptr CString) + bracket_ (setProgArgv new_args) + (setProgArgv (pName:existing_args)) + act + +setProgArgv :: [String] -> IO () setProgArgv argv = do enc <- getFileSystemEncoding - vs <- mapM (GHC.newCString enc) argv >>= newArray0 nullPtr - c_setProgArgv (genericLength argv) vs - return vs + GHC.withCStringsLen enc argv $ \len css -> + c_setProgArgv (fromIntegral len) css +-- setProgArgv copies the arguments foreign import ccall unsafe "setProgArgv" c_setProgArgv :: CInt -> Ptr CString -> IO () diff --git a/libraries/base/tests/IO/environment001.hs b/libraries/base/tests/IO/environment001.hs index 11d7912..1d7a5c1 100644 --- a/libraries/base/tests/IO/environment001.hs +++ b/libraries/base/tests/IO/environment001.hs @@ -14,3 +14,7 @@ main = do [arg1] <- withArgs ["你好!"] getArgs putStrLn arg1 putStrLn ("Test 3: " ++ show (length arg1)) + + args2 <- withArgs ["a", "b"] getArgs + print args2 + putStrLn ("Test 4: " ++ show (length args2)) diff --git a/libraries/base/tests/IO/environment001.stdout b/libraries/base/tests/IO/environment001.stdout index 2434d0c..2d32a83 100644 --- a/libraries/base/tests/IO/environment001.stdout +++ b/libraries/base/tests/IO/environment001.stdout @@ -4,3 +4,5 @@ Test 1: 3 Test 2: 1 你好! Test 3: 3 +["a","b"] +Test 4: 2 diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index c994a0c..4bd544e 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -1943,6 +1943,7 @@ getProgArgv(int *argc, char **argv[]) void setProgArgv(int argc, char *argv[]) { + freeArgv(prog_argc,prog_argv); prog_argc = argc; prog_argv = copyArgv(argc,argv); setProgName(prog_argv); From git at git.haskell.org Fri Oct 7 14:20:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Oct 2016 14:20:51 +0000 (UTC) Subject: [commit: ghc] master: Don't suggest deprecated flags in error messages (f3be304) Message-ID: <20161007142051.28F693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3be304abed6407b5ef148d76e4679c88018c780/ghc >--------------------------------------------------------------- commit f3be304abed6407b5ef148d76e4679c88018c780 Author: Martin Ceresa Date: Fri Oct 7 13:54:10 2016 +0100 Don't suggest deprecated flags in error messages When looking up flags, we make sure to lookup the non-deprecated flags first by ordering the list of flags. Reviewers: bgamari, austin, mpickering Reviewed By: mpickering Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2541 GHC Trac Issues: #12574 >--------------------------------------------------------------- f3be304abed6407b5ef148d76e4679c88018c780 compiler/main/DynFlags.hs | 10 +++++++++- testsuite/tests/warnings/should_compile/T11077.stderr | 2 +- testsuite/tests/warnings/should_compile/T12574.hs | 3 +++ testsuite/tests/warnings/should_compile/T12574.stderr | 4 ++++ testsuite/tests/warnings/should_compile/T2526.stderr | 2 +- testsuite/tests/warnings/should_compile/all.T | 3 +++ 6 files changed, 21 insertions(+), 3 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 97a6211..63bb0ef 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3236,7 +3236,15 @@ flagSpecOf flag = listToMaybe $ filter check wWarningFlags -- | These @-W\@ flags can all be reversed with @-Wno-\@ wWarningFlags :: [FlagSpec WarningFlag] -wWarningFlags = map snd wWarningFlagsDeps +wWarningFlags = wWarningFlagsDepsCurrent ++ wWarningFlagsDepsDeprecated + where + deprecatedWFlags = filter (not . isCurr) wWarningFlagsDeps + currentWFlags = filter isCurr wWarningFlagsDeps + wWarningFlagsDepsCurrent = map snd currentWFlags + wWarningFlagsDepsDeprecated = map snd deprecatedWFlags + + isCurr ( Deprecated , _ ) = False + isCurr _ = True wWarningFlagsDeps :: [(Deprecation, FlagSpec WarningFlag)] wWarningFlagsDeps = [ diff --git a/testsuite/tests/warnings/should_compile/T11077.stderr b/testsuite/tests/warnings/should_compile/T11077.stderr index ba7d4d8..1d68043 100644 --- a/testsuite/tests/warnings/should_compile/T11077.stderr +++ b/testsuite/tests/warnings/should_compile/T11077.stderr @@ -1,3 +1,3 @@ -T11077.hs:3:1: warning: [-Wmissing-exported-sigs] +T11077.hs:3:1: warning: [-Wmissing-exported-signatures] Top-level binding with no type signature: foo :: a diff --git a/testsuite/tests/warnings/should_compile/T12574.hs b/testsuite/tests/warnings/should_compile/T12574.hs new file mode 100644 index 0000000..7f54e7a --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T12574.hs @@ -0,0 +1,3 @@ +module T12574 where + +id a = a diff --git a/testsuite/tests/warnings/should_compile/T12574.stderr b/testsuite/tests/warnings/should_compile/T12574.stderr new file mode 100644 index 0000000..ded8833 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T12574.stderr @@ -0,0 +1,4 @@ + +T12574.hs:3:1: warning: [-Wmissing-local-signatures] + Polymorphic local binding with no type signature: + T12574.id :: forall t. t -> t diff --git a/testsuite/tests/warnings/should_compile/T2526.stderr b/testsuite/tests/warnings/should_compile/T2526.stderr index 07cf8d8..b433f0e 100644 --- a/testsuite/tests/warnings/should_compile/T2526.stderr +++ b/testsuite/tests/warnings/should_compile/T2526.stderr @@ -1,3 +1,3 @@ -T2526.hs:4:1: warning: [-Wmissing-exported-sigs] +T2526.hs:4:1: warning: [-Wmissing-exported-signatures] Top-level binding with no type signature: foo :: Integer diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T index d2c8c1a..ed128fa 100644 --- a/testsuite/tests/warnings/should_compile/all.T +++ b/testsuite/tests/warnings/should_compile/all.T @@ -13,6 +13,9 @@ test('T11128', normal, compile, ['']) test('T11128b', normal, compile, ['']) test('PluralS', normal, compile, ['']) +# T12574 Test that suggest current flag over deprecated +test('T12574',normal, compile, ['-fwarn-missing-local-signatures']) + test('DeprU', extra_clean([ 'DeprM.o', 'DeprU.o', From git at git.haskell.org Fri Oct 7 14:20:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Oct 2016 14:20:53 +0000 (UTC) Subject: [commit: ghc] master: Simplify implementation of wWarningFlags (76aaa6e) Message-ID: <20161007142053.D15CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/76aaa6eed264ac2398753a09418c6e1374244ff6/ghc >--------------------------------------------------------------- commit 76aaa6eed264ac2398753a09418c6e1374244ff6 Author: Matthew Pickering Date: Fri Oct 7 15:19:56 2016 +0100 Simplify implementation of wWarningFlags >--------------------------------------------------------------- 76aaa6eed264ac2398753a09418c6e1374244ff6 compiler/main/DynFlags.hs | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 63bb0ef..b78d665 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -186,6 +186,7 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.Except import Control.Exception (throwIO) +import Data.Ord import Data.Bits import Data.Char import Data.Int @@ -2295,7 +2296,7 @@ flagsPackage = map snd package_flags_deps type FlagMaker m = String -> OptKind m -> Flag m type DynFlagMaker = FlagMaker (CmdLineP DynFlags) -data Deprecation = Deprecated | NotDeprecated +data Deprecation = NotDeprecated | Deprecated deriving (Eq, Ord) -- Make a non-deprecated flag make_ord_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags) @@ -3236,15 +3237,7 @@ flagSpecOf flag = listToMaybe $ filter check wWarningFlags -- | These @-W\@ flags can all be reversed with @-Wno-\@ wWarningFlags :: [FlagSpec WarningFlag] -wWarningFlags = wWarningFlagsDepsCurrent ++ wWarningFlagsDepsDeprecated - where - deprecatedWFlags = filter (not . isCurr) wWarningFlagsDeps - currentWFlags = filter isCurr wWarningFlagsDeps - wWarningFlagsDepsCurrent = map snd currentWFlags - wWarningFlagsDepsDeprecated = map snd deprecatedWFlags - - isCurr ( Deprecated , _ ) = False - isCurr _ = True +wWarningFlags = map snd (sortBy (comparing fst) wWarningFlagsDeps) wWarningFlagsDeps :: [(Deprecation, FlagSpec WarningFlag)] wWarningFlagsDeps = [ From git at git.haskell.org Sat Oct 8 08:38:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:12 +0000 (UTC) Subject: [commit: ghc] master: Exclude Cabal PackageTests from gen_contents_index. (887485a) Message-ID: <20161008083812.EB4093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/887485a45ae55e81b26b6412b6f9dcf6a497f044/ghc >--------------------------------------------------------------- commit 887485a45ae55e81b26b6412b6f9dcf6a497f044 Author: Edward Z. Yang Date: Thu Oct 6 16:20:24 2016 -0700 Exclude Cabal PackageTests from gen_contents_index. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 887485a45ae55e81b26b6412b6f9dcf6a497f044 libraries/gen_contents_index | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/gen_contents_index b/libraries/gen_contents_index index 27fa3c7..29be2e1 100644 --- a/libraries/gen_contents_index +++ b/libraries/gen_contents_index @@ -33,7 +33,8 @@ then cd dist-haddock HADDOCK=../../inplace/bin/haddock - HADDOCK_FILES=`find ../ -name *.haddock | sort` + # Exclude Cabal package-tests, which may run haddock + HADDOCK_FILES=`find ../ -name *.haddock | grep -v 'PackageTests' | sort` HADDOCK_ARGS="-p ../prologue.txt" for HADDOCK_FILE in $HADDOCK_FILES do From git at git.haskell.org Sat Oct 8 08:38:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:15 +0000 (UTC) Subject: [commit: ghc] master: Remove reexports from ghc-boot, help bootstrap with GHC 8. (940ded8) Message-ID: <20161008083815.998333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/940ded858157173e75504e8cb0750f059ffd48b9/ghc >--------------------------------------------------------------- commit 940ded858157173e75504e8cb0750f059ffd48b9 Author: Edward Z. Yang Date: Sun Oct 2 12:59:44 2016 -0700 Remove reexports from ghc-boot, help bootstrap with GHC 8. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 940ded858157173e75504e8cb0750f059ffd48b9 compiler/ghc.cabal.in | 1 + libraries/ghc-boot/ghc-boot.cabal.in | 4 ---- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index ab72b45..b41c23a 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -58,6 +58,7 @@ Library hpc == 0.6.*, transformers == 0.5.*, ghc-boot == @ProjectVersionMunged@, + ghc-boot-th == @ProjectVersionMunged@, hoopl >= 3.10.2 && < 3.11 if os(windows) diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index eed11e3..57199e1 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -40,10 +40,6 @@ Library GHC.PackageDb GHC.Serialized - reexported-modules: - GHC.LanguageExtensions.Type, - GHC.Lexeme - build-depends: base >= 4.7 && < 4.10, binary == 0.8.*, bytestring == 0.10.*, From git at git.haskell.org Sat Oct 8 08:38:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:18 +0000 (UTC) Subject: [commit: ghc] master: The Backpack patch. (00b530d) Message-ID: <20161008083818.ECDAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00b530d5402aaa37e4085ecdcae0ae54454736c1/ghc >--------------------------------------------------------------- commit 00b530d5402aaa37e4085ecdcae0ae54454736c1 Author: Edward Z. Yang Date: Sat Oct 10 12:01:14 2015 -0700 The Backpack patch. Summary: This patch implements Backpack for GHC. It's a big patch but I've tried quite hard to keep things, by-in-large, self-contained. The user facing specification for Backpack can be found at: https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst A guide to the implementation can be found at: https://github.com/ezyang/ghc-proposals/blob/backpack-impl/proposals/0000-backpack-impl.rst Has a submodule update for Cabal, as well as a submodule update for filepath to handle more strict checking of cabal-version. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, simonmar, bgamari, goldfire Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D1482 >--------------------------------------------------------------- 00b530d5402aaa37e4085ecdcae0ae54454736c1 compiler/backpack/BkpSyn.hs | 77 ++ compiler/backpack/DriverBkp.hs | 777 +++++++++++++++++++++ compiler/backpack/NameShape.hs | 281 ++++++++ compiler/backpack/RnModIface.hs | 614 ++++++++++++++++ compiler/basicTypes/Module.hs | 645 +++++++++++++++-- compiler/basicTypes/Module.hs-boot | 3 + compiler/basicTypes/Name.hs | 7 +- compiler/deSugar/Desugar.hs | 20 +- compiler/ghc.cabal.in | 6 + compiler/iface/IfaceEnv.hs | 28 +- compiler/iface/IfaceEnv.hs-boot | 9 + compiler/iface/IfaceSyn.hs | 3 +- compiler/iface/LoadIface.hs | 133 +++- compiler/iface/LoadIface.hs-boot | 7 + compiler/iface/MkIface.hs | 103 ++- compiler/iface/TcIface.hs | 170 ++++- compiler/main/DriverPipeline.hs | 4 +- compiler/main/DynFlags.hs | 119 ++-- compiler/main/Finder.hs | 10 +- compiler/main/GhcMake.hs | 123 +++- compiler/main/HscMain.hs | 56 +- compiler/main/HscTypes.hs | 104 ++- compiler/main/PackageConfig.hs | 23 +- compiler/main/PackageConfig.hs-boot | 7 + compiler/main/Packages.hs | 437 +++++++++--- compiler/main/Packages.hs-boot | 10 +- compiler/parser/Lexer.x | 10 + compiler/parser/Parser.y | 114 ++- compiler/rename/RnEnv.hs | 40 +- compiler/rename/RnNames.hs | 9 +- compiler/typecheck/Inst.hs | 9 +- compiler/typecheck/TcBackpack.hs | 552 +++++++++++++++ compiler/typecheck/TcEnv.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 211 ++---- compiler/typecheck/TcRnDriver.hs-boot | 11 + compiler/typecheck/TcRnMonad.hs | 53 +- compiler/typecheck/TcRnTypes.hs | 146 ++-- compiler/typecheck/TcSplice.hs | 4 +- compiler/types/InstEnv.hs | 4 + compiler/utils/Outputable.hs | 2 +- ghc/Main.hs | 14 +- libraries/Cabal | 2 +- libraries/ghc-boot/GHC/PackageDb.hs | 134 +++- testsuite/.gitignore | 4 + testsuite/driver/extra_files.py | 4 +- testsuite/driver/testglobals.py | 3 + testsuite/driver/testlib.py | 40 +- testsuite/tests/{ado => backpack}/Makefile | 0 .../should_compile => backpack/cabal}/Makefile | 0 testsuite/tests/backpack/cabal/bkpcabal01/Main.hs | 2 + testsuite/tests/backpack/cabal/bkpcabal01/Makefile | 71 ++ .../cabal05 => backpack/cabal/bkpcabal01}/Setup.hs | 0 testsuite/tests/backpack/cabal/bkpcabal01/all.T | 9 + .../backpack/cabal/bkpcabal01/bkpcabal01.cabal | 33 + .../backpack/cabal/bkpcabal01/bkpcabal01.stdout | 0 .../tests/backpack/cabal/bkpcabal01/impl/H.hs | 2 + .../tests/backpack/cabal/bkpcabal01/impl/I.hs | 1 + testsuite/tests/backpack/cabal/bkpcabal01/p/H.hsig | 2 + .../tests/backpack/cabal/bkpcabal01/p/P.hs.in1 | 3 + .../tests/backpack/cabal/bkpcabal01/p/P.hs.in2 | 3 + testsuite/tests/backpack/cabal/bkpcabal01/q/I.hsig | 1 + .../tests/backpack/cabal/bkpcabal01/q/Q.hs.in1 | 3 + .../tests/backpack/cabal/bkpcabal01/q/Q.hs.in2 | 3 + testsuite/tests/backpack/cabal/bkpcabal02/Makefile | 24 + .../cabal05 => backpack/cabal/bkpcabal02}/Setup.hs | 0 testsuite/tests/backpack/cabal/bkpcabal02/all.T | 9 + .../backpack/cabal/bkpcabal02/bkpcabal02.cabal | 19 + .../backpack/cabal/bkpcabal02/bkpcabal02.stderr | 7 + .../backpack/cabal/bkpcabal02/bkpcabal02.stdout | 4 + .../tests/backpack/cabal/bkpcabal02/p/.gitignore | 1 + .../tests/backpack/cabal/bkpcabal02/p/H.hsig.in1 | 2 + .../tests/backpack/cabal/bkpcabal02/p/H.hsig.in2 | 2 + testsuite/tests/backpack/cabal/bkpcabal02/q/H.hsig | 2 + .../should_compile => backpack/reexport}/Makefile | 0 testsuite/tests/backpack/reexport/all.T | 7 + testsuite/tests/backpack/reexport/bkpreex01.bkp | 13 + testsuite/tests/backpack/reexport/bkpreex01.stderr | 6 + testsuite/tests/backpack/reexport/bkpreex02.bkp | 27 + testsuite/tests/backpack/reexport/bkpreex02.stderr | 27 + testsuite/tests/backpack/reexport/bkpreex03.bkp | 9 + testsuite/tests/backpack/reexport/bkpreex03.stderr | 5 + testsuite/tests/backpack/reexport/bkpreex04.bkp | 7 + testsuite/tests/backpack/reexport/bkpreex04.stderr | 4 + testsuite/tests/backpack/reexport/bkpreex05.bkp | 28 + testsuite/tests/backpack/reexport/bkpreex06.bkp | 11 + testsuite/tests/backpack/reexport/bkpreex06.stderr | 8 + .../should_compile/Makefile | 0 testsuite/tests/backpack/should_compile/all.T | 31 + testsuite/tests/backpack/should_compile/bkp01.bkp | 20 + .../tests/backpack/should_compile/bkp01.stderr | 18 + .../tests/backpack/should_compile/bkp01.stdout | 20 + .../tests/backpack/should_compile/bkp01c.stdout | 18 + testsuite/tests/backpack/should_compile/bkp02.bkp | 18 + .../tests/backpack/should_compile/bkp02.stderr | 14 + .../tests/backpack/should_compile/bkp02.stdout | 26 + .../tests/backpack/should_compile/bkp03.stderr | 25 + .../tests/backpack/should_compile/bkp04.stderr | 4 + .../tests/backpack/should_compile/bkp05.stderr | 19 + .../tests/backpack/should_compile/bkp06.stderr | 8 + testsuite/tests/backpack/should_compile/bkp07.bkp | 9 + .../tests/backpack/should_compile/bkp07.stderr | 5 + testsuite/tests/backpack/should_compile/bkp08.bkp | 12 + .../tests/backpack/should_compile/bkp08.stderr | 12 + testsuite/tests/backpack/should_compile/bkp09.bkp | 30 + .../tests/backpack/should_compile/bkp09.stderr | 26 + testsuite/tests/backpack/should_compile/bkp10.bkp | 13 + .../tests/backpack/should_compile/bkp10.stderr | 6 + testsuite/tests/backpack/should_compile/bkp11.bkp | 17 + .../tests/backpack/should_compile/bkp11.stderr | 7 + testsuite/tests/backpack/should_compile/bkp12.bkp | 15 + .../tests/backpack/should_compile/bkp12.stderr | 18 + .../tests/backpack/should_compile/bkp13.stderr | 6 + testsuite/tests/backpack/should_compile/bkp14.bkp | 23 + .../tests/backpack/should_compile/bkp14.stderr | 11 + testsuite/tests/backpack/should_compile/bkp15.bkp | 82 +++ .../tests/backpack/should_compile/bkp15.stderr | 25 + testsuite/tests/backpack/should_compile/bkp16.bkp | 8 + .../tests/backpack/should_compile/bkp16.stderr | 8 + testsuite/tests/backpack/should_compile/bkp17.bkp | 6 + .../tests/backpack/should_compile/bkp17.stderr | 10 + testsuite/tests/backpack/should_compile/bkp18.bkp | 18 + .../tests/backpack/should_compile/bkp18.stderr | 13 + testsuite/tests/backpack/should_compile/bkp19.bkp | 18 + .../tests/backpack/should_compile/bkp19.stderr | 13 + testsuite/tests/backpack/should_compile/bkp20.bkp | 22 + .../tests/backpack/should_compile/bkp20.stderr | 22 + testsuite/tests/backpack/should_compile/bkp21.bkp | 23 + .../tests/backpack/should_compile/bkp21.stderr | 10 + .../tests/backpack/should_compile/bkp22.stderr | 18 + testsuite/tests/backpack/should_compile/bkp23.bkp | 42 ++ .../tests/backpack/should_compile/bkp23.stderr | 24 + testsuite/tests/backpack/should_compile/bkp24.bkp | 30 + .../tests/backpack/should_compile/bkp24.stderr | 27 + testsuite/tests/backpack/should_compile/bkp25.bkp | 28 + .../tests/backpack/should_compile/bkp25.stderr | 11 + testsuite/tests/backpack/should_compile/bkp26.bkp | 21 + .../tests/backpack/should_compile/bkp26.stderr | 13 + testsuite/tests/backpack/should_compile/bkp27.bkp | 25 + .../tests/backpack/should_compile/bkp27.stderr | 14 + testsuite/tests/backpack/should_compile/bkp28.bkp | 17 + .../tests/backpack/should_compile/bkp28.stderr | 8 + testsuite/tests/backpack/should_compile/bkp29.bkp | 14 + .../tests/backpack/should_compile/bkp29.stderr | 7 + testsuite/tests/backpack/should_compile/bkp30.bkp | 15 + .../tests/backpack/should_compile/bkp30.stderr | 7 + testsuite/tests/backpack/should_compile/bkp31.bkp | 16 + .../tests/backpack/should_compile/bkp31.stderr | 8 + testsuite/tests/backpack/should_compile/bkp32.bkp | 92 +++ .../tests/backpack/should_compile/bkp32.stderr | 33 + testsuite/tests/backpack/should_compile/bkp33.bkp | 21 + .../tests/backpack/should_compile/bkp33.stderr | 14 + testsuite/tests/backpack/should_compile/bkp34.bkp | 20 + .../tests/backpack/should_compile/bkp34.stderr | 7 + testsuite/tests/backpack/should_compile/bkp35.bkp | 28 + testsuite/tests/backpack/should_compile/bkp36.bkp | 22 + .../tests/backpack/should_compile/bkp36.stderr | 9 + .../should_fail}/Makefile | 0 testsuite/tests/backpack/should_fail/all.T | 21 + testsuite/tests/backpack/should_fail/bkpfail01.bkp | 16 + .../tests/backpack/should_fail/bkpfail01.stderr | 17 + testsuite/tests/backpack/should_fail/bkpfail03.bkp | 10 + .../tests/backpack/should_fail/bkpfail03.stderr | 16 + testsuite/tests/backpack/should_fail/bkpfail04.bkp | 15 + .../tests/backpack/should_fail/bkpfail04.stderr | 15 + testsuite/tests/backpack/should_fail/bkpfail05.bkp | 22 + .../tests/backpack/should_fail/bkpfail05.stderr | 21 + testsuite/tests/backpack/should_fail/bkpfail06.bkp | 14 + .../tests/backpack/should_fail/bkpfail06.stderr | 19 + testsuite/tests/backpack/should_fail/bkpfail07.bkp | 10 + .../tests/backpack/should_fail/bkpfail07.stderr | 14 + testsuite/tests/backpack/should_fail/bkpfail09.bkp | 19 + .../tests/backpack/should_fail/bkpfail09.stderr | 15 + testsuite/tests/backpack/should_fail/bkpfail10.bkp | 18 + .../tests/backpack/should_fail/bkpfail10.stderr | 24 + testsuite/tests/backpack/should_fail/bkpfail11.bkp | 21 + .../tests/backpack/should_fail/bkpfail11.stderr | 18 + testsuite/tests/backpack/should_fail/bkpfail12.bkp | 14 + .../tests/backpack/should_fail/bkpfail12.stderr | 15 + testsuite/tests/backpack/should_fail/bkpfail13.bkp | 13 + .../tests/backpack/should_fail/bkpfail13.stderr | 15 + testsuite/tests/backpack/should_fail/bkpfail14.bkp | 18 + .../tests/backpack/should_fail/bkpfail14.stderr | 18 + testsuite/tests/backpack/should_fail/bkpfail15.bkp | 12 + testsuite/tests/backpack/should_fail/bkpfail16.bkp | 5 + .../tests/backpack/should_fail/bkpfail16.stderr | 10 + testsuite/tests/backpack/should_fail/bkpfail17.bkp | 6 + .../tests/backpack/should_fail/bkpfail17.stderr | 16 + testsuite/tests/backpack/should_fail/bkpfail18.bkp | 4 + .../tests/backpack/should_fail/bkpfail18.stderr | 12 + testsuite/tests/backpack/should_fail/bkpfail19.bkp | 5 + .../tests/backpack/should_fail/bkpfail19.stderr | 11 + testsuite/tests/backpack/should_fail/bkpfail20.bkp | 9 + .../tests/backpack/should_fail/bkpfail20.stderr | 9 + testsuite/tests/backpack/should_fail/bkpfail21.bkp | 13 + .../tests/backpack/should_fail/bkpfail21.stderr | 14 + testsuite/tests/backpack/should_fail/bkpfail22.bkp | 21 + .../tests/backpack/should_fail/bkpfail22.stderr | 1 + .../should_run}/Makefile | 0 testsuite/tests/backpack/should_run/all.T | 8 + testsuite/tests/backpack/should_run/bkprun01.bkp | 13 + .../should_run/bkprun01.stdout} | 0 testsuite/tests/backpack/should_run/bkprun02.bkp | 23 + .../should_run/bkprun02.stdout} | 0 testsuite/tests/backpack/should_run/bkprun03.bkp | 25 + .../tests/backpack/should_run/bkprun03.stdout | 0 testsuite/tests/backpack/should_run/bkprun04.bkp | 26 + .../should_run/bkprun04.stdout} | 0 testsuite/tests/backpack/should_run/bkprun05.bkp | 151 ++++ .../tests/backpack/should_run/bkprun05.stderr | 4 + .../should_run/bkprun05.stdout} | 0 testsuite/tests/backpack/should_run/bkprun06.bkp | 164 +++++ .../should_run/bkprun06.stdout} | 0 testsuite/tests/backpack/should_run/bkprun07.bkp | 32 + .../should_run/bkprun07.stdout} | 0 testsuite/tests/backpack/should_run/bkprun08.bkp | 24 + .../tests/backpack/should_run/bkprun08.stdout | 1 + testsuite/tests/cabal/cabal03/cabal03.stderr | 7 +- .../tests/driver/dynamicToo/dynamicToo005/Makefile | 14 +- .../dynamicToo/dynamicToo005/dynamicToo005.bkp | 6 + .../tests/driver/dynamicToo/dynamicToo006/A.hsig | 5 - .../tests/driver/dynamicToo/dynamicToo006/B.hs | 8 - .../tests/driver/dynamicToo/dynamicToo006/Makefile | 20 - .../tests/driver/dynamicToo/dynamicToo006/test.T | 9 - testsuite/tests/driver/recomp005/recomp005.stdout | 4 +- testsuite/tests/driver/sigof01/A.hs | 10 - testsuite/tests/driver/sigof01/B.hsig | 6 - testsuite/tests/driver/sigof01/Main.hs | 6 - testsuite/tests/driver/sigof01/Makefile | 19 - testsuite/tests/driver/sigof01/all.T | 9 - testsuite/tests/driver/sigof01/sigof01m.stdout | 7 - testsuite/tests/driver/sigof02/Double.hs | 13 - testsuite/tests/driver/sigof02/Main.hs | 11 - testsuite/tests/driver/sigof02/Makefile | 71 -- testsuite/tests/driver/sigof02/Map.hsig | 132 ---- testsuite/tests/driver/sigof02/MapAsSet.hsig | 11 - testsuite/tests/driver/sigof02/all.T | 41 -- testsuite/tests/driver/sigof02/sigof02.stderr | 4 - testsuite/tests/driver/sigof02/sigof02dm.stdout | 8 - testsuite/tests/driver/sigof02/sigof02dmt.stderr | 9 - testsuite/tests/driver/sigof02/sigof02dmt.stdout | 3 - testsuite/tests/driver/sigof02/sigof02dt.stderr | 9 - testsuite/tests/driver/sigof02/sigof02m.stderr | 4 - testsuite/tests/driver/sigof02/sigof02m.stdout | 9 - testsuite/tests/driver/sigof02/sigof02mt.stdout | 2 - testsuite/tests/driver/sigof03/A.hs | 3 - testsuite/tests/driver/sigof03/ASig1.hsig | 3 - testsuite/tests/driver/sigof03/ASig2.hsig | 3 - testsuite/tests/driver/sigof03/Main.hs | 3 - testsuite/tests/driver/sigof03/Makefile | 26 - testsuite/tests/driver/sigof03/all.T | 11 - testsuite/tests/driver/sigof04/Makefile | 10 - testsuite/tests/driver/sigof04/Sig.hsig | 2 - testsuite/tests/driver/sigof04/all.T | 4 - testsuite/tests/driver/sigof04/sigof04.stderr | 3 - testsuite/tests/ghci/scripts/T5979.stderr | 6 +- .../haddock/haddock_examples/haddock.Test.stderr | 16 +- .../should_fail/T11167_ambiguous_fixity.stderr | 4 +- testsuite/tests/package/package07e.stderr | 13 +- testsuite/tests/package/package08e.stderr | 13 +- testsuite/tests/perf/haddock/all.T | 3 +- testsuite/tests/plugins/T11244.stderr | 3 +- testsuite/tests/safeHaskell/check/Check07.stderr | 4 +- testsuite/tests/safeHaskell/check/Check08.stderr | 6 +- .../safeHaskell/safeLanguage/SafeLang12.stderr | 3 +- testsuite/tests/typecheck/should_compile/all.T | 1 - .../tests/typecheck/should_compile/tc264.hsig | 2 - .../tests/typecheck/should_fail/T6018fail.stderr | 8 +- testsuite/tests/typecheck/should_fail/all.T | 4 - .../tests/typecheck/should_fail/tcfail219.hsig | 2 - .../tests/typecheck/should_fail/tcfail219.stderr | 3 - .../tests/typecheck/should_fail/tcfail220.hsig | 4 - .../tests/typecheck/should_fail/tcfail220.stderr | 9 - .../tests/typecheck/should_fail/tcfail221.hsig | 3 - .../tests/typecheck/should_fail/tcfail221.stderr | 6 - .../tests/typecheck/should_fail/tcfail222.hsig | 2 - .../tests/typecheck/should_fail/tcfail222.stderr | 4 - utils/ghc-pkg/Main.hs | 56 +- 277 files changed, 7296 insertions(+), 1242 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 00b530d5402aaa37e4085ecdcae0ae54454736c1 From git at git.haskell.org Sat Oct 8 08:38:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:21 +0000 (UTC) Subject: [commit: ghc] master: Note about external interface changes. (3b9e45e) Message-ID: <20161008083821.9CDA53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3b9e45e587447b20e7a8cbe33424f9a4b1b4ec72/ghc >--------------------------------------------------------------- commit 3b9e45e587447b20e7a8cbe33424f9a4b1b4ec72 Author: Edward Z. Yang Date: Mon Aug 29 21:20:58 2016 -0700 Note about external interface changes. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 3b9e45e587447b20e7a8cbe33424f9a4b1b4ec72 compiler/main/GhcMake.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 0705b14..0adee6e 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -601,6 +601,11 @@ unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' - Note that objects are only considered stable if they only depend on other objects. We can't link object code against byte code. + + - Note that even if an object is stable, we may end up recompiling + if the interface is out of date because an *external* interface + has changed. The current code in GhcMake handles this case + fairly poorly, so be careful. -} checkStability :: HomePackageTable -- HPT from last compilation From git at git.haskell.org Sat Oct 8 08:38:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:25 +0000 (UTC) Subject: [commit: ghc] master: Tc267, tests what happens if you forgot to knot-tie. (082991a) Message-ID: <20161008083825.12AC23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/082991a89174f814ab12535a0ffbc06183d917e1/ghc >--------------------------------------------------------------- commit 082991a89174f814ab12535a0ffbc06183d917e1 Author: Edward Z. Yang Date: Wed Aug 24 22:11:07 2016 -0700 Tc267, tests what happens if you forgot to knot-tie. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 082991a89174f814ab12535a0ffbc06183d917e1 testsuite/driver/extra_files.py | 1 + testsuite/tests/typecheck/should_compile/Makefile | 8 ++++++++ testsuite/tests/typecheck/should_compile/Tc267a.hs | 6 ++++++ testsuite/tests/typecheck/should_compile/Tc267a.hs-boot | 4 ++++ testsuite/tests/typecheck/should_compile/Tc267b.hs | 4 ++++ testsuite/tests/typecheck/should_compile/Tc267b.hs-boot | 3 +++ testsuite/tests/typecheck/should_compile/all.T | 4 ++++ 7 files changed, 30 insertions(+) diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py index 3f1e75b..b507826 100644 --- a/testsuite/driver/extra_files.py +++ b/testsuite/driver/extra_files.py @@ -540,6 +540,7 @@ extra_src_files = { 'tc251': ['Tc251_Help.hs'], 'tc263': ['Tc263_Help.hs'], 'tc266': ['Tc266.hs', 'Tc266a.hs', 'Tc266.hs-boot'], + 'Tc267': ['Tc267a.hs', 'Tc267b.hs', 'Tc267a.hs-boot', 'Tc267b.hs-boot'], 'tcfail186': ['Tcfail186_Help.hs'], 'tcrun025': ['TcRun025_B.hs'], 'tcrun038': ['TcRun038_B.hs'], diff --git a/testsuite/tests/typecheck/should_compile/Makefile b/testsuite/tests/typecheck/should_compile/Makefile index 8f3bc61..7af8ae1 100644 --- a/testsuite/tests/typecheck/should_compile/Makefile +++ b/testsuite/tests/typecheck/should_compile/Makefile @@ -42,3 +42,11 @@ tc266: '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc266.hs-boot '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc266a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc266.hs + +Tc267: + $(RM) -f Tc267a.hi-boot Tc267a.o-boot Tc267b.hi-boot Tc267b.o-boot + $(RM) -f Tc267a.hi Tc267a.o Tc267b.hi Tc267b.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc267a.hs-boot + '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc267b.hs-boot + '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc267a.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc267b.hs diff --git a/testsuite/tests/typecheck/should_compile/Tc267a.hs b/testsuite/tests/typecheck/should_compile/Tc267a.hs new file mode 100644 index 0000000..cf74645 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/Tc267a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Tc267a where +import {-# SOURCE #-} Tc267b +data T = T deriving (Show) +data S = S +x = y diff --git a/testsuite/tests/typecheck/should_compile/Tc267a.hs-boot b/testsuite/tests/typecheck/should_compile/Tc267a.hs-boot new file mode 100644 index 0000000..66dab26 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/Tc267a.hs-boot @@ -0,0 +1,4 @@ +module Tc267a where +data T +data S +instance Show T diff --git a/testsuite/tests/typecheck/should_compile/Tc267b.hs b/testsuite/tests/typecheck/should_compile/Tc267b.hs new file mode 100644 index 0000000..56abf6d --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/Tc267b.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Tc267b where +import Tc267a +y = S diff --git a/testsuite/tests/typecheck/should_compile/Tc267b.hs-boot b/testsuite/tests/typecheck/should_compile/Tc267b.hs-boot new file mode 100644 index 0000000..cc6fa27 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/Tc267b.hs-boot @@ -0,0 +1,3 @@ +module Tc267b where +import {-# SOURCE #-} Tc267a +y :: S diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 28d7369..3ffdcf7 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -363,6 +363,10 @@ test('tc266', [extra_clean(['Tc266.hi-boot', 'Tc266.o-boot', 'Tc266a.hi', 'Tc266a.o', 'Tc266.hi', 'Tc266.o']), run_timeout_multiplier(0.01)] , run_command, ['$MAKE -s --no-print-directory tc266']) +test('Tc267', + extra_clean(['Tc267a.hi-boot', 'Tc267a.o-boot', 'Tc267b.hi-boot', 'Tc267b.o-boot', 'Tc267a.hi', 'Tc267a.o', 'Tc267b.hi', 'Tc267b.o']), + run_command, + ['$MAKE -s --no-print-directory Tc267']) test('GivenOverlapping', normal, compile, ['']) test('GivenTypeSynonym', normal, compile, ['']) From git at git.haskell.org Sat Oct 8 08:38:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:28 +0000 (UTC) Subject: [commit: ghc] master: Distinguish between UnitId and InstalledUnitId. (4e8a060) Message-ID: <20161008083828.2C6AC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e8a0607140b23561248a41aeaf837224aa6315b/ghc >--------------------------------------------------------------- commit 4e8a0607140b23561248a41aeaf837224aa6315b Author: Edward Z. Yang Date: Thu Oct 6 00:17:15 2016 -0700 Distinguish between UnitId and InstalledUnitId. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 4e8a0607140b23561248a41aeaf837224aa6315b compiler/backpack/DriverBkp.hs | 13 +- compiler/basicTypes/Module.hs | 376 +++++++++++++-------- compiler/deSugar/Desugar.hs | 4 +- compiler/ghci/Linker.hs | 27 +- compiler/iface/LoadIface.hs | 40 ++- compiler/iface/MkIface.hs | 8 +- compiler/iface/TcIface.hs | 2 +- compiler/main/CodeOutput.hs | 6 +- compiler/main/DriverPipeline.hs | 24 +- compiler/main/Finder.hs | 203 +++++++---- compiler/main/GHC.hs | 6 +- compiler/main/GhcMake.hs | 3 +- compiler/main/HscMain.hs | 22 +- compiler/main/HscTypes.hs | 27 +- compiler/main/PackageConfig.hs | 23 +- compiler/main/Packages.hs | 186 ++++++---- compiler/main/SysTools.hs | 4 +- compiler/rename/RnNames.hs | 7 +- compiler/typecheck/TcBackpack.hs | 13 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 4 +- ghc/GHCi/UI.hs | 5 +- ghc/Main.hs | 4 +- libraries/ghc-boot/GHC/PackageDb.hs | 14 +- .../tests/backpack/cabal/bkpcabal01/.gitignore | 2 + testsuite/tests/cabal/cabal05/cabal05.stderr | 2 +- testsuite/tests/cabal/ghcpkg01.stdout | 6 + testsuite/tests/cabal/ghcpkg04.stderr | 4 +- testsuite/tests/driver/driver063.stderr | 2 +- testsuite/tests/ghc-e/should_run/T2636.stderr | 2 +- testsuite/tests/module/mod1.stderr | 4 +- testsuite/tests/module/mod2.stderr | 4 +- testsuite/tests/package/package01e.stderr | 4 +- testsuite/tests/package/package06e.stderr | 12 +- testsuite/tests/package/package07e.stderr | 8 +- testsuite/tests/package/package08e.stderr | 8 +- testsuite/tests/package/package09e.stderr | 4 +- testsuite/tests/perf/compiler/parsing001.stderr | 4 +- .../safeHaskell/safeLanguage/SafeLang07.stderr | 6 +- testsuite/tests/th/T10279.stderr | 12 +- .../tests/typecheck/should_fail/tcfail082.stderr | 12 +- utils/ghc-pkg/Main.hs | 13 +- 42 files changed, 700 insertions(+), 432 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 4e8a0607140b23561248a41aeaf837224aa6315b From git at git.haskell.org Sat Oct 8 08:38:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:30 +0000 (UTC) Subject: [commit: ghc] master: Make InstalledUnitId be ONLY a FastString. (5bd8e8d) Message-ID: <20161008083830.E27413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5bd8e8d30c046187f2804db3af1768ea8b07dc41/ghc >--------------------------------------------------------------- commit 5bd8e8d30c046187f2804db3af1768ea8b07dc41 Author: Edward Z. Yang Date: Thu Oct 6 13:40:10 2016 -0700 Make InstalledUnitId be ONLY a FastString. It turns out that we don't really need to be able to extract a ComponentId from UnitId, except in one case. So compress UnitId into a single FastString. The one case where we do need the ComponentId is when we are compiling an instantiated version of a package; we need the ComponentId to look up the indefinite version of this package from the database. So now we just pass it in as an argument -this-component-id. Also: ghc-pkg now no longer will unregister a package if you register one with the same package name, if the instantiations don't match. Cabal submodule update which tracks the same data type change. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 5bd8e8d30c046187f2804db3af1768ea8b07dc41 compiler/backpack/DriverBkp.hs | 27 +++-- compiler/basicTypes/Module.hs | 235 +++++++++++++++--------------------- compiler/basicTypes/Module.hs-boot | 1 + compiler/iface/LoadIface.hs | 7 +- compiler/main/DynFlags.hs | 72 ++++++----- compiler/main/Finder.hs | 2 +- compiler/main/GhcMake.hs | 4 +- compiler/main/HscTypes.hs | 7 +- compiler/main/PackageConfig.hs | 5 +- compiler/main/Packages.hs | 42 ++++--- compiler/main/Packages.hs-boot | 3 +- compiler/typecheck/TcBackpack.hs | 25 ++-- libraries/Cabal | 2 +- libraries/ghc-boot/GHC/PackageDb.hs | 56 ++++----- utils/ghc-pkg/Main.hs | 17 +-- 15 files changed, 251 insertions(+), 254 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 5bd8e8d30c046187f2804db3af1768ea8b07dc41 From git at git.haskell.org Sat Oct 8 08:38:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:33 +0000 (UTC) Subject: [commit: ghc] master: Update haddock.Cabal perf for Cabal update. (027a086) Message-ID: <20161008083833.986943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/027a0865675f17f9b3338c57b2e21c2b23b7b6aa/ghc >--------------------------------------------------------------- commit 027a0865675f17f9b3338c57b2e21c2b23b7b6aa Author: Edward Z. Yang Date: Thu Oct 6 18:19:22 2016 -0700 Update haddock.Cabal perf for Cabal update. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 027a0865675f17f9b3338c57b2e21c2b23b7b6aa 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 ec2cce1..f2083a1 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -52,7 +52,7 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 21554874976, 5) + [(wordsize(64), 23706190072, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -90,6 +90,7 @@ test('haddock.Cabal', # the stats are comparable. # 2016-10-01: 20619433656 (amd64/Linux) - Cabal update # 2016-10-03: 21554874976 (amd64/Linux) - Cabal update + # 2016-10-06: 23706190072 (amd64/Linux) - Cabal update ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) From git at git.haskell.org Sat Oct 8 08:38:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:36 +0000 (UTC) Subject: [commit: ghc] master: Cabal submodule update. (46b78e6) Message-ID: <20161008083836.48E5E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46b78e604c06c8878e436fea93729158dcf55269/ghc >--------------------------------------------------------------- commit 46b78e604c06c8878e436fea93729158dcf55269 Author: Edward Z. Yang Date: Thu Oct 6 23:20:38 2016 -0700 Cabal submodule update. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 46b78e604c06c8878e436fea93729158dcf55269 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 579fd67..36dbbf7 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 579fd676a6f066775dcce9427c8463d0dbae101f +Subproject commit 36dbbf724aba6e23981f5195550965fd679f1b6b From git at git.haskell.org Sat Oct 8 08:38:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 08:38:38 +0000 (UTC) Subject: [commit: ghc] master: Report that we support Backpack in --info. (61b143a) Message-ID: <20161008083838.F238E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/61b143afa4cdf4ddf3aca018b581ae38f4240aca/ghc >--------------------------------------------------------------- commit 61b143afa4cdf4ddf3aca018b581ae38f4240aca Author: Edward Z. Yang Date: Thu Oct 6 23:20:19 2016 -0700 Report that we support Backpack in --info. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 61b143afa4cdf4ddf3aca018b581ae38f4240aca compiler/main/DynFlags.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index cb28664..7978c03 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -4797,6 +4797,8 @@ compilerInfo dflags ("Support reexported-modules", "YES"), -- Whether or not we support extended @-package foo (Foo)@ syntax. ("Support thinning and renaming package flags", "YES"), + -- Whether or not we support Backpack. + ("Support Backpack", "YES"), -- If true, we require that the 'id' field in installed package info -- match what is passed to the @-this-unit-id@ flag for modules -- built in it From git at git.haskell.org Sat Oct 8 09:08:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 09:08:40 +0000 (UTC) Subject: [commit: ghc] master: Rework renaming of children in export lists. (e660f4b) Message-ID: <20161008090840.7F3F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e660f4bf546e90fb6719ad268ca3daaecdce4b82/ghc >--------------------------------------------------------------- commit e660f4bf546e90fb6719ad268ca3daaecdce4b82 Author: Matthew Pickering Date: Sat Oct 8 10:06:01 2016 +0100 Rework renaming of children in export lists. The target of this patch is exports such as: ``` module Foo ( T(A, B, C) ) where ``` Essentially this patch makes sure that we use the correct lookup functions in order to lookup the names in parent-children export lists. This change highlighted the complexity of this small part of GHC which accounts for the scale. This change was motivated by wanting to remove the `PatternSynonym` constructor from `Parent`. As with all these things, it quickly spiraled out of control into a much larger refactor. Reviewers: simonpj, goldfire, bgamari, austin Subscribers: adamgundry, thomie Differential Revision: https://phabricator.haskell.org/D2179 GHC Trac Issues: #11970 >--------------------------------------------------------------- e660f4bf546e90fb6719ad268ca3daaecdce4b82 compiler/basicTypes/Avail.hs | 38 +- compiler/basicTypes/RdrName.hs | 26 +- compiler/ghc.cabal.in | 1 + compiler/iface/LoadIface.hs | 2 +- compiler/iface/MkIface.hs | 2 +- compiler/main/HscTypes.hs | 2 +- compiler/rename/RnEnv.hs | 4 +- compiler/rename/RnExpr.hs | 2 +- compiler/rename/RnNames.hs | 449 +---------- compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 140 +--- compiler/typecheck/TcRnExports.hs | 848 +++++++++++++++++++++ compiler/typecheck/TcRnMonad.hs | 23 +- compiler/typecheck/TcType.hs | 2 +- compiler/types/TyCoRep.hs | 19 +- compiler/utils/Util.hs | 10 +- testsuite/tests/module/MultiExport.hs | 6 + testsuite/tests/module/MultiExport.stderr | 3 + testsuite/tests/module/T11970.hs | 19 + testsuite/tests/module/T11970.stderr | 12 + testsuite/tests/module/T11970A.hs | 3 + testsuite/tests/module/T11970A.stderr | 5 + testsuite/tests/module/T11970A1.hs | 3 + testsuite/tests/module/T11970B.hs | 5 + testsuite/tests/module/T11970B.stderr | 5 + testsuite/tests/module/all.T | 4 + testsuite/tests/module/mod10.stderr | 4 +- testsuite/tests/module/mod17.stderr | 8 +- testsuite/tests/module/mod3.stderr | 8 +- testsuite/tests/module/mod4.stderr | 7 +- .../overloadedrecflds/should_fail/NoParent.hs | 6 + .../overloadedrecflds/should_fail/NoParent.stderr | 6 + .../tests/overloadedrecflds/should_fail/all.T | 1 + .../tests/patsyn/should_fail/export-class.stderr | 5 +- 34 files changed, 1021 insertions(+), 659 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 e660f4bf546e90fb6719ad268ca3daaecdce4b82 From git at git.haskell.org Sat Oct 8 09:30:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 09:30:35 +0000 (UTC) Subject: [commit: ghc] master: Add trailing comma to fix the build. (f2d80de) Message-ID: <20161008093035.0220B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f2d80de4b6aa7c3b5b9da20d7569907662d39bbe/ghc >--------------------------------------------------------------- commit f2d80de4b6aa7c3b5b9da20d7569907662d39bbe Author: Matthew Pickering Date: Sat Oct 8 10:28:47 2016 +0100 Add trailing comma to fix the build. >--------------------------------------------------------------- f2d80de4b6aa7c3b5b9da20d7569907662d39bbe compiler/rename/RnNames.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 5ea5dac..3b37b18 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -13,7 +13,7 @@ module RnNames ( calculateAvails, reportUnusedNames, plusAvail, - checkConName + checkConName, nubAvails, mkChildEnv, findChildren, From git at git.haskell.org Sat Oct 8 10:29:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 10:29:42 +0000 (UTC) Subject: [commit: ghc] master: Fix build (21647bc) Message-ID: <20161008102942.B76EF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21647bcd6fe8206840bdcc7b747c7cc60c0c3db8/ghc >--------------------------------------------------------------- commit 21647bcd6fe8206840bdcc7b747c7cc60c0c3db8 Author: Csongor Kiss Date: Sat Oct 8 11:28:22 2016 +0100 Fix build - interaction between backpack and export list refactoring introduced a few syntax errors, and constructor arity mismatches - CPP macro used in backpack was not accepted by clang because of extraneous whitespace Signed-off-by: Csongor Kiss Reviewers: austin, bgamari, mpickering Reviewed By: mpickering Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2582 >--------------------------------------------------------------- 21647bcd6fe8206840bdcc7b747c7cc60c0c3db8 compiler/backpack/NameShape.hs | 4 ++-- compiler/backpack/RnModIface.hs | 2 +- compiler/deSugar/Desugar.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/backpack/NameShape.hs b/compiler/backpack/NameShape.hs index 568d700..0a2d7ca 100644 --- a/compiler/backpack/NameShape.hs +++ b/compiler/backpack/NameShape.hs @@ -167,7 +167,7 @@ substName env n | Just n' <- lookupNameEnv env n = n' -- for type constructors, where it is sufficient to substitute the 'availName' -- to induce a substitution on 'availNames'. substNameAvailInfo :: HscEnv -> ShNameSubst -> AvailInfo -> IO AvailInfo -substNameAvailInfo _ env (Avail p n) = return (Avail p (substName env n)) +substNameAvailInfo _ env (Avail n) = return (Avail (substName env n)) substNameAvailInfo hsc_env env (AvailTC n ns fs) = let mb_mod = fmap nameModule (lookupNameEnv env n) in AvailTC (substName env n) @@ -243,7 +243,7 @@ uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $ -- with only name holes from @flexi@ unifiable (all other name holes rigid.) uAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo -> Either SDoc ShNameSubst -uAvailInfo flexi subst (Avail _ n1) (Avail _ n2) = uName flexi subst n1 n2 +uAvailInfo flexi subst (Avail n1) (Avail n2) = uName flexi subst n1 n2 uAvailInfo flexi subst (AvailTC n1 _ _) (AvailTC n2 _ _) = uName flexi subst n1 n2 uAvailInfo _ _ a1 a2 = Left $ text "While merging export lists, could not combine" <+> ppr a1 <+> text "with" <+> ppr a2 diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs index 536f0b0..b90edd9 100644 --- a/compiler/backpack/RnModIface.hs +++ b/compiler/backpack/RnModIface.hs @@ -140,7 +140,7 @@ rnModule mod = do return (renameHoleModule dflags hmap mod) rnAvailInfo :: Rename AvailInfo -rnAvailInfo (Avail p n) = Avail p <$> rnIfaceGlobal n +rnAvailInfo (Avail n) = Avail <$> rnIfaceGlobal n rnAvailInfo (AvailTC n ns fs) = do -- Why don't we rnIfaceGlobal the availName itself? It may not -- actually be exported by the module it putatively is from, in diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 1f589a9..28ec706 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -369,7 +369,7 @@ deSugar hsc_env ; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names dep_files merged -- id_mod /= mod when we are processing an hsig, but hsigs -- never desugared and compiled (there's no code!) - ; MASSERT ( id_mod == mod ) + ; MASSERT( id_mod == mod ) ; let mod_guts = ModGuts { mg_module = mod, From git at git.haskell.org Sat Oct 8 16:15:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:16 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Merge remote-tracking branch 'origin/master' into wip/hasfield (4dd3636) Message-ID: <20161008161516.501273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/4dd3636f46ed0a413ccc554d413fd163975d2781/ghc >--------------------------------------------------------------- commit 4dd3636f46ed0a413ccc554d413fd163975d2781 Merge: b50eb34 46b78e6 Author: Adam Gundry Date: Sat Oct 8 11:39:48 2016 +0100 Merge remote-tracking branch 'origin/master' into wip/hasfield Conflicts: compiler/hsSyn/PlaceHolder.hs compiler/prelude/PrelNames.hs compiler/typecheck/TcEvidence.hs compiler/typecheck/TcInteract.hs compiler/typecheck/TcSMonad.hs testsuite/tests/overloadedrecflds/should_run/all.T >--------------------------------------------------------------- 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 4dd3636f46ed0a413ccc554d413fd163975d2781 From git at git.haskell.org Sat Oct 8 16:15:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:19 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Remove Proxy# argument from GHC.OverloadedLabels.fromLabel (3b80b75) Message-ID: <20161008161519.0E5973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/3b80b754f1bc4e3d82d2b1abb927a75821247b33/ghc >--------------------------------------------------------------- commit 3b80b754f1bc4e3d82d2b1abb927a75821247b33 Author: Adam Gundry Date: Sat Oct 8 12:05:03 2016 +0100 Remove Proxy# argument from GHC.OverloadedLabels.fromLabel >--------------------------------------------------------------- 3b80b754f1bc4e3d82d2b1abb927a75821247b33 compiler/typecheck/TcExpr.hs | 14 +++++--------- libraries/base/GHC/OverloadedLabels.hs | 9 ++++----- .../overloadedrecflds/ghci/overloadedlabelsghci01.script | 4 ++-- .../should_run/OverloadedLabelsRun04_A.hs | 2 +- .../overloadedrecflds/should_run/overloadedlabelsrun01.hs | 4 ++-- .../overloadedrecflds/should_run/overloadedlabelsrun02.hs | 4 ++-- .../overloadedrecflds/should_run/overloadedlabelsrun03.hs | 2 +- 7 files changed, 17 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 8ae454c..3a5f715 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -224,12 +224,9 @@ tcExpr e@(HsOverLabel l) res_ty -- See Note [Type-checking overloaded labels] pred = mkClassPred isLabelClass [lbl, alpha] ; loc <- getSrcSpanM ; var <- emitWantedEvVar origin pred - ; let proxy_arg = L loc (mkHsWrap (mkWpTyApps [typeSymbolKind, lbl]) - (HsVar (L loc proxyHashId))) - tm = L loc (fromDict pred (HsVar (L loc var))) `HsApp` proxy_arg - ; tcWrapResult e tm alpha res_ty } + ; tcWrapResult e (fromDict pred (HsVar (L loc var))) alpha res_ty } where - -- Coerces a dictionary for `IsLabel "x" t` into `Proxy# x -> t`. + -- Coerces a dictionary for `IsLabel "x" t` into `t`. fromDict pred = HsWrap $ mkWpCastR $ unwrapIP pred origin = OverLabelOrigin l @@ -269,16 +266,15 @@ Note [Type-checking overloaded labels] Recall that (in GHC.OverloadedLabels) we have class IsLabel (x :: Symbol) a where - fromLabel :: Proxy# x -> a + fromLabel :: a When we see an overloaded label like `#foo`, we generate a fresh variable `alpha` for the type and emit an `IsLabel "foo" alpha` constraint. Because the `IsLabel` class has a single method, it is represented by a newtype, so we can coerce `IsLabel "foo" alpha` to -`Proxy# "foo" -> alpha` (just like for implicit parameters). We then -apply it to `proxy#` of type `Proxy# "foo"`. +`alpha` (just like for implicit parameters). -That is, we translate `#foo` to `fromLabel (proxy# :: Proxy# "foo")`. +That is, we translate `#foo` to `fromLabel @"foo"`. -} diff --git a/libraries/base/GHC/OverloadedLabels.hs b/libraries/base/GHC/OverloadedLabels.hs index f4a76cf..3a3449d 100644 --- a/libraries/base/GHC/OverloadedLabels.hs +++ b/libraries/base/GHC/OverloadedLabels.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE NoImplicitPrelude +{-# LANGUAGE AllowAmbiguousTypes + , NoImplicitPrelude , MultiParamTypeClasses - , MagicHash , KindSignatures , DataKinds #-} @@ -23,7 +23,7 @@ -- The key idea is that when GHC sees an occurrence of the new -- overloaded label syntax @#foo@, it is replaced with -- --- > fromLabel (proxy# :: Proxy# "foo") :: alpha +-- > fromLabel @"foo" :: alpha -- -- plus a wanted constraint @IsLabel "foo" alpha at . -- @@ -42,7 +42,6 @@ module GHC.OverloadedLabels ) where import GHC.Base ( Symbol ) -import GHC.Exts ( Proxy# ) class IsLabel (x :: Symbol) a where - fromLabel :: Proxy# x -> a + fromLabel :: a diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script index 3b5dde1..70efb79 100644 --- a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script +++ b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script @@ -2,8 +2,8 @@ :t #x :m + GHC.OverloadedLabels :seti -XFlexibleInstances -XFlexibleContexts -XTypeFamilies -XMultiParamTypeClasses -instance IsLabel x [Char] where fromLabel _ = "hello" -instance (s ~ [Char], t ~ [Char]) => IsLabel x (s -> t) where fromLabel _ = (++ " world") +instance IsLabel x [Char] where fromLabel = "hello" +instance (s ~ [Char], t ~ [Char]) => IsLabel x (s -> t) where fromLabel = (++ " world") #x :: String #x #y :{ diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs index e3b38c2..8c3b992 100644 --- a/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs @@ -5,4 +5,4 @@ import GHC.OverloadedLabels import Language.Haskell.TH instance IsLabel x (Q [Dec]) where - fromLabel _ = [d| main = putStrLn "Ok" |] + fromLabel = [d| main = putStrLn "Ok" |] diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs index 45c7854..972932c 100644 --- a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs @@ -11,10 +11,10 @@ import GHC.OverloadedLabels instance IsLabel "true" Bool where - fromLabel _ = True + fromLabel = True instance IsLabel "false" Bool where - fromLabel _ = False + fromLabel = False a :: IsLabel "true" t => t a = #true diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs index eea8f36..94f8d0c 100644 --- a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs @@ -20,7 +20,7 @@ import Data.Proxy ( Proxy(..) ) import GHC.TypeLits ( Symbol ) instance x ~ y => IsLabel x (Proxy y) where - fromLabel _ = Proxy + fromLabel = Proxy data Elem (x :: Symbol) g where Top :: Elem x (x ': g) @@ -45,7 +45,7 @@ data Tm g where deriving instance Show (Tm g) instance IsElem x g => IsLabel x (Tm g) where - fromLabel _ = Var (which :: Elem x g) + fromLabel = Var (which :: Elem x g) lam :: Proxy x -> Tm (x ': g) -> Tm g lam _ = Lam diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs index a854d7a..f84a380 100644 --- a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs @@ -15,7 +15,7 @@ import Data.Proxy ( Proxy(..) ) import GHC.TypeLits ( KnownSymbol, symbolVal ) instance (KnownSymbol x, c ~ Char) => IsLabel x [c] where - fromLabel _ = symbolVal (Proxy :: Proxy x) + fromLabel = symbolVal (Proxy :: Proxy x) main = do putStrLn #x print $ #x ++ #y From git at git.haskell.org Sat Oct 8 16:15:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:21 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Remove Proxy# argument from HasField and make poly-kinded (319ec37) Message-ID: <20161008161521.DB5343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/319ec378d3d5ada0a1e5c12351baf2fa2dea6591/ghc >--------------------------------------------------------------- commit 319ec378d3d5ada0a1e5c12351baf2fa2dea6591 Author: Adam Gundry Date: Sat Oct 8 13:12:24 2016 +0100 Remove Proxy# argument from HasField and make poly-kinded >--------------------------------------------------------------- 319ec378d3d5ada0a1e5c12351baf2fa2dea6591 compiler/typecheck/TcInteract.hs | 32 ++++------------------ libraries/base/GHC/Records.hs | 17 +++++++----- .../should_fail/hasfieldfail01.hs | 5 ++-- .../should_fail/hasfieldfail01.stderr | 11 ++++---- .../should_fail/hasfieldfail02.hs | 8 +++--- .../should_fail/hasfieldfail02.stderr | 12 ++++---- .../overloadedrecflds/should_run/hasfieldrun01.hs | 21 ++++++++------ .../overloadedrecflds/should_run/hasfieldrun02.hs | 5 ++-- 8 files changed, 48 insertions(+), 63 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 319ec378d3d5ada0a1e5c12351baf2fa2dea6591 From git at git.haskell.org Sat Oct 8 16:15:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:24 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Extend extra_files for hasfieldfail01 (93c1ca8) Message-ID: <20161008161524.ACF263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/93c1ca8676325f6b13c090f8db04458c9fdce712/ghc >--------------------------------------------------------------- commit 93c1ca8676325f6b13c090f8db04458c9fdce712 Author: Adam Gundry Date: Sat Oct 8 13:12:45 2016 +0100 Extend extra_files for hasfieldfail01 >--------------------------------------------------------------- 93c1ca8676325f6b13c090f8db04458c9fdce712 testsuite/driver/extra_files.py | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py index 5918523..a45d0f2 100644 --- a/testsuite/driver/extra_files.py +++ b/testsuite/driver/extra_files.py @@ -410,6 +410,7 @@ extra_src_files = { 'overloadedrecfldsfail11': ['OverloadedRecFldsFail11_A.hs'], 'overloadedrecfldsfail12': ['OverloadedRecFldsFail12_A.hs'], 'overloadedrecfldsrun02': ['OverloadedRecFldsRun02_A.hs'], + 'hasfieldfail01': ['HasFieldFail01_A.hs'], 'p10': ['D.hs'], 'p11': ['E.hs'], 'p13': ['P13_A.hs'], From git at git.haskell.org Sat Oct 8 16:15:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:27 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Add IsLabel (->) instance (d2df666) Message-ID: <20161008161527.B2D9E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/d2df6663d9874333e0593af4f95c11ba6de1f7b3/ghc >--------------------------------------------------------------- commit d2df6663d9874333e0593af4f95c11ba6de1f7b3 Author: Adam Gundry Date: Sat Oct 8 13:17:53 2016 +0100 Add IsLabel (->) instance >--------------------------------------------------------------- d2df6663d9874333e0593af4f95c11ba6de1f7b3 libraries/base/GHC/OverloadedLabels.hs | 13 ++++++++++--- .../tests/overloadedrecflds/should_run/hasfieldrun02.hs | 6 +----- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/libraries/base/GHC/OverloadedLabels.hs b/libraries/base/GHC/OverloadedLabels.hs index 3a3449d..7dcfdc6 100644 --- a/libraries/base/GHC/OverloadedLabels.hs +++ b/libraries/base/GHC/OverloadedLabels.hs @@ -1,8 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes - , NoImplicitPrelude - , MultiParamTypeClasses - , KindSignatures , DataKinds + , FlexibleInstances + , KindSignatures + , MultiParamTypeClasses + , NoImplicitPrelude + , ScopedTypeVariables + , TypeApplications #-} ----------------------------------------------------------------------------- @@ -42,6 +45,10 @@ module GHC.OverloadedLabels ) where import GHC.Base ( Symbol ) +import qualified GHC.Records class IsLabel (x :: Symbol) a where fromLabel :: a + +instance GHC.Records.HasField x r a => IsLabel x (r -> a) where + fromLabel = GHC.Records.fromLabel @x diff --git a/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs index ce0173a..121f35e 100644 --- a/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs +++ b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DuplicateRecordFields, OverloadedLabels, ExistentialQuantification, - FlexibleInstances, MultiParamTypeClasses, - ScopedTypeVariables, TypeApplications #-} + FlexibleInstances, MultiParamTypeClasses #-} import GHC.OverloadedLabels (IsLabel(..)) import GHC.Records (HasField(..)) @@ -9,8 +8,5 @@ import GHC.Records (HasField(..)) data S = MkS { foo :: Int } data T x y z = forall b . MkT { foo :: y, bar :: b } -instance HasField x r a => IsLabel x (r -> a) where - fromLabel = GHC.Records.fromLabel @x - main = do print (#foo (MkS 42)) print (#foo (MkT True False)) From git at git.haskell.org Sat Oct 8 16:15:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:30 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Rename overloadedrecfldsghci01 test to duplicaterecfldsghci01 (f906047) Message-ID: <20161008161530.6A4E33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/f9060470224be40bef8667541302a97e58decd73/ghc >--------------------------------------------------------------- commit f9060470224be40bef8667541302a97e58decd73 Author: Adam Gundry Date: Sat Oct 8 13:48:06 2016 +0100 Rename overloadedrecfldsghci01 test to duplicaterecfldsghci01 >--------------------------------------------------------------- f9060470224be40bef8667541302a97e58decd73 testsuite/tests/overloadedrecflds/ghci/all.T | 2 +- .../{overloadedrecfldsghci01.script => duplicaterecfldsghci01.script} | 0 .../{overloadedrecfldsghci01.stdout => duplicaterecfldsghci01.stdout} | 0 3 files changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/overloadedrecflds/ghci/all.T b/testsuite/tests/overloadedrecflds/ghci/all.T index c67d42f..6a95bb2 100644 --- a/testsuite/tests/overloadedrecflds/ghci/all.T +++ b/testsuite/tests/overloadedrecflds/ghci/all.T @@ -1,2 +1,2 @@ -test('overloadedrecfldsghci01', combined_output, ghci_script, ['overloadedrecfldsghci01.script']) +test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsghci01.script']) test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script']) diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.script similarity index 100% rename from testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script rename to testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.script diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout similarity index 100% rename from testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout rename to testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout From git at git.haskell.org Sat Oct 8 16:15:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:33 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Reintroduce OverloadedRecordFields extension, with specialised behaviour (307ab8e) Message-ID: <20161008161533.B06633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/307ab8ed1c15b7ea779f00389cca11e44dbeb44d/ghc >--------------------------------------------------------------- commit 307ab8ed1c15b7ea779f00389cca11e44dbeb44d Author: Adam Gundry Date: Sat Oct 8 14:39:52 2016 +0100 Reintroduce OverloadedRecordFields extension, with specialised behaviour >--------------------------------------------------------------- 307ab8ed1c15b7ea779f00389cca11e44dbeb44d compiler/main/DynFlags.hs | 1 + compiler/parser/Lexer.x | 3 +- compiler/typecheck/TcExpr.hs | 52 +++++++++++++++------- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + testsuite/tests/overloadedrecflds/ghci/all.T | 1 + .../ghci/overloadedrecfldsghci01.script | 8 ++++ .../ghci/overloadedrecfldsghci01.stdout | 5 +++ 7 files changed, 54 insertions(+), 17 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7978c03..63d0d16 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3661,6 +3661,7 @@ xFlagsDeps = [ "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS", flagSpec "OverloadedLabels" LangExt.OverloadedLabels, flagSpec "OverloadedLists" LangExt.OverloadedLists, + flagSpec "OverloadedRecordFields" LangExt.OverloadedRecordFields, flagSpec "OverloadedStrings" LangExt.OverloadedStrings, flagSpec "PackageImports" LangExt.PackageImports, flagSpec "ParallelArrays" LangExt.ParallelArrays, diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 6800fab..de71c18 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -2231,7 +2231,8 @@ mkParserFlags flags = .|. ThQuotesBit `setBitIf` xopt LangExt.TemplateHaskellQuotes flags .|. QqBit `setBitIf` xopt LangExt.QuasiQuotes flags .|. IpBit `setBitIf` xopt LangExt.ImplicitParams flags - .|. OverloadedLabelsBit `setBitIf` xopt LangExt.OverloadedLabels flags + .|. OverloadedLabelsBit `setBitIf` (xopt LangExt.OverloadedLabels flags + || xopt LangExt.OverloadedRecordFields flags) .|. ExplicitForallBit `setBitIf` xopt LangExt.ExplicitForAll flags .|. BangPatBit `setBitIf` xopt LangExt.BangPatterns flags .|. HaddockBit `setBitIf` gopt Opt_Haddock flags diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 3a5f715..63396f2 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -218,17 +218,29 @@ tcExpr e@(HsIPVar x) res_ty origin = IPOccOrigin x tcExpr e@(HsOverLabel l) res_ty -- See Note [Type-checking overloaded labels] - = do { isLabelClass <- tcLookupClass isLabelClassName - ; alpha <- newOpenFlexiTyVarTy - ; let lbl = mkStrLitTy l - pred = mkClassPred isLabelClass [lbl, alpha] - ; loc <- getSrcSpanM - ; var <- emitWantedEvVar origin pred - ; tcWrapResult e (fromDict pred (HsVar (L loc var))) alpha res_ty } + = do { dflags <- getDynFlags + ; if xopt LangExt.OverloadedLabels dflags + then do { isLabelClass <- tcLookupClass isLabelClassName + ; alpha <- newFlexiTyVarTy liftedTypeKind + ; let pred = mkClassPred isLabelClass [lbl, alpha] + ; loc <- getSrcSpanM + ; var <- emitWantedEvVar origin pred + ; tcWrapResult e (fromDict pred (HsVar (L loc var))) alpha res_ty } + else do { -- must be OverloadedRecordFields alone + hasFieldClass <- tcLookupClass hasFieldClassName + ; alpha <- newFlexiTyVarTy liftedTypeKind + ; beta <- newFlexiTyVarTy liftedTypeKind + ; let pred = mkClassPred hasFieldClass [typeSymbolKind, lbl, alpha, beta] + ; loc <- getSrcSpanM + ; var <- emitWantedEvVar origin pred + ; tcWrapResult e (fromDict pred (HsVar (L loc var))) (mkFunTy alpha beta) res_ty } + } where - -- Coerces a dictionary for `IsLabel "x" t` into `t`. + -- Coerces a dictionary for `IsLabel "x" t` into `t`, + -- or `HasField "x" r a into `r -> a`. fromDict pred = HsWrap $ mkWpCastR $ unwrapIP pred origin = OverLabelOrigin l + lbl = mkStrLitTy l tcExpr (HsLam match) res_ty = do { (match', wrap) <- tcMatchLambda herald match_ctxt match res_ty @@ -263,18 +275,26 @@ tcExpr e@(ExprWithTySig expr sig_ty) res_ty {- Note [Type-checking overloaded labels] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Recall that (in GHC.OverloadedLabels) we have +Recall that we have - class IsLabel (x :: Symbol) a where + class IsLabel (x :: Symbol) a where -- in GHC.OverloadedLabels fromLabel :: a -When we see an overloaded label like `#foo`, we generate a fresh -variable `alpha` for the type and emit an `IsLabel "foo" alpha` -constraint. Because the `IsLabel` class has a single method, it is -represented by a newtype, so we can coerce `IsLabel "foo" alpha` to -`alpha` (just like for implicit parameters). + class HasField (x :: k) r a | x r -> a where -- in GHC.Records + fromLabel :: r -> a + +We translate `#foo` to `fromLabel @"foo"`, where we use + + * `GHC.OverloadedLabels.fromLabel` if `OverloadedLabels` is enabled + * `GHC.Records.fromLabel` otherwise (`OverloadedRecordFields` must be enabled) -That is, we translate `#foo` to `fromLabel @"foo"`. +In the first case, when we see an overloaded label like `#foo`, we +generate a fresh variable `alpha` for the type and emit an +`IsLabel "foo" alpha` constraint. Because the `IsLabel` class has a +single method, it is represented by a newtype, so we can coerce +`IsLabel "foo" alpha` to `alpha` (just like for implicit parameters). +The second case is similar, but we generate two fresh variables and +emit a `HasField` constraint. -} diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs index ff26ec6..248677f 100644 --- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs +++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs @@ -121,6 +121,7 @@ data Extension | BinaryLiterals | NegativeLiterals | DuplicateRecordFields + | OverloadedRecordFields | OverloadedLabels | EmptyCase | PatternSynonyms diff --git a/testsuite/tests/overloadedrecflds/ghci/all.T b/testsuite/tests/overloadedrecflds/ghci/all.T index 6a95bb2..1fd9f65 100644 --- a/testsuite/tests/overloadedrecflds/ghci/all.T +++ b/testsuite/tests/overloadedrecflds/ghci/all.T @@ -1,2 +1,3 @@ test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsghci01.script']) +test('overloadedrecfldsghci01', combined_output, ghci_script, ['overloadedrecfldsghci01.script']) test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script']) diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script new file mode 100644 index 0000000..afe7536 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script @@ -0,0 +1,8 @@ +:set -XOverloadedRecordFields +:t #x +:m + GHC.Records +:t #foo . #bar +data T = MkT { foo :: Int } +#foo (MkT 42) +:set -XOverloadedLabels +:t #x diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout new file mode 100644 index 0000000..13fe63a --- /dev/null +++ b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout @@ -0,0 +1,5 @@ +#x :: GHC.Records.HasField "x" t2 t1 => t2 -> t1 +#foo . #bar + :: (HasField "foo" t1 c, HasField "bar" t2 t1) => t2 -> c +42 +#x :: GHC.OverloadedLabels.IsLabel "x" t => t From git at git.haskell.org Sat Oct 8 16:15:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:36 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Adapt ORF/OL tests (c6f7c45) Message-ID: <20161008161536.63A1B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/c6f7c45f3151886869a364ae85b86aceb0940bcb/ghc >--------------------------------------------------------------- commit c6f7c45f3151886869a364ae85b86aceb0940bcb Author: Adam Gundry Date: Sat Oct 8 14:54:18 2016 +0100 Adapt ORF/OL tests >--------------------------------------------------------------- c6f7c45f3151886869a364ae85b86aceb0940bcb .../ghci/overloadedlabelsghci01.script | 5 ++-- .../should_fail/overloadedlabelsfail01.hs | 5 ++-- .../should_fail/overloadedlabelsfail01.stderr | 29 ++++++++++------------ 3 files changed, 19 insertions(+), 20 deletions(-) diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script index 70efb79..7bbee54 100644 --- a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script +++ b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script @@ -3,10 +3,11 @@ :m + GHC.OverloadedLabels :seti -XFlexibleInstances -XFlexibleContexts -XTypeFamilies -XMultiParamTypeClasses instance IsLabel x [Char] where fromLabel = "hello" -instance (s ~ [Char], t ~ [Char]) => IsLabel x (s -> t) where fromLabel = (++ " world") +instance {-# OVERLAPS #-} (s ~ [Char]) => IsLabel x (s -> [Char]) where fromLabel = (++ " world") #x :: String -#x #y +#x #y :: String :{ #x "goodbye" + :: String :} diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.hs index 361da45..ed68685 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.hs +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.hs @@ -5,8 +5,9 @@ import GHC.OverloadedLabels -- No instance for (OverloadedLabel "x" t0) a = #x --- No instance for (OverloadedLabel "x" (t0 -> t1), OverloadedLabel "y" t0) -b = #x #y +-- No instance for (OverloadedLabel "x" Int) +b :: Int +b = #x -- Could not deduce (OverloadedLabel "y" t) from (OverloadedLabel "x" t) c :: IsLabel "x" t => t diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr index f938d03..6709008 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr @@ -1,31 +1,28 @@ overloadedlabelsfail01.hs:6:5: error: - • No instance for (IsLabel "x" t2) - arising from the overloaded label ‘#x’ + • Ambiguous type variable ‘t0’ arising from the overloaded label ‘#x’ + prevents the constraint ‘(IsLabel "x" t0)’ from being solved. + Relevant bindings include + a :: t0 (bound at overloadedlabelsfail01.hs:6:1) + Probable fix: use a type annotation to specify what ‘t0’ should be. + These potential instance exist: + instance GHC.Records.HasField x r a => IsLabel x (r -> a) + -- Defined in ‘GHC.OverloadedLabels’ • In the expression: #x In an equation for ‘a’: a = #x -overloadedlabelsfail01.hs:9:5: error: - • No instance for (IsLabel "x" (t1 -> t0)) +overloadedlabelsfail01.hs:10:5: error: + • No instance for (IsLabel "x" Int) arising from the overloaded label ‘#x’ - (maybe you haven't applied a function to enough arguments?) • In the expression: #x - In the expression: #x #y - In an equation for ‘b’: b = #x #y - -overloadedlabelsfail01.hs:9:8: error: - • No instance for (IsLabel "y" t1) - arising from the overloaded label ‘#y’ - • In the first argument of ‘#x’, namely ‘#y’ - In the expression: #x #y - In an equation for ‘b’: b = #x #y + In an equation for ‘b’: b = #x -overloadedlabelsfail01.hs:13:5: error: +overloadedlabelsfail01.hs:14:5: error: • Could not deduce (IsLabel "y" t) arising from the overloaded label ‘#y’ from the context: IsLabel "x" t bound by the type signature for: c :: IsLabel "x" t => t - at overloadedlabelsfail01.hs:12:1-23 + at overloadedlabelsfail01.hs:13:1-23 • In the expression: #y In an equation for ‘c’: c = #y From git at git.haskell.org Sat Oct 8 16:15:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:40 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Support combination of OverloadedLabels and RebindableSyntax (fixes #12243) (acd495d) Message-ID: <20161008161540.7DC403A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/acd495db07e72f4eaed0082b1cb44a124396baa0/ghc >--------------------------------------------------------------- commit acd495db07e72f4eaed0082b1cb44a124396baa0 Author: Adam Gundry Date: Sat Oct 8 15:55:03 2016 +0100 Support combination of OverloadedLabels and RebindableSyntax (fixes #12243) >--------------------------------------------------------------- acd495db07e72f4eaed0082b1cb44a124396baa0 compiler/deSugar/Coverage.hs | 2 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsMeta.hs | 2 +- compiler/deSugar/Match.hs | 2 +- compiler/hsSyn/HsExpr.hs | 8 +++-- compiler/parser/Parser.y | 2 +- compiler/rename/RnExpr.hs | 8 +++-- compiler/typecheck/TcExpr.hs | 38 ++++++++++++++++------ compiler/typecheck/TcHsSyn.hs | 4 +-- compiler/typecheck/TcRnTypes.hs | 2 +- .../tests/overloadedrecflds/should_fail/all.T | 2 ++ .../should_fail/overloadedlabelsfail02.hs | 3 ++ .../should_fail/overloadedlabelsfail02.stderr | 2 ++ .../should_fail/overloadedlabelsfail03.hs | 5 +++ .../should_fail/overloadedlabelsfail03.stderr | 10 ++++++ .../tests/overloadedrecflds/should_run/T12243.hs | 25 ++++++++++++++ .../overloadedrecflds/should_run/T12243.stdout | 2 ++ testsuite/tests/overloadedrecflds/should_run/all.T | 1 + 18 files changed, 97 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 acd495db07e72f4eaed0082b1cb44a124396baa0 From git at git.haskell.org Sat Oct 8 16:15:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:43 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Add a mysterious reverse to correct evidence for HasField (94a4e8f) Message-ID: <20161008161543.3DB3E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/94a4e8fbd14e237914a7d3d3a93f6030f3ba9454/ghc >--------------------------------------------------------------- commit 94a4e8fbd14e237914a7d3d3a93f6030f3ba9454 Author: Adam Gundry Date: Sat Oct 8 16:15:50 2016 +0100 Add a mysterious reverse to correct evidence for HasField >--------------------------------------------------------------- 94a4e8fbd14e237914a7d3d3a93f6030f3ba9454 compiler/typecheck/TcInteract.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index a725eb8..9df4585 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2237,7 +2237,7 @@ matchHasField dflags clas tys@[_k_ty, x_ty, r_ty, a_ty] loc where co = mkTcFunCo Nominal (mkTcReflCo Nominal r_ty) (evTermCoercion ev) - body = mkHsWrap (mkWpCastN co <.> mkWpTyApps rep_tc_args) + body = mkHsWrap (mkWpCastN co <.> mkWpTyApps (reverse rep_tc_args)) (HsVar (noLoc sel_id)) ax = case tcInstNewTyCon_maybe (classTyCon clas) tys of Just x -> snd x From git at git.haskell.org Sat Oct 8 16:15:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Oct 2016 16:15:54 +0000 (UTC) Subject: [commit: ghc] wip/hasfield's head updated: Add a mysterious reverse to correct evidence for HasField (94a4e8f) Message-ID: <20161008161554.EC3BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/hasfield' now includes: 7cddcde Docs: -interactive-print should reside in registered package 3221599 Make testsuite work again with Py3 353e97a config.mk.in: Disable stripping by default on ARM 3017cbc ghc-cabal: Bring back TRANSITIVE_DEP_NAMES 6ec236b Improve SimplUtils.interestingArg d990354 Improve the runRW magic in CorePrep fcc7498 Improve tracing a bit in CoreSubst 1af0d36 Refactoring only e338376 Fix normalisation of TyCon representations 48db13d Don't drop last char of file if -osuf contains dot 2db18b8 Visible type application 2032635 Testsuite: fix qq005 and qq006 (#11279) bc8cac1 Testsuite: mark T7681 expect_broken (#11287) 5e4e9e0 Fix #11255. bd7ab66 Test #11254 in typecheck/should_compile/T11254 1411eaf Note [TyBinder] in TyCoRep 52da6bd Have mkCastTy look more closely for reflexivity. da69358 Fix #11287. b218241 Test #10589 in typecheck/should_compile/T10589 05e3541 Test #10619 in typecheck/should_fail/T10619 0fda908 Bump Haddock submodule again 8bf2d8f Linker: Fix cut-and-paste error in debug output 422107e T10518: Ensure literal has 64-bit type e39d10f testsuite/T8274: Remove 32-bit test output fb5d26d testsuite/codegen: Add missing dummy Makefiles 0b0652f testsuite/T9430: Fix word-size dependence b62215d Linker: Reenable Thumb support e8672e5 libraries/ghci: Implement mkJumpToAddr for ppc64 909bbdb Linker(ELF): Fix addProddableBlocks usage da5e693 testsuite/joao-circular: Clean up test results a3b34b6 Clean up a botched merge. d1ebbb0 testsuite/CmmSwitchTest: Mark as broken on 32-bit platforms 11778f7 Add testcase for getSizeofMutableByteArray# 07b3be7 integer-gmp: Fix #11296 bec5350 Adding flags: -ffull-guard-reasoning and too-many-guards c8d0af3 RTS: Detect powerpc64le as ELF 64-bit system 1b00016 The -package flag should select match from right-most package db. 0054bcd rts/Linker(ARM): Ensure all code sections are flushed from cache 01299ca Synchronise ghci-package version with ghc-package 4a10ecb Patch-level increment integer-gmp to 1.0.0.1 e01aa22 Patch-level increment integer-simple version 0.1.1.1 c7830bd Update hpc submodule to 0.6.0.3 version 3aa4a45 Update filepath submodule to v1.4.1.0 rls tag 295085c Update time submodule to latest snapshot bab5109 Make git-committer inferred version-date TZ-invariant 7fef7fe drop obsolete/redundant OPTIONS pragma [skip ci] af92ef3 ghc/Main: Update list of --print modes 4f69203 Fix panic when using pattern synonyms with DisambiguateRecordFields 5bb7fec Export some useful GHC API functions. 8e735fd Fix GEq1 when optimizations are enabled 2e49c8c users_guide: Move 7.12.1-notes to 8.0.1-notes 9cb79c5 Update a few references to GHC 7.12 b093e63 Modify getFullArgs to include program name df6cb57 Accept submodule libraries/primitive commit 1af89788d fcc7649 Introduce negative patterns for literals (addresses #11303) a1e01b6 testlib: Make TyCon normalization Python 2.6-compatible adcbc98 Add regression test for #11303 e4cc19d Update Cabal submodule to latest snapshot c6cab9d Remove `cabal07`-test broken by e4cc19de4bdbcc 34af60c testsuite: normalise away `ld`-warning on AIX c06b46d Fix #11305. 8fcf1e7 Make iserv-bin compatible with GHC version bump to 8.0 07779c2 T11303: Set maximum heap size 630303a users_guide/ghci: Fix heading 3bbc01a Testsuite: mark T7653 with high_memory_usage b0fa286 Fix some typos e9ab6d5 rts/PrimOps.cmm: fix UNREG profiled build d3a79bc rts/Linker.c: mark ia64 as 64-bit ELF, drop unused branches 0380a95 glasgow_exts.rst: fix code block 947c8a5 Bump GHC HEAD's Version from 7.11 to 8.1 bb7f2e3 Address #11245: Ensure the non-matched list is always non-empty 25e4556 Various API Annotations fixes 75851bf fix ghci build on ArchUnknown targets 0579fe9 Improve exprIsBottom 5ba3caa Comments only 70eefbc Test Trac #11245 351dea4 Drop redundant `-D__GLASGOW_HASKELL__=...` flag eae40e1 Use 0/1 instead of YES/NO as `__GLASGOW_HASKELL_TH__` macro value 0d20737 Drop redundant/explicit `=1` in `-DFOO=1` flags 2f923ce Drop pre-AMP compatibility CPP conditionals 3c8cb7f Remove some redundant definitions/constraints 12ee511 Remove ghc-7.8 `-package-name`-compat handling 37945c1 Simplify -fcmm-sink handling for Parser.hs 6a010b9 Update haskeline submodule to latest snapshot 8afeaad travis: use GHC 7.10.3 dafeb51 Canonicalise `MonadPlus` instances b469b30 Minor fix of MonadFail instance for `ReadPrec` ab0d733 Update Cabal submodule, Fixes #11326 f3cc345 Add strictness for runRW# 0b8dc7d API Annotations: AnnTilde missing 78daabc mk/config.mk.in: drop unused CONF_CC_OPTS for ia64 f5ad1f0 AnnDotDot missing for Pattern Synonym export 256c2cf Test Trac #11336 0490fed Linker: ARM: Ensure that cache flush covers all symbol extras d159a51 Linker: ARM: Refactor relocation handling 48e0f9c Linker: Make debugging output a bit more readable 07d127a Linker: Use contiguous mmapping on ARM d935d20 Omit TEST=T10697_decided_3 WAY=ghci 1dbc8d9 Add test for #10379 04f3524 Linker: ARM: Don't change to BLX if jump needed veneer c7d84d2 Update .mailmap [skip ci] 7e599f5 Linker: Move helpers to #ifdef da0f043 Rewrite Haddocks for GHC.Base.const 5c10f5c users_guide: Add ghci-cmd directive 4c56ad3 Build system: delete ghc-pwd 0acdcf2 Avoid generating guards for CoPats if possible (Addresses #11276) 1a8b752 Add (failing) test case for #11347 1f526d2 Release notes: Mention remote GHCi cdeefa4 ghc.mk: Add reference to Trac #5987 77494fa Remove -Wtoo-many-guards from default flags (fixes #11316) e32a6e1 Add Cabal synopses and descriptions bbee3e1 StgCmmForeign: Push local register creation into code generation bd702f4 StgCmmForeign: Break up long line aa699b9 Extend ghc environment file features 4dc4b84 relnotes: Note dropped support for Windows XP and earlier 852b603 Restore old GHC generics behavior vis-à-vis Fixity cac0795 Change Template Haskell representation of GADTs. 89ba83d Bump Cabal and Haddock to fix #11308 7861a22 Add a note describing the protocol for adding a language extension f01eb54 Fall back on ghc-stage2 when using Windows' GHCi driver 568736d users guide: Add documentation for custom compile-time errors 5040686 users guide: Add links to release notes 47367e0 Rewrite announce file 0a04837 users guide: Tweak wording of RTS -Nmax description 0839a66 Remove unused export 3f98045 Tiny refactor 97c49e9 Spelling in a comment 290a553 Tidy up tidySkolemInfo 4dda4ed Comment wibble 29b4632 Inline solveTopConstraints dc97096 Refactor simpl_top 02c1c57 Use an Implication in 'deriving' error a5cea73 Turn AThing into ATcTyCon, in TcTyThing 9915b65 Make demand analysis understand catch 1ee9229 Test Trac #10625 c78fedd Typos in docs and comments 6be09e8 Enable stack traces with ghci -fexternal-interpreter -prof 09425cb Support for qRecover in TH with -fexternal-interpreter 6f2e722 User's Guide: injective type families section 0163427 Fix Template Haskell's handling of infix GADT constructors 1abb700 Improve GHC.Event.IntTable performance c33e7c2 Fix +RTS -h when compiling without -prof 10769a1 Rename the test-way prof_h to normal_h 47ccf4d Add a pointer to the relevant paper for InScopeSet 2bd05b8 Docs for stack traces in GHCi f7b45c3 Build system: fix `pwd` issues on Windows 1cdf12c Fix test for T9367 (Windows) a6c3289 users_guide: Use semantic directive/role for command line options 86d0657 users-guide: A few fixes 8f60fd4 docs: Fix DeriveAnyClass reference in release notes and ANNOUNCE 67b5cec user-guide: More semantic markup 0dc2308 user-guide/safe_haskell: Fix typos a84c21e Reject import declaration with semicolon in GHCi 831102f Parser: delete rule numbers + validate shift/reduce conlicts 4405f9d Add failing testcase for #10603 5cb236d fix -ddump-splices to parenthesize ((\x -> x) a) correctly fbd6de2 Add InjectiveTypeFamilies language extension 4c9620f TrieMap: Minor documentation fix b1c063b ghc.mk: Use Windows_Target instead of Windows_Host 8e0c658 Linker: Define ELF_64BIT for aarch64_HOST_ARCH 00c8076 fix typo causing compilation failure on SPARC (ArchSparc -> ArchSPARC) 6cb860a Add -prof stack trace to assert 3e796e1 A little closer to supporting breakpoints with -fexternal-interpreter 88d6d5a Use implicit CallStacks for ASSERT when available d44bc5c TemplateHaskell: revive isStrict, notStrict and unpacked ac3cf68 Add missing type representations e782e88 Add test for Data.Typeable.typeOf c3f9246 Print a message when loading a .ghci file. 6ea24af Handle over-applied custom type errors too. c313327 Minor improvement in CoreDump outputs: c73333a Minor code refactoring 61011b4 users-guide: Wibbles 91dcc65 GHC.Generics: Fix documentation f0c4e46 Add tests for #11391 b0641ad INSTALL.md: Mention -j and other wibbles 78a4c72 Rename InjectiveTypeFamilies to TypeFamilyDependencies 4dbc31b users-guide: Update language extension implications b355b8f users-guide: Add since annotations for language extensions 83c13c2 user-guide: Use ghc-flag for dump formatting flags fd686c4 API Annotations: use AnnValue for (~) db371c1 T11300: Fix test on windows 49e414a Remove lookup of sections by name instead use the index numbers as offsets 91f1c60 Fix #11015 with a nice note. 8959b03 ANNOUNCE: Mention powerpc code generator b90cac6 user-guide: Note Cabal version limitation faf3f96 users-guide: Fix cabal version number c6a3e22 Link command line libs to temp so e7eec3a Use XZ compression by default 7cf16aa Don't output manpage in same directory as source 756b228 Refactor lookupFixityRn-related code following D1744 67fc3f3 configure.ac: Export MAKECMD to build system 443bf04 Allow pattern synonyms which have several clauses. 165ae44 Expand type/kind synonyms in TyVars before deriving-related typechecking e6ca930 Fix #11355. d4af57f Test #11252 in ghci/scripts/T11252 d459f55 Fix #10872. 6c07f14 Fix #11311 3a7f204 Clarify topological sorting of spec vars in manual 39ea4b4 Fix #11254. bafbde7 Constrained types have kind * in validity check. 072191f Fix #11404 33950aa Tiny refactoring in TcUnify 80b4c71 Fix typo in error message (#11409) 3c6635e Fix #11405. 148a50b Fix some typos 3a1babd Work SourceText in for all integer literals 9308c73 Fix a number of subtle solver bugs 3b6a490 Add missing T11408.hs ae1c48c rts/posix: Fail with HEAPOVERFLOW when out of memory during mmap d1ce1aa users-guide: Clean manpage build artifacts and fix usage of clean-target b3eb8fa Complete operators properly 65b810b Show TYPE 'Lifted/TYPE 'Unlifted as */# in Show TypeRep instance f3a867e Add testcase for #11414 2fd407c validate: Use gz compression during bindist check a7b751d un-wire-in error, undefined, CallStack, and IP 5a62b6a Simplify API to tcMatchTys f02200f Layout only cb24e68 Fix typecheck of default associated type decls b7e5c30 White space only 6e0c0fd Improve debug printing/warnings ec8a188 Refactoring on IdInfo and system derived names 8e6a68d Add Trac #11427 to Note [Recursive superclasses] e2c7b7e Implement scoped type variables in pattern synonyms 8e50301 Test Trac #11379 5412899 Typo in comment 817dd92 Fixes to "make clean" for the iserv dir b8abd85 Replace calls to `ptext . sLit` with `text` 240ddd7 Switch from -this-package-key to -this-unit-id. cbc03f1 ghci: Kill global macros list d2ea7f9 Hide derived OccNames from user 38666bd user-guide: Delete errant fragment aff51af users-guide: Begin documenting --frontend 80265c4 Typos in comments 9d33adb Check InScopeSet in substTy and provide substTyUnchecked 713aa90 Re-export ghc-boot:GHC.Serialized as Serialized 952eda2 Fix IfaceType generation for TyCons without TyVars 975bdac T11266: Improve the test by adding more of the other problematic modules 514bac2 Fix combineIdenticalAlts 0373a84 Oops. Add missing close-comment 5cce095 Use (&&) instead of `if` in Ix derivation 84b0ebe Rework derivation of type representations for wired-in things 225afc4 Add test T9407 (Windows) 6ddc991 Update submodule stm + random 48d4bc5 substTy to substTyUnchecked to fix Travis build 1ce1371 MkId: Update OpenKind reference 2e65aae Add comments about tyCoVarsOfType e604e91 Comments only c572430 Re-add missing kind generalisation 6f95e23 Comments only b3ee37c Improve pretty-printing of UnivCo 07afe44 Remove the check_lifted check in TcValidity b2e6350 Strip casts in checkValidInstHead 395ec41 Allow implicit parameters in constraint synonyms ede055e TyCoRep: Restore compatibility with 7.10.1 f23b578 user-guide:: Improve -D description 928484d user-guide: Refer to MIN_VERSION_GLASGOW_HASKELL from intro 3883f99 rel-notes: Note the return of -Wmonomorphism-restriction 7cb893f Update and improve documentation in Data.Foldable 96303db Add a missing .gitignore entry in annotations tests 2ffc260 Add -ignore-dot-ghci to tests that use --interactive 4c4a0a5 Fix docstring GHC.IO.Handle.FD.openFileBLocking 4c11db6 sphinx-build: fix python stack overflow (Trac #10950) b617e9f Improve comments in CmmSwitch 85e147e Always run test T9407 36b174d Add expected stderr for #11466 test case adb721b Make a constraint synonym for repeated BinaryStringRep and use it. 835a2a2 Default non-canonical CallStack constraints 2df4221 Add tests for #11465 and the kind invariant 9048c3d Don't print "Loaded GHCi configuration" message in ghc -e (#11478) 65881c0 Mark some ghci tests as req_interp 6e5f828 Fix a formatting error in the user's guide 4d51bfc Do not count void arguments when considering a function for loopification. b01288d rts: Disable tick timer unless really needed 4e04043 Add test for Trac #11056 f42db15 Remove unused IND_PERM 06c2547 Small doc fix 7cd37c5 Give a more verbose error message when desugaring a HsTypeOut 8e9a870 Remove -Wredundant-superclasses from standard warnings 1be8491 mkUserGuidePart: Better flag cross-referencing 6f96109 user-guide: Reformat warning lists b5e52bf user-guide: Fix typos ec87788 Don't add ticks around type applications (#11329) 923d215 user-guide: Document -L RTS flag 89bdac7 Add test for #11473 8b5ea7c User's guide: fix singular/plural typo in flagnames 98d6a29 Docs: delete section on Hierarchical Modules edc68b2 Remove `replaceDynFlags` from `ContainsDynFlags` 2c6fe5b Add -fwarn-redundant-constrains to test for #9708 fd6dd41 Implement `-Wnoncanonical-monadfail-instances` warning ff21795 Special-case implicit params in superclass expansion 746764c Refactor validity checking for type/data instances 42c6263 Avoid recursive use of immSuperClasses f7e0e5f Improve tracing in checkValidInstance 3c060f3 Fix exprIsHNF (Trac #11248) 5c82333 Show error message for unknown symbol on Elf_Rel platforms edb30fd Comments only: more alternate names for ARM registers [skip ci] bc1e085 HscTypes: Fix typo in comment 132c208 Rename -Wmissing-monadfail-instance to plural-form 6e2658f Better document behavior of -Wmissed-specialisations 128b678 user-guide: Note order-dependence of flags f0f63b3 Implement -Wunrecognised-warning-flag 9fe7d20 Ensure that we don't produce code for pre-ARMv7 without barriers 632f020 Less verbose output for the in-scope set cf788a5 White space only 47b3f58 Add "ticks-exhausted" comment 1c6d70c Kill off zipTopTCvSubst in favour of zipOpenTCvSubst 016a0bd Fix two cloning-related bugs 34c9a4e Missed plural renaming in user's guide 5f5dc86 Minor users-guide markup fixup [skip ci] 9b71695 Update transformers submodule to 0.5.1.0 release f1885df Update process submodule to 1.4.2.0 release 3798b2a Fix three broken tests involving exceptions 01809bc Pass InScopeSet to substTy in lintTyApp e24a9b5 Nicer error on +RTS -hc without -rtsopts or -prof 6d2bdfd Fix segmentation fault when .prof file not writeable 6817703 Split off -Wunused-type-variables from -Wunused-matches 144ddb4 Construct in_scope set in mkTopTCvSubst eeb67c9 Testsuite: fixup req_profiling tests (#11496) e2bdf03 Build profiling libraries on `validate --slow` (#11496) 44a5d51 Enable RemoteGHCi on Windows 45fd83b Fix a typo in the note name in comments 448ea97 Typos in comments 1f6d142 ghci: fix trac issue #11481 1c6130d rts/Timer: Actually fix #9105 0dc7b36 Restore original alignment for info tables 0d92d9c Use stage1 build variables when building the RTS d50609e Test for undef bugs in the LLVM backend when validating 45c6fbc Document -fllvm-fill-undef-with-garbage 4faa1a6 s/unLifted/unlifted for consistency 2899aa5 Fix some substitution InScopeSets 00cbbab Refactor the typechecker to use ExpTypes. 5dcae88 Rename "open" subst functions 85daac5 Fix cost-centre-stack bug when creating new PAP (#5654) a496f82 Remote GHCi: create cost centre stacks in batches 71b1183 Update profiling test output 0d5ddad fix validate breakage 63700a1 Use the in_scope set in lint_app 1b72534 Fixup test for #10728 61e4d6b Mark dynamic-paper as expect_fail_for optasm and optllvm (#11330) d3b7db0 Fix the Windows build 0dd663b Add closing parenthesis in comment for eqString (#11507) bc83c73 Add release note about flexible RebindableSyntax bb956eb Add asserts to other substitution functions 6c7760b Define CTYPE for more Posix types 2fbf370 Update unix submodule to latest snapshot b61f5f7 Put docs in /usr/share/doc/ghc- 4d0e4fe Add type signatures. 90f688e Code formatting cleanup. 6544f8d Properly track live registers when saving the CCCS. 669cbef Fix Trac issue #11487. 34519f0 When encountering a duplicate symbol, show source of the first symbol f8e2b7e Minor doc fixes to GHC.Generics a883c1b Missing @since annotations in GHC.Generics e5a0a89 Suppress substitution assertions to fix tests 0d60165 Simplify ghc-boot database representation with new type class. 94048f9 Hide the CallStack implicit parameter 86897e1 Implement basic uniform warning set tower ba88aab Fix LOOKS_LIKE_PTR for 64-bit platforms 2ad46a8 Add some Outputable instances 02e3ce0 Typo in docs 7329310 Fix runtime linker error message when old symbol had no owner dd0b7c7 Avoid mangled/derived names in GHCi autocomplete (fixes #11328) ddd38e7 Update unix submodule to latest snapshot af8fdb9 TyCoRep: Implement some helpers for dropping/checking Levity arguments 2fb6a8c Remote GHCi: Optimize the serialization/deserialization of byte code 7cb1fae Remote GHCi: batch the creation of strings c996db5 Remote GHCi: parallelise BCO serialization 01c587c Fix Windows build after D1874 07ed241 Use a correct substitution in tcCheckPatSynDecl a7ad0b9 Make TypeError a newtype, add changelog entry db97ed9 Add (failing) test for #11247 871c96f TcMType: Add some elementary notes 92c46a4 Update cabal_macros_boot.h 483858e Update binary submodule to 0.8.2.0 release db121b2 Allow all RTS options to iserv 28f951e Overhaul the Overhauled Pattern Match Checker bbc0ec5 Fix a few loose ends from D1795 4f9967a Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape 91a56e9 Use default xz compression level 70980b1 GHCi: Fix Windows build (again) 8aa9f35 Fix @since annotations for renamed pretty{CallStack,SrcLoc} 38af3d1 Add a derived `Show SrcLoc` instance b49d509 Add test for #11516 5d73fb6 Revert "Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape" f1f5837 unlit: mark local functions as 'static' 72545c7 hp2ps: mark local functions as 'static' f3923d5 testsuite: ignore *.prof.normalised files 1060301 mkDocs: Update for xz c96acf3 mkDocs: Fix fallout from c5f4f95c64006a9f 66fa0ed validate: enable -DDEBUG in stage 1 by default 7362809 rts: drop unused calcLiveBlocks, calcLiveWords 9e43c7f rts: mark scavenge_mutable_list as static 4f283a6 rts: mark 'copied' as static 256c1b3 rts: drop unused getThreadCPUTime 3dbd836 rts: mark 'wakeBlockingQueue' as static 8abc7e7 rts: drop unused mut_user_time_during_heap_census 39cba20 rts: mark 'removeFromRunQueue' as static 7a48865 rts: mark 'setProgName' as static a49c9d4 rts: drop unused 'traverseAllRetainerSet' c358567 rts: mark 'blockedThrowTo' as static e1ca583 rts: mark 'ccs_mutex' and 'prof_arena' as static 0e51109 rts: drop unused 'traceEventThreadRunnable' 0a2bd9c rts: mark 'shutdownCapability' as static c0a0ee3 Fix haddocks for TypeError b3e9452 Bump haddock submodule 8263d09 Remove unused export from TcUnify 2cf3cac Allow foralls in instance decls 20f90ea Fix SimpleFail12 error output e2b66a0 user-guide: Add cross-reference for -XUnicodeSyntax 4e65301 Add Edward Kmett's example as a test case 6036cb6 Comments only, on the invariants of GlobalRdrEnv a96c4e7 Add comments to TcCoercibleFail ee11a84 White space and comments only 8871737 Document and improve superclass expansion e72665b Comment out some traceFlat calls 7212968 Improve tracing in TcInteract d6b68be Improve error messages for recursive superclasses f79b9ec Use runTcSDeriveds for simplifyDefault 6252b70 A small, local refactoring of TcSimplify.usefulToFloat 43e02d1 Fix a nasty superclass expansion bug 5a58634 release notes: Note new two-step allocator 96d4514 Some tiding up in TcGenDeriv fac0efc Define mkTvSubst, and use it c9ac9de Test Trac #11552 489a9a3 Define tyConRolesRepresentational and use it 023fc92 Remove unused LiveVars and SRT fields of StgCase da19c13 Print * has Unicode star with -fprint-unicode-syntax 16cf460 testsuite: Un-break T5642 4ec6141 Fix the removal of unnecessary stack checks 04fb781 Early error when crosscompiling + haddock/docs bfec4a6 Unset GREP_OPTIONS in build system 1f894f2 Restore derived Eq instance for SrcLoc c8702e3 TcErrors: Fix plural form of "instance" error 99cb627 TcPatSyn: Fix spelling of "pattern" in error message 7953b27 DynFlags: drop tracking of '-#include' flags 2f9931e add Template Haskell regression test for #9022. 93e2c8f Expand users' guide TH declaration groups section (#9813) d80caca Error early when you register with too old a version of Cabal. c57d019 docs: add newline after '.. ghc-flag::' a824972 mkUserGuide: fix option wrapping in a table b565830 Wrap solveEqualities in checkNoErrs d27da53 Replace mkTvSubstPrs (a `zip` b) with zipTvSubst a b 8500855 Always do eta-reduction 62d1888 Comments about ru_auto 023bf8d Ignore untracked in nofib 51a3392 sizeExpr: fix a bug in the size calculation 46af683 compiler: Do not suggest nor complete deprecated flags fix trac issue #11454 efba41e Another batch of typo fixes in non-code dbf72db Build the substitution correctly in piResultTy b7dfbb4 Add test for #11319 8da6a16 Revert "sizeExpr: fix a bug in the size calculation" be3d7f6 Add IsList instance for CallStack, restore Show instance for CallStack f3b9db3 Revert "Build the substitution correctly in piResultTy" c6485d5 Simplify AbsBinds wrapping 1251518 Beef up tc124 d084624 Improve pretty-printing of HsWrappers 24305be Minor refactoring to tauifyMultipleMatches 6cf9b06 User manual improvments f37bb54 testsuite: tweak error messages for new Show instance cd4a7d0 renamer discards name location for HsRecField 4bba19a Update directory submodule to v1.2.5.1 release 18cd712 Improve error message suppression bb7f230 Comments only 160765f Document -dynamic-too (#11488) f6b98ea Tiny refactor; use guards instead of 'if' 0057125 Comments and white space e2f7d77 A tiny, outright bug in tcDataFamInstDecl 023742e Add a testcase for #11362 426a25c Make T11361 actually run with reversed uniques 3c39bec Rename missing-pat-syn-sigs to missing-pat-syn-signatures ed69b21 Add missing newlines at end of file [skip ci] d066e68 Testsuite: delete only_compiler_types, assume ghc c8df3f1 Bump haddock submodule 525a304 Make bootstrapping more robust 693a54e Improved error message about exported type operators. af5a0e5 Fix two wrong uses of "data constructor" in error msgs 3116003 PowerPC: Improve float register assignment. 49c5cb4 Fix typos 5fc06b9 Suggest candidate instances in error message ad30c76 Remove documentation for -Wlazy-unlifted-bindings 2b906af DynFlags: Don't panic on incompatible Safe Haskell flags 6f25fb3 Testsuite: delete compiler_lt/le/gt/ge setup functions 34c9523 Comments only 21b4228 Simplify the defn of coreViewOneStarKind 4c6e95e Small refactor and comments b962bcc Make exactTyCoVarsOfTypes closed over kinds. 90f3561 Existentials should be specified. aff5bb4 Add missing kind cast to pure unifier. 7d8031b Remove extraneous fundeps on (~) 6f952f5 Use CoercionN and friends in TyCoRep 43468fe Fix #11241. 489e6ab Fix #11246. a615215 Fix #11313. 67d2226 Derive Eq and Ord instance for SrcLoc and RealSrcLoc a82956d Remove superfluous code when deriving Foldable/Traversable 525b54c users-guide: Fix typos 0c420cb Comments only (#11513) 27842ec Fix thinko that crept into D1908 01449eb Fix desugaring of bang-pattern let-bindings b529255 (Another) minor refactoring of substitutions 4d031cf Improve piResultTys and friends a008ead Take type-function arity into account 206a8bf Unwire Typeable representation types 0b68cbe Bump haddock submodule 8b073f6 A few more typos in non-code 2f733b3 Delete support for deprecated "-- # ..."-style haddock options d738e66 Modifier letter in middle of identifier is ok c6007fe Pass -haddock to tests in should_compile_*flag*_nohaddock a8653c8 Docs: no space in `-i⟨dir1⟩:⟨dir2⟩` [skip ci] 6cec905 Refactoring only: use ExprLStmt 3259bf6 Fix a bug in ApplicativeDo (#11612) 2340485 Fix a double-free bug in -fexternal-interpreter 80d35be Use a better test for profiling 1ef7add Add test (only) to assure that #11535 is fixed 9634e24 unexport MAKEFLAGS when running tests (#11569) 0b00add Add test for #6132: hash bang + CPP 6e691ca Testsuite: pass '-s --no-print-directory' to MAKE f451039 Build system: fix sed expression (#11537) bb9cd45 Fix GHC.Stats documentation markup (#11619) ed11909 Docs: -keep-llvm-file(s)/-ddump-llvm imply -fllvm d3cf2a9 Add missing files 31c312e Testsuite: delete Windows line endings [skip ci] (#11631) 8626ac9 Testsuite: delete Windows line endings [skip ci] (#11631) 754a2f2 Testsuite: delete Windows line endings [skip ci] (#11631) 6074c10 Testsuite: delete Windows line endings [skip ci] (#11631) d5e8b39 Testsuite: delete Windows line endings [skip ci] (#11631) 978c3ea Testsuite: accept output without Windows line endings (#11631) 42f06f6 Testsuite: accept output without Windows line endings (#11631) 28620ba Testsuite: delete Windows line endings [skip ci] (#11631) 6d0aa9f Testsuite: delete Windows line endings [skip ci] (#11631) 73e4095 Testsuite: cleanup profiling/should_run/all.T (#11521) 176be87 Filter out -prof callstacks from test output (#11521) 661aa07 Testsuite: failing profiling tests (#10037) 2aee419 Allow combining characters in identifiers (#7650) a3e0e93 Testsuite: MAKEFLAGS is magic, do not unexport it 32a9a7f Extend `-Wunrecognised-warning-flag` to cover `-f(no-)warn-*` ce36115 Follow-up to 32a9a7f514bdd33ff72a673ade d8c64e8 Address #11471 by putting RuntimeRep in kinds. a9dc62a Remove "use mask" from StgAlt syntax 009a999 TyCoRep: Add haddock sections c1efdcc Overload the static form to reduce verbosity. feb19ea testsuite: mark tests broken on powerpc64 8e19d3a base: A selection of fixes to the comments in GHC.Stats 0c7db61 ApplicativeDo: Handle terminal `pure` statements 6319a8c HscMain: Delete some unused code 673efcc Add more type class instances for GHC.Generics 6658491 Make warning names more consistent 52879d1 Reconstruct record expression in bidir pattern synonym ebaa638 Bump haddock.base allocations 073e20e cmpTypeX: Avoid kind comparison when possible 6739397 (Alternative way to) address #8710 6350eb1 Handle multiline named haddock comments properly e38c07b Improve accuracy of suggestion to use TypeApplications 20ab2ad Note new GHC.Generics instances in release notes 116528c Improve pattern synonym error messages (add `PatSynOrigin`) 8e6e022 Testsuite: Introduce config.plugin_way_flags. e02b8c8 Testsuite: for tests that use TH, omit *all* prof_ways 90fa8cf Mark tests for #11643, #11644, #11645 and #9406 expect_broken 9b49c65 Testsuite: delete empty files [skip ci] 1badf15 Testsuite: do not write empty files on 'make accept' bb5afd3 Print which warning-flag controls an emitted warning bbfff22 Unconditionally handle TH known key names. a026112 Typos in comments, etc. e3f341f Fix and refactor strict pattern bindings a81e9d5 Special case for desugaring AbsBinds 4ddfe13 Get the right in-scope set in specUnfolding 7496be5 Exclude TyVars from the constraint solver 253ccdf Comments and white space only b4dfe04 Fix kind generalisation for pattern synonyms e193f66 Filter out BuiltinRules in occurrence analysis ef7b1d5 Test Trac #11611 eee040c Update transformer submodule to v0.5.2.0 release 890e2bb GHC.Generics: Ensure some, many for U1 don't bottom 3ee4fc0 rts: drop unused global 'blackhole_queue' b9c697e Print which flag controls emitted desugaring warnings 869d9c6 Print which flag controls emitted lexer warnings 82f200b Annotate `[-Wredundant-constraints]` in warnings (re #10752) b6c61e3 Print which flag controls emitted SafeHaskell warnings 3cd4c9c Annotate `[-Wdeferred-type-errors]` in warnings (re #10752) 46f3775 Default to -fno-show-warning-groups (re #10752) 171d95d Missing Proxy instances, make U1 instance more Proxy-like ad4428d base: Mark Data.Type.Equality as Trustworthy 2535c82 Fix bug where reexports of wired-in packages don't work. f72bdbd Refactor `warnMissingSignatures` in `RnNames.hs` 16e97c1 Build system: Correctly pass `TARGETPLATFORM` as host 2e49a31 DynFlags: Add -Wredundant-constraints to -Wall e3b9dbf Testsuite: check actual_prof_file only when needed de01de7 Remove some more Windows line endings [skip ci] f8a5dd0 Only add -fshow-warning-groups for ghc >= 7.11 (#10752) 49c55e6 Skip TEST=TcCoercibleFail when compiler_debugged 3c29c77 Do not check synonym RHS for ambiguity 243e2ab Comments only 2d52c3a A bit more tracing in TcHsType.tcTyVar a0899b2 Remove unnecessary isTyVar tests in TcType 57b4c55 Don't complain about unused Rule binders 286dc02 Fix an outright bug in expandTypeSynonyms aea1e5d Use tyConArity rather than (length tvs) 91a6a9c Add Monoid instance for FastString 15517f3 SimplEnv: Add Haddock headings to export list 1f3d953 users-guide: Mention #11558 in release notes 120b9cd rts/timer: use timerfd_* on Linux instead of alarm signals 6ca9b15 GHCi: Fix load/reload space leaks (#4029) 3801262 Fix printing of an `IfacePatSyn` 1d6177b Using unsafe foreign import for rtsSupportsBoundThreads (part of #9696) bd681bc Drop module qualifier from punned record fields (#11662) ade1a46 Fix minimum alignment for StgClosure (Trac #11395) 5e2605e GhcMake: Clang/ASSERT fix 13a801a Revert "Mark tests for #11643, #11644, #11645 and #9406 expect_broken" 82e36ed Reduce fragmentation from m32_allocator 90e1e16 Split external symbol prototypes (EF_) (Trac #11395) 1a9734a template-haskell: Drop use of Rank2Types/PolymorphicComponents 941b8f5 template-haskell: remove redundant CPP use 1c76e16 template-haskell: define `MonadFail Q` instance 4c3a0a4 Fix the implementation of lazyId 5a494d8 Refactoring around TcPatSyn.tcPatToExpr 374f919 Update Cabal submodule to latest HEAD snapshot c42cdb7 fix Float/Double unreg cross-compilation fc16690 Fix #11624, cannot declare hs-boot if already one in scope. c937f42 Add regression test for #11555 a1c4230 Use catchException in a few more places 30ee910 Make `catch` lazy in the action f3def76 add regression test for #11145. 767ff7c Document Quasi-quotes/list comprehension ambiguity a74a384 Include version in AC_PACKAGE_TARNAME f8056fc Make integer-gmp operations more strict d48220e Add Note [Running splices in the Renamer] 90b8af0 Fix readme link to FixingBugs wiki page 06b70ff Add doc to (<$>) explaining its relationship to ($) 8626d76 rtx/posix/Itimer.c: Handle return value of `read` 6a2992d Add MonadUnique instance for LlvmM e764ede Add ghc-flag directory for -XPatternGuards 2908ae8 Handle unset HOME environment variable more gracefully 3ea11eb Move getOccFS to Name 7ba817c Bump allocations for T6048 2f45cf3 Add -foptimal-applicative-do e46742f rts: fix threadStackUnderflow type in cmm 4d791b4 Simplify: Make generated names more useful 41051dd ghci: add message when reusing compiled code #9887 92821ec LlvmCodeGen: Fix generation of malformed LLVM blocks 9ee51da users_guide: Break up -fprint-* description d12166a Fix the name of the Word16ElemRep wired-in datacon 3f60ce8 Add regression test for #11702 18fbfa3 Move and expand (slightly) TypeApplications docs e9bf7bb Fix #11407. 84c773e Fix #11334. 35d37ff Fix #11401. 972730c Refactor visible type application. 6c768fc Expand Note [Non-trivial definitional equality] 693b38c Test case for #11699 in typecheck/should_compile e7a8cb1 Document TypeInType (#11614) 55577a9 Fix #11648. 3f5d1a1 Allow eager unification with type families. de4df6b Testsuite wibbles from previous commits. 19be538 Remove redundant anonymiseTyBinders (#11648) 857e9b0 Incorporate bgamari's suggestions for #11614. 1eefedf Fix #11357. aade111 Fix #11473. f602f4a Fix printing of "kind" vs. "type" 5d98b8b Clean up some pretty-printing in errors. 46f9a47 DriverPipeline: Fix 'unused arguments' warnings from Clang b5565f1 Fix #11711. c5ed41c typechecker: fix trac issue #11708 3fe87aa Fix #11716. f4f315a Fix #11512 by getting visibility right for methods 220a0b9 Add test for #9646 3ddfcc9 PrelRules: Fix constant folding for WordRemOp 2841cca Mark GHC.Real.even and odd as INLINEABLE c095ec5 Ensure T11702 always runs with optasm c0f628d Revert "Add test for #11473" cb7ecda Fix duplicate T11334 test 08d254b Fix T9646 7186a01 Dwarf: Add support for labels in unwind expressions ba95f22 prof: Fix heap census for large ARR_WORDS (#11627) b735e99 DsExpr: Don't build/foldr huge lists 289d57a Add test for incompatible flags (issue #11580) cb3456d base: Rework System.CPUTime e6a44f2 T11145: Fix expected output 286c65f base: Fix CPUTime on Windows 3ade8bc Delete a misleading comment in TyCon 2cb5577 Remove unnecessary Ord instance for ConLike c37a583 Remove unused substTyWithBinders functions af2f7f9 Fix exponential algorithm in pure unifier. 01b29eb TypeApplications does not imply AllowAmbiguousTypes 0706a10 Add two small optimizations. (#11196) 1701255 Fix #11635 / #11719. 0b89064 Make equality print better. (#11712) f8ab575 Rename test for #11334 to 11334b, fixing conflict 3e1b882 Prevent eager unification with type families. 9477093 Comment a suspicious zonk in TcFlatten. 35e9379 Track specified/invisible more carefully. 5c0c751 Zonk before calling splitDepVarsOfType. d978c5e Fix #11723 and #11724. e19e58c Improve panicking output 1934f7f stgMallocBytes: Tolerate malloc(0) returning a NULL ptr 2d6d907 Comments (only) in TcFlatten 6f0e41d PPC NCG: Emit more portable `fcmpu 0, ...` instead of `fcmpu cr0, ...` 685398e Use the correct in-scope set in coercionKind 0beb82c Avoid running afoul of the zipTvSubst check. 7e74079 Comment fix 7d5ff3d Move applyTysX near piResultTys db9e4eb Move DFunUnfolding generation to TcInstDcls e57b9ff Fix regression test for #11145. 2ddfb75 base: Fix ClockGetTime on OS X da3b29b Ensure T9646 dump-simpl output is cleaned 8048d51 ErrUtils: Add timings to compiler phases 997312b Add `PatSynSigSkol` and modify `PatSynCtxt` 2708c22 Close ticky profiling file stream after printing (#9405) 03a1bb4 Add unicode syntax for banana brackets 6c2c853 Various ticky-related work 9f9345e Create empty dump files (fixes #10320) 0db0594 DsExpr: Rip out static/dynamic check in list desugaring 8335cc7 Add expected output for T9405 ef653f1 Revert "Various ticky-related work" 1448f8a Show: Restore redundant parentheses around records 371608f Default RuntimeRep variables unless -fprint-explicit-runtime-reps 0bd0c31 Defer inlining of Eq for primitive types 2b5929c Comments only cb08f8d Tidy up handling of coercion variables 343349d Avoid local label syntax for assembler on AIX 2cebbe6 users_guide: Fix various issues 8ff6518 users-guide: Add -Wredundant-constraints to flags reference 173a5d8 users_guide: small improvements on pattern synonyms. 2414952 Add option `no-keep-hi-files` and `no-keep-o-files` (fixes #4114) df26b95 Add NCG support for AIX/ppc32 4dc8835 Remove code-duplication in the PPC NCG 26f86f3 base: Fix GHC.Word and GHC.Int on 32-bit platforms 84dd9d0 An extra traceTc in tcExpr for ExprWithSig 356e5e0 Do not eta-reduce across Ticks in CorePrep 12372ba CorePrep: refactoring to reduce duplication 067335a A raft of comments about TyBinders b416630f Test Trac #11728 da4bc0c Document implicit quantification better 454585c More clarification in docs for implicit quantification 4e98b4f DynFlags: Initialize unsafeGlobalDynFlags enough to be useful e8d3567 Panic: Try outputting SDocs d0787a2 testsuite: Identify framework failures in testsuite summary 1b4d120 DWARF: Add debugging information chapter to users guide 882179d RTS: Fix & refactor "portable inline" macros 4da8e73 Fix #11754 by adding an additional check. 12a76be Check for rep poly on wildcard binders. 9f73e46 Clarify Note [Kind coercions in Unify] 06cd26b Remove now obsolete LD_STAGE0 hack c7b32ad Remove now pointless INLINE_ME macro 61df7f8 Fix AIX/ppc codegen in `-prof` compilation mode 0bca3f3 Scrap IRIX support f911358 Scrap DEC OSF/1 support ffc802e Drop Xcode 4.1 hack and fix ignored CC var issue afc48f8 Autoconf: detect and set CFLAGS/CPPFLAGS needed for C99 mode 49b9d80 Do not test for existence of the executable eb25381 Update bytestring submodule to latest snapshot cd3fbff Remove obsolete --with-hc flag from ./configure 91b96e1 fix compilation failure on Solaris 11 a658ad9 Reenable external-json linters 0f0c138 base: Document caveats about Control.Concurrent.Chan 415b706 users-guide: Provide more depth in table-of-contents eb8bc4d users-guide: Wibbles aa61174 users-guide: Add references to various issues in bugs section 7393532 Use a correct substitution in tcInstType a49228e Build correct substitution in instDFunType 4a93e4f Use the correct substitution in lintCoercion 5097f38 Add Data.Functor.Classes instances for Proxy (trac issue #11756) b0ab8db base: Add comment noting import loop be2a7ba cleanup POSIX/XOPEN defines for switch to C99 85e6997 Remove all mentions of IND_OLDGEN outside of docs/rts 30b9061 Be more explicit about closure types in ticky-ticky-report 38c7714 Ticky: Do not count every entry twice 8af1d08 Typo in Note name 80d4fdf SpecConstr: Transport strictness data to specialization’s argument’s binders e6e17a0 Rename isNopSig to isTopSig c8138c8 Do not print DmdType in Core output cf768ec Tes suite output updates d5d6804 rename: Disallow type signatures in patterns in plain Haskell ae6a56e users-guide/rel-notes: Note broken-ness of ImpredicativeTypes eb6b709 base: Fix haddock typo cb9a1e6 Add testcase for #11770 a76e6f5 Typos in non-code 1757dd8 Don't recompute some free vars in lintCoercion 3d245bf Do not claim that -O2 does not do better than -O 973633a Comments only in Unify.hs 7aa4c52 rts/posix/Itimer.c: Handle EINTR when reading timerfd d1179c4 ghc-prim: Delay inlining of {gt,ge,lt,le}Int to phase 1 c0e3e63 Defer inlining of Ord methods 58bbb40 ghc-prim: Mark unpackCStringUtf8# and unpackNBytes# as NOINLINE e9c2555 Don't require -hide-all-packages for MIN_VERSION_* macros bc953fc Add -f(no-)version-macro to explicitly control macros. 24d7615 Kill the magic of Any 8f66bac Comments only 1f68da1 Minor refactoring in mkExport 2e5e822 Comments only bdd9042 Refactor in TcMatches 174d3a5 Small refactor of TcMType.tauifyExpType 0ad2021 Make SigSkol take TcType not ExpType 9fc65bb Refactor error generation for pattern synonyms 28fe0ee Demand Analyzer: Do not set OneShot information da260a5 Revert accidental change to collectTyAndValBinders 6ea42c7 Revert "Demand Analyzer: Do not set OneShot information" 3806891 Make the example for -M work 72bd7f7 Improve printing of pattern synonym types f2a2b79 Deeply instantiate in :type 90d7d60 rts: Make StablePtr derefs thread-safe (#10296) b3ecd04 Elaborate test for #11376 9b6820c Bump binary submodule 7407a66 Don't infer CallStacks 2f3b803 Use exprCtOrigin in tcRnExpr 1e6ec12 Fix misattribution of `-Wunused-local-binds` warnings 351f976 T10272, T4340: Add 32-bit output 726cbc2 T10870: Skip on 32-bit architectures 1a8d61c testsuite: Update 32-bit performance numbers 2265c84 Core pretty printer: Omit wild case binders 5b986a4 CSE code cleanup and improvement 0f58d34 Demand Analyzer: Do not set OneShot information (second try) c9e8f80 Set tct_closed to TopLevel for closed bindings. eda273b runtime: replace hw.ncpu with hw.logicalcpu for Mac OS X 27528b3 Adjust performance numbers 06b7ce2 testsuite: One more 32-bit performance slip 6b6beba Fix installation of static sphinx assets 535896e rts: Fix parsing of profiler selectors 2bcf0c3 Revert "testsuite: One more 32-bit performance slip" eca8648 GHC.Base: Use thenIO in instance Applicative IO f0af351 Remove obsolete comment about the implementation of foldl f9d26e5 Fix a comment: triple -> tuple 485608d Refactor comments about shutdown c4a7520 Provide an optimized replicateM_ implementation #11795 90d66de Add doc to (<=<) comparing its type to (.) f3beed3 Remove left-over shell-tools.c 6d7fda5 Remove spurious STG_UNUSED annotation 2f82da7 Fix Template Haskell bug reported in #11809. d2e05c6 Reduce default for -fmax-pmcheck-iterations from 1e7 to 2e6 5a1add1 Export zonkEvBinds from TcHsSyn. 470d4d5 Fix suggestions for unbound variables (#11680) cf5ff08 Bump haddock submodule ad532de base: Fix "since" annotation on GHC.ExecutionStack 7443e5c Remove the instantiation check when deriving Generic(1) 378091c RtsFlags: Un-constify temporary buffer 8987ce0 Typos in Note 90538d8 Change runtime linker to perform lazy loading of symbols/sections 46e8f19 Fix a closed type family error message 02a5c58 Filter out invisible kind arguments during TH reification 8b57cac Added (more) missing instances for Identity and Const aadde2b Deriving Functor-like classes should unify kind variables 2ef35d8 Use `@since` annotation in GHC.ExecutionStack c6e579b Add linker notes 83eb4fd Small simplification (#11777) 5c4cd0e Cache the size of part_list/scavd_list (#11783) f4446c5 Allocate blocks in the GC in batches b1084fd Fix #11811. dd99f2e Fix #11797. 0b6dcf6 Fix #11814 by throwing more stuff into InScopeSets d81cdc2 Teach lookupLocalRdrEnv about Exacts. (#11813) 49560ba Fix commented out debugging code in ByteCodeGen 227a29d Fix typos: tyars -> tyvars 20f9056 Remove some old commented out code in StgLint 3a34b5c Add a test case for #11731. f4fd98c Add a final demand analyzer run right before TidyCore 928d747 Kill some unnecessary varSetElems 2acfaae Comments only e24b3b1 Adjust error check for class method types 31e4974 Remove some gratitious varSetElemsWellScoped 8d66765 Increase an InScopeSet for a substitution aaaa61c users-guide: Note change in LLVM support policy 10c6df0 utils: Provide CallStack to expectJust 116088d testsuite: Add T11824 cb0d29b testsuite: Add test for #11827 9d063b6 Linker: Fix signedness mismatch 933abfa rel-notes: Add note about UndecidableSuperClasses and #11762 54e67c1 Remove dead function SimplUtils.countValArgs f0e331b Comments only, on Type.topSortTyVars a7ee2d4 Improve TcFlatten.flattenTyVar e9ad489 libdw: More precise version check d77981e rts/RetainerProfile: Remove unused local bf17fd0 deriveConstants: Verify sanity of nm f4e6591 Bump haddock submodule 865602e Rework CC/CC_STAGE0 handling in `configure.ac` 3f3ad75 Update `directory` submodule to v1.2.6.0 release 4cbae1b Update array submodule to v0.5.1.1 release tag 97f2b16 Add Windows import library support to the Runtime Linker 04b70cd Add TemplateHaskell support for Overlapping pragmas 89b6674 TH: Tweak Haddock language 7a1c073 users-guide: Fix typo 07dc330 validate: Note existence of config_args variable 7005b9f Add flag to control number of missing patterns in warnings 36a0b6d Check CCS tree for pointers into shared object during checkUnload 177aec6 Linker: Clean up #if USE_MMAP usage a392208 Resolve symlinks when attempting to find GHC's lib folder on Windows 93d85af Update `directory` submodule to v1.2.6.1 release dd920e4 Silence unused-import warning introduced by 93d85af9fec968b 8a75bb5 Update haskeline submodule to 0.7.2.3 release 3dac53f Make it easy to get hyperlinked sources 10d808c relnotes: Add note about #11744 and workaround 87114ae Use stdint types to define SIZEOF and ALIGNMENT of INTx/WORDx 32ddd96 Remove obsolete/redundant FLEXIBLE_ARRAY macro 350ffc3 rts: Limit maximum backtrace depth d1ce35d rts: Don't use strndup 8556f56 Update `directory` submodule to v1.2.6.2 release a3c37c3 Remove unused import of emptyNameEnv d59939a Define TyCoRep.ppSuggestExplicitKinds, and use it 17eb241 Refactor computing dependent type vars 8136a5c Tighten checking for associated type instances 9de405d Kill dead TauTvFlavour, and move code around 81e2279 Update hsc2hs submodule 91ee509 Mark GHC.Stack.Types Trustworthy 96e1bb4 Update deepseq submodule to latest 1.4.2.0 snapshot ff290b8 Update binary submodule to 0.8.3.0 release 15b7e87 Update `pretty` submodule to v1.1.3.3 release 81b14c1 Update unix submodule to v2.7.2.0 release 7f71dbe Bump haddock submodule 81aa3d1 Reduce use of instances in hs-boot files 871f684 Define NameSet.intersectFVs 7319b80 Tighten up imports, white space 353d8ae SCC analysis for instances as well as types/classes 61191de Fix two buglets in 17eb241 noticed by Richard cdcf014 Tighten up imports on TcTyClsDecls 687c778 Kill unnecessary varSetElemsWellScoped in deriveTyData 62943d2 Build a correct substitution in dataConInstPat 55b1b85 Accept tcrun045 output 2e33320 Rename FV related functions 98a14ff Point to note about FV eta-expansion performance 7c6585a Remove mysterious varSetElemsWellScoped in tidyFreeTyCoVars 8c33cd4 testsuite: Bump max bytes used of T4029 f02af79 Improve the behaviour of warnIf edf54d7 Do not use defaulting in ambiguity check 9421b0c Warn about simplifiable class constraints 251a376 Test Trac #3990 26a1804 wibble to simplifiable 24d3276 A little more debug tracing c2b7a3d Avoid double error on out-of-scope identifier 970ff58 Simplify defaultKindVar and friends 6ad2b42 Refactor free tyvars on LHS of rules ed4a228 Fix typos: alpah -> alpha 4221cc2 Typo: veraibles -> variables a9076fc Remove unused tyCoVarsOfTelescope 0f96686 Make benign non-determinism in pretty-printing more obvious 03006f5 Get rid of varSetElemsWellScoped in abstractFloats 28503fe deriveConstants: Fix nm-classic error message e8c04d4 Testsuite: Delete test for deprecated "packedstring" dadf82d Testsuite: fixup lots of tests 2a83713 Testsuite: delete Roles9.stderr fd5212f Testsuite: delete unused concurrent/prog002/FileIO.hs c9bcaf3 Kill varSetElemsWellScoped in quantifyTyVars e68195a RTS: Add setInCallCapability() 95f9334 GHCi: use real time instead of CPU time for :set -s d396996 Doc improvement for ApplicativeDo 24864ba Use __builtin_clz() to implement log_2() 0712f55 Just comments & reformatting 2dc5b92 Kill varSetElems in TcErrors 94320e1 Kill varSetElems try_tyvar_defaulting f13a8d2 Kill varSetElems in markNominal a48ebcc Implement the state hack without modifiyng OneShotInfo 5adf8f3 Document -fmax-pmcheck-iterations a bit better a0e1051 Recommend more reliable recourse for broken nm 57c636f Update nofib submodule to nofib master fa3ba06 Expand the comment on pprVarSet 82538f6 Kill varSetElems in injImproveEqns af6dced Comments only a2abcf6 Minor improvement to error message 1e86cab Comments only 9ed57d6 Remove unused unifyType_ 4c746cb Add missing solveEqualities 3dce4f2 Refactor RecordPatSynField, FieldLabel c4dd4ae Better documentation of -XConstrainedClassMethods c5b1014 Fix debug-only check in CoreLint 546f24e Revert "Use __builtin_clz() to implement log_2()" 3a53380 Kill unused foldOccSet 196ce62 Testsuite: delete accidentally committed .stderr.normalised file 89c6d07 Testsuite: add -ignore-dot-ghci to some ghci tests [skip ci] 9dc34d3 Testsuite: fix T11223_simple_(unused_)duplicate_lib b0569e8 Testsuite: benign test fixes 3c426b0 Add uniqSetAny and uniqSetAll and use them 7312923 Kill mapUniqSet 32c0aba Testsuite: delete -fesc tests e20b3ed Testsuite: delete T5054 and T5054_2 (#5054) bcfee21 rts/LdvProfile.c: Fix NULL dereference on shutdown f255f80 Linker: Fix implicit function declaration warning on OS X 6e195f4 Remove unused foldFsEnv 031de8b Remove unused foldNameEnv f99db38 Fix path to the new build system, now called Hadrian. 0fa1d07 testsuite: fix up T11223's Makefile a2970f8 RTS: delete BlockedOnGA* + dead code c5919f7 Remove the incredibly hairy splitTelescopeTvs. 7242582 Test #11484 in th/T11484 00053ee Fix typo: Superclases -> Superclasses b725fe0 PPC NCG: Improve pointer de-tagging code c4259ff Testsuite: make CLEANUP=1 the default (#9758) 2ae39ac Testsuite: accept new output for 2 partial-sigs tests 2fe7a0a Fix reference to Note in TcCanonical cb05860 Comment typos: Mkae -> Make, Hsakell -> Haskell 49bae46 Comment typo: unambigious -> unambiguous f69e707 Typos in DmdAnal e6627d1 Fix aggressive cleanup of T1407 868d2c4 rts: Remove deprecated C type `lnat` eac6967 users-guide: Add index entry for "environment file" 18676a4 Bump haddock submodule 533037c Greater customization of GHCi prompt 16a51a6 rts: Close livelock window due to rapid ticker enable/disable 65e13f6 rts: Split up Itimer.c df9b772 Catch errors from timerfd_settime 55f4009 Kill Itimer.h 999c464 rts/itimer/pthread: Stop timer when ticker is stopped 116d3fe Remove unused getScopedTyVarBinds 1161932 Add T11747 as a test ecc0603 deriveConstants: Fix nm advice one last time a28611b Export constructors for IntPtr and WordPtr ea34f56 Remove unused equivClassesByUniq cd85dc8 Make sure record pattern synonym selectors are in scope in GHCi. db2bfe0 added docstring for '-fhistory-size' flag 81d8a23 glasgow_exts.rst: fix quoting c5be5e2 docs/users_guide/glasgow_exts.rst: fix merge conflict fa86ac7 Make validDerivPred ignore non-visible arguments to a class type constructor 36d29f7 StaticPointers: Allow closed vars in the static form. 5f8c0b8 Revert "Revert "Use __builtin_clz() to implement log_1()"" ef44606 Cleanups related to MAX_FREE_LIST 0051ac1 Update libraries/hpc submodule to v0.6.0.3 release tag 4466ae6 Update bytestring submodule to 0.10.8.0 release tag 50e7055 Export oneShot from GHC.Exts f9d9375 Adjust testsuite output to bytestring-0.10.8.0 76ee260 Allow limiting the number of GC threads (+RTS -qn) f703fd6 Add +RTS -AL 1fa92ca schedulePushWork: avoid unnecessary wakeups dbcaa8c Don't STATIC_INLINE giveCapabilityToTask aa5e2dd Make 'make fast' work for the User Guide b75d194 Be more aggressive when checking constraints for custom type errors. 4f2afe1 testsuite: Add test for #11959 763610e base: Export runRW# from GHC.Exts ad4392c Kill non-deterministic foldUFM in TrieMap and TcAppMap db9de7e rts: Replace `nat` with `uint32_t` e340520 Comments only explaining export list parsing. 94f2ee1 Explain linter optimization for StaticPtr checks. 990ce8c Use tcExtendGlobalValEnv for default methods ecc1d58 Update Win32 submodule to v2.3.1.1 release tag 018487e Fix pretty printing of IEThingWith fe190ae Remove trailing whitespace from 'testsuite/tests/module/all.T' 633b099 Update time submodule to 1.6.0.1 release tag 8e5776b rts/ProfHeap.c: Use `ssize_t` instead of `long`. dd3e847 Documentation for simplifyDeriv. 260a564 Use stdint types for Stg{Word,Int}{8,16,32,64} 2593e20 White space only 76d9156 Emit wild-card constraints in the right place cc75a5d Comments only e1ff2b4 Fix partial sigs and pattern bindings interaction 9dbf5f5 Tidy up partial-sig quantification bb296bf Error message wibbles, re partial type sigs 0597493 Re-do the invariant for TcDepVars 3ca7806 stg/Types.h: Fix comment and #include 53f26f5 Forbid variables to be parents in import lists. e996e85 RdrHsSyn: Only suggest `type` qualification when appropriate ea3d1ef Fix a crash in requestSync() bff6e1b Comments only 4ac0e81 Kill unnecessary cmpType in lhs_cmp_type b58b0e1 Make simplifyInstanceContexts deterministic a4717f5 Comments about static forms b21e8cc Comments only e7e5939 Add Outputable ShowHowMuch e24b50c Use partial-sig constraints as givens 1a43783 Record that EqualityConstraint now works f6e58be Test Trac #11640 7e28e47 Get rid of Traversable UniqFM and Foldable UniqFM 402f201 Fix typos ab91b85 make accept for Make simplifyInstanceContexts deterministic e207198 Kill foldUFM in classifyTyCon 8669c48 Document why closeOverKind is OK for determinism 584ade6 RtsFlags: Make `mallocFailHook` const correct 0efbf18 rts: Fix C compiler warnings on Windows 9363f04 Handle promotion failures when scavenging a WEAK (#11108) 0e71988 Remove some varSetElems in dsCmdStmt 3edbd09 Document SCC determinism cfc5df4 Fix ASSERT failure and re-enable setnumcapabilities001 2a0d00d Make random an "extra" package 86a1f20 Remove a copy of System.Random and use reqlib('random') b5f85ce Remove stale comment. da105ca Don't prematurely force TyThing thunks with -ddump-if-trace. 925b0ae Make absentError not depend on uniques eae3362 docs: add skeleton 8.2.1 release notes e217287 Bump haddock submodule c079de3 Add TH support for pattern synonyms (fixes #8761) e53f218 Fix deriveTyData's kind unification when two kind variables are unified b8e2565 Make Generic1 poly-kinded 6971430 Allow putting Haddocks on derived instances 01bc109 Document zonkTyCoVarsAndFV determinism 6bf0eef Kill varEnvElts in specImports 69c974f Use StgHalfWord instead of a CPP #if 995cf0f rts: Make function pointer parameters `const` where possible 0c0129b RtsUtils: Use `size_t` instead of `int` where appropriate 7c0b595 Fix comments about scavenging WEAK objects 5416fad Refactor some ppr functions to use pprUFM bd01bbb Test Trac #12039 8e48d24 Bump haddock submodule e4834ed Fix a performance issue with -fprint-expanded-synonyms c974927 Update bytestring submodule to 0.10.8.1 release tag bf669a0 Bump haddock submodule 2dbdc79 PPC NCG: Fix pretty printing of st[wd]ux instr. 563a485 PPC: Implement SMP primitives using gcc built-ins d78faa1 testsuite/ImpSafe03: Normalize version of bytestring eed820b Move Extension type to ghc-boot-th 21fe4ff Kill varSetElems in tcInferPatSynDecl d20d843 Another bump of haddock submodule 7814420 Remove html_theme requirement of haddock docs 4a037a9 Set `USE_MMAP` at configure time 770d708 Add ghc-boot-th to rules/foreachLibrary dc94914 Document determinism in shortOutIndirections 3f3dc23 Testsuite: run tests in /tmp after copying required files 1a9ae4b Testsuite: delete old cleanup code (#11980) a9dd9b7 Testsuite: delete unused file [skip ci] c92cfbc Testsuite: don't skip concio001 and concio001_thr 931b3c7 Delete libraries/ghci/GNUmakefile [skip ci] a54d87a rules: Fix name of ghc-boot-th library 5d80d14 rules/build-prog: Ensure programs depend upon their transitive deps 33c029d rts: More const correct-ness fixes b088c02 Testsuite: T10052 requires interpreter (#11730) 3251743 Testsuite: don't warn when mk/ghcconfig_* hasn't been created yet 77ee3a9 Update .mailmap [skip ci] fffe3a2 Make inert_model and inert_eqs deterministic sets f0f0ac8 Fix histograms for ticky code ba3e1fd Add a test for #11108 39a2faa Rework parser to allow use with DynFlags 310371f rts: Add isPinnedByteArray# primop f091218 CLabel: Catch #11155 during C-- pretty-printing 9dd0481 Add (broken) test for #12063. 5f1557e Failing test case for #12076. f18e8d8 rts: Add missing `const` from HashTable API 6282bc3 Kill varSetElems in tidyFreeTyCoVars 13e40f9 Kill varEnvElts in tcPragExpr 72b677d Fix Trac #12051 ad7f122 Improve pretty-printing of equalities f9e90bc Improve documentation for type wildcards 0bfcfd0 Comments only d1efe86 Comments only 358567a testsuite: Add expected output for T11108 470def9 Testsuite: fix T11827 (#11827) 296b8f1 Add libraries/ghci/GNUmakefile to .gitignore [skip ci] f0f3517 Remove use of caddr_t 8abc193 Get types in osFreeMBlocks in sync with osGetMBlocks 464b6f8 {,M}BLOCK_SIZE_W * sizeof(W_) -> {,M}BLOCK_SIZE 2e6433a testsuite: Add a TypeRep test a88bb1b Give lifted primitive types a representation 1ee47c1 Use the correct return type for Windows' send()/recv() (Fix #12010) 3910306 Add -XStaticPointers to the flag reference. 08e47ca FunDep printer: Fix unicode arrow 43589f5 testsuite: add CmmSwitchTest for 32-bit platforms ae7e9cb Fix Windows build after Ticky changes 8e92974 Testsuite: mark T8761 expect_broken #12077 a1f3bb8 Fix failing T12010 d9cb7a8 compiler/iface: compress .hi files e44a6f9 users-guide: Vector version of Thomson-Wheeler logo 6d6d6e4 rules/sphinx: Add missing dependency on conf.py for pdf rule cf1efc7 users-guide: Fix index in PDF output da3c1eb Enable checkProddableBlock on x86_64 527ed72 Fix deriving Ord when RebindableSyntax is enabled c81e7b2 Build system: temp solution for parallelisation bug (#11960) f669764 Use `setSession` instead of `modifySession` when setting `HscEnv` a70a6da rts/Linker.c: Fix compile error on Arm fa58710 Update format specifiers for Tickey.c 2230c88 Testsuite: fix T12010 for real 8c9b8a3 Allow unlifted types in pattern synonym result type d835ee6 Fix build by removing unused import. 785b38f testsuite: Update max_bytes_used for T4029 9bb2772 Revert "compiler/iface: compress .hi files" 4f5b335 Suppress the warning about __sync_fetch_and_nand (#9678) 03d8960 Don't split the arg types in a PatSyn signature eb8eb02 Spelling in comment 839b424 Remove unused Type.splitFunTysN 9c3e55b Comments only 35053eb Testsuite: delete check_files_written 1bf5c12 Spelling 8f7d016 Add support for unicode TH quotes (#11743) 4c6e69d Document some benign nondeterminism 9d06ef1 Make Arrow desugaring deterministic 95dfdce Remove 'deriving Typeable' statements fe8a4e5 Runtime linker: Break m32 allocator out into its own file 1956cbf Fix: #12084 deprecate old profiling flags 31f1804 Testsuite: delete drvfail015.stderr-7.0 [skip ci] 1319363 Always use native-Haskell de/encoders for ASCII and latin1 ac38c02 Update submodule vector [skip ci] 961ed26 Fix broken links to mdo papers eec88ee RTS: simplify read_heap_profiling_flag bdc5558 Testsuite: introduce TEST_HC_OPTS_INTERACTIVE (#11468) 8408d84 Spelling in comments 6a5bce1 Testsuite: also normalise platform-dependent .stdout/stderr f07bf19 Testsuite: fix enum01/02/03 on Windows (#9399) 5020bc8 Testsuite: add a test for #5522 (-fliberate-case -fspec-constr) 0f1e315 Fix bytecode gen to deal with rep-polymorphism e9e61f1 Reduce special-casing for nullary unboxed tuple 5b8bec2 StgCmmExpr: Fix a duplication 5b145c9 Coverage.hs: Fix a duplication cd50d23 StgCmmCon: Do not generate moves from unused fields to local variables b43a793 More fixes for unboxed tuples 72fd407 Comments and white space only 59250dc StgCmmExpr: Remove a redundant list 3a00ff9 Do not init record accessors as exported 3f20da1 Typos in comments d0dd572 Clarify users' guide section on GeneralizedNewtypeDeriving d40682e Testsuite: don't use --interactive in Makefiles 1e67010 RtsFlags.c: Const correct fixes 7e4f3dc StgCmmUtils.emitMultiAssign: Make assertion msg more helpful 0ffa23d Remove unused FAST_STRING_NOT_NEEDED macro defs 930e74f Update a Cmm note 0676e68 Fix detection and use of `USE_LIBDW` cb2c042 Use nameSetAny in findUses f2b3be0 Improve failed knot-tying error message. 99ace83 Kill nameSetElems in getInfo 36d254a Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx 940229c Travis: llvm's apt repository is offline cb9f635 Localize orphan-related nondeterminism d348acd Serialize vParallelTyCons in a stable order 3eac3a0 Add nameSetElemsStable and fix the build dad39ff Remove dead generics-related code from OccName d753ea2 Use UniqDSet for finding free names in the Linker e2446c0 Kill nameSetElems in findImportUsage be47085 Kill nameSetElems in rnCmdTop 060c176 Whitespace only 1d1987e HscMain: Minor simplification 9cc6fac Make FieldLabelEnv a deterministic set 2046297 Document putSymbolTable determinism 4842a80 Derive instances in Data.Data 1dadd9a testsuite: Mark broken tests on powerpc64le 3747372 Refactored SymbolInfo to lower memory usage in RTS 079c1b8 Use useful names for Symbol Addr and Names in Linker.c 02f893e integer-gmp: Make minusInteger more efficient 4aa299d PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames eda73a3 RTS SMP: Use compiler built-ins on all platforms. 4dbacbc Rename isPinnedByteArray# to isByteArrayPinned# b948a1d Refactor the SymbolName and SymbolAddr types to be pointers 5965117 Replace hand-written Bounded instances with derived ones 0d963ca Add relocation type R_X86_64_REX_GOTPCRELX 4848ab9 Testsuite: fixup comments for T9872d [skip ci] 886f4c1 Better comment for orIfNotFound. f91d87d Failing test-case for #12135. 3042a9d Use UniqDFM for HomePackageTable 48e9a1f Implement deterministic CallInfoSet a90085b Add @since annotations to base instances e684f54 Desugar ApplicativeDo and RecDo deterministically 31ba8d6 Kill nameSetElems 46d2da0 Document putDictionary determinism 3e7a876 Kill foldUniqSet 1937ef1 Make UnitIdMap a deterministic map a13cb27 Merge MatchFixity and HsMatchContext 77ccdf3 Kill occSetElts 7fea712 Use a deterministic map for imp_dep_mods d05dee3 CoreToStg: Remove hand-written Eq instances of HowBound and LetInfo 4426c5f Kill two instances of uniqSetToList 0d6f428 Fix build by removing unused import c148212 Kill varSetElems in checkValidInferredKinds ad8e203 Use DVarSet in Vectorise.Exp 3b698e8 Document determinism in pprintClosureCommand 5db93d2 Make vectInfoParallelVars a DVarSet 7008515 Kill varSetElems 7d58a97 Use pprUFM in pprStgLVs 00e3a5d Typofix. 4d5b2f6 Testsuite driver: always quote opts.testdir f5f5a8a Testsuite Windows: mark T8308 expect_broken (#8308) d4b548e Add some determinism tests dd33245 Desugar: Display resulting program stats with -v2 44a3c18 Revert "Desugar: Display resulting program stats with -v2" c2bbc8b Report term sizes with -v3 even when -ddump is enabled 80cf4cf Literal: Remove unused hashLiteral function d7933cb Show sources of cost centers in .prof 8f6d292 Fix #12064 by making IfaceClass typechecking more lazy. acb9e85 Minor performance note about IdInfo. 11ff1df Fix #12076 by inlining trivial expressions in CorePrep. 48385cb Remove special casing of Windows in generic files ceaf7f1 Implement Eq TyCon directly 68c1c29 Remove Ord (CoAxiom br) 9dbf354 Testsuite: delete dead code [skip ci] e703a23 Docs: fix links to ghc-flags 70e0a56 Remove Ord Class b2624ee Remove Ord PatSyn 77b8c29 Remove Ord AltCon c22ab1a Docs: delete PatternGuards documentation b020db2 Fix Ticky histogram on Windows e9dfb6e Improve the error messages for static forms. b0a7664 prettyPrintClosure(): Untag the closure before accessing fields 47d8173 Remove Printer.c:prettyPrintClosure() bcb419a Fix #12099: Remove bogus flags 6adff01 Comments only 6905ce2 Refine imports slightly 0f0b002 Comments only 3ae18df Minor refactoring b9fa72a Small refactor to mkRuntimErrorId 9e5ea67 NUMA support c88f31a Rts flags cleanup 5990016 ModuleSet: Use an actual set instead of map to units 6ace660 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined 9130867 Skip retc001 on OSX b40e1b4 Fix incorrect calculated relocations on Windows x86_64 29e1464 Disable T12031 on linux 2bb6ba6 rts: Fix NUMA when cross compiling d25cb61 Kill off redundant SigTv check in occurCheckExpand 15b9bf4 Improve typechecking of let-bindings c28dde3 Tidy up zonkQuantifiedTyVar 7afb7ad Get in-scope set right in top_instantiate 35c9de7 Move the constraint-kind validity check 1f66128 Beef up mkNakedCastTy 15fc528 Fix the in-scope set for extendTvSubstWithClone 599d912 Beef up isPredTy 8104f7c Remove some traceTc calls e064f50 Add to .gitignore 921ebc9 Test Trac #12055 1dcb32d A second test for Trac #12055 5cee88d Add thin library support to Windows too 7de776c Kill unused foldModuleEnv 586d558 Use UniqFM for SigOf 0497ee5 Make the Ord Module independent of Unique order d55a9b4 Update Haddock to follow change in LHsSigWcType 4f35646 Adjust error message slightly 8dfd4ae Build system: mention ghc version in bindist's `configure --help` docdir a2deee0 Testsuite: enable ghci.prog010 (#2542) 23b73c9 Don't GC sparks for CAFs 9d22fbe Rename cmpType to nonDetCmpType 753c5b2 Simplify readProcessEnvWithExitCode + set LANGUAGE=C 70a4589 Revert "Make the Ord Module independent of Unique order" e33ca0e Fix testsuite wibble 77bb092 Re-add FunTy (big patch) e368f32 Major patch to introduce TyConBinder c56f8bd CoreMonad: Update error msg function docs 930a525 Abort the build when a Core plugin pass is specified in stage1 compiler a7f65b8 Remove dead code: countOnce, countMany 498ed26 NUMA cleanups 8d33af9 CoreLint: Slightly improve case type annotation error msgs 3e8c495 CmmNode: Make CmmTickScope's Unique strict 2396d9b llvmGen: Make metadata ids a newtype 85e09b1 llvmGen: Consolidate MetaExpr pretty-printing 9bb0578 Revert accidental submodule updates e02beb1 Driver: `ghc ../Test` (without file extension) should work f72f23f Testsuite: run tests in .run instead of /tmp 6f6f515 Testsuite: write "\n" instead of "\r\n" when using mingw Python d94c405 Testsuite: validate the tests/stage1 directory with the stage1 compiler a4c8532 Validate: use `rm -f` instead of `rm` 6354991 VarEnv: Comment only 270d545 Add Bifoldable and Bitraversable to base 9649fc0 Refactor derived Generic instances to reduce allocations 4d71cc8 Avoid find_tycon panic if datacon is not in scope f12fb8a Fix trac #10647: Notice about lack of SIMD support 2897be7 PPC NCG: Fix float parameter passing on 64-bit. f4b0488 PPC NCG: Fix and refactor TOC handling. 0be38a2 llvmGen: Add strictness to metadata fields 0e92af9 Remove use of KProxy in GHC.Generics 0ba34b6 ApplicativeDo: allow "return $ e" e7e42c8 Fix double-free in T5644 (#12208) cdc14b4 Testsuite: remove Windows CR again.. [skip ci] 9cdde38 Testsuite: remove Windows CR [skip ci] cf6e656 Testsuite: remove Windows CR [skip ci] 3dc1202 Testsuite: tabs -> spaces [skip ci] 7e7094f Testsuite: tabs -> spaces [skip ci] 46ff80f Testsuite: tabs -> spaces [skip ci] 915e07c Testsuite: tabs -> spaces [skip ci] 5b03dc6 Testsuite: tabs -> spaces [skip ci] a7160fa Testsuite: tabs -> spaces [skip ci] 4a4bdda Testsuite: recover from utf8 decoding errors 6d0a4fc Testsuite: fix WAY=ghci when LOCAL=0 1ddc10b Testsuite: *do* replace backslashes in config.libdir 1d938aa Testsuite: mark tests expect broken 3b49f8f Testsuite: remove `-fforce-recomp` from default flags (#11980) 82f7f18 Testsuite: delete TEST_HC_OPTS_NO_RECOMP 135fc86 Testsuite: remove `-Wno-warn-tabs` from default flags ebaf26b Testsuite: delete dead code + cleanup e170d19 Testsuite: assume timeout_prog always exists ee3bde7 Expand and clarify the docs for ApplicativeDo (#11835) 7301404 Typos in comments d09e982 Don't quantify over Refl in a RULE 97a50f8 Delete commented-out code 1230629 Make checkFamInstConsistency less expensive a47b62c Second attempt to fix sizeExpr c0583a9 Fix build breakage due to rebase 9d62d09 Hopefully fix all the rebase-induced breakage 4e7d835 Typos in comments [skip ci] 6199588 More typos in comments [skip ci] 93f40cb Don't error on GCC inlining warning in rts 348f2db Make the Ord Module independent of Unique order (2nd try) 15641b0 Accept new (lower) allocations for T7257 7e7aeab Comments only cc92a44 Improve error message in deriving( Functor ) a1b3359 Remove unused arg to tcSuperClasses ce97b72 Expand given superclasses more eagerly 210a2e1 Test Trac #12163 3e0af46 Give lookupGRE_Name a better API e556f76 Remove unused import 643706e Narrow the warning for simplifiable constraints 2f8cd14 Narrow the use of record wildcards slightly 7fc20b0 Have Core linter accept programs using StaticPointers and -fhpc. 35d1564 Provide Uniquable version of SCC bb74021 Remove Ord TyCon 7f5d560 Very confusing typo in error message. 9a34bf1 Fix #11974 by adding a more smarts to TcDefaults. 8035d1a Fix #10963 and #11975 by adding new cmds to GHCi. 4ae950f Release notes for #11975 and #10963 df9611e Testsuite: do not copy .hi/.o files to testdir (#12112) d2958bd Improve typechecking of instance defaults c871ce4 Comments around invisibility 393928d Fix renamer panic f86a337 Remove bogus comment on ForAllTy bb84ee4 Improve pretty-printing of Avail 12c4449 Implement ReifyConStrictness for -fexternal-interpreter (#12219) d2006d0 Run all TH tests with -fexternal-interpreter (#12219) bdb0d24 Remote GHCi: separate out message types eb73219 Remote GHCi: comments only 0bab375 Fix T8761 (#12219, #12077) dadd8b8 Test Trac #12229 9bc2233 Fix typo in Data.Bitraverse Haddocks 31b5806 Clean up outdated comments in template-haskell changelog a33b498 Add template-haskell changelog note for #8761 5fdb854 s/Invisible/Inferred/g s/Visible/Required/g 4cc5a39 Refactor tcInferArgs and add comments. 8c1cedd Allow building static libs. da60e3e rts/Linker.c: Improve ugly C pre-processor hack 7843c71 Make T8761 deterministic, I hope ff1cc26 Don't run the run_command tests with ext-interp 82282e8 Remove some `undefined`s 60c24b2 Typos in user manual and code: recurisve -> recursive afa6e83 rts/Linker.c: Rename ONLY_USED_x86_64_HOST_ARCH macro bbf0aa2 Testsuite: never pick up .T files in .run directories 7593c2f Testsuite: report duplicate testnames when `make TEST=` 1f45bce Testsuite: remove one level of indentation [skip ci] 206b4a1 Testsuite: simplify extra_file handling bafd615 Testsuite: do not print timeout message 58f0086 Testsuite: open/close stdin/stdout/stderr explicitly d8e9b87 Testsuite: cleanup printing of summary 782cacf Testsuite: framework failure improvements (#11165) 6b3b631 Testsuite: run all indexed-types ways on ./validate --slow 0eb0378 Testsuite: do not add -debug explicitly in .T file 3fb9837 Testsuite: mark tests expect_broken af21e38 Don't omit any evidence bindings 23b80ac Deal correctly with unused imports for 'coerce' dc62a22 Wibble error message for #11471 dd92c67 Stop the simplifier from removing StaticPtr binds. 2e9079f Test Trac #12185 848e3ce Testsuite: fixes for python2.6 support 9a645a1 Refactor match to not use Unique order 8f7194f Double the file descriptor limit for openFile008 1084d37 Testsuite: use ignore_stderr/stdout instead of ignore_output 24194a6 Fix pretty-printer for IfaceCo e8d6271 Testsuite: do not depend on sys.stdout.encoding fb6e2c7 Delete Ord Unique 9854f14 Add a new determinism test b6b20a5 Reorganize some determinism tests 480e066 Remove ufmToList b8b3e30 Axe RecFlag on TyCons. 0701db1 Updates to handle new Cabal 430f5c8 Trac #11554 fix loopy GADTs 6a5d13c nativeGen: Allow -fregs-graph to be used f68d40c ghc-pkg: Drop trailing slashes in computing db paths f1e16e9 CmmExpr: remove unused `vgcFlag` function b65363d Fix check_uniques in non-unicode locale 0afc41b Testsuite: be less strict about topHandler03's stderr c27ce26 users-guide: Fix markup in release notes 81b437b Add NamedThing (GenLocated l e) instance b412d82 Allow one type signature for multiple pattern synonyms 6ba4197 rules/sphinx.mk: stop xelatex on error ee8d1fa Remove unused oc->isImportLib (#12230) 6377757 Linker: some extra debugging / logging cbfeff4 Remove uniqSetToList 0d522b8 Document some benign nondeterminism 0ab63cf Kill varEnvElts in seqDmdEnv 01f449f Fix 32-bit build failures 9031382 MkCore: Fix some note names a6819a0 base: Add release date to changelog bf7cbe7 users-guide: Note multiple pattern signature change in relnotes afec447 testsuite: Add testcase for #12355 2a3af15 Treat duplicate pattern synonym signatures as an error 3b2deca users-guide: Remove static field type from rts-flag 331febf CallArity: Use not . null instead of length > 0 0bd7c4b Enum: Ensure that operations on Word fuse 18e71e4 Revert "Fix 32-bit build failures" 890ec98 Revert "Linker: some extra debugging / logging" e10497b Kill some varEnvElts 85aa6ef Check generic-default method for ambiguity 1267048 Extra ASSERTs for nameModule 55e43a6 Use DVarEnv for vectInfoVar 5f79394 Delete out-of-date comment 895eefa Make unique auxiliary function names in deriving cbe30fd Tidy up tidying f2d36ea White space only 6cedef0 Test Trac #12133 27fc75b Document codegen nondeterminism 18b782e Kill varEnvElts in zonkEnvIds 1b058d4 Remove varEnvElts b7b130c Fix GetTime.c on Darwin with clock_gettime f560a03 Adds x86_64-apple-darwin14 target. 567dbd9 Have addModFinalizer expose the local type environment. 56f47d4 Mention addModFinalizer changes in release notes. 672314c Switch to LLVM version 3.8 b9cea81 Show testcase where demand analysis abortion code fails 979baec --without-libcharset disables the use of libcharset bedd620 Style changes for UniqFM 6ed7c47 Document some codegen nondeterminism 9858552 Use deterministic maps for FamInstEnv 34085b5 Correct the message displayed for syntax error (#12146) 64bce8c Add Note [FamInstEnv determinism] 6e280c2 Utils: Fix `lengthIs` and `lengthExceeds` for negative args 0481324 Use UniqDFM for InstEnv b8cd94d GHC.Stack.CCS: Fix typo in Haddocks 91fd87e FastString: Reduce allocations of concatFS 15751f2 FastString: Add IsString instance c4a9dca FastString: Supply mconcat implementation fc53d36 OccName: Implement startsWithUnderscore in terms of headFS eb3d659 OccName: Avoid re-encoding derived OccNames 4f21a51 Kill eltsUFM in classifyTyCons 6c7c193 DsExpr: Remove usage of concatFS in fingerprintName 0177c85 Testsuite: expose TEST_CC (path to gcc) f53d761 TysWiredIn: Use UniqFM lookup for built-in OccNames 9a3df1f check-api-annotations utility loads by filename 17d0b84 Add -package-env to the flags reference 372dbc4 Pretty: delete really old changelog 45d8f4e Demand analyser: Implement LetUp rule (#12370) 18ac80f tidyType: Rename variables of nested forall at once cd0750e tidyOccNames: Rename variables fairly 37aeff6 Added type family dependency to Data.Type.Bool.Not b35e01c Bring comments in TcGenGenerics up to date a9bc547 Log heap profiler samples to event log ffe4660 IfaceEnv: Only check for built-in OccNames if mod is GHC.Types 24f5f36 Binary: Use ByteString's copy in getBS 0f0cdb6 Bugfix for bug 11632: `readLitChar` should consume null characters 1ba79fa CodeGen: Way to dump cmm only once (#11717) 89a8be7 Pretty: remove a harmful $! (#12227) 5df92f6 hp2ps: fix invalid PostScript for names with parentheses d213ab3 Fix misspellings of the word "instance" in comments 3fa3fe8 Make DeriveFunctor work with unboxed tuples 514c4a4 Fix Template Haskell reification of unboxed tuple types 1fc41d3 Make okConIdOcc recognize unboxed tuples 0df3f4c Fix PDF build for the User's Guide. 98b2c50 Support SCC pragmas in declaration context e46b768 Make Data.{Bifoldable,Bitraversable} -XSafe 908f8e2 TcInteract: Add braces to matchClassInst trace output 8de6e13 Fix bytecode generator panic cac3fb0 Cleanup PosixSource.h a0f83a6 Data.Either: Add fromLeft and fromRight (#12402) 627c767 Update docs for partial type signatures (#12365) ed48098 InstEnv: Ensure that instance visibility check is lazy 9513fe6 Clean up interaction between name cache and built-in syntax a4f2b76 testsuite: Add regression test for #12381 93acc02 Add another testcase for #12082 cf989ff Compact Regions 83e4f49 Revert "Clean up interaction between name cache and built-in syntax" 714bebf Implement unboxed sum primitive type a09c0e3 Comments only 9c54185 Comments + tiny refactor of isNullarySrcDataCon 8d4760f Comments re ApThunks + small refactor in mkRhsClosure 6a4dc89 Bump Haddock submodule 8265c78 Fix and document Unique generation for sum TyCon and DataCons e710f8f Correct a few mistyped words in prose/comments bbf36f8 More typos in comments fb34b27 Revert "Cleanup PosixSource.h" 86b1522 Unboxed sums: More unit tests bfef2eb StgCmmBind: Some minor simplifications c4f3d91 Add deepseq dependency and a few NFData instances 648fd73 Squash space leaks in the result of byteCodeGen 7f0f1d7 -fprof-auto-top 1fe5c89 UNPACK the size field of SizedSeq d068220 Fix the non-Linux build 4036c1f Testsuite: fix T10482a 1967d74 Some typos in comments a9251c6 MonadUtils: Typos in comments 1783011 Fix productivity calculation (#12424) 9d62f0d Accept better stats for T9675 8f63ba3 Compute boot-defined TyCon names from ModIface. b0a5144 Add mblocks_allocated to GC stats API e98edbd Move stat_startGCSync d3feb16 Make Unique a newtype c06e3f4 Add atomic operations to package.conf.in 89ae1e8 Relevant Bindings no longer reports shadowed bindings (fixes #12176) 750553a Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) 2078909 Typo in comment 36565a9 ForeignCall.hs: Remove DrIFT directives 55f5aed Track the lengths of the thread queues 988ad8b Fix to thread migration d1fe08e Only trace cap/capset events if we're tracing anything else 4dcbbd1 Remove the DEBUG_ variables, use RtsFlags directly 9df9490 StgSyn: Remove unused StgLiveVars types 2f79e79 Add comment about lexing of INLINE and INLINABLE pragma 0c37aef Update old comment InlinePragma b1e6415 More comments about InlinePragmas 7a06b22 Typo in comment [skip ci] 7a8ef01 Remove `setUnfoldingInfoLazily` a13fda7 Clarify comment on makeCorePair d85b26d CmmLive: Remove some redundant exports 8ecac25 CmmLayoutStack: Minor simplification fc66415 Replace an unsafeCoerce with coerce db5a226 Fix omission in haddock instance head 1101045 Trim all spaces after 'version:' fe4008f Remove identity update of field componentsConfigs f09d654 check that the number of parallel build is greater than 0 e3e2e49 codeGen: Remove binutils<2.17 hack, fixes T11758 ca7e1ad Expanded abbreviations in Haddock documentation ce13a9a Fix an assertion that could randomly fail 89fa4e9 Another try to get thread migration right 8fe1672 Bump `hoopl` submodule, mostly cosmetics 253fc38 Temporarily mark T1969 perf test as broken (#12437) 7354f93 StgCmm: Remove unused Bool field of Return sequel 02614fd Replace some `length . filter` with `count` 9aa5d87 Util.count: Implement as a left-fold instead of a right-fold affcec7 rts/Printer.h: fix constness of argument declaration 03af399 AsmCodeGen: Give linear-scan and coloring reg. allocators different cc names 3bfe6a5 RegAlloc: Remove duplicate seqList (use seqList from Util) bd51064 RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps 7a2e933 Use Data.Functor.Const to implement Data.Data internals 6fe2355 configure.ac: Remove checks for bug 9439 773e3aa T1969: Enable it again but bump the max residency temporarily 4d9c22d Fix typo in Data.Bitraversable Haddocks fe19be2 Cabal submodule update. dd23a4c Actually update haddock.Cabal stats. e79bb2c Fix a bug in unboxed sum layout generation 9684dbb Remove StgRubbishArg and CmmArg ac0e112 Improve missing-sig warning bd0c310 Fix GHCi perf-llvm build on x86_64 37a7bcb Update `nofib` submodule to newest commit 7ad3b49 Misspellings in comments [skip ci] 18f0687 Fix configure detection. ffd4029 fix compilation failure on OpenBSD with system supplied GNU C 4.2.1 fc1432a Update hoopl submodule (extra .gitignore entry) 3551e62 refactor test for __builtin_unreachable into Rts.h macro RTS_UNREACHABLE da99a7f Darwin: Detect broken NM program at configure time f9a11a2 When in sanity mode, un-zero malloc'd memory; fix uninitialized memory bugs. d331ace Minor typofix. b222ef7 Typofix in System.Environment docs. 34da8e5 Typo in comment efc0372 Not-in-scope variables are always errors f352e5c Keep the bindings local during defaultCallStacks 58e7316 Refactor nestImplicTcS d610274 Revert "T1969: Enable it again but bump the max residency temporarily" 113d50b Add gcoerceWith to Data.Type.Coercion b2c5e4c Revert "codeGen: Remove binutils<2.17 hack, fixes T11758" 896d216 Annotate initIfaceCheck with usage information. e907e1f Axe initIfaceTc, tie the knot through HPT (or if_rec_types). 704913c Support for noinline magic function. 1f1bd92 Introduce BootUnfolding, set when unfolding is absent due to hs-boot file. 5a8fa2e When a value Id comes from hi-boot, insert noinline. Fixes #10083. 8fd1848 Retypecheck both before and after finishing hs-boot loops in --make. e528061 We also need to retypecheck before when we do parallel make. 0d3bf62 Fix #12472 by looking for noinline/lazy inside oversaturated applications. f9aa996 pass -z wxneeded or -Wl,-zwxneeded for linking on OpenBSD fb0d87f Splice singleton unboxed tuples correctly with Template Haskell 1f75440 Extra comments, as per SPJ in #12035. acdbd16 Move #12403, #12513 users guide notes to 8.2.1 release notes 89facad Add T12520 as a test 1766bb3 RtClosureInspect: Fix off-by-one error in cvReconstructType 613d745 Template Haskell support for unboxed sums 7a86f58 Comments only: Refer to actually existing Notes 8d92b88 DmdAnal: Add a final, safe iteration d6fd2e3 DmdAnal: Testcase about splitFVs and dmdFix abortion ec7fcfd Degrade "case scrutinee not known to diverge for sure" Lint error to warning faaf313 WwLib: Add strictness signature to "let x = absentError …" 1083f45 Fix doc build inconsistency ae66f35 Allow typed holes to be levity-polymorphic a60ea70 Move import to avoid warning 0050aff Fix scoping of type variables in instances ca8c0e2 Typofix in docs. 983f660 Template Haskell support for TypeApplications 822af41 Fix broken Haddock comment f4384ef Remove unused DerivInst constructor for DerivStuff 21c2ebf Missing stderr for T12531. 9d17560 GhcMake: limit Capability count to CPU count in parallel mode a5d26f2 rts: enable parallel GC scan of large (32M+) allocation area 044e81b OccName: Remove unused DrIFT directive ff1931e TcGenDeriv: Typofix d168c41 Fix and complete runghc documentation 6781f37 Clarify pkg selection when multiple versions are available 83b326c Fix binary-trees regression from unnecessary floating in CorePrep. a25bf26 Tag pointers in interpreted constructors ef784c5 Fix handling of package-db entries in .ghc.environment files, etc. 2ee1db6 Fixes #12504: Double-escape paths used to build call to hsc_line 28b71c5 users_guide: More capabilities than processors considered harmful 0e74925 GHC: Expose installSignalHandlers, withCleanupSession 3005fa5 iserv: Show usage message on argument parse failure d790cb9 Bump the default allocation area size to 1MB d40d6df StgCmmPrim: Add missing MO_WriteBarrier d1f2239 Clarify scope of `getQ`/`putQ` state. 22259c1 testsuite: Failing testcase for #12091 2d22026 ErrUtils: Expose accessors of ErrDoc and ErrMsg a07a3ff A failing testcase for T12485 9306db0 TysWiredIn: Use dataConWorkerUnique instead of incrUnique 9cfef16 Add Read1/Read2 methods defined in terms of ReadPrec 1ad770f Add -flocal-ghci-history flag (#9089). 010b07a PPC NCG: Implement minimal stack frame header. ca6d0eb testsuite: Update bytes allocated of parsing001 75321ff Add -fdefer-out-of-scope-variables flag (#12170). e9b0bf4 Remove redundant-constraints from -Wall (#10635) 043604c RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax dad6a88 LoadIFace: Show known names on inconsistent interface file 3fb8f48 Revert "testsuite: Update bytes allocated of parsing001" a69371c users_guide: Document removal of -Wredundant-constraints from -Wall ad1e072 users_guide: Move addModFinalizer mention to 8.0.2 release notes 1f5d4a3 users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes da920f6 users_guide: Move initGhcMonad note to 8.0.2 relnotes a48de37 restore -fmax-worker-args handling (Trac #11565) 1e39c29 Kill vestiages of DEFAULT_TMPDIR 8d35e18 Fix startsVarSym and refactor operator predicates (fixes #4239) b946cf3 Revert "Fix startsVarSym and refactor operator predicates (fixes #4239)" f233f00 Fix startsVarSym and refactor operator predicates (fixes #4239) e5ecb20 Added support for deprecated POSIX functions on Windows. 0cc3931 configure.ac: fix --host= handling 818760d Fix #10923 by fingerprinting optimization level. 36bba47 Typos in notes 33d3527 Protect StablPtr dereference with the StaticPtr table lock. 133a5cc ghc-cabal: accept EXTRA_HC_OPTS make variable f93c363 extend '-fmax-worker-args' limit to specialiser (Trac #11565) ac2ded3 Typo in comment 57aa6bb Fix comment about result f8b139f test #12567: add new testcase with expected plugin behaviour 1805754 accept current (problematic) output cdbb9da cleanup: drop 11 years old performance hack 71dd6e4 Don't ignore addTopDecls in module finalizers. 6ea6242 Turn divInt# and modInt# into bitwise operations when possible 8d00175 Less scary arity mismatch error message when deriving 4ff4929 Make generated Ord instances smaller (per #10858). 34010db Derive the Generic instance in perf/compiler/T5642 05b497e distrib: Fix libdw bindist check a7a960e Make the test for #11108 less fragile dcc4904 Add failing testcase for #12433 feaa31f Remove references to -XRelaxedPolyRec 5eab6a0 Document meaning of order of --package-db flags, fixes #12485. a8238a4 Update unix submodule to latest HEAD. 65d9597 Add hook for creating ghci external interpreter 1b5f920 Make start address of `osReserveHeapMemory` tunable via command line -xb 7b4bb40 Remove -flocal-ghci-history from default flags 710f21c Add platform warning to Foreign.C.Types 158288b Generalise type of mkMatchGroup to unify with mkMatchGroupName 04184a2 Remove uses of mkMatchGroupName 7b7ea8f Fix derived Ix instances for one-constructor GADTs 0e7ccf6 Fix TH ppr output for list comprehensions with only one Stmt 454033b Add hs_try_putmvar() 03541cb Be less picky about reporing inaccessible code 21d0bfe Remove unused exports 35086d4 users_guide: Fix Docbook remnant b451fef users_guide: #8761 is now fixed c6ac1e5 users_guide: TH now partially supports typed holes 6555c6b rts: Disable -hb with multiple capabilities 5eeabe2 Test wibbles for commit 03541cba ec3edd5 Testsuite wibbles, to the same files 505a518 Comments and white space only 8074e03 Comments and white space only 876b00b Comments and white space 86836a2 Fix codegen bug in PIC version of genSwitch (#12433) 9123845 tryGrabCapability should be using TRY_ACQUIRE_LOCK 626db8f Unify CallStack handling in ghc a001299 Comments only a72d798 Comments in TH.Syntax (Trac #12596) 97b47d2 Add test case for #7611 ea310f9 Remove directories from include paths 14c2e8e Codegen for case: Remove redundant void id checks 6886bba Bump Haddock submodule to fix rendering of class methods 8bd3d41 Fix failing test T12504 9cbcdb4 shutdownHaskellAndExit: just do a normal hs_exit() (#5402) 74c4ca0 Expose hs_exit_(rtsFalse) as hs_exit_nowait() 3a17916 Improved documentation for Foreign.Concurrent (#12547) 9766b0c Fix #12442. d122935 Mark mapUnionFV as INLINABLE rather than INLINE 68f72f1 Replace INLINEABLE by INLINABLE (#12613) 55d92cc Update test output bc7c730 Pattern Synonyms documentation update 796f0f2 Print foralls in user format b0ae0dd Remove #ifdef with never fulfilled condition c36904d Fix layout of MultiWayIf expressions (#10807) f897b74 TH: Use atomicModifyIORef' for fresh names 0b6024c Comments and manual only: spelling 13d3b53 Test Trac #12634 f21eedb Check.hs: Use actual import lists instead of comments 0b533a2 A bit of tracing about flattening 2fbfbca Fix desugaring of pattern bindings (again) 66a8c19 Fix a bug in occurs checking 3012c43 Add Outputable Report in TcErrors b612da6 Fix impredicativity (again) fc4ef66 Comments only 5d473cd Add missing stderr file 3f27237 Make tcrun042 fail 28a00ea Correct spelling in note references b3d55e2 Document Safe Haskell restrictions on Generic instances 9e86276 Implement deriving strategies b61b7c2 CodeGen X86: fix unsafe foreign calls wrt inlining 59d7ee5 GHCi: Don't remove shadowed bindings from typechecker scope. 3c17905 Support more than 64 logical processors on Windows 151edd8 Recognise US spelling for specialisation flags. f869b23 Move -dno-debug-output to the end of the test flags d1b4fec Mark T11978a as broken due to #12019 1e795a0 Use check stacking on Windows. c93813d Add NUMA support for Windows 2d6642b Fix interaction of record pattern synonyms and record wildcards 1851349 Don't warn about name shadowing when renaming the patten in a PatSyn decl ce3370e PPC/CodeGen: fix lwa instruction generation 48ff084 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) 0014fa5 ghc-pkg: Allow unregistering multiple packages in one call b0d53a8 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again f547b44 Eliminate some unsafeCoerce#s with deriving strategies 23cf32d Disallow standalone deriving declarations involving unboxed tuples or sums 4d2b15d validate: Add --build-only 42f1d86 runghc: use executeFile to run ghc process on POSIX 3630ad3 Mark #6132 as broken on OS X 8cab9bd Ignore output from derefnull and divbyzero on Darwin e9104d4 DynFlags: Fix absolute import path to generated header eda5a4a testsuite: Mark test for #12355 as unbroken on Darwin. 22c6b7f Update Cabal submodule to latest version. 8952cc3 runghc: Fix import of System.Process on Windows 7a6731c genapply: update source file in autogenerated text c5d6288 Mark zipWithAndUnzipM as INLINABLE rather than INLINE e4cf962 Bring Note in TcDeriv up to date 465c6c5 Improve error handling in TcRnMonad 58ecdf8 Remove unused T12124.srderr 4a03012 Refactor TcDeriv and TcGenDeriv a2bedb5 RegAlloc: Make some pattern matched complete 57a207c Remove dead code “mkHsConApp” cbe11d5 Add compact to packages so it gets cleaned on make clean. e41b9c6 Fix memory leak from #12664 f3be304 Don't suggest deprecated flags in error messages 76aaa6e Simplify implementation of wWarningFlags 082991a Tc267, tests what happens if you forgot to knot-tie. 3b9e45e Note about external interface changes. 940ded8 Remove reexports from ghc-boot, help bootstrap with GHC 8. 887485a Exclude Cabal PackageTests from gen_contents_index. 00b530d The Backpack patch. 4e8a060 Distinguish between UnitId and InstalledUnitId. 5bd8e8d Make InstalledUnitId be ONLY a FastString. 027a086 Update haddock.Cabal perf for Cabal update. 61b143a Report that we support Backpack in --info. 46b78e6 Cabal submodule update. 4dd3636 Merge remote-tracking branch 'origin/master' into wip/hasfield 3b80b75 Remove Proxy# argument from GHC.OverloadedLabels.fromLabel 319ec37 Remove Proxy# argument from HasField and make poly-kinded 93c1ca8 Extend extra_files for hasfieldfail01 d2df666 Add IsLabel (->) instance f906047 Rename overloadedrecfldsghci01 test to duplicaterecfldsghci01 307ab8e Reintroduce OverloadedRecordFields extension, with specialised behaviour c6f7c45 Adapt ORF/OL tests acd495d Support combination of OverloadedLabels and RebindableSyntax (fixes #12243) 94a4e8f Add a mysterious reverse to correct evidence for HasField From git at git.haskell.org Sun Oct 9 13:32:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 13:32:24 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Replace EvExpr with more specific EvSelector in EvTerm (bbf6615) Message-ID: <20161009133224.DEA763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/bbf6615cf2a07181098cebcfc4f117b3b1b50f1c/ghc >--------------------------------------------------------------- commit bbf6615cf2a07181098cebcfc4f117b3b1b50f1c Author: Adam Gundry Date: Sun Oct 9 10:38:49 2016 +0100 Replace EvExpr with more specific EvSelector in EvTerm >--------------------------------------------------------------- bbf6615cf2a07181098cebcfc4f117b3b1b50f1c compiler/deSugar/DsBinds.hs | 4 +++- compiler/typecheck/TcEvidence.hs | 9 +++++---- compiler/typecheck/TcHsSyn.hs | 7 ++++--- compiler/typecheck/TcInteract.hs | 23 +++++++++++++++-------- 4 files changed, 27 insertions(+), 16 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 72e003b..8dd1b51 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1086,7 +1086,6 @@ dsEvTerm (EvCallStack cs) = dsEvCallStack cs dsEvTerm (EvTypeable ty ev) = dsEvTypeable ty ev dsEvTerm (EvLit (EvNum n)) = mkIntegerExpr n dsEvTerm (EvLit (EvStr s)) = mkStringExprFS s -dsEvTerm (EvExpr e) = dsExpr e dsEvTerm (EvCast tm co) = do { tm' <- dsEvTerm tm @@ -1103,6 +1102,9 @@ dsEvTerm (EvSuperClass d n) sc_sel_id = classSCSelId cls n -- Zero-indexed ; return $ Var sc_sel_id `mkTyApps` tys `App` d' } +dsEvTerm (EvSelector sel_id tys) + = return $ Var sel_id `mkTyApps` tys + dsEvTerm (EvDelayedError ty msg) = return $ dsEvDelayedError ty msg dsEvDelayedError :: Type -> FastString -> CoreExpr diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 23bd6b1..0dd73ee 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -380,8 +380,9 @@ data EvTerm | EvTypeable Type EvTypeable -- Dictionary for (Typeable ty) - | EvExpr (HsExpr Id) -- Dictionary for HasField (internal) - -- or arbitrary class (generated by plugin) + | EvSelector Id [Type] -- Selector id plus the types at which it should be + -- instantiated, used for HasField dictionaries; + -- see Note [HasField instances] in TcInterface deriving Data.Data @@ -685,7 +686,7 @@ evVarsOfTerm (EvDelayedError _ _) = emptyVarSet evVarsOfTerm (EvLit _) = emptyVarSet evVarsOfTerm (EvCallStack cs) = evVarsOfCallStack cs evVarsOfTerm (EvTypeable _ ev) = evVarsOfTypeable ev -evVarsOfTerm (EvExpr _) = emptyVarSet +evVarsOfTerm (EvSelector{}) = emptyVarSet evVarsOfTerms :: [EvTerm] -> VarSet evVarsOfTerms = mapUnionVarSet evVarsOfTerm @@ -790,7 +791,7 @@ instance Outputable EvTerm where ppr (EvDelayedError ty msg) = text "error" <+> sep [ char '@' <> ppr ty, ppr msg ] ppr (EvTypeable ty ev) = ppr ev <+> dcolon <+> text "Typeable" <+> ppr ty - ppr (EvExpr e) = ppr e + ppr (EvSelector sel tys) = ppr sel <+> sep (map ppr tys) instance Outputable EvLit where ppr (EvNum n) = integer n diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index f21e9e4..a40b51a 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -1419,9 +1419,10 @@ zonkEvTerm env (EvDFunApp df tys tms) zonkEvTerm env (EvDelayedError ty msg) = do { ty' <- zonkTcTypeToType env ty ; return (EvDelayedError ty' msg) } -zonkEvTerm env (EvExpr e) - = do { e' <- zonkExpr env e - ; return (EvExpr e') } +zonkEvTerm env (EvSelector sel_id tys) + = do { sel_id' <- zonkIdBndr env sel_id + ; tys' <- zonkTcTypeToTypes env tys + ; return (EvSelector sel_id' tys') } zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable zonkEvTypeable env (EvTypeableTyCon ts) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 9df4585..bf12f57 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2166,13 +2166,21 @@ Note that so the expression we construct is - \ foo @Int |> co + foo @Int |> co where - co :: (T Int -> [Int]) ~# (T Int -> b) + co :: (T Int -> [Int]) ~# HasField "foo" (T Int) b -is built from the new wanted ([Int] ~# b). +is built from + + co1 :: (T Int -> [Int]) ~# (T Int -> b) + +derived from the new wanted ([Int] ~# b) and + + co2 :: (T Int -> b) ~# HasField "foo" (T Int) b + +derived from the newtype coercion. If `foo` is not in scope, higher-rank or existentially quantified then the constraint is not solved automatically, but may be solved by a @@ -2233,13 +2241,12 @@ matchHasField dflags clas tys@[_k_ty, x_ty, r_ty, a_ty] loc ; addUsedGRE True gre -- Build evidence term as described in Note [HasField instances] - ; let mk_ev [ev] = EvExpr body `EvCast` mkTcSymCo ax + ; let mk_ev [ev] = EvSelector sel_id (reverse rep_tc_args) `EvCast` co where - co = mkTcFunCo Nominal (mkTcReflCo Nominal r_ty) + co = mkTcSubCo co1 `mkTcTransCo` mkTcSymCo co2 + co1 = mkTcFunCo Nominal (mkTcNomReflCo r_ty) (evTermCoercion ev) - body = mkHsWrap (mkWpCastN co <.> mkWpTyApps (reverse rep_tc_args)) - (HsVar (noLoc sel_id)) - ax = case tcInstNewTyCon_maybe (classTyCon clas) tys of + co2 = case tcInstNewTyCon_maybe (classTyCon clas) tys of Just x -> snd x Nothing -> panic "HasField not a newtype" mk_ev _ = panic "matchHasField.mk_ev" From git at git.haskell.org Sun Oct 9 13:32:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 13:32:27 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Remove unnecessary SOURCE imports (4078612) Message-ID: <20161009133227.96F463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/407861293edb49b92c39ae691b3ecf0e28a1abfc/ghc >--------------------------------------------------------------- commit 407861293edb49b92c39ae691b3ecf0e28a1abfc Author: Adam Gundry Date: Sun Oct 9 11:23:45 2016 +0100 Remove unnecessary SOURCE imports >--------------------------------------------------------------- 407861293edb49b92c39ae691b3ecf0e28a1abfc compiler/deSugar/DsBinds.hs | 2 +- compiler/hsSyn/PlaceHolder.hs | 2 +- compiler/typecheck/TcEvidence.hs | 1 - compiler/typecheck/TcEvidence.hs-boot | 3 --- 4 files changed, 2 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 8dd1b51..a9de886 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -18,7 +18,7 @@ module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec, #include "HsVersions.h" -import {-# SOURCE #-} DsExpr( dsExpr, dsLExpr ) +import {-# SOURCE #-} DsExpr( dsLExpr ) import {-# SOURCE #-} Match( matchWrapper ) import DsMonad diff --git a/compiler/hsSyn/PlaceHolder.hs b/compiler/hsSyn/PlaceHolder.hs index 6ffbdb3..2e195df 100644 --- a/compiler/hsSyn/PlaceHolder.hs +++ b/compiler/hsSyn/PlaceHolder.hs @@ -16,7 +16,7 @@ import Coercion import ConLike (ConLike) import FieldLabel import SrcLoc (Located) -import {-# SOURCE #-} TcEvidence ( HsWrapper ) +import TcEvidence ( HsWrapper ) import Data.Data hiding ( Fixity ) import BasicTypes (Fixity) diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 0dd73ee..c06d1c3 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -53,7 +53,6 @@ import VarEnv import VarSet import Name import Pair -import {-# SOURCE #-} HsExpr ( HsExpr ) import Util import Bag diff --git a/compiler/typecheck/TcEvidence.hs-boot b/compiler/typecheck/TcEvidence.hs-boot deleted file mode 100644 index 48c3cbc..0000000 --- a/compiler/typecheck/TcEvidence.hs-boot +++ /dev/null @@ -1,3 +0,0 @@ -module TcEvidence where - -data HsWrapper From git at git.haskell.org Sun Oct 9 13:32:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 13:32:30 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Check HasField instances to prevent overlap with built-in solving (369a3de) Message-ID: <20161009133230.AE0B23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/369a3dee65caf2642c9f137b3154edd1d6d764f8/ghc >--------------------------------------------------------------- commit 369a3dee65caf2642c9f137b3154edd1d6d764f8 Author: Adam Gundry Date: Sun Oct 9 13:01:16 2016 +0100 Check HasField instances to prevent overlap with built-in solving >--------------------------------------------------------------- 369a3dee65caf2642c9f137b3154edd1d6d764f8 compiler/typecheck/TcInteract.hs | 3 +- compiler/typecheck/TcValidity.hs | 43 ++++++++++++++++++++++ compiler/types/TyCon.hs | 5 ++- .../tests/overloadedrecflds/should_fail/all.T | 1 + .../should_fail/hasfieldfail03.hs | 38 +++++++++++++++++++ .../should_fail/hasfieldfail03.stderr | 21 +++++++++++ 6 files changed, 108 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index bf12f57..a2222ee 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -39,7 +39,6 @@ import FieldLabel import FunDeps import FamInst import FamInstEnv -import FastStringEnv ( lookupDFsEnv ) import Unify ( tcUnifyTyWithTFs ) import HsBinds ( emptyLocalBinds ) @@ -2203,7 +2202,7 @@ matchHasField dflags clas tys@[_k_ty, x_ty, r_ty, a_ty] loc -- Check that the field belongs to the tycon, and get its -- selector name from the FieldLabel - ; case lookupDFsEnv (tyConFieldLabelEnv rep_tycon) x of + ; case lookupTyConFieldLabel x rep_tycon of Nothing -> matchInstEnv dflags clas tys loc Just fl -> do { diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 49767fe..ca6ed33 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1052,6 +1052,9 @@ checkValidInstHead ctxt clas cls_args nameModule (getName clas) == mod) (instTypeErr clas cls_args abstract_class_msg) + ; when (clas `hasKey` hasFieldClassNameKey) $ + checkHasFieldInst clas cls_args + -- Check language restrictions; -- but not for SPECIALISE instance pragmas ; let ty_args = filterOutInvisibleTypes (classTyCon clas) cls_args @@ -1144,6 +1147,26 @@ instTypeErr cls tys msg 2 (quotes (pprClassPred cls tys))) 2 msg +-- | See Note [Validity checking of HasField instances] +checkHasFieldInst :: Class -> [Type] -> TcM () +checkHasFieldInst cls tys@[_k_ty, x_ty, r_ty, _a_ty] = + case splitTyConApp_maybe r_ty of + Nothing -> whoops (text "Record data type must be specified") + Just (tc, _) + | isFamilyTyCon tc -> whoops (text "Record data type may not be a data family") + | otherwise -> case isStrLitTy x_ty of + Just lbl + | isJust (lookupTyConFieldLabel lbl tc) + -> whoops (ppr tc <+> text "already has a field" + <+> quotes (ppr lbl)) + | otherwise -> return () + Nothing + | null (tyConFieldLabels tc) -> return () + | otherwise -> whoops (ppr tc <+> text "has fields") + where + whoops = addErrTc . instTypeErr cls tys +checkHasFieldInst _ tys = pprPanic "checkHasFieldInst" (ppr tys) + {- Note [Casts during validity checking] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the (bogus) @@ -1159,6 +1182,26 @@ the middle: Eq ((Either |> g) a) +Note [Validity checking of HasField instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The HasField class has magic constraint solving behaviour (see Note +[HasField instances] in TcInteract). However, we permit users to +declare their own instances, provided they do not clash with the +built-in behaviour. In particular, we forbid: + + 1. `HasField _ r _` where r is a variable + + 2. `HasField _ (T ...) _` if T is a data family + (because it might have fields introduced later) + + 3. `HasField x (T ...) _` where x is a variable, + if T has any fields at all + + 4. `HasField "foo" (T ...) _` if T has a "foo" field + +The usual functional dependency checks also apply. + + Note [Valid 'deriving' predicate] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ validDerivPred checks for OK 'deriving' context. See Note [Exotic diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index d0ecb70..9578303 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -23,7 +23,7 @@ module TyCon( isVisibleTyConBinder, isInvisibleTyConBinder, -- ** Field labels - tyConFieldLabels, tyConFieldLabelEnv, + tyConFieldLabels, lookupTyConFieldLabel, -- ** Constructing TyCons mkAlgTyCon, @@ -1277,6 +1277,9 @@ tyConFieldLabelEnv tc | isAlgTyCon tc = algTcFields tc | otherwise = emptyDFsEnv +-- | Look up a field label belonging to this 'TyCon' +lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel +lookupTyConFieldLabel lbl tc = lookupDFsEnv (tyConFieldLabelEnv tc) lbl -- | Make a map from strings to FieldLabels from all the data -- constructors of this algebraic tycon diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T index 25e36af..c98c509 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/all.T +++ b/testsuite/tests/overloadedrecflds/should_fail/all.T @@ -36,3 +36,4 @@ test('hasfieldfail01', extra_clean(['HasFieldFail01_A.hi', 'HasFieldFail01_A.o']), multimod_compile_fail, ['hasfieldfail01', '']) test('hasfieldfail02', normal, compile_fail, ['']) +test('hasfieldfail03', normal, compile_fail, ['']) diff --git a/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.hs b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.hs new file mode 100644 index 0000000..1d5c8af --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-} + +import GHC.Records (HasField(..)) + +data T = MkT { foo :: Int, bar :: Int } + +-- This is far too polymorphic +instance HasField "woo" a Bool where + fromLabel = const True + +-- This conflicts with the built-in instance +instance HasField "foo" T Int where + fromLabel = foo + +-- So does this +instance HasField "bar" T Bool where + fromLabel = const True + +-- This doesn't conflict because there is no "baz" field in T +instance HasField "baz" T Bool where + fromLabel = const True + +-- Bool has no fields, so this is okay +instance HasField a Bool Bool where + fromLabel = id + + +data family V a b c d +data instance V x Int y [z] = MkVInt { baz :: (x, y, z, Bool) } + +-- Data families cannot have HasField instances, because they may get +-- fields defined later on +instance HasField "baz" (V a b c d) Bool where + fromLabel = const True + +-- Function types can have HasField instances, in case it's useful +instance HasField "woo" (a -> b) Bool where + fromLabel = const True diff --git a/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.stderr b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.stderr new file mode 100644 index 0000000..2fb8dbd --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.stderr @@ -0,0 +1,21 @@ + +hasfieldfail03.hs:8:10: error: + • Illegal instance declaration for ‘HasField "woo" a Bool’ + Record data type must be specified + • In the instance declaration for ‘HasField "woo" a Bool’ + +hasfieldfail03.hs:12:10: error: + • Illegal instance declaration for ‘HasField "foo" T Int’ + T already has a field ‘foo’ + • In the instance declaration for ‘HasField "foo" T Int’ + +hasfieldfail03.hs:16:10: error: + • Illegal instance declaration for ‘HasField "bar" T Bool’ + T already has a field ‘bar’ + • In the instance declaration for ‘HasField "bar" T Bool’ + +hasfieldfail03.hs:33:10: error: + • Illegal instance declaration for + ‘HasField "baz" (V a b c d) Bool’ + Record data type may not be a data family + • In the instance declaration for ‘HasField "baz" (V a b c d) Bool’ From git at git.haskell.org Sun Oct 9 13:32:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 13:32:33 +0000 (UTC) Subject: [commit: ghc] wip/hasfield: Remove redundant imports (3aaae48) Message-ID: <20161009133233.6A27A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hasfield Link : http://ghc.haskell.org/trac/ghc/changeset/3aaae48d195e56ce0b7fbaf8660947fffd9de612/ghc >--------------------------------------------------------------- commit 3aaae48d195e56ce0b7fbaf8660947fffd9de612 Author: Adam Gundry Date: Sun Oct 9 13:04:08 2016 +0100 Remove redundant imports >--------------------------------------------------------------- 3aaae48d195e56ce0b7fbaf8660947fffd9de612 compiler/typecheck/TcExpr.hs | 2 -- compiler/typecheck/TcInteract.hs | 9 ++------- libraries/base/GHC/Records.hs | 2 -- 3 files changed, 2 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 4cbe50e..2411182 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -33,7 +33,6 @@ import TcSimplify ( simplifyInfer, InferMode(..) ) import FamInst ( tcGetFamInstEnvs, tcLookupDataFamInst ) import FamInstEnv ( FamInstEnvs ) import RnEnv ( addUsedGRE, addNameClashErrRn - , lookupOccRn , unknownSubordinateErr ) import TcEnv import TcArrows @@ -62,7 +61,6 @@ import TysWiredIn import TysPrim( intPrimTy ) import PrimOp( tagToEnumKey ) import PrelNames -import MkId ( proxyHashId ) import DynFlags import SrcLoc import Util diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index a2222ee..aac0089 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -9,7 +9,7 @@ module TcInteract ( #include "HsVersions.h" -import BasicTypes ( infinity, IntWithInf, intGtLimit, Origin(Generated) ) +import BasicTypes ( infinity, IntWithInf, intGtLimit ) import HsTypes ( HsIPName(..) ) import TcCanonical import TcFlatten @@ -29,7 +29,7 @@ import PrelNames ( knownNatClassName, knownSymbolClassName, heqTyConKey, ipClassKey ) import TysWiredIn ( typeNatKind, typeSymbolKind, heqDataCon, coercibleDataCon ) -import TysPrim ( eqPrimTyCon, eqReprPrimTyCon, mkProxyPrimTy ) +import TysPrim ( eqPrimTyCon, eqReprPrimTyCon ) import Id( idType, isNaughtyRecordSelector ) import CoAxiom ( Eqn, CoAxiom(..), CoAxBranch(..), fromBranches ) import Class @@ -41,11 +41,6 @@ import FamInst import FamInstEnv import Unify ( tcUnifyTyWithTFs ) -import HsBinds ( emptyLocalBinds ) -import HsExpr -import HsPat ( Pat(WildPat) ) -import HsUtils ( mkHsWrap ) - import TcEvidence import Outputable diff --git a/libraries/base/GHC/Records.hs b/libraries/base/GHC/Records.hs index 9a3e654..dc1cfc4 100644 --- a/libraries/base/GHC/Records.hs +++ b/libraries/base/GHC/Records.hs @@ -27,7 +27,5 @@ module GHC.Records ( HasField(..) ) where -import GHC.Base ( Symbol ) - class HasField (x :: k) r a | x r -> a where fromLabel :: r -> a From git at git.haskell.org Sun Oct 9 22:55:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 22:55:09 +0000 (UTC) Subject: [commit: ghc] master: Generate a unique symbol for signature object stub files, fixes #12673 (7b060e1) Message-ID: <20161009225509.514C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7b060e12efbfed2f29136fd605f76e8d6ca79f85/ghc >--------------------------------------------------------------- commit 7b060e12efbfed2f29136fd605f76e8d6ca79f85 Author: Edward Z. Yang Date: Sun Oct 9 18:17:32 2016 -0400 Generate a unique symbol for signature object stub files, fixes #12673 Test Plan: validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2585 GHC Trac Issues: #12673 >--------------------------------------------------------------- 7b060e12efbfed2f29136fd605f76e8d6ca79f85 compiler/main/DriverPipeline.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index b1f1f6c..aec89e4 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -284,13 +284,18 @@ compileStub hsc_env stub_c = do return stub_o -compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> IO () -compileEmptyStub dflags hsc_env basename location = do +compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO () +compileEmptyStub dflags hsc_env basename location mod_name = do -- To maintain the invariant that every Haskell file -- compiles to object code, we make an empty (but - -- valid) stub object file for signatures + -- valid) stub object file for signatures. However, + -- we make sure this object file has a unique symbol, + -- so that ranlib on OS X doesn't complain, see + -- http://ghc.haskell.org/trac/ghc/ticket/12673 + -- and https://github.com/haskell/cabal/issues/2257 empty_stub <- newTempName dflags "c" - writeFile empty_stub "" + let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;" + writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) _ <- runPipeline StopLn hsc_env (empty_stub, Nothing) (Just basename) @@ -1032,7 +1037,7 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState let input_fn = expectJust "runPhase" (ml_hs_file location) basename = dropExtension input_fn - liftIO $ compileEmptyStub dflags hsc_env' basename location + liftIO $ compileEmptyStub dflags hsc_env' basename location mod_name return (RealPhase StopLn, o_file) HscRecomp cgguts mod_summary -> do output_fn <- phaseOutputFilename next_phase From git at git.haskell.org Sun Oct 9 22:55:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 22:55:12 +0000 (UTC) Subject: [commit: ghc] master: Do not segfault if no common root can be found (bcd3445) Message-ID: <20161009225512.04E8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bcd34451382e0d1b52ef82cb9d762e9d68bc0887/ghc >--------------------------------------------------------------- commit bcd34451382e0d1b52ef82cb9d762e9d68bc0887 Author: Moritz Angermann Date: Sun Oct 9 18:17:46 2016 -0400 Do not segfault if no common root can be found When trying to profile a plugin, ghc mysteriously segfaulted. Upon closer examination the segfault happend due to a `->prevStack` lookup on a NULL pointer. A new CostCentre: Unknown is introduced that is set, if ccsapp and ccsfn are of equal depth (e.g. 0), and do not have a common CostCentre in their stacks. Reviewers: bgamari, simonmar, austin, erikd Reviewed By: simonmar Subscribers: Phyx, thomie Differential Revision: https://phabricator.haskell.org/D2551 >--------------------------------------------------------------- bcd34451382e0d1b52ef82cb9d762e9d68bc0887 rts/Linker.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/rts/Linker.c b/rts/Linker.c index f16fb83..3eeb46e 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1399,6 +1399,11 @@ static SymbolAddr* lookupSymbol_ (SymbolName* lbl) errorBelch("Could not on-demand load symbol '%s'\n", lbl); return NULL; } +#ifdef PROFILING + // collect any new cost centres & CCSs + // that were defined during runInit + initProfiling2(); +#endif } return val; From git at git.haskell.org Sun Oct 9 22:55:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 22:55:14 +0000 (UTC) Subject: [commit: ghc] master: Cleanup PosixSource.h (8dc72f3) Message-ID: <20161009225514.B86F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8dc72f3c33b0e724ddb690c9d494969980c10afd/ghc >--------------------------------------------------------------- commit 8dc72f3c33b0e724ddb690c9d494969980c10afd Author: Moritz Angermann Date: Sun Oct 9 18:19:26 2016 -0400 Cleanup PosixSource.h When trying to build arm64-apple-iso, the build fell over `strdup`, as the arm64-apple-ios build did not fall into `darwin_HOST_OS`, and would need `ios_HOST_OS`. This diff tries to clean up PosixSource.h, instead of layering another define on top. As we use `strnlen` in sources that include PosixSource.h, and `strnlen` is defined in POSIX.1-2008, the `_POSIX_C_SOURCE` and `_XOPEN_SOURCE` are increased accordingly. Furthermore the `_DARWIN_C_SOURCE` (required for `u_char`, etc. used in sysctl.h) define is moved into `OSThreads.h` alongside a similar ifdef for freebsd. Test Plan: Build on all supported platforms. Reviewers: austin, simonmar, erikd, kgardas, bgamari Reviewed By: simonmar, erikd, kgardas, bgamari Subscribers: Phyx, hvr, thomie Differential Revision: https://phabricator.haskell.org/D2579 GHC Trac Issues: #12624 >--------------------------------------------------------------- 8dc72f3c33b0e724ddb690c9d494969980c10afd rts/PosixSource.h | 23 +++++++++++++---------- rts/posix/OSThreads.c | 5 +++++ 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/rts/PosixSource.h b/rts/PosixSource.h index f4b880e..0ba74df 100644 --- a/rts/PosixSource.h +++ b/rts/PosixSource.h @@ -21,18 +21,21 @@ 9945:2002 or UNIX 03 and SUSv3. Please also see trac ticket #11757 for more information about switch to C99/C11. -*/ -#define _POSIX_C_SOURCE 200112L -#define _XOPEN_SOURCE 600 -#define __USE_MINGW_ANSI_STDIO 1 + However, the use of `strnlen`, which is strictly speaking only available in + IEEE Std 1003.1-2008 (XPG7), requires lifting the bounds, to be able to + compile ghc on systems that are strict about enforcing the standard, e.g. + Apples mobile platforms. + + Oracle's Solaris 11 supports only up to XPG6, hence the ifdef. + */ -#if defined(darwin_HOST_OS) -/* If we don't define this the including sysctl breaks with things like - /usr/include/bsm/audit.h:224:0: - error: syntax error before 'u_char' -*/ -#define _DARWIN_C_SOURCE 1 +#if defined(solaris2_HOST_OS) +#define _POSIX_C_SOURCE 200112L +#define _XOPEN_SOURCE 600 +#else +#define _POSIX_C_SOURCE 200809L +#define _XOPEN_SOURCE 700 #endif #endif /* POSIXSOURCE_H */ diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c index 8c7c8f0..63e9790 100644 --- a/rts/posix/OSThreads.c +++ b/rts/posix/OSThreads.c @@ -14,6 +14,11 @@ * because of some specific types, like u_char, u_int, etc. */ #define __BSD_VISIBLE 1 #endif +#if defined(darwin_HOST_OS) +/* Inclusion of system headers usually requires _DARWIN_C_SOURCE on Mac OS X + * because of some specific types like u_char, u_int, etc. */ +#define _DARWIN_C_SOURCE 1 +#endif #include "Rts.h" From git at git.haskell.org Sun Oct 9 22:55:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 22:55:17 +0000 (UTC) Subject: [commit: ghc] master: Default +RTS -qn to the number of cores (6c47f2e) Message-ID: <20161009225517.729833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c47f2efa3f8f4639f375d34f54c01a60c9a1a82/ghc >--------------------------------------------------------------- commit 6c47f2efa3f8f4639f375d34f54c01a60c9a1a82 Author: Simon Marlow Date: Sun Oct 9 18:20:53 2016 -0400 Default +RTS -qn to the number of cores Setting a -N value that is too large has a dramatic negative effect on performance, but the new -qn flag can mitigate the worst of the effects by limiting the number of GC threads. So now, if you don't explcitly set +RTS -qn, and you set -N larger than the number of cores (or use setNumCapabilities to do the same), we'll default -qn to the number of cores. These are the results from nofib/parallel on my 4-core (2 cores x 2 threads) i7 laptop, comparing -N8 before and after this change. ``` ------------------------------------------------------------------------ Program Size Allocs Runtime Elapsed TotalMem ------------------------------------------------------------------------ blackscholes +0.0% +0.0% -72.5% -72.0% +9.5% coins +0.0% -0.0% -73.7% -72.2% -0.8% mandel +0.0% +0.0% -76.4% -75.4% +3.3% matmult +0.0% +15.5% -26.8% -33.4% +1.0% nbody +0.0% +2.4% +0.7% 0.076 0.0% parfib +0.0% -8.5% -33.2% -31.5% +2.0% partree +0.0% -0.0% -60.4% -56.8% +5.7% prsa +0.0% -0.0% -65.4% -60.4% 0.0% queens +0.0% +0.2% -58.8% -58.8% -1.5% ray +0.0% -1.5% -88.7% -85.6% -3.6% sumeuler +0.0% -0.0% -47.8% -46.9% 0.0% ------------------------------------------------------------------------ Min +0.0% -8.5% -88.7% -85.6% -3.6% Max +0.0% +15.5% +0.7% -31.5% +9.5% Geometric Mean +0.0% +0.6% -61.4% -63.1% +1.4% ``` Test Plan: validate, nofib/parallel benchmarks Reviewers: niteria, ezyang, nh2, austin, erikd, trofi, bgamari Reviewed By: trofi, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2580 GHC Trac Issues: #9221 >--------------------------------------------------------------- 6c47f2efa3f8f4639f375d34f54c01a60c9a1a82 docs/users_guide/runtime_control.rst | 3 ++- rts/Schedule.c | 15 ++++++++++++--- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index 5226d6d..0ffb1d8 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -467,7 +467,8 @@ performance. .. rts-flag:: -qn - :default: the value of ``-N`` + :default: the value of ``-N`` or the number of CPU cores, + whichever is smaller. :since: 8.2.1 .. index:: diff --git a/rts/Schedule.c b/rts/Schedule.c index 611d704..3cbfc0e 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1531,6 +1531,7 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, uint32_t gc_type; uint32_t i; uint32_t need_idle; + uint32_t n_gc_threads; uint32_t n_idle_caps = 0, n_failed_trygrab_idles = 0; StgTSO *tso; rtsBool *idle_cap; @@ -1561,9 +1562,17 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, gc_type = SYNC_GC_SEQ; } - if (gc_type == SYNC_GC_PAR && RtsFlags.ParFlags.parGcThreads > 0) { - need_idle = stg_max(0, enabled_capabilities - - RtsFlags.ParFlags.parGcThreads); + // If -qn is not set and we have more capabilities than cores, set the + // number of GC threads to #cores. We do this here rather than in + // normaliseRtsOpts() because here it will work if the program calls + // setNumCapabilities. + n_gc_threads = RtsFlags.ParFlags.parGcThreads; + if (n_gc_threads == 0 && enabled_capabilities > getNumberOfProcessors()) { + n_gc_threads = getNumberOfProcessors(); + } + + if (gc_type == SYNC_GC_PAR && n_gc_threads > 0) { + need_idle = stg_max(0, enabled_capabilities - n_gc_threads); } else { need_idle = 0; } From git at git.haskell.org Sun Oct 9 22:55:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 22:55:20 +0000 (UTC) Subject: [commit: ghc] master: Turn on -n4m with -A16m or greater (85e81a8) Message-ID: <20161009225520.23F823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/85e81a850a3e79d965e18f267a0e0b1c4bc69fae/ghc >--------------------------------------------------------------- commit 85e81a850a3e79d965e18f267a0e0b1c4bc69fae Author: Simon Marlow Date: Sun Oct 9 18:21:35 2016 -0400 Turn on -n4m with -A16m or greater Nursery chunks help reduce the cost of GC when capabilities are unevenly loaded, by ensuring that we use more of the available nursery. The rationale for enabling this at -A16m is that any negative effects due to loss of cache locality are less likely to be an issue at -A16m and above. It's a conservative guess. If we had a lot of benchmark data we could probably do better. Results for nofib/parallel at -N4 -A32m with and without -n4m: ``` ------------------------------------------------------------------------ Program Size Allocs Runtime Elapsed TotalMem ------------------------------------------------------------------------ blackscholes 0.0% -9.5% -9.0% -15.0% -2.2% coins 0.0% -4.7% -3.6% -0.6% -13.6% mandel 0.0% -0.3% +7.7% +13.1% +0.1% matmult 0.0% +1.5% +10.0% +7.7% +0.1% nbody 0.0% -4.1% -2.9% 0.085 0.0% parfib 0.0% -1.4% +1.0% +1.5% +0.2% partree 0.0% -0.3% +0.8% +2.9% -0.8% prsa 0.0% -0.5% -2.1% -7.6% 0.0% queens 0.0% -3.2% -1.4% +2.2% +1.3% ray 0.0% -5.6% -14.5% -7.6% +0.8% sumeuler 0.0% -0.4% +2.4% +1.1% 0.0% ------------------------------------------------------------------------ Min 0.0% -9.5% -14.5% -15.0% -13.6% Max 0.0% +1.5% +10.0% +13.1% +1.3% Geometric Mean +0.0% -2.6% -1.3% -0.5% -1.4% ``` Not conclusive, but slightly better. This matters a lot more when you have more cores. Test Plan: validate, nofib/paralel Reviewers: niteria, ezyang, nh2, trofi, austin, erikd, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2581 GHC Trac Issues: #9221 >--------------------------------------------------------------- 85e81a850a3e79d965e18f267a0e0b1c4bc69fae docs/users_guide/runtime_control.rst | 2 +- rts/RtsFlags.c | 18 ++++++++++++++++++ rts/sm/Storage.c | 13 ------------- 3 files changed, 19 insertions(+), 14 deletions(-) diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index 0ffb1d8..54c7508 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -327,7 +327,7 @@ performance. .. rts-flag:: -n ⟨size⟩ - :default: 0 + :default: 4m with ``-A16m`` or larger, otherwise 0. .. index:: single: allocation area, chunk size diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 4bd544e..d86b154 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -1454,6 +1454,24 @@ static void normaliseRtsOpts (void) errorUsage(); } + if (RtsFlags.GcFlags.maxHeapSize != 0 && + RtsFlags.GcFlags.heapSizeSuggestion > + RtsFlags.GcFlags.maxHeapSize) { + RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; + } + + if (RtsFlags.GcFlags.maxHeapSize != 0 && + RtsFlags.GcFlags.minAllocAreaSize > + RtsFlags.GcFlags.maxHeapSize) { + errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)"); + RtsFlags.GcFlags.minAllocAreaSize = RtsFlags.GcFlags.maxHeapSize; + } + + // If we have -A16m or larger, use -n4m. + if (RtsFlags.GcFlags.minAllocAreaSize >= (16*1024*1024) / BLOCK_SIZE) { + RtsFlags.GcFlags.nurseryChunkSize = (4*1024*1024) / BLOCK_SIZE; + } + if (RtsFlags.ParFlags.parGcLoadBalancingGen == ~0u) { StgWord alloc_area_bytes = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE; diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 4d0c8d5..357e018 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -140,19 +140,6 @@ initStorage (void) ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure)); ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure)); - if (RtsFlags.GcFlags.maxHeapSize != 0 && - RtsFlags.GcFlags.heapSizeSuggestion > - RtsFlags.GcFlags.maxHeapSize) { - RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; - } - - if (RtsFlags.GcFlags.maxHeapSize != 0 && - RtsFlags.GcFlags.minAllocAreaSize > - RtsFlags.GcFlags.maxHeapSize) { - errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)"); - RtsFlags.GcFlags.minAllocAreaSize = RtsFlags.GcFlags.maxHeapSize; - } - initBlockAllocator(); #if defined(THREADED_RTS) From git at git.haskell.org Sun Oct 9 22:55:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Oct 2016 22:55:22 +0000 (UTC) Subject: [commit: ghc] master: Escape lambda. (1a9705c) Message-ID: <20161009225522.CC59D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a9705c32f6841be8bc6df3c1084a50dacba2730/ghc >--------------------------------------------------------------- commit 1a9705c32f6841be8bc6df3c1084a50dacba2730 Author: Vaibhav Sagar Date: Sun Oct 9 18:21:58 2016 -0400 Escape lambda. Test Plan: View updated documentation? Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2583 GHC Trac Issues: #12672 >--------------------------------------------------------------- 1a9705c32f6841be8bc6df3c1084a50dacba2730 libraries/base/GHC/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 1afa45c..34a038d 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -469,7 +469,7 @@ Instances of 'Monad' should satisfy the following laws: * @'return' a '>>=' k = k a@ * @m '>>=' 'return' = m@ -* @m '>>=' (\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ +* @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: From git at git.haskell.org Mon Oct 10 10:51:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 10:51:25 +0000 (UTC) Subject: [commit: ghc] master: Orient improvement constraints better (b255ae7) Message-ID: <20161010105125.D478B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b255ae7b555b4b63085a6de4a7a6bd742326b9c9/ghc >--------------------------------------------------------------- commit b255ae7b555b4b63085a6de4a7a6bd742326b9c9 Author: Simon Peyton Jones Date: Fri Oct 7 23:51:44 2016 +0100 Orient improvement constraints better This patch fixes an infinite loop in the constraint solver, shown up by Trac #12522. The solution is /very/ simple: just reverse the orientation of the derived constraints arising from improvement using type-family injectivity. I'm not very proud of the fix --- it seems fragile --- but it has the very great merit of simplicity, and it works fine. See Note [Improvement orientation] in TcInteract, and some discussion on the Trac ticket. >--------------------------------------------------------------- b255ae7b555b4b63085a6de4a7a6bd742326b9c9 compiler/typecheck/TcInteract.hs | 78 ++++++++++++++++------ .../tests/indexed-types/should_compile/T12522.hs | 50 ++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 107 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 75224d8..05efceb 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -782,9 +782,8 @@ interactGivenIP inerts workItem@(CDictCan { cc_ev = ev, cc_class = cls interactGivenIP _ wi = pprPanic "interactGivenIP" (ppr wi) -{- -Note [Shadowing of Implicit Parameters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Shadowing of Implicit Parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following example: f :: (?x :: Char) => Char @@ -807,8 +806,19 @@ signature, and we implement this as follows: when we add a new *given* implicit parameter to the inert set, it replaces any existing givens for the same implicit parameter. -This works for the normal cases but it has an odd side effect -in some pathological programs like this: +Similarly, consider + f :: (?x::a) => Bool -> a + + g v = let ?x::Int = 3 + in (f v, let ?x::Bool = True in f v) + +This should probably be well typed, with + g :: Bool -> (Int, Bool) + +So the inner binding for ?x::Bool *overrides* the outer one. + +All this works for the normal cases but it has an odd side effect in +some pathological programs like this: -- This is accepted, the second parameter shadows f1 :: (?x :: Int, ?x :: Char) => Char @@ -824,7 +834,7 @@ which would lead to an error. I can think of two ways to fix this: - 1. Simply disallow multiple constratits for the same implicit + 1. Simply disallow multiple constraints for the same implicit parameter---this is never useful, and it can be detected completely syntactically. @@ -1501,11 +1511,13 @@ improve_top_fun_eqs fam_envs fam_tc args rhs_ty -- part of the tuple, which is the range of the substitution then -- the order could be important. let subst = theta `unionTCvSubst` theta' - return [ Pair arg (substTyUnchecked subst ax_arg) + return [ Pair (substTyUnchecked subst ax_arg) arg + -- NB: the ax_arg part is on the left + -- see Note [Improvement orientation] | case cabr of Just cabr' -> apartnessCheck (substTys subst ax_args) cabr' _ -> True - , (arg, ax_arg, True) <- zip3 args ax_args inj_args ] + , (ax_arg, arg, True) <- zip3 ax_args args inj_args ] shortCutReduction :: CtEvidence -> TcTyVar -> TcCoercion @@ -1690,7 +1702,6 @@ Then it is solvable, but its very hard to detect this on the spot. It's exactly the same with implicit parameters, except that the "aggressive" approach would be much easier to implement. - Note [Weird fundeps] ~~~~~~~~~~~~~~~~~~~~ Consider class Het a b | a -> b where @@ -1712,19 +1723,42 @@ as the fundeps. Trac #7875 is a case in point. -Note [Overriding implicit parameters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f :: (?x::a) -> Bool -> a - - g v = let ?x::Int = 3 - in (f v, let ?x::Bool = True in f v) - -This should probably be well typed, with - g :: Bool -> (Int, Bool) - -So the inner binding for ?x::Bool *overrides* the outer one. -Hence a work-item Given overrides an inert-item Given. +Note [Improvement orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A very delicate point is the orientation of derived equalities +arising from injectivity improvement (Trac #12522). Suppse we have + type family F x = t | t -> x + type instance F (a, Int) = (Int, G a) +where G is injective; and wanted constraints + + [W] TF (alpha, beta) ~ fuv + [W] fuv ~ (Int, ) + +The injectivity will give rise to derived constraionts + + [D] gamma1 ~ alpha + [D] Int ~ beta + +The fresh unification variable gamma1 comes from the fact that we +can only do "partial improvement" here; see Section 5.2 of +"Injective type families for Haskell" (HS'15). + +Now, it's very important to orient the equations this way round, +so that the fresh unification variable will be eliminated in +favour of alpha. If we instead had + [D] alpha ~ gamma1 +then we would unify alpha := gamma1; and kick out the wanted +constraint. But when we grough it back in, it'd look like + [W] TF (gamma1, beta) ~ fuv +and exactly the same thing would happen again! Infnite loop. + +This all sesms fragile, and it might seem more robust to avoid +introducing gamma1 in the first place, in the case where the +actual argument (alpha, beta) partly matches the improvement +template. But that's a bit tricky, esp when we remember that the +kinds much match too; so it's easier to let the normal machinery +handle it. Instead we are careful to orient the new derived +equality with the template on the left. Delicate, but it works. -} {- ******************************************************************* diff --git a/testsuite/tests/indexed-types/should_compile/T12522.hs b/testsuite/tests/indexed-types/should_compile/T12522.hs new file mode 100644 index 0000000..7779942 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12522.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module T12522 where + +foo = f (Just 'c') + +data D1 x +data D2 + +type family TF x = t | t -> x +type instance TF (D1 x, a) = Maybe (TF (x, a)) +type instance TF (D2, ()) = Char + +f :: TF (x, a) -> () +f _ = () + +foo1 = f_good (Just 'c') +foo2 = f_bad (Just 'c') + +type family TF2 x y = t | t -> x y +type instance TF2 Int Float = Char + +type family TF_Good x y = t | t -> x y +type instance TF_Good a (Maybe x) = Maybe (TF2 a x) + +f_good :: TF_Good a x -> () +f_good _ = () + +type family TF_Bad x y = t | t -> x y +type instance TF_Bad (Maybe x) a = Maybe (TF2 a x) + +f_bad :: TF_Bad x a -> () +f_bad _ = () + +{- + +Maybe Char ~ TF (xx, aa) + + +Model [D] s_aF4 ~ Maybe Char + + [W] TF (x_aDY, a_aJn) ~ s_aF4 FunEq +--> {aJn = aJp) + [W} TF (x_aDY, a_aJp) ~ s_aF4 FunEq +--> {new derived equalities} + [D] x_aDY ~ D1 x_aJq + [D] a_aJp ~ a_aJR +-} diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 84cd5dc..4eeb777 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -274,3 +274,4 @@ test('T11361', normal, compile, ['-dunique-increment=-1']) test('T11361a', normal, compile_fail, ['']) test('T11581', normal, compile, ['']) test('T12175', normal, compile, ['']) +test('T12522', normal, compile, ['']) From git at git.haskell.org Mon Oct 10 10:51:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 10:51:28 +0000 (UTC) Subject: [commit: ghc] master: Rename a parameter; trivial refactor (b5c8963) Message-ID: <20161010105128.8A0F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5c896369a60effd78d5bcd3161d6225929eaf39/ghc >--------------------------------------------------------------- commit b5c896369a60effd78d5bcd3161d6225929eaf39 Author: Simon Peyton Jones Date: Fri Oct 7 23:55:54 2016 +0100 Rename a parameter; trivial refactor >--------------------------------------------------------------- b5c896369a60effd78d5bcd3161d6225929eaf39 compiler/typecheck/TcHsSyn.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index b444385..efb7dfe 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -252,8 +252,8 @@ extendIdZonkEnv1 (ZonkEnv zonk_ty ty_env id_env) id = ZonkEnv zonk_ty ty_env (extendVarEnv id_env id id) extendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv -extendTyZonkEnv1 (ZonkEnv zonk_ty ty_env id_env) ty - = ZonkEnv zonk_ty (extendVarEnv ty_env ty ty) id_env +extendTyZonkEnv1 (ZonkEnv zonk_ty ty_env id_env) tv + = ZonkEnv zonk_ty (extendVarEnv ty_env tv tv) id_env setZonkType :: ZonkEnv -> UnboundTyVarZonker -> ZonkEnv setZonkType (ZonkEnv _ ty_env id_env) zonk_ty From git at git.haskell.org Mon Oct 10 10:51:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 10:51:31 +0000 (UTC) Subject: [commit: ghc] master: Delete orphan where clause (88eb773) Message-ID: <20161010105131.3F0C03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/88eb77380936f265fd881afb1d0d27926ca2a233/ghc >--------------------------------------------------------------- commit 88eb77380936f265fd881afb1d0d27926ca2a233 Author: Simon Peyton Jones Date: Fri Oct 7 23:57:29 2016 +0100 Delete orphan where clause >--------------------------------------------------------------- 88eb77380936f265fd881afb1d0d27926ca2a233 compiler/typecheck/TcHsType.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 058eab2..9919c0f 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1701,7 +1701,6 @@ tcTyClTyVars tycon_name thing_inside -- are the ones mentioned in the source. ; tcExtendTyVarEnv scoped_tvs $ thing_inside binders res_kind } - where ----------------------------------- tcDataKindSig :: Kind -> TcM ([TyConBinder], Kind) From git at git.haskell.org Mon Oct 10 10:51:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 10:51:33 +0000 (UTC) Subject: [commit: ghc] master: Move zonking out of tcFamTyPats (76a5477) Message-ID: <20161010105133.E58553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/76a5477b86c66c52854d8d4fbabbd15ce128fa83/ghc >--------------------------------------------------------------- commit 76a5477b86c66c52854d8d4fbabbd15ce128fa83 Author: Simon Peyton Jones Date: Sat Oct 8 00:03:53 2016 +0100 Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. >--------------------------------------------------------------- 76a5477b86c66c52854d8d4fbabbd15ce128fa83 compiler/typecheck/TcInstDcls.hs | 30 +++++++++++++++--------- compiler/typecheck/TcTyClsDecls.hs | 48 ++++++++++++++++++++++---------------- 2 files changed, 47 insertions(+), 31 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 2e7104c..a0bbb83 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -21,7 +21,8 @@ import TcClassDcl( tcClassDecl2, tcATDefault, import TcSigs import TcRnMonad import TcValidity -import TcHsSyn ( zonkTcTypeToTypes, emptyZonkEnv ) +import TcHsSyn ( zonkTyBndrsX, emptyZonkEnv + , zonkTcTypeToTypes, zonkTcTypeToType ) import TcMType import TcType import BuildTyCl @@ -623,22 +624,21 @@ tcDataFamInstDecl mb_clsinfo -- Kind check type patterns ; tcFamTyPats (famTyConShape fam_tc) mb_clsinfo pats (kcDataDefn (unLoc fam_tc_name) pats defn) $ - \tvs' pats' res_kind -> do - { - -- Check that left-hand sides are ok (mono-types, no type families, - -- consistent instantiations, etc) - ; checkValidFamPats mb_clsinfo fam_tc tvs' [] pats' + \tvs pats res_kind -> + do { stupid_theta <- solveEqualities $ tcHsContext ctxt - -- Result kind must be '*' (otherwise, we have too few patterns) - ; checkTc (isLiftedTypeKind res_kind) $ tooFewParmsErr (tyConArity fam_tc) + -- Zonk the patterns etc into the Type world + ; (ze, tvs') <- zonkTyBndrsX emptyZonkEnv tvs + ; pats' <- zonkTcTypeToTypes ze pats + ; res_kind' <- zonkTcTypeToType ze res_kind + ; stupid_theta' <- zonkTcTypeToTypes ze stupid_theta - ; stupid_theta <- solveEqualities $ tcHsContext ctxt - ; stupid_theta <- zonkTcTypeToTypes emptyZonkEnv stupid_theta - ; gadt_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons + ; gadt_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta' cons -- Construct representation tycon ; rep_tc_name <- newFamInstTyConName fam_tc_name pats' ; axiom_name <- newFamInstAxiomName fam_tc_name [pats'] + ; let (eta_pats, etad_tvs) = eta_reduce pats' eta_tvs = filterOut (`elem` etad_tvs) tvs' full_tvs = eta_tvs ++ etad_tvs @@ -680,6 +680,14 @@ tcDataFamInstDecl mb_clsinfo ; return (rep_tc, axiom) } -- Remember to check validity; no recursion to worry about here + -- Check that left-hand sides are ok (mono-types, no type families, + -- consistent instantiations, etc) + ; checkValidFamPats mb_clsinfo fam_tc tvs' [] pats' + + -- Result kind must be '*' (otherwise, we have too few patterns) + ; checkTc (isLiftedTypeKind res_kind') $ + tooFewParmsErr (tyConArity fam_tc) + ; checkValidTyCon rep_tc ; let m_deriv_info = case derivs of diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 04da5f2..155396f 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -954,6 +954,7 @@ tcDataDefn roles_info stupid_theta tc_rhs (VanillaAlgTyCon tc_rep_nm) gadt_syntax) } + ; traceTc "tcDataDefn" (ppr tc_name $$ ppr tycon_binders $$ ppr extra_bndrs) ; return tycon } where mk_tc_rhs is_boot tycon data_cons @@ -1056,16 +1057,19 @@ tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = L _ tc_name -- are different. ; (pats', rhs_ty) <- tcFamTyPats shape Nothing pats - (discardResult . tcCheckLHsType rhs) $ \_ pats' rhs_kind -> + (discardResult . tcCheckLHsType rhs) $ \tvs pats rhs_kind -> do { rhs_ty <- solveEqualities $ tcCheckLHsType rhs rhs_kind - ; return (pats', rhs_ty) } - -- pats' is fully zonked already - ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty + + -- Zonk the patterns etc into the Type world + ; (ze, _) <- zonkTyBndrsX emptyZonkEnv tvs + ; pats' <- zonkTcTypeToTypes ze pats + ; rhs_ty' <- zonkTcTypeToType ze rhs_ty + ; return (pats', rhs_ty') } -- See Note [Type-checking default assoc decls] ; case tcMatchTys pats' (mkTyVarTys (tyConTyVars fam_tc)) of - Just subst -> return ( Just (substTyUnchecked subst rhs_ty, loc) ) + Just subst -> return (Just (substTyUnchecked subst rhs_ty, loc) ) Nothing -> failWithTc (defaultAssocKindErr fam_tc) -- We check for well-formedness and validity later, -- in checkValidClass @@ -1114,13 +1118,17 @@ tcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_) mb_clsinfo , tfe_rhs = hs_ty })) = ASSERT( fam_tc_name == eqn_tc_name ) setSrcSpan loc $ - tcFamTyPats fam_tc_shape mb_clsinfo pats (discardResult . (tcCheckLHsType hs_ty)) $ - \tvs' pats' res_kind -> + tcFamTyPats fam_tc_shape mb_clsinfo pats + (discardResult . (tcCheckLHsType hs_ty)) $ + \tvs pats res_kind -> do { rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind - ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty + + ; (ze, tvs') <- zonkTyBndrsX emptyZonkEnv tvs + ; pats' <- zonkTcTypeToTypes ze pats + ; rhs_ty' <- zonkTcTypeToType ze rhs_ty ; traceTc "tcTyFamInstEqn" (ppr fam_tc_name <+> pprTvBndrs tvs') -- don't print out the pats here, as they might be zonked inside the knot - ; return (mkCoAxBranch tvs' [] pats' rhs_ty + ; return (mkCoAxBranch tvs' [] pats' rhs_ty' (map (const Nominal) tvs') loc) } @@ -1239,11 +1247,12 @@ tc_fam_ty_pats (name, _, binders, res_kind) mb_clsinfo -- See Note [tc_fam_ty_pats vs tcFamTyPats] tcFamTyPats :: FamTyConShape -> Maybe ClsInstInfo - -> HsTyPats Name -- patterns + -> HsTyPats Name -- patterns -> (TcKind -> TcM ()) -- kind-checker for RHS - -> ( [TyVar] -- Kind and type variables + -> ( [TcTyVar] -- Kind and type variables -> [TcType] -- Kind and type arguments - -> Kind -> TcM a) -- NB: You can use solveEqualities here. + -> TcKind + -> TcM a) -- NB: You can use solveEqualities here. -> TcM a tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside = do { (typats, res_kind) @@ -1279,15 +1288,14 @@ tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside -- above would fail. TODO (RAE): Update once the solveEqualities -- bit is cleverer. - -- Zonk the patterns etc into the Type world - ; (ze, qtkvs') <- zonkTyBndrsX emptyZonkEnv qtkvs - ; typats' <- zonkTcTypeToTypes ze typats - ; res_kind' <- zonkTcTypeToType ze res_kind + ; traceTc "tcFamTyPats" (ppr name $$ ppr typats $$ ppr qtkvs) + -- Don't print out too much, as we might be in the knot - ; traceTc "tcFamTyPats" (ppr name $$ ppr typats) - -- don't print out too much, as we might be in the knot - ; tcExtendTyVarEnv qtkvs' $ - thing_inside qtkvs' typats' res_kind' } + ; tcExtendTyVarEnv qtkvs $ + -- Extend envt with TcTyVars not TyVars, because the + -- kind checking etc done by thing_inside does not expect + -- to encounter TyVars; it expects TcTyVars + thing_inside qtkvs typats res_kind } {- Note [Constraints in patterns] From git at git.haskell.org Mon Oct 10 12:48:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 12:48:25 +0000 (UTC) Subject: [commit: ghc] master: Improved stats for Trac #1969 (cc5ca21) Message-ID: <20161010124825.494123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc5ca21b6595d550b27439699cc223c7b0ceab61/ghc >--------------------------------------------------------------- commit cc5ca21b6595d550b27439699cc223c7b0ceab61 Author: Simon Peyton Jones Date: Mon Oct 10 13:45:42 2016 +0100 Improved stats for Trac #1969 With my latest commits 76a5477 Move zonking out of tcFamTyPats b255ae7 Orient improvement constraints better perf has improved slightly for T1969: allocs: 733M -> 26M residency: 43M -> 41M I don't know exactly why, but hey, it's good >--------------------------------------------------------------- cc5ca21b6595d550b27439699cc223c7b0ceab61 testsuite/tests/perf/compiler/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index f9482d1..28c80e1 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -28,7 +28,7 @@ setTestOpts(no_lint) # really changed, then you know there's an issue. test('T1969', - [expect_broken(12437), + [# expect_broken(12437), compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] [(wordsize(32), 30, 15), # 2010-05-17 14 (x86/Windows) From git at git.haskell.org Mon Oct 10 12:57:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 12:57:39 +0000 (UTC) Subject: [commit: ghc] master: More tests for Trac #12522 (a6111b8) Message-ID: <20161010125739.1AA803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6111b8cc14a5dc019e2613f6f634dec4eb57a8a/ghc >--------------------------------------------------------------- commit a6111b8cc14a5dc019e2613f6f634dec4eb57a8a Author: Simon Peyton Jones Date: Mon Oct 10 13:57:01 2016 +0100 More tests for Trac #12522 These ones test the variations in coment:15 of the ticket >--------------------------------------------------------------- a6111b8cc14a5dc019e2613f6f634dec4eb57a8a .../tests/indexed-types/should_compile/T12522b.hs | 20 ++++++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + .../tests/indexed-types/should_fail/T12522a.hs | 21 +++++++++++++++++++++ .../should_fail/T12522a.stderr} | 18 +++++++----------- testsuite/tests/indexed-types/should_fail/all.T | 1 + 5 files changed, 50 insertions(+), 11 deletions(-) diff --git a/testsuite/tests/indexed-types/should_compile/T12522b.hs b/testsuite/tests/indexed-types/should_compile/T12522b.hs new file mode 100644 index 0000000..7501382 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12522b.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} + +module T12522a where + +newtype I a = I a + +type family Curry (as :: [*]) b = f | f -> as b where + Curry '[] b = I b + Curry (a:as) b = a -> Curry as b + +data Uncurried (as :: [*]) b + +def :: Curry as b -> Uncurried as b +def = undefined + +-- test2 :: Uncurried [Bool, Bool] Bool +test2 = def $ \a b -> I $ a && b diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 4eeb777..eab93ac 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -275,3 +275,4 @@ test('T11361a', normal, compile_fail, ['']) test('T11581', normal, compile, ['']) test('T12175', normal, compile, ['']) test('T12522', normal, compile, ['']) +test('T12522b', normal, compile, ['']) diff --git a/testsuite/tests/indexed-types/should_fail/T12522a.hs b/testsuite/tests/indexed-types/should_fail/T12522a.hs new file mode 100644 index 0000000..eb855f4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T12522a.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} + +module T12522a where + +newtype I a = I a + +type family Curry (as :: [*]) b = f | f -> as b where + Curry '[] b = I b + Curry (a:as) b = a -> Curry as b + +data Uncurried (as :: [*]) b + +def :: Curry as b -> Uncurried as b +def = undefined + +-- test :: Uncurried [Int, String] String +test = def $ \n s -> I $ show n ++ s + diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/indexed-types/should_fail/T12522a.stderr similarity index 54% copy from testsuite/tests/typecheck/should_compile/holes2.stderr copy to testsuite/tests/indexed-types/should_fail/T12522a.stderr index eb8d56f..7356791 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12522a.stderr @@ -1,7 +1,10 @@ -holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] +T12522a.hs:20:26: error: • Ambiguous type variable ‘a0’ arising from a use of ‘show’ prevents the constraint ‘(Show a0)’ from being solved. + Relevant bindings include + n :: a0 (bound at T12522a.hs:20:15) + test :: Uncurried '[a0, [Char]] [Char] (bound at T12522a.hs:20:1) Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance Show Ordering -- Defined in ‘GHC.Show’ @@ -10,13 +13,6 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] ...plus 22 others ...plus five instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the expression: show _ - In an equation for ‘f’: f = show _ - -holes2.hs:3:10: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: a0 - Where: ‘a0’ is an ambiguous type variable - • In the first argument of ‘show’, namely ‘_’ - In the expression: show _ - In an equation for ‘f’: f = show _ - • Relevant bindings include f :: String (bound at holes2.hs:3:1) + • In the first argument of ‘(++)’, namely ‘show n’ + In the second argument of ‘($)’, namely ‘show n ++ s’ + In the expression: I $ show n ++ s diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 1aaa07e..f4f8c8d 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -139,3 +139,4 @@ test('T11136', normal, compile_fail, ['']) test('T7788', normal, compile_fail, ['']) test('T11450', normal, compile_fail, ['']) test('T12041', normal, compile_fail, ['']) +test('T12522a', normal, compile_fail, ['']) From git at git.haskell.org Mon Oct 10 15:00:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:14 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: runghc: use executeFile to run ghc process on POSIX (c904258) Message-ID: <20161010150014.12AA53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c904258319b8eb6e47ba727c667bca765537802b/ghc >--------------------------------------------------------------- commit c904258319b8eb6e47ba727c667bca765537802b Author: Michael Snoyman Date: Sat Oct 1 21:24:05 2016 -0400 runghc: use executeFile to run ghc process on POSIX This means that, on POSIX systems, there will be only one ghc process used for running scripts, as opposed to the current situation of a runghc process and a ghc process. Beyond minor performance benefits of not having an extra fork and resident process, the more important impact of this is automatically getting proper signal handling. I noticed this problem myself when running runghc as PID1 inside a Docker container. I attempted to create a shim library for executeFile that would work for both POSIX and Windows, but unfortunately I ran into issues with exit codes being propagated correctly (see https://github.com/fpco/replace-process/issues/2). Therefore, this patch leaves the Windows behavior unchanged. Given that signals are a POSIX issue, this isn't too bad a trade-off. If someone has suggestions for better Windows _exec support, please let me know. Reviewers: erikd, austin, bgamari Reviewed By: bgamari Subscribers: Phyx, thomie Differential Revision: https://phabricator.haskell.org/D2538 (cherry picked from commit 42f1d86770f963cf810aa4d31757dda8a08a52fa) >--------------------------------------------------------------- c904258319b8eb6e47ba727c667bca765537802b testsuite/tests/runghc/Makefile | 4 ++ testsuite/tests/runghc/T-signals-child.hs | 113 ++++++++++++++++++++++++++++++ testsuite/tests/runghc/T7859.stderr | 2 +- testsuite/tests/runghc/all.T | 5 ++ utils/runghc/Main.hs | 24 +++++-- utils/runghc/runghc.cabal.in | 3 + 6 files changed, 144 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/runghc/Makefile b/testsuite/tests/runghc/Makefile index f96c829..643e967 100644 --- a/testsuite/tests/runghc/Makefile +++ b/testsuite/tests/runghc/Makefile @@ -10,3 +10,7 @@ T7859: #compile. T8601: -echo 'main = putStrLn "Hello World!"' | '$(RUNGHC)' -f '$(TEST_HC)' -hide-package --ghc-arg=bytestring + +T-signals-child: + -'$(RUNGHC)' T-signals-child.hs --runghc '$(RUNGHC)' + diff --git a/testsuite/tests/runghc/T-signals-child.hs b/testsuite/tests/runghc/T-signals-child.hs new file mode 100644 index 0000000..21c1b64 --- /dev/null +++ b/testsuite/tests/runghc/T-signals-child.hs @@ -0,0 +1,113 @@ +import Control.Concurrent.MVar (readMVar) +import System.Environment (getArgs) +import System.Exit (ExitCode (ExitFailure), exitFailure) +import System.IO (hGetLine, hPutStrLn) +import System.Posix.Process (exitImmediately, getProcessID) +import System.Posix.Signals (Handler (Catch), installHandler, sigHUP, + signalProcess) +import System.Process (StdStream (CreatePipe), createProcess, proc, + std_in, std_out, waitForProcess) +import System.Process.Internals (ProcessHandle (..), + ProcessHandle__ (OpenHandle)) + +main :: IO () +main = do + args <- getArgs + case args of + ["--runghc", runghc] -> runParent runghc + ["child"] -> runChild + _ -> error $ "Unknown args: " ++ show args + +runParent :: FilePath -> IO () +runParent runghc = do + (Just inH, Just outH, Nothing, ph@(ProcessHandle mvar _)) <- + createProcess (proc runghc ["T-signals-child.hs", "child"]) + { std_in = CreatePipe + , std_out = CreatePipe + } + + -- Get the PID of the actual child process. This will initially be + -- runghc. If executeFile is used by runghc, that same process + -- will become the ghc process running our code from + -- runChild. Otherwise, runChild will run in a child of this + -- process. + OpenHandle childPid <- readMVar mvar + + -- Get the PID of the process actually running the runChild code, + -- by reading it from its stdout (see runChild below). + pidS <- hGetLine outH + let pid = fromIntegral (read pidS :: Int) + + -- Send the child process the HUP signal. We know this is after + -- the signal handler has been installed, since we already got the + -- PID from the process. + signalProcess sigHUP childPid + + -- Send the child some input so that it will exit if it didn't + -- have a sigHUP handler installed. + hPutStrLn inH "" + + -- Read out the rest of stdout from the child, which will be + -- either "NOSIGNAL\n" or "HUP\n" + rest <- hGetLine outH + + -- Get the exit code of the child + ec <- waitForProcess ph + + -- Check that everything matches + if childPid /= pid || rest /= hupMessage || ec /= hupExitCode + then do + -- Debugging display + putStrLn $ concat + [ "Child process: " + , show childPid + , ", real process: " + , show pid + ] + putStrLn $ concat + [ "Expected " + , show hupMessage + , ", received: " + , show rest + ] + putStrLn $ concat + [ "Expected " + , show hupExitCode + , ", received " + , show ec + ] + exitFailure + else return () + +runChild :: IO () +runChild = do + -- Install our sigHUP handler: print the HUP message and exit with + -- the HUP exit code. + let handler = Catch $ do + putStrLn hupMessage + exitImmediately hupExitCode + _ <- installHandler sigHUP handler Nothing + + -- Get our actual process ID and print it to stdout. + pid <- getProcessID + print (fromIntegral pid :: Int) + + -- Block until we receive input, giving a chance for the signal + -- handler to be triggered, and if the signal handler isn't + -- triggered, gives us an escape route from this function. + _ <- getLine + + -- Reaching this point indicates a failure of the test. Print some + -- non HUP message and exit with a non HUP exit + -- code. Interestingly, in a failure, this exit code will _not_ + -- be received by the parent process, since the runghc process + -- itself will exit with ExitFailure -1, indicating that it was + -- killed by signal 1 (SIGHUP). + putStrLn "No signal received" + exitImmediately $ ExitFailure 41 + +hupExitCode :: ExitCode +hupExitCode = ExitFailure 42 + +hupMessage :: String +hupMessage = "HUP" diff --git a/testsuite/tests/runghc/T7859.stderr b/testsuite/tests/runghc/T7859.stderr index f784874..59348de 100644 --- a/testsuite/tests/runghc/T7859.stderr +++ b/testsuite/tests/runghc/T7859.stderr @@ -1 +1 @@ -runghc: defer-type-errors: rawSystem: runInteractiveProcess: exec: does not exist (No such file or directory) +runghc: defer-type-errors: executeFile: does not exist (No such file or directory) diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index 3ffaa20..ef3cb94 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -3,3 +3,8 @@ test('T7859', req_interp, run_command, test('T8601', req_interp, run_command, ['$MAKE --no-print-directory -s T8601']) + +test('T-signals-child', + [when(opsys('mingw32'), skip), req_interp], + run_command, + ['$MAKE --no-print-directory -s T-signals-child']) diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs index 001d902..bcf77e7 100644 --- a/utils/runghc/Main.hs +++ b/utils/runghc/Main.hs @@ -24,11 +24,13 @@ import System.Environment import System.Exit import System.FilePath import System.IO -import System.Process #if defined(mingw32_HOST_OS) +import System.Process (runProcess) import Foreign import Foreign.C.String +#else +import System.Posix.Process (executeFile) #endif #if defined(mingw32_HOST_OS) @@ -141,11 +143,21 @@ doIt ghc ghc_args rest = do else [] c1 = ":set prog " ++ show filename c2 = ":main " ++ show prog_args - res <- rawSystem ghc (["-ignore-dot-ghci"] ++ - xflag ++ - ghc_args ++ - [ "-e", c1, "-e", c2, filename]) - exitWith res + + let cmd = ghc + args = ["-ignore-dot-ghci"] ++ + xflag ++ + ghc_args ++ + [ "-e", c1, "-e", c2, filename] + + +#if defined(mingw32_HOST_OS) + rawSystem cmd args >>= exitWith +#else + -- Passing False to avoid searching the PATH, since the cmd should + -- always be an absolute path to the ghc executable. + executeFile cmd False args Nothing +#endif getGhcArgs :: [String] -> ([String], [String]) getGhcArgs args diff --git a/utils/runghc/runghc.cabal.in b/utils/runghc/runghc.cabal.in index efef5ec..2253292 100644 --- a/utils/runghc/runghc.cabal.in +++ b/utils/runghc/runghc.cabal.in @@ -30,3 +30,6 @@ Executable runghc directory >= 1 && < 1.3, process >= 1 && < 1.5, filepath + + if !os(windows) + build-depends: unix \ No newline at end of file From git at git.haskell.org Mon Oct 10 15:00:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: runghc: Fix import of System.Process on Windows (9cc5a8f) Message-ID: <20161010150016.CBD533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9cc5a8f49b47221f258ab360716a6a51f1bf38d1/ghc >--------------------------------------------------------------- commit 9cc5a8f49b47221f258ab360716a6a51f1bf38d1 Author: Ben Gamari Date: Sun Oct 2 19:40:56 2016 -0400 runghc: Fix import of System.Process on Windows This apparently should have been an import of rawSystem instead of runProcess. Oops. Fixes D2538. Test Plan: Validate on Linux and Windows. Reviewers: austin, snowleopard Reviewed By: snowleopard Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2561 (cherry picked from commit 8952cc3e8e36985b06166c23c482174b07ffa66d) >--------------------------------------------------------------- 9cc5a8f49b47221f258ab360716a6a51f1bf38d1 utils/runghc/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs index bcf77e7..b5d4a4a 100644 --- a/utils/runghc/Main.hs +++ b/utils/runghc/Main.hs @@ -26,7 +26,7 @@ import System.FilePath import System.IO #if defined(mingw32_HOST_OS) -import System.Process (runProcess) +import System.Process (rawSystem) import Foreign import Foreign.C.String #else From git at git.haskell.org Mon Oct 10 15:00:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:19 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Escape lambda. (bdfa8a1) Message-ID: <20161010150019.9BD2D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/bdfa8a1ce14b551ce2989ad7fa74ee6b4015c5e1/ghc >--------------------------------------------------------------- commit bdfa8a1ce14b551ce2989ad7fa74ee6b4015c5e1 Author: Vaibhav Sagar Date: Sun Oct 9 18:21:58 2016 -0400 Escape lambda. Test Plan: View updated documentation? Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2583 GHC Trac Issues: #12672 (cherry picked from commit 1a9705c32f6841be8bc6df3c1084a50dacba2730) >--------------------------------------------------------------- bdfa8a1ce14b551ce2989ad7fa74ee6b4015c5e1 libraries/base/GHC/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 1f989c4..2edce60 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -456,7 +456,7 @@ Instances of 'Monad' should satisfy the following laws: * @'return' a '>>=' k = k a@ * @m '>>=' 'return' = m@ -* @m '>>=' (\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ +* @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: From git at git.haskell.org Mon Oct 10 15:00:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:23 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve error handling in TcRnMonad (5662cea) Message-ID: <20161010150023.6D2AC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5662ceaeb4da4fdee0f9fc01f72855168471377f/ghc >--------------------------------------------------------------- commit 5662ceaeb4da4fdee0f9fc01f72855168471377f Author: Simon Peyton Jones Date: Wed Oct 5 22:00:02 2016 +0100 Improve error handling in TcRnMonad See Note [Constraints and errors] in TcRnMonad. This patch fixes Trac #12124 in quite a neat way. (cherry picked from commit 465c6c5d15f8fb54afb78408f3a79e75e74d2cd4) >--------------------------------------------------------------- 5662ceaeb4da4fdee0f9fc01f72855168471377f compiler/typecheck/TcRnMonad.hs | 60 +++++++++++++--------- compiler/typecheck/TcSplice.hs | 2 +- .../should_fail/CustomTypeErrors02.stderr | 5 -- testsuite/tests/typecheck/should_fail/T12124.hs | 8 +++ .../should_fail/T12124.srderr} | 0 .../tests/typecheck/should_fail/T12124.stderr | 9 ++++ testsuite/tests/typecheck/should_fail/T8142.stderr | 10 ---- testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 56 insertions(+), 39 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 5662ceaeb4da4fdee0f9fc01f72855168471377f From git at git.haskell.org Mon Oct 10 15:00:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Orient improvement constraints better (12cfcbe) Message-ID: <20161010150026.933B43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/12cfcbeb93cff0747259e2cc5be652184734a292/ghc >--------------------------------------------------------------- commit 12cfcbeb93cff0747259e2cc5be652184734a292 Author: Simon Peyton Jones Date: Fri Oct 7 23:51:44 2016 +0100 Orient improvement constraints better This patch fixes an infinite loop in the constraint solver, shown up by Trac #12522. The solution is /very/ simple: just reverse the orientation of the derived constraints arising from improvement using type-family injectivity. I'm not very proud of the fix --- it seems fragile --- but it has the very great merit of simplicity, and it works fine. See Note [Improvement orientation] in TcInteract, and some discussion on the Trac ticket. (cherry picked from commit b255ae7b555b4b63085a6de4a7a6bd742326b9c9) >--------------------------------------------------------------- 12cfcbeb93cff0747259e2cc5be652184734a292 compiler/typecheck/TcInteract.hs | 78 ++++++++++++++++------ .../tests/indexed-types/should_compile/T12522.hs | 50 ++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 107 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 259c570..402e6da 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -779,9 +779,8 @@ interactGivenIP inerts workItem@(CDictCan { cc_ev = ev, cc_class = cls interactGivenIP _ wi = pprPanic "interactGivenIP" (ppr wi) -{- -Note [Shadowing of Implicit Parameters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Shadowing of Implicit Parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following example: f :: (?x :: Char) => Char @@ -804,8 +803,19 @@ signature, and we implement this as follows: when we add a new *given* implicit parameter to the inert set, it replaces any existing givens for the same implicit parameter. -This works for the normal cases but it has an odd side effect -in some pathological programs like this: +Similarly, consider + f :: (?x::a) => Bool -> a + + g v = let ?x::Int = 3 + in (f v, let ?x::Bool = True in f v) + +This should probably be well typed, with + g :: Bool -> (Int, Bool) + +So the inner binding for ?x::Bool *overrides* the outer one. + +All this works for the normal cases but it has an odd side effect in +some pathological programs like this: -- This is accepted, the second parameter shadows f1 :: (?x :: Int, ?x :: Char) => Char @@ -821,7 +831,7 @@ which would lead to an error. I can think of two ways to fix this: - 1. Simply disallow multiple constratits for the same implicit + 1. Simply disallow multiple constraints for the same implicit parameter---this is never useful, and it can be detected completely syntactically. @@ -1498,11 +1508,13 @@ improve_top_fun_eqs fam_envs fam_tc args rhs_ty -- part of the tuple, which is the range of the substitution then -- the order could be important. let subst = theta `unionTCvSubst` theta' - return [ Pair arg (substTyUnchecked subst ax_arg) + return [ Pair (substTyUnchecked subst ax_arg) arg + -- NB: the ax_arg part is on the left + -- see Note [Improvement orientation] | case cabr of Just cabr' -> apartnessCheck (substTys subst ax_args) cabr' _ -> True - , (arg, ax_arg, True) <- zip3 args ax_args inj_args ] + , (ax_arg, arg, True) <- zip3 ax_args args inj_args ] shortCutReduction :: CtEvidence -> TcTyVar -> TcCoercion @@ -1687,7 +1699,6 @@ Then it is solvable, but its very hard to detect this on the spot. It's exactly the same with implicit parameters, except that the "aggressive" approach would be much easier to implement. - Note [Weird fundeps] ~~~~~~~~~~~~~~~~~~~~ Consider class Het a b | a -> b where @@ -1709,19 +1720,42 @@ as the fundeps. Trac #7875 is a case in point. -Note [Overriding implicit parameters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f :: (?x::a) -> Bool -> a - - g v = let ?x::Int = 3 - in (f v, let ?x::Bool = True in f v) - -This should probably be well typed, with - g :: Bool -> (Int, Bool) - -So the inner binding for ?x::Bool *overrides* the outer one. -Hence a work-item Given overrides an inert-item Given. +Note [Improvement orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A very delicate point is the orientation of derived equalities +arising from injectivity improvement (Trac #12522). Suppse we have + type family F x = t | t -> x + type instance F (a, Int) = (Int, G a) +where G is injective; and wanted constraints + + [W] TF (alpha, beta) ~ fuv + [W] fuv ~ (Int, ) + +The injectivity will give rise to derived constraionts + + [D] gamma1 ~ alpha + [D] Int ~ beta + +The fresh unification variable gamma1 comes from the fact that we +can only do "partial improvement" here; see Section 5.2 of +"Injective type families for Haskell" (HS'15). + +Now, it's very important to orient the equations this way round, +so that the fresh unification variable will be eliminated in +favour of alpha. If we instead had + [D] alpha ~ gamma1 +then we would unify alpha := gamma1; and kick out the wanted +constraint. But when we grough it back in, it'd look like + [W] TF (gamma1, beta) ~ fuv +and exactly the same thing would happen again! Infnite loop. + +This all sesms fragile, and it might seem more robust to avoid +introducing gamma1 in the first place, in the case where the +actual argument (alpha, beta) partly matches the improvement +template. But that's a bit tricky, esp when we remember that the +kinds much match too; so it's easier to let the normal machinery +handle it. Instead we are careful to orient the new derived +equality with the template on the left. Delicate, but it works. -} {- ******************************************************************* diff --git a/testsuite/tests/indexed-types/should_compile/T12522.hs b/testsuite/tests/indexed-types/should_compile/T12522.hs new file mode 100644 index 0000000..7779942 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12522.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module T12522 where + +foo = f (Just 'c') + +data D1 x +data D2 + +type family TF x = t | t -> x +type instance TF (D1 x, a) = Maybe (TF (x, a)) +type instance TF (D2, ()) = Char + +f :: TF (x, a) -> () +f _ = () + +foo1 = f_good (Just 'c') +foo2 = f_bad (Just 'c') + +type family TF2 x y = t | t -> x y +type instance TF2 Int Float = Char + +type family TF_Good x y = t | t -> x y +type instance TF_Good a (Maybe x) = Maybe (TF2 a x) + +f_good :: TF_Good a x -> () +f_good _ = () + +type family TF_Bad x y = t | t -> x y +type instance TF_Bad (Maybe x) a = Maybe (TF2 a x) + +f_bad :: TF_Bad x a -> () +f_bad _ = () + +{- + +Maybe Char ~ TF (xx, aa) + + +Model [D] s_aF4 ~ Maybe Char + + [W] TF (x_aDY, a_aJn) ~ s_aF4 FunEq +--> {aJn = aJp) + [W} TF (x_aDY, a_aJp) ~ s_aF4 FunEq +--> {new derived equalities} + [D] x_aDY ~ D1 x_aJq + [D] a_aJp ~ a_aJR +-} diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index d88505e..9763d89 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -274,3 +274,4 @@ test('T11408', normal, compile, ['']) test('T11361', normal, compile, ['']) test('T11361a', normal, compile_fail, ['']) test('T12175', normal, compile, ['']) +test('T12522', normal, compile, ['']) From git at git.haskell.org Mon Oct 10 15:00:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: More tests for Trac #12522 (801cbb4) Message-ID: <20161010150030.0800A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/801cbb42638714004587ba39d1d6b2bbc9ad3b9d/ghc >--------------------------------------------------------------- commit 801cbb42638714004587ba39d1d6b2bbc9ad3b9d Author: Simon Peyton Jones Date: Mon Oct 10 13:57:01 2016 +0100 More tests for Trac #12522 These ones test the variations in coment:15 of the ticket (cherry picked from commit a6111b8cc14a5dc019e2613f6f634dec4eb57a8a) >--------------------------------------------------------------- 801cbb42638714004587ba39d1d6b2bbc9ad3b9d .../tests/indexed-types/should_compile/T12522b.hs | 20 ++++++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + .../tests/indexed-types/should_fail/T12522a.hs | 21 +++++++++++++++++++++ .../should_fail/T12522a.stderr} | 18 +++++++----------- testsuite/tests/indexed-types/should_fail/all.T | 1 + 5 files changed, 50 insertions(+), 11 deletions(-) diff --git a/testsuite/tests/indexed-types/should_compile/T12522b.hs b/testsuite/tests/indexed-types/should_compile/T12522b.hs new file mode 100644 index 0000000..7501382 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12522b.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} + +module T12522a where + +newtype I a = I a + +type family Curry (as :: [*]) b = f | f -> as b where + Curry '[] b = I b + Curry (a:as) b = a -> Curry as b + +data Uncurried (as :: [*]) b + +def :: Curry as b -> Uncurried as b +def = undefined + +-- test2 :: Uncurried [Bool, Bool] Bool +test2 = def $ \a b -> I $ a && b diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 9763d89..ab49be4 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -275,3 +275,4 @@ test('T11361', normal, compile, ['']) test('T11361a', normal, compile_fail, ['']) test('T12175', normal, compile, ['']) test('T12522', normal, compile, ['']) +test('T12522b', normal, compile, ['']) diff --git a/testsuite/tests/indexed-types/should_fail/T12522a.hs b/testsuite/tests/indexed-types/should_fail/T12522a.hs new file mode 100644 index 0000000..eb855f4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T12522a.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} + +module T12522a where + +newtype I a = I a + +type family Curry (as :: [*]) b = f | f -> as b where + Curry '[] b = I b + Curry (a:as) b = a -> Curry as b + +data Uncurried (as :: [*]) b + +def :: Curry as b -> Uncurried as b +def = undefined + +-- test :: Uncurried [Int, String] String +test = def $ \n s -> I $ show n ++ s + diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/indexed-types/should_fail/T12522a.stderr similarity index 54% copy from testsuite/tests/typecheck/should_compile/holes2.stderr copy to testsuite/tests/indexed-types/should_fail/T12522a.stderr index eb8d56f..7356791 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12522a.stderr @@ -1,7 +1,10 @@ -holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] +T12522a.hs:20:26: error: • Ambiguous type variable ‘a0’ arising from a use of ‘show’ prevents the constraint ‘(Show a0)’ from being solved. + Relevant bindings include + n :: a0 (bound at T12522a.hs:20:15) + test :: Uncurried '[a0, [Char]] [Char] (bound at T12522a.hs:20:1) Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance Show Ordering -- Defined in ‘GHC.Show’ @@ -10,13 +13,6 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] ...plus 22 others ...plus five instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the expression: show _ - In an equation for ‘f’: f = show _ - -holes2.hs:3:10: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: a0 - Where: ‘a0’ is an ambiguous type variable - • In the first argument of ‘show’, namely ‘_’ - In the expression: show _ - In an equation for ‘f’: f = show _ - • Relevant bindings include f :: String (bound at holes2.hs:3:1) + • In the first argument of ‘(++)’, namely ‘show n’ + In the second argument of ‘($)’, namely ‘show n ++ s’ + In the expression: I $ show n ++ s diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 83dd708..7c55bde 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -140,3 +140,4 @@ test('T10899', normal, compile_fail, ['']) test('T11136', normal, compile_fail, ['']) test('T7788', normal, compile_fail, ['']) test('T12041', normal, compile_fail, ['']) +test('T12522a', normal, compile_fail, ['']) From git at git.haskell.org Mon Oct 10 15:00:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:32 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add missing test from D2545 (7643c14) Message-ID: <20161010150032.BE8663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7643c14951e2c6115b9bc0797899ebb4d3897ebe/ghc >--------------------------------------------------------------- commit 7643c14951e2c6115b9bc0797899ebb4d3897ebe Author: Matthew Pickering Date: Sat Oct 1 17:55:26 2016 -0400 Add missing test from D2545 This was somehow dropped from the original merge. Differential Revision: https://phabricator.haskell.org/D2545 GHC Trac Issues: #12615 (cherry picked from commit 1851349acd9e73f1c18d68f70d5cf7b46a843cb5) >--------------------------------------------------------------- 7643c14951e2c6115b9bc0797899ebb4d3897ebe testsuite/tests/patsyn/should_compile/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 0300915..9841462 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -57,4 +57,4 @@ test('T12489', normal, compile, ['']) test('T11959', expect_broken(11959), multimod_compile, ['T11959', '-v0']) test('T12615', normal, compile, ['']) test('T11987', normal, multimod_compile, ['T11987', '-v0']) - +test('T12615', normal, compile, ['']) From git at git.haskell.org Mon Oct 10 15:00:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix memory leak from #12664 (b08ffec) Message-ID: <20161010150035.A641A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b08ffec0aa9cf88ff47fd71d0c6e61d3a31d7b0d/ghc >--------------------------------------------------------------- commit b08ffec0aa9cf88ff47fd71d0c6e61d3a31d7b0d Author: Bartosz Nitka Date: Thu Oct 6 05:40:24 2016 -0700 Fix memory leak from #12664 This fixes the leak with `setProgArgv`. The problem was that `setProgArgv` would not free the objects pointed to by `prog_argc`, `prog_argv` when the globals were changed resulting in a leak. The only strictly necessary change is in `rts/RtsFlags.c`, but the code in `System.Environment` was a bit confusing and not exception safe, so I refactored it. Test Plan: ./validate Reviewers: simonmar, ezyang, austin, hvr, bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2576 GHC Trac Issues: #12664 (cherry picked from commit e41b9c614984b63c4660018cecde682453e083e5) >--------------------------------------------------------------- b08ffec0aa9cf88ff47fd71d0c6e61d3a31d7b0d libraries/base/GHC/Foreign.hs | 18 ++++++++++++++++ libraries/base/System/Environment.hs | 30 +++++++++++---------------- libraries/base/tests/IO/environment001.hs | 4 ++++ libraries/base/tests/IO/environment001.stdout | 2 ++ rts/RtsFlags.c | 1 + 5 files changed, 37 insertions(+), 18 deletions(-) diff --git a/libraries/base/GHC/Foreign.hs b/libraries/base/GHC/Foreign.hs index e8553d8..7d2f915 100644 --- a/libraries/base/GHC/Foreign.hs +++ b/libraries/base/GHC/Foreign.hs @@ -32,6 +32,7 @@ module GHC.Foreign ( -- withCString, withCStringLen, + withCStringsLen, charIsRepresentable, ) where @@ -134,6 +135,23 @@ withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a withCStringLen enc = withEncodedCString enc False +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f -- | Determines whether a character can be accurately encoded in a 'CString'. -- diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs index b3fbaf8..40fdfcf 100644 --- a/libraries/base/System/Environment.hs +++ b/libraries/base/System/Environment.hs @@ -32,12 +32,14 @@ module System.Environment import Foreign import Foreign.C import System.IO.Error (mkIOError) -import Control.Exception.Base (bracket, throwIO) +import Control.Exception.Base (bracket_, throwIO) +#ifdef mingw32_HOST_OS +import Control.Exception.Base (bracket) +#endif -- import GHC.IO import GHC.IO.Exception import GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC -import Data.List import Control.Monad #ifdef mingw32_HOST_OS import GHC.Environment @@ -369,25 +371,17 @@ withProgArgv :: [String] -> IO a -> IO a withProgArgv new_args act = do pName <- System.Environment.getProgName existing_args <- System.Environment.getArgs - bracket (setProgArgv new_args) - (\argv -> do _ <- setProgArgv (pName:existing_args) - freeProgArgv argv) - (const act) - -freeProgArgv :: Ptr CString -> IO () -freeProgArgv argv = do - size <- lengthArray0 nullPtr argv - sequence_ [ peek (argv `advancePtr` i) >>= free - | i <- [size - 1, size - 2 .. 0]] - free argv - -setProgArgv :: [String] -> IO (Ptr CString) + bracket_ (setProgArgv new_args) + (setProgArgv (pName:existing_args)) + act + +setProgArgv :: [String] -> IO () setProgArgv argv = do enc <- getFileSystemEncoding - vs <- mapM (GHC.newCString enc) argv >>= newArray0 nullPtr - c_setProgArgv (genericLength argv) vs - return vs + GHC.withCStringsLen enc argv $ \len css -> + c_setProgArgv (fromIntegral len) css +-- setProgArgv copies the arguments foreign import ccall unsafe "setProgArgv" c_setProgArgv :: CInt -> Ptr CString -> IO () diff --git a/libraries/base/tests/IO/environment001.hs b/libraries/base/tests/IO/environment001.hs index 11d7912..1d7a5c1 100644 --- a/libraries/base/tests/IO/environment001.hs +++ b/libraries/base/tests/IO/environment001.hs @@ -14,3 +14,7 @@ main = do [arg1] <- withArgs ["你好!"] getArgs putStrLn arg1 putStrLn ("Test 3: " ++ show (length arg1)) + + args2 <- withArgs ["a", "b"] getArgs + print args2 + putStrLn ("Test 4: " ++ show (length args2)) diff --git a/libraries/base/tests/IO/environment001.stdout b/libraries/base/tests/IO/environment001.stdout index 2434d0c..2d32a83 100644 --- a/libraries/base/tests/IO/environment001.stdout +++ b/libraries/base/tests/IO/environment001.stdout @@ -4,3 +4,5 @@ Test 1: 3 Test 2: 1 你好! Test 3: 3 +["a","b"] +Test 4: 2 diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index fda33f0..32c1a72 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -1876,6 +1876,7 @@ getProgArgv(int *argc, char **argv[]) void setProgArgv(int argc, char *argv[]) { + freeArgv(prog_argc,prog_argv); prog_argc = argc; prog_argv = copyArgv(argc,argv); setProgName(prog_argv); From git at git.haskell.org Mon Oct 10 15:00:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Do not segfault if no common root can be found (ec05551) Message-ID: <20161010150038.73DD93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ec05551392aeb39b42d1a529fac32b1f795f29b0/ghc >--------------------------------------------------------------- commit ec05551392aeb39b42d1a529fac32b1f795f29b0 Author: Moritz Angermann Date: Sun Oct 9 18:17:46 2016 -0400 Do not segfault if no common root can be found When trying to profile a plugin, ghc mysteriously segfaulted. Upon closer examination the segfault happend due to a `->prevStack` lookup on a NULL pointer. A new CostCentre: Unknown is introduced that is set, if ccsapp and ccsfn are of equal depth (e.g. 0), and do not have a common CostCentre in their stacks. Reviewers: bgamari, simonmar, austin, erikd Reviewed By: simonmar Subscribers: Phyx, thomie Differential Revision: https://phabricator.haskell.org/D2551 (cherry picked from commit bcd34451382e0d1b52ef82cb9d762e9d68bc0887) >--------------------------------------------------------------- ec05551392aeb39b42d1a529fac32b1f795f29b0 rts/Linker.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/rts/Linker.c b/rts/Linker.c index ae2830e..9412e5b 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1427,6 +1427,11 @@ static void* lookupSymbol_ (char *lbl) errorBelch("Could not on-demand load symbol '%s'\n", lbl); return NULL; } +#ifdef PROFILING + // collect any new cost centres & CCSs + // that were defined during runInit + initProfiling2(); +#endif } return val; From git at git.haskell.org Mon Oct 10 15:00:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:41 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remove reexports from ghc-boot, help bootstrap with GHC 8. (bdfb901) Message-ID: <20161010150041.3BB623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/bdfb90125009e269b2fbe7f1a7622cc5ca1cd52f/ghc >--------------------------------------------------------------- commit bdfb90125009e269b2fbe7f1a7622cc5ca1cd52f Author: Edward Z. Yang Date: Sun Oct 2 12:59:44 2016 -0700 Remove reexports from ghc-boot, help bootstrap with GHC 8. (cherry picked from commit 940ded858157173e75504e8cb0750f059ffd48b9) >--------------------------------------------------------------- bdfb90125009e269b2fbe7f1a7622cc5ca1cd52f compiler/ghc.cabal.in | 1 + libraries/ghc-boot/GHC/Lexeme.hs | 5 ----- libraries/ghc-boot/ghc-boot.cabal.in | 1 - 3 files changed, 1 insertion(+), 6 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index b3ac89c..4d5e3b5 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -58,6 +58,7 @@ Library hpc == 0.6.*, transformers == 0.5.*, ghc-boot == @ProjectVersionMunged@, + ghc-boot-th == @ProjectVersionMunged@, hoopl >= 3.10.2 && < 3.11 if os(windows) diff --git a/libraries/ghc-boot/GHC/Lexeme.hs b/libraries/ghc-boot/GHC/Lexeme.hs deleted file mode 100644 index ab9310e..0000000 --- a/libraries/ghc-boot/GHC/Lexeme.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# LANGUAGE PackageImports #-} - -module GHC.Lexeme ( module X ) where - -import "ghc-boot-th" GHC.Lexeme as X diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index da2cb32..6375b8b 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -38,7 +38,6 @@ Library exposed-modules: GHC.LanguageExtensions GHC.LanguageExtensions.Type - GHC.Lexeme GHC.PackageDb GHC.Serialized From git at git.haskell.org Mon Oct 10 15:00:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:44 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Don't ignore addTopDecls in module finalizers. (a77bbb8) Message-ID: <20161010150044.8F16A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a77bbb8b8c15ef21eab4357248d5d6964c542150/ghc >--------------------------------------------------------------- commit a77bbb8b8c15ef21eab4357248d5d6964c542150 Author: Facundo Domínguez Date: Thu Sep 1 11:00:08 2016 -0300 Don't ignore addTopDecls in module finalizers. Summary: Module finalizer could call addTopDecls, however, the declarations added in this fashion were ignored. This patch makes sure to rename, type check and incorporate this declarations. Because a declaration may include a splice which calls addModFinalizer, the list of finalizers is repeteadly checked after adding declarations until no more finalizers remain. Test Plan: ./validate Reviewers: bgamari, goldfire, simonpj, austin Reviewed By: bgamari, simonpj Subscribers: simonmar, mboes, thomie Differential Revision: https://phabricator.haskell.org/D2505 GHC Trac Issues: #12559 (cherry picked from commit 71dd6e4429833238bcdaf96da8e2e41a62dacbf4) >--------------------------------------------------------------- a77bbb8b8c15ef21eab4357248d5d6964c542150 compiler/rename/RnSplice.hs | 1 + compiler/typecheck/TcRnDriver.hs | 25 +++++++++++++++++++++- compiler/typecheck/TcSplice.hs | 10 +++------ testsuite/tests/th/TH_finalizer2.hs | 3 +++ .../T3279.stdout => th/TH_finalizer2.stdout} | 0 testsuite/tests/th/TH_finalizer2M.hs | 9 ++++++++ testsuite/tests/th/all.T | 3 +++ 7 files changed, 43 insertions(+), 8 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 828ee8e..0dc4487 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -612,6 +612,7 @@ rnTopSpliceDecls splice -- -- See Note [Delaying modFinalizers in untyped splices]. add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn () + add_mod_finalizers_now [] = return () add_mod_finalizers_now mod_finalizers = do th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv updTcRef th_modfinalizers_var $ \fins -> diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index b05e4b4..7dd7774 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -477,7 +477,9 @@ tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all tcRnSrcDecls explicit_mod_hdr decls = do { -- Do all the declarations ; ((tcg_env, tcl_env), lie) <- captureConstraints $ - do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ; + do { envs <- tc_rn_src_decls decls + ; (tcg_env, tcl_env) <- setEnvs envs run_th_modfinalizers + ; tcg_env <- setEnvs (tcg_env, tcl_env) $ checkMain explicit_mod_hdr ; return (tcg_env, tcl_env) } @@ -548,6 +550,27 @@ tcRnSrcDecls explicit_mod_hdr decls } } } +#ifdef GHCI +-- | Runs TH finalizers and renames and typechecks the top-level declarations +-- that they could introduce. +run_th_modfinalizers :: TcM (TcGblEnv, TcLclEnv) +run_th_modfinalizers = do + th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv + th_modfinalizers <- readTcRef th_modfinalizers_var + if null th_modfinalizers + then getEnvs + else do + writeTcRef th_modfinalizers_var [] + sequence_ th_modfinalizers + -- Finalizers can add top-level declarations with addTopDecls. + envs <- tc_rn_src_decls [] + -- addTopDecls can add declarations which add new finalizers. + setEnvs envs run_th_modfinalizers +#else +run_th_modfinalizers :: TcM (TcGblEnv, TcLclEnv) +run_th_modfinalizers = getEnvs +#endif /* GHCI */ + tc_rn_src_decls :: [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv) -- Loops around dealing with each top level inter-splice group diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 002306b..1bc2497 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -961,16 +961,12 @@ addModFinalizerRef finRef = do pprPanic "addModFinalizer was called when no finalizers were collected" (ppr th_stage) --- | Run all module finalizers +-- | Releases the external interpreter state. finishTH :: TcM () finishTH = do - tcg <- getGblEnv - let th_modfinalizers_var = tcg_th_modfinalizers tcg - modfinalizers <- readTcRef th_modfinalizers_var - writeTcRef th_modfinalizers_var [] - sequence_ modfinalizers dflags <- getDynFlags - when (gopt Opt_ExternalInterpreter dflags) $ + when (gopt Opt_ExternalInterpreter dflags) $ do + tcg <- getGblEnv writeTcRef (tcg_th_remote_state tcg) Nothing runTHExp :: ForeignHValue -> TcM TH.Exp diff --git a/testsuite/tests/th/TH_finalizer2.hs b/testsuite/tests/th/TH_finalizer2.hs new file mode 100644 index 0000000..a233fdb --- /dev/null +++ b/testsuite/tests/th/TH_finalizer2.hs @@ -0,0 +1,3 @@ +import TH_finalizer2M + +main = print (f 0) diff --git a/testsuite/tests/concurrent/should_run/T3279.stdout b/testsuite/tests/th/TH_finalizer2.stdout similarity index 100% copy from testsuite/tests/concurrent/should_run/T3279.stdout copy to testsuite/tests/th/TH_finalizer2.stdout diff --git a/testsuite/tests/th/TH_finalizer2M.hs b/testsuite/tests/th/TH_finalizer2M.hs new file mode 100644 index 0000000..7eea2d8 --- /dev/null +++ b/testsuite/tests/th/TH_finalizer2M.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} +module TH_finalizer2M where + +import Language.Haskell.TH.Syntax + +g :: IO () +g = $(do addModFinalizer (do d <- [d| f x = (2 :: Int) |]; addTopDecls d) + [| return ()|] + ) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index e5e07d7..74a1d4b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -401,6 +401,9 @@ test('T11341', normal, compile, ['-v0 -dsuppress-uniques']) test('T11345', normal, compile_and_run, ['-v0 -dsuppress-uniques']) test('TH_finalizer', normal, compile, ['-v0']) +test('TH_finalizer2', + normal, multimod_compile_and_run, + ['TH_finalizer2', '-v0 ' + config.ghc_th_way_flags]) test('T10603', normal, compile, ['-ddump-splices -dsuppress-uniques']) test('T11452', normal, compile_fail, ['-v0']) test('T11145', normal, compile_fail, ['-v0 -dsuppress-uniques']) From git at git.haskell.org Mon Oct 10 15:00:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 15:00:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix test output (f168a61) Message-ID: <20161010150047.67D933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f168a616f4aae82cc7007310c320032232d09e79/ghc >--------------------------------------------------------------- commit f168a616f4aae82cc7007310c320032232d09e79 Author: Ben Gamari Date: Mon Oct 10 10:58:42 2016 -0400 Fix test output >--------------------------------------------------------------- f168a616f4aae82cc7007310c320032232d09e79 .../InstantiatedNamedWildcardsInConstraints.stderr | 12 ------------ .../tests/partial-sigs/should_fail/T10999.stderr | 10 ---------- .../should_fail/WildcardInstantiations.stderr | 19 ------------------- 3 files changed, 41 deletions(-) diff --git a/testsuite/tests/partial-sigs/should_fail/InstantiatedNamedWildcardsInConstraints.stderr b/testsuite/tests/partial-sigs/should_fail/InstantiatedNamedWildcardsInConstraints.stderr index 2df1544..b8fb188 100644 --- a/testsuite/tests/partial-sigs/should_fail/InstantiatedNamedWildcardsInConstraints.stderr +++ b/testsuite/tests/partial-sigs/should_fail/InstantiatedNamedWildcardsInConstraints.stderr @@ -1,16 +1,4 @@ -InstantiatedNamedWildcardsInConstraints.hs:4:14: error: - • Found type wildcard ‘_a’ standing for ‘b’ - Where: ‘b’ is a rigid type variable bound by - the inferred type of foo :: (Enum b, Show b) => b -> (String, b) - at InstantiatedNamedWildcardsInConstraints.hs:4:8 - To use the inferred type, enable PartialTypeSignatures - • In the type signature: - foo :: (Enum _a, _) => _a -> (String, b) - • Relevant bindings include - foo :: b -> (String, b) - (bound at InstantiatedNamedWildcardsInConstraints.hs:5:1) - InstantiatedNamedWildcardsInConstraints.hs:4:18: error: Found constraint wildcard ‘_’ standing for ‘Show b’ To use the inferred type, enable PartialTypeSignatures diff --git a/testsuite/tests/partial-sigs/should_fail/T10999.stderr b/testsuite/tests/partial-sigs/should_fail/T10999.stderr index c74719a..66c9628 100644 --- a/testsuite/tests/partial-sigs/should_fail/T10999.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T10999.stderr @@ -4,13 +4,3 @@ T10999.hs:5:6: error: To use the inferred type, enable PartialTypeSignatures In the type signature: f :: _ => () -> _ - -T10999.hs:5:17: error: - • Found type wildcard ‘_’ standing for ‘Set.Set a’ - Where: ‘a’ is a rigid type variable bound by - the inferred type of f :: Ord a => () -> Set.Set a at T10999.hs:6:1 - To use the inferred type, enable PartialTypeSignatures - • In the type signature: - f :: _ => () -> _ - • Relevant bindings include - f :: () -> Set.Set a (bound at T10999.hs:6:1) diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr index 7e0b5ac..480d795 100644 --- a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr @@ -1,29 +1,10 @@ -WildcardInstantiations.hs:5:14: error: - • Found type wildcard ‘_a’ standing for ‘a’ - Where: ‘a’ is a rigid type variable bound by - the inferred type of foo :: (Enum a, Show a) => a -> String - at WildcardInstantiations.hs:6:1 - To use the inferred type, enable PartialTypeSignatures - • In the type signature: - foo :: (Show _a, _) => _a -> _ - • Relevant bindings include - foo :: a -> String (bound at WildcardInstantiations.hs:6:1) - WildcardInstantiations.hs:5:18: error: Found constraint wildcard ‘_’ standing for ‘Enum a’ To use the inferred type, enable PartialTypeSignatures In the type signature: foo :: (Show _a, _) => _a -> _ -WildcardInstantiations.hs:5:30: error: - • Found type wildcard ‘_’ standing for ‘String’ - To use the inferred type, enable PartialTypeSignatures - • In the type signature: - foo :: (Show _a, _) => _a -> _ - • Relevant bindings include - foo :: a -> String (bound at WildcardInstantiations.hs:6:1) - WildcardInstantiations.hs:8:8: error: • Found type wildcard ‘_’ standing for ‘t’ Where: ‘t’ is a rigid type variable bound by From git at git.haskell.org Mon Oct 10 21:42:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:42:56 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T12618-squashed' created Message-ID: <20161010214256.859A53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T12618-squashed Referencing: 6ef0f7e8dda3d516eba02584dec54c81dd684bab From git at git.haskell.org Mon Oct 10 21:42:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:42:59 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Include constructor in freeNamesIfExpr (cc7e754) Message-ID: <20161010214259.3A9A83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/cc7e75428218cc02fe7da916fb2ee5a5e3868807/ghc >--------------------------------------------------------------- commit cc7e75428218cc02fe7da916fb2ee5a5e3868807 Author: Joachim Breitner Date: Thu Oct 6 23:38:34 2016 -0400 Include constructor in freeNamesIfExpr >--------------------------------------------------------------- cc7e75428218cc02fe7da916fb2ee5a5e3868807 compiler/iface/IfaceSyn.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 89dbd41..39af25f 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -1350,7 +1350,8 @@ freeNamesIfExpr (IfaceCo co) = freeNamesIfCoercion co freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as freeNamesIfExpr (IfaceLam (b,_) body) = freeNamesIfBndr b &&& freeNamesIfExpr body freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a -freeNamesIfExpr (IfaceConApp _ args) = fnList freeNamesIfExpr args +freeNamesIfExpr (IfaceConApp dc args) = unitNameSet dc &&& + fnList freeNamesIfExpr args freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfCoercion co freeNamesIfExpr (IfaceTick _ e) = freeNamesIfExpr e freeNamesIfExpr (IfaceECase e ty) = freeNamesIfExpr e &&& freeNamesIfType ty From git at git.haskell.org Mon Oct 10 21:43:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:01 +0000 (UTC) Subject: [commit: ghc] wip/T12618: isTrueLHsExpr: Match on data con wrapper now (13557d6) Message-ID: <20161010214301.E96D13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/13557d6e3d92315ed034479905aa4a15baff4025/ghc >--------------------------------------------------------------- commit 13557d6e3d92315ed034479905aa4a15baff4025 Author: Joachim Breitner Date: Fri Oct 7 09:18:53 2016 -0400 isTrueLHsExpr: Match on data con wrapper now >--------------------------------------------------------------- 13557d6e3d92315ed034479905aa4a15baff4025 compiler/prelude/TysWiredIn.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 25dd64d..7be162a 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -24,7 +24,7 @@ module TysWiredIn ( -- * Bool boolTy, boolTyCon, boolTyCon_RDR, boolTyConName, trueDataCon, trueDataConId, true_RDR, - falseDataCon, falseDataConId, false_RDR, + falseDataCon, false_RDR, promotedFalseDataCon, promotedTrueDataCon, -- * Ordering @@ -1252,9 +1252,8 @@ falseDataCon, trueDataCon :: DataCon falseDataCon = pcDataCon falseDataConName [] [] boolTyCon trueDataCon = pcDataCon trueDataConName [] [] boolTyCon -falseDataConId, trueDataConId :: Id -falseDataConId = dataConWorkId falseDataCon -trueDataConId = dataConWorkId trueDataCon +trueDataConId :: Id +trueDataConId = dataConWrapId trueDataCon orderingTyCon :: TyCon orderingTyCon = pcTyCon True orderingTyConName Nothing From git at git.haskell.org Mon Oct 10 21:43:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:04 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Temporarily disable rule shadowing warnings (f0b1873) Message-ID: <20161010214304.9A3163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/f0b187303fad8c36df615bc835752b5a16202831/ghc >--------------------------------------------------------------- commit f0b187303fad8c36df615bc835752b5a16202831 Author: Joachim Breitner Date: Fri Oct 7 15:21:35 2016 -0400 Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. >--------------------------------------------------------------- f0b187303fad8c36df615bc835752b5a16202831 mk/warnings.mk | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mk/warnings.mk b/mk/warnings.mk index 5ca097f..8e8b68d 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -41,6 +41,8 @@ endif SRC_HC_WARNING_OPTS_STAGE1 += -Wnoncanonical-monad-instances SRC_HC_WARNING_OPTS_STAGE2 += -Wnoncanonical-monad-instances +# TODO #12618 see https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 +SRC_HC_WARNING_OPTS += -fno-warn-inline-rule-shadowing ###################################################################### # Disable some warnings in packages we use From git at git.haskell.org Mon Oct 10 21:43:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:07 +0000 (UTC) Subject: [commit: ghc] wip/T12618: maybe_substitute: Detect ConApp (5a0b128) Message-ID: <20161010214307.57A563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/5a0b12869b7d9058348a4af42ef016da3d5b83ae/ghc >--------------------------------------------------------------- commit 5a0b12869b7d9058348a4af42ef016da3d5b83ae Author: Joachim Breitner Date: Fri Oct 7 17:39:42 2016 -0400 maybe_substitute: Detect ConApp >--------------------------------------------------------------- 5a0b12869b7d9058348a4af42ef016da3d5b83ae compiler/coreSyn/CoreSubst.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 058ccfe..e211624 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -1082,11 +1082,14 @@ maybe_substitute subst b r safe_to_inline NoOccInfo = trivial trivial | exprIsTrivial r = True + -- See Note [Getting the map/coerce RULE to work] + | (ConApp dc args) <- r + , dc `hasKey` heqDataConKey || dc `hasKey` coercibleDataConKey + , all exprIsTrivial args = True | (Var fun, args) <- collectArgs r , Just dc <- isDataConWorkId_maybe fun , dc `hasKey` heqDataConKey || dc `hasKey` coercibleDataConKey , all exprIsTrivial args = True - -- See Note [Getting the map/coerce RULE to work] | otherwise = False ---------------------- From git at git.haskell.org Mon Oct 10 21:43:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:10 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Revert "CorePrep: Stop creating weird bindings for data constructor workers" (c9a3415) Message-ID: <20161010214310.086773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/c9a3415460ab6361ecdaf396800a3a533d62587e/ghc >--------------------------------------------------------------- commit c9a3415460ab6361ecdaf396800a3a533d62587e Author: Joachim Breitner Date: Fri Oct 7 21:43:24 2016 -0400 Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. >--------------------------------------------------------------- c9a3415460ab6361ecdaf396800a3a533d62587e compiler/coreSyn/CorePrep.hs | 55 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 52 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index fdd6f1b..d321064 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -54,6 +54,8 @@ import Outputable import Platform import FastString import Config +import Name ( NamedThing(..), nameSrcSpan ) +import SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) import Data.Bits import MonadUtils ( mapAccumLM ) import Data.List ( mapAccumL ) @@ -166,16 +168,21 @@ type CpeRhs = CoreExpr -- Non-terminal 'rhs' corePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon] -> IO CoreProgram -corePrepPgm hsc_env this_mod _mod_loc binds _data_tycons = +corePrepPgm hsc_env this_mod mod_loc binds data_tycons = withTiming (pure dflags) (text "CorePrep"<+>brackets (ppr this_mod)) (const ()) $ do us <- mkSplitUniqSupply 's' initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env - let binds_out = initUs_ us $ do + let implicit_binds = mkDataConWorkers dflags mod_loc data_tycons + -- NB: we must feed mkImplicitBinds through corePrep too + -- so that they are suitably cloned and eta-expanded + + binds_out = initUs_ us $ do floats1 <- corePrepTopBinds initialCorePrepEnv binds - return (deFloatTop floats1) + floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds + return (deFloatTop (floats1 `appendFloats` floats2)) endPassIO hsc_env alwaysQualify CorePrep binds_out [] return binds_out @@ -201,6 +208,27 @@ corePrepTopBinds initialCorePrepEnv binds binds' <- go env' binds return (bind' `appendFloats` binds') +mkDataConWorkers :: DynFlags -> ModLocation -> [TyCon] -> [CoreBind] +-- See Note [Data constructor workers] +-- c.f. Note [Injecting implicit bindings] in TidyPgm +mkDataConWorkers dflags mod_loc data_tycons + = [ NonRec id (tick_it (getName data_con) (Var id)) + -- The ice is thin here, but it works + | tycon <- data_tycons, -- CorePrep will eta-expand it + data_con <- tyConDataCons tycon, + let id = dataConWorkId data_con + ] + where + -- If we want to generate debug info, we put a source note on the + -- worker. This is useful, especially for heap profiling. + tick_it name + | debugLevel dflags == 0 = id + | RealSrcSpan span <- nameSrcSpan name = tick span + | Just file <- ml_hs_file mod_loc = tick (span1 file) + | otherwise = tick (span1 "???") + where tick span = Tick (SourceNote span $ showSDoc dflags (ppr name)) + span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1 + {- Note [Floating out of top level bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -253,6 +281,24 @@ out CafInfo later, after CorePrep. We'll do that in due course. Meanwhile this horrible hack works. +Note [Data constructor workers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Create any necessary "implicit" bindings for data con workers. We +create the rather strange (non-recursive!) binding + + $wC = \x y -> $wC x y + +i.e. a curried constructor that allocates. This means that we can +treat the worker for a constructor like any other function in the rest +of the compiler. The point here is that CoreToStg will generate a +StgConApp for the RHS, rather than a call to the worker (which would +give a loop). As Lennart says: the ice is thin here, but it works. + +Hmm. Should we create bindings for dictionary constructors? They are +always fully applied, and the bindings are just there to support +partial applications. But it's easier to let them through. + + Note [Dead code in CorePrep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Imagine that we got an input program like this (see Trac #4962): @@ -1258,6 +1304,9 @@ allLazyNested is_rec (Floats IfUnboxedOk _) = isNonRec is_rec -- We decided not to adopt this solution to keep the definition -- of 'exprIsTrivial' simple. -- +-- There is ONE caveat however: for top-level bindings we have +-- to preserve the binding so that we float the (hacky) non-recursive +-- binding for data constructors; see Note [Data constructor workers]. -- -- Note [CorePrep inlines trivial CoreExpr not Id] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Mon Oct 10 21:43:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:12 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Do not lint the bodz of the data con worker bindings introduced by CorePrep (7a62038) Message-ID: <20161010214312.B20303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/7a6203882ee5af9db0cdc5463f23a60989ab7cee/ghc >--------------------------------------------------------------- commit 7a6203882ee5af9db0cdc5463f23a60989ab7cee Author: Joachim Breitner Date: Fri Oct 7 21:59:46 2016 -0400 Do not lint the bodz of the data con worker bindings introduced by CorePrep >--------------------------------------------------------------- 7a6203882ee5af9db0cdc5463f23a60989ab7cee compiler/coreSyn/CoreLint.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 127ae0f..bccbd9f 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -471,6 +471,13 @@ lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintSingleBinding top_lvl_flag rec_flag (binder,rhs) + -- CorePrep introduces bindings for data constructors. This is just a hack for the + -- code generator, the definitions do not matter (and would fail some of the + -- checks below). Therefore, skip these. + -- See Note [Data constructor workers] in CorePrep + | isDataConWorkId binder + = return () + | otherwise = addLoc (RhsOf binder) $ -- Check the rhs do { ty <- lintRhs rhs From git at git.haskell.org Mon Oct 10 21:43:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:15 +0000 (UTC) Subject: [commit: ghc] : coreToStgExpr: add con worker to free variables reported (ab230b9) Message-ID: <20161010214315.66C453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/ab230b9fe7142b1a9dcd62f6af2dce848b0d8f59/ghc >--------------------------------------------------------------- commit ab230b9fe7142b1a9dcd62f6af2dce848b0d8f59 Author: Joachim Breitner Date: Sat Oct 8 16:59:00 2016 -0400 coreToStgExpr: add con worker to free variables reported >--------------------------------------------------------------- ab230b9fe7142b1a9dcd62f6af2dce848b0d8f59 compiler/stgSyn/CoreToStg.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index 70d6b8e..1f9cf15 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -340,9 +340,11 @@ coreToStgExpr e@(ConApp dc args) let app = StgConApp dc args' (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty))) let tapp = foldr StgTick app ticks' let vars = getFVSet args_fvs - app `seq` args_fvs `seq` seqVarSet vars `seq` return ( + let fun_fvs = singletonFVInfo (dataConWorkId dc) ImportBound noBinderInfo + let fvs = fun_fvs `unionFVInfo` args_fvs + app `seq` fvs `seq` seqVarSet vars `seq` return ( tapp, - args_fvs, + fvs, vars ) From git at git.haskell.org Mon Oct 10 21:43:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:18 +0000 (UTC) Subject: [commit: ghc] : Handle ConApp in inlineBoringOk (518ed79) Message-ID: <20161010214318.133903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/518ed7909a9c81d96480b9ed2fd39a0be2fb8fe3/ghc >--------------------------------------------------------------- commit 518ed7909a9c81d96480b9ed2fd39a0be2fb8fe3 Author: Joachim Breitner Date: Sat Oct 8 22:55:54 2016 -0400 Handle ConApp in inlineBoringOk >--------------------------------------------------------------- 518ed7909a9c81d96480b9ed2fd39a0be2fb8fe3 compiler/coreSyn/CoreUnfold.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 7170997..56fd3ca 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -321,7 +321,9 @@ inlineBoringOk e go credit (App f (Type {})) = go credit f go credit (App f a) | credit > 0 , exprIsTrivial a = go (credit-1) f - go credit (Tick _ e) = go credit e -- dubious + go credit (ConApp dc args) = all exprIsTrivial args && + credit >= dataConRepArity dc + go credit (Tick _ e) = go credit e -- dubious go credit (Cast e _) = go credit e go _ (Var {}) = boringCxtOk go _ _ = boringCxtNotOk From git at git.haskell.org Mon Oct 10 21:43:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:18 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (6ef0f7e) Message-ID: <20161010214318.97CBD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/6ef0f7e8dda3d516eba02584dec54c81dd684bab/ghc >--------------------------------------------------------------- commit 6ef0f7e8dda3d516eba02584dec54c81dd684bab Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core This is an all-commits-squashed commit, for the sake of testing this branch on perf.haskell.org without testing the intermediate commits. + This is a combination of 47 commits. + The first commit's message is: Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? + This is the 2nd commit message: Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. + This is the 3rd commit message: ConApp bytecode: Add more ASSERT + This is the 4th commit message: ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. + This is the 5th commit message: ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. + This is the 6th commit message: mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). + This is the 7th commit message: DataCon wrapper: Use ConApp in the body + This is the 8th commit message: mkCoreConApps: Warn about unsaturated use + This is the 9th commit message: Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. + This is the 10th commit message: Use ConApp in tagToEnumRule + This is the 11th commit message: knownCon: Use ConApp in unfolding of scrutinee + This is the 12th commit message: Get rid of unitDataConId (use ConApp instead) + This is the 13th commit message: Always build a wrapper for data types + This is the 14th commit message: Always use ConApp in CoreSyn + This is the 15th commit message: Reserve a unique for the wrapper of a wired in DataCon + This is the 16th commit message: CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. + This is the 17th commit message: Desugar: Use Coercible worker, not wrapper + This is the 18th commit message: Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) + This is the 19th commit message: Deserialize interface tuples to ConApp + This is the 20th commit message: Handle ConApp in "Eliminate Identity Case" + This is the 21st commit message: Use dataConWrapId in unsaturated uses of mkCoreConApps + This is the 22nd commit message: ConApp: More Linting + This is the 23rd commit message: mkSimpleDataConRep: No wrapper for newtypes + This is the 24th commit message: mkCoreConApps: Do not use ConApp for newtypes + This is the 25th commit message: New Lint Check: No data con workers any more, please + This is the 26th commit message: Use ConApp when creating True resp. False + This is the 27th commit message: Include constructor in freeNamesIfExpr + This is the 28th commit message: isTrueLHsExpr: Match on data con wrapper now + This is the 29th commit message: Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. + This is the 30th commit message: maybe_substitute: Detect ConApp + This is the 31st commit message: Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. + This is the 32nd commit message: Do not lint the bodz of the data con worker bindings introduced by CorePrep + This is the 33rd commit message: coreToStgExpr: add con worker to free variables reported + This is the 34th commit message: Handle ConApp in inlineBoringOk + This is the 35th commit message: cpe_ExprIsTrivial: Nullary Constructors are trivial + This is the 36th commit message: Handle nullary Cons in myCollectArgs + This is the 37th commit message: Handle nullary constructors in the byte code generator. + This is the 38th commit message: getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons + This is the 39th commit message: Avoid invalid haddock synatx + This is the 40th commit message: No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. + This is the 41st commit message: Update some test output + This is the 42nd commit message: SetLevels: Do not float nullary data constructors + This is the 43rd commit message: Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. + This is the 44th commit message: Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. + This is the 45th commit message: Nullary data constructors are trivial + This is the 46th commit message: sptModuleInitCode: Look for ConApp + This is the 47th commit message: Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. >--------------------------------------------------------------- 6ef0f7e8dda3d516eba02584dec54c81dd684bab compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/Demand.hs | 17 ++- compiler/basicTypes/MkId.hs | 128 +++++++++++++------- compiler/basicTypes/MkId.hs-boot | 4 +- compiler/basicTypes/Unique.hs | 22 ++-- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++ compiler/coreSyn/CoreLint.hs | 42 +++++++ compiler/coreSyn/CorePrep.hs | 24 ++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 47 +++++--- compiler/coreSyn/CoreSyn.hs | 21 +++- compiler/coreSyn/CoreTidy.hs | 15 +-- compiler/coreSyn/CoreUnfold.hs | 9 +- compiler/coreSyn/CoreUtils.hs | 57 ++++++--- compiler/coreSyn/MkCore.hs | 39 +++++- compiler/coreSyn/PprCore.hs | 10 ++ compiler/coreSyn/TrieMap.hs | 68 +++++++---- compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/ByteCodeGen.hs | 42 ++++++- compiler/iface/IfaceSyn.hs | 47 +++++--- compiler/iface/MkIface.hs | 27 +++-- compiler/iface/TcIface.hs | 7 +- compiler/main/StaticPtrTable.hs | 5 + compiler/main/TidyPgm.hs | 2 + compiler/prelude/PrelNames.hs | 17 ++- compiler/prelude/PrelRules.hs | 8 +- compiler/prelude/TysWiredIn.hs | 35 +++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++- compiler/simplCore/FloatIn.hs | 19 +++ compiler/simplCore/FloatOut.hs | 8 ++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++ compiler/simplCore/SAT.hs | 12 ++ compiler/simplCore/SetLevels.hs | 18 ++- compiler/simplCore/SimplUtils.hs | 3 + compiler/simplCore/Simplify.hs | 24 +++- compiler/specialise/Rules.hs | 13 ++ compiler/specialise/SpecConstr.hs | 4 + compiler/specialise/Specialise.hs | 3 + compiler/stgSyn/CoreToStg.hs | 20 ++++ compiler/stranal/DmdAnal.hs | 33 +++++ compiler/stranal/WorkWrap.hs | 3 + compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 48 ++++---- compiler/vectorise/Vectorise/Exp.hs | 13 ++ compiler/vectorise/Vectorise/Utils.hs | 6 - mk/warnings.mk | 2 + .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++-- .../tests/ghci.debugger/scripts/print006.stdout | 14 +-- .../tests/ghci.debugger/scripts/print008.stdout | 10 +- .../tests/ghci.debugger/scripts/print010.stdout | 7 +- .../tests/ghci.debugger/scripts/print012.stdout | 9 +- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +-- .../tests/ghci.debugger/scripts/print034.stdout | 6 +- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/numeric/should_compile/T7116.stdout | 40 ++++--- testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 +++++----- .../tests/roles/should_compile/Roles13.stderr | 70 +++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 ++-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 ++-- testsuite/tests/roles/should_compile/T8958.stderr | 32 ++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 25 +++- .../tests/simplCore/should_compile/T3717.stderr | 20 ++-- .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 47 ++++---- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++-- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 114 ++++++++++-------- .../tests/simplCore/should_compile/T8274.stdout | 34 ++++-- .../tests/simplCore/should_compile/T8832.stdout | 20 ++-- .../tests/simplCore/should_compile/T8848.stderr | 32 ++--- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../tests/simplCore/should_compile/rule2.stderr | 19 ++- .../simplCore/should_compile/spec-inline.stderr | 133 +++++++++++++-------- testsuite/tests/th/TH_Roles2.stderr | 8 +- 96 files changed, 1334 insertions(+), 709 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 6ef0f7e8dda3d516eba02584dec54c81dd684bab From git at git.haskell.org Mon Oct 10 21:43:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:20 +0000 (UTC) Subject: [commit: ghc] : cpe_ExprIsTrivial: Nullary Constructors are trivial (d519964) Message-ID: <20161010214320.BBCBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/d51996444bfd40eb7588e696078f3f6eedd35442/ghc >--------------------------------------------------------------- commit d51996444bfd40eb7588e696078f3f6eedd35442 Author: Joachim Breitner Date: Sun Oct 9 12:07:50 2016 -0400 cpe_ExprIsTrivial: Nullary Constructors are trivial >--------------------------------------------------------------- d51996444bfd40eb7588e696078f3f6eedd35442 compiler/coreSyn/CorePrep.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index d321064..a98abab 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -950,6 +950,7 @@ cpe_ExprIsTrivial (Type _) = True cpe_ExprIsTrivial (Coercion _) = True cpe_ExprIsTrivial (Lit _) = True cpe_ExprIsTrivial (App e arg) = not (isRuntimeArg arg) && cpe_ExprIsTrivial e +cpe_ExprIsTrivial (ConApp _ args) = not (any isRuntimeArg args) cpe_ExprIsTrivial (Lam b e) = not (isRuntimeVar b) && cpe_ExprIsTrivial e cpe_ExprIsTrivial (Tick t e) = not (tickishIsCode t) && cpe_ExprIsTrivial e cpe_ExprIsTrivial (Cast e _) = cpe_ExprIsTrivial e From git at git.haskell.org Mon Oct 10 21:43:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:23 +0000 (UTC) Subject: [commit: ghc] : Handle nullary Cons in myCollectArgs (4068e40) Message-ID: <20161010214323.6C4A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/4068e403fe104e4226939190bb107a1f3c655d0c/ghc >--------------------------------------------------------------- commit 4068e403fe104e4226939190bb107a1f3c655d0c Author: Joachim Breitner Date: Sun Oct 9 12:38:14 2016 -0400 Handle nullary Cons in myCollectArgs >--------------------------------------------------------------- 4068e403fe104e4226939190bb107a1f3c655d0c compiler/stgSyn/CoreToStg.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index 1f9cf15..5a8ce94 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -1058,6 +1058,8 @@ myCollectArgs expr where go (Var v) as ts = (v, as, ts) go (App f a) as ts = go f (a:as) ts + go (ConApp dc args) as ts = ASSERT( all isTypeArg as && all isTypeArg args ) + (dataConWorkId dc, [], ts) go (Tick t e) as ts = ASSERT( all isTypeArg as ) go e as (t:ts) -- ticks can appear in type apps go (Cast e _) as ts = go e as ts @@ -1070,6 +1072,10 @@ myCollectArgs expr -- -- This big-lambda case occurred following a rather obscure eta expansion. -- It all seems a bit yukky to me. +-- +-- It can happen more often now with saturated constructor applications, where +-- (\ (@a) -> [] [@a]) @Type +-- can happen. stgArity :: Id -> HowBound -> Arity stgArity _ (LetBound _ arity) = arity From git at git.haskell.org Mon Oct 10 21:43:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:26 +0000 (UTC) Subject: [commit: ghc] : Handle nullary constructors in the byte code generator. (2fee127) Message-ID: <20161010214326.18ABB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/2fee1279c78e39e7233a9f79b27549b02a74d565/ghc >--------------------------------------------------------------- commit 2fee1279c78e39e7233a9f79b27549b02a74d565 Author: Joachim Breitner Date: Sun Oct 9 13:20:59 2016 -0400 Handle nullary constructors in the byte code generator. >--------------------------------------------------------------- 2fee1279c78e39e7233a9f79b27549b02a74d565 compiler/ghci/ByteCodeGen.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 214a0f0..2f9c938 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -446,7 +446,8 @@ schemeE d s p (AnnLet (AnnNonRec x (_,AnnConApp dc args)) (_,body)) = do -- Special case for a non-recursive let whose RHS is a -- saturatred constructor application. -- Just allocate the constructor and carry on - alloc_code <- mkConAppCode d s p dc (map snd (reverse args)) + let args_r_to_l = reverse $ map snd $ dropWhile isAnnTypeArg args + alloc_code <- mkConAppCode d s p dc args_r_to_l body_code <- schemeE (d+1) s (Map.insert x d p) body return (alloc_code `appOL` body_code) @@ -720,7 +721,7 @@ mkConAppCode _ _ _ con [] -- Nullary constructor -- copy of this constructor, use the single shared version. mkConAppCode orig_d _ p con args_r_to_l - = ASSERT( dataConRepArity con == length args_r_to_l ) + = ASSERT2( dataConRepArity con == length args_r_to_l, ppr con <+> ppr (length args_r_to_l) ) do_pushery orig_d (non_ptr_args ++ ptr_args) where -- The args are already in reverse order, which is the way PACK @@ -1387,6 +1388,16 @@ pushAtom d p (AnnVar v) MASSERT(sz == 1) return (unitOL (PUSH_G (getName v)), sz) +pushAtom _ _ (AnnConApp dc args) = do + MASSERT( all isAnnTypeArg args ) + dflags <- getDynFlags + let v = dataConWorkId dc + let sz :: Word16 + sz = fromIntegral (idSizeW dflags v) + MASSERT(sz == 1) + return (unitOL (PUSH_G (getName v)), sz) + + pushAtom _ _ (AnnLit lit) = do dflags <- getDynFlags @@ -1648,6 +1659,8 @@ isVAtom _ = False atomPrimRep :: AnnExpr' Id ann -> PrimRep atomPrimRep e | Just e' <- bcView e = atomPrimRep e' atomPrimRep (AnnVar v) = bcIdPrimRep v +atomPrimRep (AnnConApp dc args) = ASSERT (all isAnnTypeArg args) + bcIdPrimRep (dataConWorkId dc) atomPrimRep (AnnLit l) = typePrimRep (literalType l) -- Trac #12128: From git at git.haskell.org Mon Oct 10 21:43:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:28 +0000 (UTC) Subject: [commit: ghc] : getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons (75e5dd9) Message-ID: <20161010214328.B771E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/75e5dd948dc4c3db6830383b5cc83231a71005d6/ghc >--------------------------------------------------------------- commit 75e5dd948dc4c3db6830383b5cc83231a71005d6 Author: Joachim Breitner Date: Sun Oct 9 13:44:00 2016 -0400 getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons >--------------------------------------------------------------- 75e5dd948dc4c3db6830383b5cc83231a71005d6 compiler/coreSyn/CoreUtils.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index bb361a3..01b9047 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -839,6 +839,7 @@ getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id getIdFromTrivialExpr_maybe e = go e where go (Var v) = Just v go (App f t) | not (isRuntimeArg t) = go f + go (ConApp dc args) | all isTypeArg args = Just (dataConWorkId dc) go (Tick t e) | not (tickishIsCode t) = go e go (Cast e _) = go e go (Lam b e) | not (isRuntimeVar b) = go e From git at git.haskell.org Mon Oct 10 21:43:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:31 +0000 (UTC) Subject: [commit: ghc] : Avoid invalid haddock synatx (33728e8) Message-ID: <20161010214331.6ADD03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/33728e85c73918b2e4549ee92f5350a7accce00a/ghc >--------------------------------------------------------------- commit 33728e85c73918b2e4549ee92f5350a7accce00a Author: Joachim Breitner Date: Sun Oct 9 13:45:08 2016 -0400 Avoid invalid haddock synatx >--------------------------------------------------------------- 33728e85c73918b2e4549ee92f5350a7accce00a compiler/specialise/Rules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 5a5ce0f..6297d88 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -1164,7 +1164,7 @@ ruleCheck _ (Type _) = emptyBag ruleCheck _ (Coercion _) = emptyBag ruleCheck env (App f a) = ruleCheckApp env (App f a) [] ruleCheck env (ConApp _ args) = unionManyBags (map (ruleCheck env) args) - -- ^ TODO #12618 check dc? + -- TODO #12618 check dc? ruleCheck env (Tick _ e) = ruleCheck env e ruleCheck env (Cast e _) = ruleCheck env e ruleCheck env (Let bd e) = ruleCheckBind env bd `unionBags` ruleCheck env e From git at git.haskell.org Mon Oct 10 21:43:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:34 +0000 (UTC) Subject: [commit: ghc] : No lint warning about staticPtr data con worker (891c903) Message-ID: <20161010214334.19ECE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/891c903b791b67aa4742a8634cfad71bf61a8d2c/ghc >--------------------------------------------------------------- commit 891c903b791b67aa4742a8634cfad71bf61a8d2c Author: Joachim Breitner Date: Sun Oct 9 14:23:04 2016 -0400 No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. >--------------------------------------------------------------- 891c903b791b67aa4742a8634cfad71bf61a8d2c compiler/coreSyn/CoreLint.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index bccbd9f..6c2296d 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -911,6 +911,7 @@ checkBadDataConWorker :: Id -> LintM () -- (It should either be a ConApp or a reference to the wrapper) checkBadDataConWorker id | Just dc <- isDataConWorkId_maybe id + , dataConName dc /= staticPtrDataConName = checkL (isNewTyCon (dataConTyCon dc)) (text "data constructor worker found" <+> ppr id) | otherwise From git at git.haskell.org Mon Oct 10 21:43:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:36 +0000 (UTC) Subject: [commit: ghc] : Have a compulary unfolding for unboxed tuple wrappers (557166a) Message-ID: <20161010214336.CFED53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/557166a6b670f3dcd3bed4f79af1119b9a3f4832/ghc >--------------------------------------------------------------- commit 557166a6b670f3dcd3bed4f79af1119b9a3f4832 Author: Joachim Breitner Date: Mon Oct 10 17:35:36 2016 -0400 Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. >--------------------------------------------------------------- 557166a6b670f3dcd3bed4f79af1119b9a3f4832 compiler/basicTypes/MkId.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index ba7b633..edbfc5a 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -495,7 +495,11 @@ mkSimpleDataConRep wrap_name dc `setUnfoldingInfo` wrap_unf `setStrictnessInfo` wrap_sig wrap_arity = dataConRepArity dc - wrap_unf = mkInlineUnfolding (Just wrap_arity) wrap_rhs + wrap_unf + -- Somewhat ugly, but there is no code generated for wrappers + -- for unboxed tuples. Let's just get rid of them as soon as possible. + | is_unbox_tup = mkCompulsoryUnfolding wrap_rhs + | otherwise = mkInlineUnfolding (Just wrap_arity) wrap_rhs wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR dc) wrap_arg_dmds = replicate wrap_arity topDmd rep_strs = [ NotMarkedStrict | _ <- arg_tys ] @@ -508,6 +512,8 @@ mkSimpleDataConRep wrap_name dc , map varToCoreExpr wrap_args ] + is_unbox_tup = isUnboxedTupleCon dc + mkDataConRep :: DynFlags -> FamInstEnvs -> Name From git at git.haskell.org Mon Oct 10 21:43:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:39 +0000 (UTC) Subject: [commit: ghc] : Update some test output (0ae46fe) Message-ID: <20161010214339.84BCF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/0ae46fea877a38b872ba7eb241e9a620d1c2de1d/ghc >--------------------------------------------------------------- commit 0ae46fea877a38b872ba7eb241e9a620d1c2de1d Author: Joachim Breitner Date: Sun Oct 9 14:43:56 2016 -0400 Update some test output >--------------------------------------------------------------- 0ae46fea877a38b872ba7eb241e9a620d1c2de1d .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/numeric/should_compile/T7116.stdout | 40 +++---- testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 +++++----- .../tests/roles/should_compile/Roles13.stderr | 70 ++++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 ++-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 ++-- testsuite/tests/roles/should_compile/T8958.stderr | 32 +++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 25 ++++- .../tests/simplCore/should_compile/T3717.stderr | 20 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 53 +++++---- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++--- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 123 +++++++++++++-------- .../tests/simplCore/should_compile/T8274.stdout | 34 ++++-- .../tests/simplCore/should_compile/T8832.stdout | 20 ++-- .../tests/simplCore/should_compile/T8848.stderr | 32 +++--- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../tests/simplCore/should_compile/rule2.stderr | 19 +++- .../simplCore/should_compile/spec-inline.stderr | 12 +- testsuite/tests/th/TH_Roles2.stderr | 8 +- 29 files changed, 425 insertions(+), 354 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 0ae46fea877a38b872ba7eb241e9a620d1c2de1d From git at git.haskell.org Mon Oct 10 21:43:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:42 +0000 (UTC) Subject: [commit: ghc] : Nullary data constructors are trivial (11b0d18) Message-ID: <20161010214342.3E56B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/11b0d182da0b283ab73f3682c195cce452c4a57f/ghc >--------------------------------------------------------------- commit 11b0d182da0b283ab73f3682c195cce452c4a57f Author: Joachim Breitner Date: Mon Oct 10 16:37:54 2016 -0400 Nullary data constructors are trivial >--------------------------------------------------------------- 11b0d182da0b283ab73f3682c195cce452c4a57f compiler/coreSyn/CoreUtils.hs | 1 + .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../simplCore/should_compile/spec-inline.stderr | 121 ++++++++++++++------- 3 files changed, 92 insertions(+), 52 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 11b0d182da0b283ab73f3682c195cce452c4a57f From git at git.haskell.org Mon Oct 10 21:43:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:44 +0000 (UTC) Subject: [commit: ghc] : Move zonking out of tcFamTyPats (09f72a9) Message-ID: <20161010214344.E33A33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/09f72a920ba786bf7a0c235a38402d8ff8d6f9a5/ghc >--------------------------------------------------------------- commit 09f72a920ba786bf7a0c235a38402d8ff8d6f9a5 Author: Simon Peyton Jones Date: Sat Oct 8 00:03:53 2016 +0100 Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. >--------------------------------------------------------------- 09f72a920ba786bf7a0c235a38402d8ff8d6f9a5 compiler/typecheck/TcInstDcls.hs | 30 +++++++++++++++--------- compiler/typecheck/TcTyClsDecls.hs | 48 ++++++++++++++++++++++---------------- 2 files changed, 47 insertions(+), 31 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 2e7104c..a0bbb83 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -21,7 +21,8 @@ import TcClassDcl( tcClassDecl2, tcATDefault, import TcSigs import TcRnMonad import TcValidity -import TcHsSyn ( zonkTcTypeToTypes, emptyZonkEnv ) +import TcHsSyn ( zonkTyBndrsX, emptyZonkEnv + , zonkTcTypeToTypes, zonkTcTypeToType ) import TcMType import TcType import BuildTyCl @@ -623,22 +624,21 @@ tcDataFamInstDecl mb_clsinfo -- Kind check type patterns ; tcFamTyPats (famTyConShape fam_tc) mb_clsinfo pats (kcDataDefn (unLoc fam_tc_name) pats defn) $ - \tvs' pats' res_kind -> do - { - -- Check that left-hand sides are ok (mono-types, no type families, - -- consistent instantiations, etc) - ; checkValidFamPats mb_clsinfo fam_tc tvs' [] pats' + \tvs pats res_kind -> + do { stupid_theta <- solveEqualities $ tcHsContext ctxt - -- Result kind must be '*' (otherwise, we have too few patterns) - ; checkTc (isLiftedTypeKind res_kind) $ tooFewParmsErr (tyConArity fam_tc) + -- Zonk the patterns etc into the Type world + ; (ze, tvs') <- zonkTyBndrsX emptyZonkEnv tvs + ; pats' <- zonkTcTypeToTypes ze pats + ; res_kind' <- zonkTcTypeToType ze res_kind + ; stupid_theta' <- zonkTcTypeToTypes ze stupid_theta - ; stupid_theta <- solveEqualities $ tcHsContext ctxt - ; stupid_theta <- zonkTcTypeToTypes emptyZonkEnv stupid_theta - ; gadt_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons + ; gadt_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta' cons -- Construct representation tycon ; rep_tc_name <- newFamInstTyConName fam_tc_name pats' ; axiom_name <- newFamInstAxiomName fam_tc_name [pats'] + ; let (eta_pats, etad_tvs) = eta_reduce pats' eta_tvs = filterOut (`elem` etad_tvs) tvs' full_tvs = eta_tvs ++ etad_tvs @@ -680,6 +680,14 @@ tcDataFamInstDecl mb_clsinfo ; return (rep_tc, axiom) } -- Remember to check validity; no recursion to worry about here + -- Check that left-hand sides are ok (mono-types, no type families, + -- consistent instantiations, etc) + ; checkValidFamPats mb_clsinfo fam_tc tvs' [] pats' + + -- Result kind must be '*' (otherwise, we have too few patterns) + ; checkTc (isLiftedTypeKind res_kind') $ + tooFewParmsErr (tyConArity fam_tc) + ; checkValidTyCon rep_tc ; let m_deriv_info = case derivs of diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 04da5f2..155396f 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -954,6 +954,7 @@ tcDataDefn roles_info stupid_theta tc_rhs (VanillaAlgTyCon tc_rep_nm) gadt_syntax) } + ; traceTc "tcDataDefn" (ppr tc_name $$ ppr tycon_binders $$ ppr extra_bndrs) ; return tycon } where mk_tc_rhs is_boot tycon data_cons @@ -1056,16 +1057,19 @@ tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = L _ tc_name -- are different. ; (pats', rhs_ty) <- tcFamTyPats shape Nothing pats - (discardResult . tcCheckLHsType rhs) $ \_ pats' rhs_kind -> + (discardResult . tcCheckLHsType rhs) $ \tvs pats rhs_kind -> do { rhs_ty <- solveEqualities $ tcCheckLHsType rhs rhs_kind - ; return (pats', rhs_ty) } - -- pats' is fully zonked already - ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty + + -- Zonk the patterns etc into the Type world + ; (ze, _) <- zonkTyBndrsX emptyZonkEnv tvs + ; pats' <- zonkTcTypeToTypes ze pats + ; rhs_ty' <- zonkTcTypeToType ze rhs_ty + ; return (pats', rhs_ty') } -- See Note [Type-checking default assoc decls] ; case tcMatchTys pats' (mkTyVarTys (tyConTyVars fam_tc)) of - Just subst -> return ( Just (substTyUnchecked subst rhs_ty, loc) ) + Just subst -> return (Just (substTyUnchecked subst rhs_ty, loc) ) Nothing -> failWithTc (defaultAssocKindErr fam_tc) -- We check for well-formedness and validity later, -- in checkValidClass @@ -1114,13 +1118,17 @@ tcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_) mb_clsinfo , tfe_rhs = hs_ty })) = ASSERT( fam_tc_name == eqn_tc_name ) setSrcSpan loc $ - tcFamTyPats fam_tc_shape mb_clsinfo pats (discardResult . (tcCheckLHsType hs_ty)) $ - \tvs' pats' res_kind -> + tcFamTyPats fam_tc_shape mb_clsinfo pats + (discardResult . (tcCheckLHsType hs_ty)) $ + \tvs pats res_kind -> do { rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind - ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty + + ; (ze, tvs') <- zonkTyBndrsX emptyZonkEnv tvs + ; pats' <- zonkTcTypeToTypes ze pats + ; rhs_ty' <- zonkTcTypeToType ze rhs_ty ; traceTc "tcTyFamInstEqn" (ppr fam_tc_name <+> pprTvBndrs tvs') -- don't print out the pats here, as they might be zonked inside the knot - ; return (mkCoAxBranch tvs' [] pats' rhs_ty + ; return (mkCoAxBranch tvs' [] pats' rhs_ty' (map (const Nominal) tvs') loc) } @@ -1239,11 +1247,12 @@ tc_fam_ty_pats (name, _, binders, res_kind) mb_clsinfo -- See Note [tc_fam_ty_pats vs tcFamTyPats] tcFamTyPats :: FamTyConShape -> Maybe ClsInstInfo - -> HsTyPats Name -- patterns + -> HsTyPats Name -- patterns -> (TcKind -> TcM ()) -- kind-checker for RHS - -> ( [TyVar] -- Kind and type variables + -> ( [TcTyVar] -- Kind and type variables -> [TcType] -- Kind and type arguments - -> Kind -> TcM a) -- NB: You can use solveEqualities here. + -> TcKind + -> TcM a) -- NB: You can use solveEqualities here. -> TcM a tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside = do { (typats, res_kind) @@ -1279,15 +1288,14 @@ tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside -- above would fail. TODO (RAE): Update once the solveEqualities -- bit is cleverer. - -- Zonk the patterns etc into the Type world - ; (ze, qtkvs') <- zonkTyBndrsX emptyZonkEnv qtkvs - ; typats' <- zonkTcTypeToTypes ze typats - ; res_kind' <- zonkTcTypeToType ze res_kind + ; traceTc "tcFamTyPats" (ppr name $$ ppr typats $$ ppr qtkvs) + -- Don't print out too much, as we might be in the knot - ; traceTc "tcFamTyPats" (ppr name $$ ppr typats) - -- don't print out too much, as we might be in the knot - ; tcExtendTyVarEnv qtkvs' $ - thing_inside qtkvs' typats' res_kind' } + ; tcExtendTyVarEnv qtkvs $ + -- Extend envt with TcTyVars not TyVars, because the + -- kind checking etc done by thing_inside does not expect + -- to encounter TyVars; it expects TcTyVars + thing_inside qtkvs typats res_kind } {- Note [Constraints in patterns] From git at git.haskell.org Mon Oct 10 21:43:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:47 +0000 (UTC) Subject: [commit: ghc] : sptModuleInitCode: Look for ConApp (5bdf9d0) Message-ID: <20161010214347.90E623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/5bdf9d042d812fdfeece8db9037c0175c2b8ed6b/ghc >--------------------------------------------------------------- commit 5bdf9d042d812fdfeece8db9037c0175c2b8ed6b Author: Joachim Breitner Date: Mon Oct 10 17:27:19 2016 -0400 sptModuleInitCode: Look for ConApp >--------------------------------------------------------------- 5bdf9d042d812fdfeece8db9037c0175c2b8ed6b compiler/main/StaticPtrTable.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/main/StaticPtrTable.hs b/compiler/main/StaticPtrTable.hs index 9ec970f..2b947e5 100644 --- a/compiler/main/StaticPtrTable.hs +++ b/compiler/main/StaticPtrTable.hs @@ -82,6 +82,11 @@ sptModuleInitCode this_mod binds = , Just w0 <- fromPlatformWord64Rep lit0 , Just w1 <- fromPlatformWord64Rep lit1 = Just $ Fingerprint (fromInteger w0) (fromInteger w1) + | ConApp dc (_ : Lit lit0 : Lit lit1 : _) <- e + , dataConName dc == staticPtrDataConName + , Just w0 <- fromPlatformWord64Rep lit0 + , Just w1 <- fromPlatformWord64Rep lit1 + = Just $ Fingerprint (fromInteger w0) (fromInteger w1) staticPtrFp _ = Nothing fromPlatformWord64Rep (MachWord w) = Just w From git at git.haskell.org Mon Oct 10 21:43:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:50 +0000 (UTC) Subject: [commit: ghc] : Update debugger test output (0a5850d) Message-ID: <20161010214350.44F143A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/0a5850dab49cbec07c41dcac6771da4c1584d9cd/ghc >--------------------------------------------------------------- commit 0a5850dab49cbec07c41dcac6771da4c1584d9cd Author: Joachim Breitner Date: Sun Oct 9 17:54:51 2016 -0400 Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. >--------------------------------------------------------------- 0a5850dab49cbec07c41dcac6771da4c1584d9cd .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++++++++---------- .../tests/ghci.debugger/scripts/print006.stdout | 14 +++++-------- .../tests/ghci.debugger/scripts/print008.stdout | 10 ++++----- .../tests/ghci.debugger/scripts/print010.stdout | 7 +++---- .../tests/ghci.debugger/scripts/print012.stdout | 9 ++++---- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +++++++------- .../tests/ghci.debugger/scripts/print034.stdout | 6 +++--- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 24 ++++++++-------------- .../tests/simplCore/should_compile/T7360.stderr | 23 +++++---------------- 14 files changed, 55 insertions(+), 83 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 0a5850dab49cbec07c41dcac6771da4c1584d9cd From git at git.haskell.org Mon Oct 10 21:43:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:52 +0000 (UTC) Subject: [commit: ghc] : SetLevels: Do not float nullary data constructors (32a2826) Message-ID: <20161010214352.EA8153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/32a2826823c67b8ff54224b47ede9017619a7a23/ghc >--------------------------------------------------------------- commit 32a2826823c67b8ff54224b47ede9017619a7a23 Author: Joachim Breitner Date: Sun Oct 9 15:51:04 2016 -0400 SetLevels: Do not float nullary data constructors >--------------------------------------------------------------- 32a2826823c67b8ff54224b47ede9017619a7a23 compiler/simplCore/SetLevels.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 6a0c723..0d1ad99 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -617,11 +617,12 @@ notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool notWorthFloating e abs_vars = go e (count isId abs_vars) where - go (_, AnnVar {}) n = n >= 0 - go (_, AnnLit lit) n = ASSERT( n==0 ) - litIsTrivial lit -- Note [Floating literals] - go (_, AnnTick t e) n = not (tickishIsCode t) && go e n - go (_, AnnCast e _) n = go e n + go (_, AnnVar {}) n = n >= 0 + go (_, AnnConApp _ args) _ = all isAnnTypeArg args + go (_, AnnLit lit) n = ASSERT( n==0 ) + litIsTrivial lit -- Note [Floating literals] + go (_, AnnTick t e) n = not (tickishIsCode t) && go e n + go (_, AnnCast e _) n = go e n go (_, AnnApp e arg) n | (_, AnnType {}) <- arg = go e n | (_, AnnCoercion {}) <- arg = go e n @@ -634,6 +635,7 @@ notWorthFloating e abs_vars is_triv (_, AnnVar {}) = True -- (ie not worth floating) is_triv (_, AnnCast e _) = is_triv e is_triv (_, AnnApp e (_, AnnType {})) = is_triv e + is_triv (_, AnnConApp _ args) = all isAnnTypeArg args is_triv (_, AnnApp e (_, AnnCoercion {})) = is_triv e is_triv (_, AnnTick t e) = not (tickishIsCode t) && is_triv e is_triv _ = False From git at git.haskell.org Mon Oct 10 21:43:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Oct 2016 21:43:56 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (6ef0f7e) Message-ID: <20161010214356.0B0A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/6ef0f7e8dda3d516eba02584dec54c81dd684bab/ghc >--------------------------------------------------------------- commit 6ef0f7e8dda3d516eba02584dec54c81dd684bab Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core This is an all-commits-squashed commit, for the sake of testing this branch on perf.haskell.org without testing the intermediate commits. + This is a combination of 47 commits. + The first commit's message is: Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? + This is the 2nd commit message: Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. + This is the 3rd commit message: ConApp bytecode: Add more ASSERT + This is the 4th commit message: ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. + This is the 5th commit message: ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. + This is the 6th commit message: mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). + This is the 7th commit message: DataCon wrapper: Use ConApp in the body + This is the 8th commit message: mkCoreConApps: Warn about unsaturated use + This is the 9th commit message: Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. + This is the 10th commit message: Use ConApp in tagToEnumRule + This is the 11th commit message: knownCon: Use ConApp in unfolding of scrutinee + This is the 12th commit message: Get rid of unitDataConId (use ConApp instead) + This is the 13th commit message: Always build a wrapper for data types + This is the 14th commit message: Always use ConApp in CoreSyn + This is the 15th commit message: Reserve a unique for the wrapper of a wired in DataCon + This is the 16th commit message: CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. + This is the 17th commit message: Desugar: Use Coercible worker, not wrapper + This is the 18th commit message: Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) + This is the 19th commit message: Deserialize interface tuples to ConApp + This is the 20th commit message: Handle ConApp in "Eliminate Identity Case" + This is the 21st commit message: Use dataConWrapId in unsaturated uses of mkCoreConApps + This is the 22nd commit message: ConApp: More Linting + This is the 23rd commit message: mkSimpleDataConRep: No wrapper for newtypes + This is the 24th commit message: mkCoreConApps: Do not use ConApp for newtypes + This is the 25th commit message: New Lint Check: No data con workers any more, please + This is the 26th commit message: Use ConApp when creating True resp. False + This is the 27th commit message: Include constructor in freeNamesIfExpr + This is the 28th commit message: isTrueLHsExpr: Match on data con wrapper now + This is the 29th commit message: Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. + This is the 30th commit message: maybe_substitute: Detect ConApp + This is the 31st commit message: Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. + This is the 32nd commit message: Do not lint the bodz of the data con worker bindings introduced by CorePrep + This is the 33rd commit message: coreToStgExpr: add con worker to free variables reported + This is the 34th commit message: Handle ConApp in inlineBoringOk + This is the 35th commit message: cpe_ExprIsTrivial: Nullary Constructors are trivial + This is the 36th commit message: Handle nullary Cons in myCollectArgs + This is the 37th commit message: Handle nullary constructors in the byte code generator. + This is the 38th commit message: getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons + This is the 39th commit message: Avoid invalid haddock synatx + This is the 40th commit message: No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. + This is the 41st commit message: Update some test output + This is the 42nd commit message: SetLevels: Do not float nullary data constructors + This is the 43rd commit message: Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. + This is the 44th commit message: Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. + This is the 45th commit message: Nullary data constructors are trivial + This is the 46th commit message: sptModuleInitCode: Look for ConApp + This is the 47th commit message: Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. >--------------------------------------------------------------- 6ef0f7e8dda3d516eba02584dec54c81dd684bab compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/Demand.hs | 17 ++- compiler/basicTypes/MkId.hs | 128 +++++++++++++------- compiler/basicTypes/MkId.hs-boot | 4 +- compiler/basicTypes/Unique.hs | 22 ++-- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++ compiler/coreSyn/CoreLint.hs | 42 +++++++ compiler/coreSyn/CorePrep.hs | 24 ++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 47 +++++--- compiler/coreSyn/CoreSyn.hs | 21 +++- compiler/coreSyn/CoreTidy.hs | 15 +-- compiler/coreSyn/CoreUnfold.hs | 9 +- compiler/coreSyn/CoreUtils.hs | 57 ++++++--- compiler/coreSyn/MkCore.hs | 39 +++++- compiler/coreSyn/PprCore.hs | 10 ++ compiler/coreSyn/TrieMap.hs | 68 +++++++---- compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/ByteCodeGen.hs | 42 ++++++- compiler/iface/IfaceSyn.hs | 47 +++++--- compiler/iface/MkIface.hs | 27 +++-- compiler/iface/TcIface.hs | 7 +- compiler/main/StaticPtrTable.hs | 5 + compiler/main/TidyPgm.hs | 2 + compiler/prelude/PrelNames.hs | 17 ++- compiler/prelude/PrelRules.hs | 8 +- compiler/prelude/TysWiredIn.hs | 35 +++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++- compiler/simplCore/FloatIn.hs | 19 +++ compiler/simplCore/FloatOut.hs | 8 ++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++ compiler/simplCore/SAT.hs | 12 ++ compiler/simplCore/SetLevels.hs | 18 ++- compiler/simplCore/SimplUtils.hs | 3 + compiler/simplCore/Simplify.hs | 24 +++- compiler/specialise/Rules.hs | 13 ++ compiler/specialise/SpecConstr.hs | 4 + compiler/specialise/Specialise.hs | 3 + compiler/stgSyn/CoreToStg.hs | 20 ++++ compiler/stranal/DmdAnal.hs | 33 +++++ compiler/stranal/WorkWrap.hs | 3 + compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 48 ++++---- compiler/vectorise/Vectorise/Exp.hs | 13 ++ compiler/vectorise/Vectorise/Utils.hs | 6 - mk/warnings.mk | 2 + .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++-- .../tests/ghci.debugger/scripts/print006.stdout | 14 +-- .../tests/ghci.debugger/scripts/print008.stdout | 10 +- .../tests/ghci.debugger/scripts/print010.stdout | 7 +- .../tests/ghci.debugger/scripts/print012.stdout | 9 +- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +-- .../tests/ghci.debugger/scripts/print034.stdout | 6 +- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/numeric/should_compile/T7116.stdout | 40 ++++--- testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 +++++----- .../tests/roles/should_compile/Roles13.stderr | 70 +++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 ++-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 ++-- testsuite/tests/roles/should_compile/T8958.stderr | 32 ++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 25 +++- .../tests/simplCore/should_compile/T3717.stderr | 20 ++-- .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 47 ++++---- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++-- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 114 ++++++++++-------- .../tests/simplCore/should_compile/T8274.stdout | 34 ++++-- .../tests/simplCore/should_compile/T8832.stdout | 20 ++-- .../tests/simplCore/should_compile/T8848.stderr | 32 ++--- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../tests/simplCore/should_compile/rule2.stderr | 19 ++- .../simplCore/should_compile/spec-inline.stderr | 133 +++++++++++++-------- testsuite/tests/th/TH_Roles2.stderr | 8 +- 96 files changed, 1334 insertions(+), 709 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 6ef0f7e8dda3d516eba02584dec54c81dd684bab From git at git.haskell.org Tue Oct 11 15:06:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Oct 2016 15:06:13 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T12618-squashed' deleted Message-ID: <20161011150613.D6DDA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T12618-squashed From git at git.haskell.org Tue Oct 11 15:06:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Oct 2016 15:06:16 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (4dcdb0f) Message-ID: <20161011150616.BE4D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/4dcdb0faead6a0093b6039fcc73a96dd3e188440/ghc >--------------------------------------------------------------- commit 4dcdb0faead6a0093b6039fcc73a96dd3e188440 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core This is an all-commits-squashed commit, for the sake of testing this branch on perf.haskell.org without testing the intermediate commits. + This is a combination of 50 commits. + The first commit's message is: Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? + This is the 2nd commit message: Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. + This is the 3rd commit message: ConApp bytecode: Add more ASSERT + This is the 4th commit message: ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. + This is the 5th commit message: ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. + This is the 6th commit message: mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). + This is the 7th commit message: DataCon wrapper: Use ConApp in the body + This is the 8th commit message: mkCoreConApps: Warn about unsaturated use + This is the 9th commit message: Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. + This is the 10th commit message: Use ConApp in tagToEnumRule + This is the 11th commit message: knownCon: Use ConApp in unfolding of scrutinee + This is the 12th commit message: Get rid of unitDataConId (use ConApp instead) + This is the 13th commit message: Always build a wrapper for data types + This is the 14th commit message: Always use ConApp in CoreSyn + This is the 15th commit message: Reserve a unique for the wrapper of a wired in DataCon + This is the 16th commit message: CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. + This is the 17th commit message: Desugar: Use Coercible worker, not wrapper + This is the 18th commit message: Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) + This is the 19th commit message: Deserialize interface tuples to ConApp + This is the 20th commit message: Handle ConApp in "Eliminate Identity Case" + This is the 21st commit message: Use dataConWrapId in unsaturated uses of mkCoreConApps + This is the 22nd commit message: ConApp: More Linting + This is the 23rd commit message: mkSimpleDataConRep: No wrapper for newtypes + This is the 24th commit message: mkCoreConApps: Do not use ConApp for newtypes + This is the 25th commit message: New Lint Check: No data con workers any more, please + This is the 26th commit message: Use ConApp when creating True resp. False + This is the 27th commit message: Include constructor in freeNamesIfExpr + This is the 28th commit message: isTrueLHsExpr: Match on data con wrapper now + This is the 29th commit message: Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. + This is the 30th commit message: maybe_substitute: Detect ConApp + This is the 31st commit message: Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. + This is the 32nd commit message: Do not lint the bodz of the data con worker bindings introduced by CorePrep + This is the 33rd commit message: coreToStgExpr: add con worker to free variables reported + This is the 34th commit message: Handle ConApp in inlineBoringOk + This is the 35th commit message: cpe_ExprIsTrivial: Nullary Constructors are trivial + This is the 36th commit message: Handle nullary Cons in myCollectArgs + This is the 37th commit message: Handle nullary constructors in the byte code generator. + This is the 38th commit message: getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons + This is the 39th commit message: Avoid invalid haddock synatx + This is the 40th commit message: No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. + This is the 41st commit message: Update some test output + This is the 42nd commit message: SetLevels: Do not float nullary data constructors + This is the 43rd commit message: Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. + This is the 44th commit message: Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. + This is the 45th commit message: Nullary data constructors are trivial + This is the 46th commit message: sptModuleInitCode: Look for ConApp + This is the 47th commit message: Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. + This is the 48th commit message: Fix instance Eq (DeBruijn CoreExpr) for ConApp + This is the 49th commit message: Adjust exprIsCheap + This is the 50th commit message: SpecConstr.isValue: Handle ConApp now all tests pass (here) >--------------------------------------------------------------- 4dcdb0faead6a0093b6039fcc73a96dd3e188440 compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/Demand.hs | 17 ++- compiler/basicTypes/MkId.hs | 128 +++++++++++++------- compiler/basicTypes/MkId.hs-boot | 4 +- compiler/basicTypes/Unique.hs | 22 ++-- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++ compiler/coreSyn/CoreLint.hs | 42 +++++++ compiler/coreSyn/CorePrep.hs | 24 ++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 47 +++++--- compiler/coreSyn/CoreSyn.hs | 21 +++- compiler/coreSyn/CoreTidy.hs | 15 +-- compiler/coreSyn/CoreUnfold.hs | 9 +- compiler/coreSyn/CoreUtils.hs | 65 ++++++---- compiler/coreSyn/MkCore.hs | 39 +++++- compiler/coreSyn/PprCore.hs | 10 ++ compiler/coreSyn/TrieMap.hs | 80 ++++++++----- compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/ByteCodeGen.hs | 42 ++++++- compiler/iface/IfaceSyn.hs | 47 +++++--- compiler/iface/MkIface.hs | 27 +++-- compiler/iface/TcIface.hs | 7 +- compiler/main/StaticPtrTable.hs | 5 + compiler/main/TidyPgm.hs | 2 + compiler/prelude/PrelNames.hs | 17 ++- compiler/prelude/PrelRules.hs | 8 +- compiler/prelude/TysWiredIn.hs | 35 +++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++- compiler/simplCore/FloatIn.hs | 19 +++ compiler/simplCore/FloatOut.hs | 8 ++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++ compiler/simplCore/SAT.hs | 12 ++ compiler/simplCore/SetLevels.hs | 18 ++- compiler/simplCore/SimplUtils.hs | 3 + compiler/simplCore/Simplify.hs | 24 +++- compiler/specialise/Rules.hs | 13 ++ compiler/specialise/SpecConstr.hs | 6 + compiler/specialise/Specialise.hs | 3 + compiler/stgSyn/CoreToStg.hs | 20 ++++ compiler/stranal/DmdAnal.hs | 33 +++++ compiler/stranal/WorkWrap.hs | 3 + compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 48 ++++---- compiler/vectorise/Vectorise/Exp.hs | 13 ++ compiler/vectorise/Vectorise/Utils.hs | 6 - mk/warnings.mk | 2 + .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++-- .../tests/ghci.debugger/scripts/print006.stdout | 14 +-- .../tests/ghci.debugger/scripts/print008.stdout | 10 +- .../tests/ghci.debugger/scripts/print010.stdout | 7 +- .../tests/ghci.debugger/scripts/print012.stdout | 9 +- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +-- .../tests/ghci.debugger/scripts/print034.stdout | 6 +- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/numeric/should_compile/T7116.stdout | 40 ++++--- testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 +++++----- .../tests/roles/should_compile/Roles13.stderr | 70 +++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 ++-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 ++-- testsuite/tests/roles/should_compile/T8958.stderr | 32 ++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 25 +++- .../tests/simplCore/should_compile/T3717.stderr | 20 ++-- .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 47 ++++---- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++-- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 114 ++++++++++-------- .../tests/simplCore/should_compile/T7865.stdout | 2 +- .../tests/simplCore/should_compile/T8274.stdout | 34 ++++-- .../tests/simplCore/should_compile/T8832.stdout | 20 ++-- .../tests/simplCore/should_compile/T8848.stderr | 32 ++--- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../tests/simplCore/should_compile/rule2.stderr | 19 ++- .../simplCore/should_compile/spec-inline.stderr | 133 +++++++++++++-------- testsuite/tests/th/TH_Roles2.stderr | 8 +- 97 files changed, 1348 insertions(+), 719 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 4dcdb0faead6a0093b6039fcc73a96dd3e188440 From git at git.haskell.org Tue Oct 11 20:43:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Oct 2016 20:43:07 +0000 (UTC) Subject: [commit: ghc] master: Add test case for #12689 (b5be2ec) Message-ID: <20161011204307.2F73F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5be2ec33c395e3e092baf85ebd0696f233ad706/ghc >--------------------------------------------------------------- commit b5be2ec33c395e3e092baf85ebd0696f233ad706 Author: Joachim Breitner Date: Tue Oct 11 16:25:05 2016 -0400 Add test case for #12689 which test a few variants of rules involving constructors, including nullary constructors, constructors with wrappers, and unsaturated of constructors. At the moment, all the rules work as expected, despite GHC’s compile time warnings when called with -Wall. >--------------------------------------------------------------- b5be2ec33c395e3e092baf85ebd0696f233ad706 testsuite/tests/simplCore/should_run/T12689.hs | 26 ++++++++++++++++++++++ testsuite/tests/simplCore/should_run/T12689.stdout | 7 ++++++ testsuite/tests/simplCore/should_run/T12689a.hs | 24 ++++++++++++++++++++ .../tests/simplCore/should_run/T12689a.stdout | 5 +++++ testsuite/tests/simplCore/should_run/all.T | 2 ++ 5 files changed, 64 insertions(+) diff --git a/testsuite/tests/simplCore/should_run/T12689.hs b/testsuite/tests/simplCore/should_run/T12689.hs new file mode 100644 index 0000000..84a5419 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T12689.hs @@ -0,0 +1,26 @@ +data T1 = MkT1Bad | MkT1Good deriving Show +data T2 = MkT2Bad Int | MkT2Good Int deriving Show +data T3 = MkT3Bad {-# UNPACK #-} !Int | MkT3Good {-# UNPACK #-} !Int deriving Show +data T4 = MkT4Bad Int | MkT4Good Int deriving Show +data T5 = MkT5Bad {-# UNPACK #-} !Int | MkT5Good {-# UNPACK #-} !Int deriving Show + +{-# RULES + +"T1" MkT1Bad = MkT1Good +"T2" forall x. MkT2Bad x = MkT2Good x +"T3" forall x. MkT3Bad x = MkT3Good x +"T4" MkT4Bad = MkT4Good +"T5" MkT5Bad = MkT5Good + #-} + +app = id +{-# NOINLINE app #-} + +main = do + print MkT1Bad + print (MkT2Bad 42) + print (MkT3Bad 42) + print (MkT4Bad 42) + print (app MkT4Bad 42) + print (MkT5Bad 42) + print (app MkT5Bad 42) diff --git a/testsuite/tests/simplCore/should_run/T12689.stdout b/testsuite/tests/simplCore/should_run/T12689.stdout new file mode 100644 index 0000000..7e9baf3 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T12689.stdout @@ -0,0 +1,7 @@ +MkT1Good +MkT2Good 42 +MkT3Good 42 +MkT4Good 42 +MkT4Good 42 +MkT5Good 42 +MkT5Good 42 diff --git a/testsuite/tests/simplCore/should_run/T12689a.hs b/testsuite/tests/simplCore/should_run/T12689a.hs new file mode 100644 index 0000000..88fd5ee --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T12689a.hs @@ -0,0 +1,24 @@ +data T1 = MkT1Bad | MkT1Good deriving Show +data T2 = MkT2Bad Int | MkT2Good Int deriving Show +data T3 = MkT3Bad {-# UNPACK #-} !Int | MkT3Good {-# UNPACK #-} !Int deriving Show +data T4 = MkT4Bad Int | MkT4Good Int deriving Show +data T5 = MkT5Bad {-# UNPACK #-} !Int | MkT5Good {-# UNPACK #-} !Int deriving Show + +{-# RULES + +"T1" app MkT1Bad = MkT1Good +"T2" forall x. app (MkT2Bad x) = MkT2Good x +"T3" forall x. app (MkT3Bad x) = MkT3Good x +"T4" app MkT4Bad = MkT4Good +"T5" app MkT5Bad = MkT5Good + #-} + +app = id +{-# NOINLINE app #-} + +main = do + print (app MkT1Bad) + print (app (MkT2Bad 42)) + print (app (MkT3Bad 42)) + print (app MkT4Bad 42) + print (app MkT5Bad 42) diff --git a/testsuite/tests/simplCore/should_run/T12689a.stdout b/testsuite/tests/simplCore/should_run/T12689a.stdout new file mode 100644 index 0000000..c924bde --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T12689a.stdout @@ -0,0 +1,5 @@ +MkT1Good +MkT2Good 42 +MkT3Good 42 +MkT4Good 42 +MkT5Good 42 diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 60a279a..1e4e8a7 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -73,3 +73,5 @@ test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, ['']) test('T11172', normal, compile_and_run, ['']) test('T11731', normal, compile_and_run, ['-fspec-constr']) test('T7611', normal, compile_and_run, ['']) +test('T12689', normal, compile_and_run, ['']) +test('T12689a', normal, compile_and_run, ['']) From git at git.haskell.org Tue Oct 11 20:52:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Oct 2016 20:52:11 +0000 (UTC) Subject: [commit: ghc] master: Add a broken test case for #12689 (f8d2c20) Message-ID: <20161011205211.CC0863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f8d2c205e04bcb83d39ccbede4c2a6279f702a6b/ghc >--------------------------------------------------------------- commit f8d2c205e04bcb83d39ccbede4c2a6279f702a6b Author: Joachim Breitner Date: Tue Oct 11 16:50:25 2016 -0400 Add a broken test case for #12689 A rule with a phase specification trying to match on a constructor with a wrapper will fail to match, as the wrapper will be inlined by then. The fact that it works in the other case is also mostly by accident. (Split into two test cases so that regressions with regard what works so far are caught.) >--------------------------------------------------------------- f8d2c205e04bcb83d39ccbede4c2a6279f702a6b testsuite/tests/simplCore/should_run/T12689broken.hs | 9 +++++++++ testsuite/tests/simplCore/should_run/T12689broken.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 1 + 3 files changed, 11 insertions(+) diff --git a/testsuite/tests/simplCore/should_run/T12689broken.hs b/testsuite/tests/simplCore/should_run/T12689broken.hs new file mode 100644 index 0000000..cb83cc4 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T12689broken.hs @@ -0,0 +1,9 @@ +data T6 = MkT6Bad {-# UNPACK #-} !Int | MkT6Good {-# UNPACK #-} !Int deriving Show + +{-# RULES + +"T6" [1] forall x. MkT6Bad x = MkT6Good x + #-} + +main = do + print (MkT6Bad 42) -- late rule diff --git a/testsuite/tests/simplCore/should_run/T12689broken.stdout b/testsuite/tests/simplCore/should_run/T12689broken.stdout new file mode 100644 index 0000000..75ff341 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T12689broken.stdout @@ -0,0 +1 @@ +MkT6Good 42 diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 1e4e8a7..733f158 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -74,4 +74,5 @@ test('T11172', normal, compile_and_run, ['']) test('T11731', normal, compile_and_run, ['-fspec-constr']) test('T7611', normal, compile_and_run, ['']) test('T12689', normal, compile_and_run, ['']) +test('T12689broken', expect_broken(12689), compile_and_run, ['']) test('T12689a', normal, compile_and_run, ['']) From git at git.haskell.org Tue Oct 11 23:04:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Oct 2016 23:04:12 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Make data con wrappers ConLike (and see what happens) (f8312ea) Message-ID: <20161011230412.139F53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/f8312ea10d2dcfc87034e6497e21fb324f3ce827/ghc >--------------------------------------------------------------- commit f8312ea10d2dcfc87034e6497e21fb324f3ce827 Author: Joachim Breitner Date: Tue Oct 11 19:03:51 2016 -0400 Make data con wrappers ConLike (and see what happens) >--------------------------------------------------------------- f8312ea10d2dcfc87034e6497e21fb324f3ce827 compiler/basicTypes/MkId.hs | 4 ++-- compiler/simplCore/Simplify.hs | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index edbfc5a..c0d38cc 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -491,7 +491,7 @@ mkSimpleDataConRep wrap_name dc `setArityInfo` wrap_arity -- It's important to specify the arity, so that partial -- applications are treated as values - `setInlinePragInfo` alwaysInlinePragma + `setInlinePragInfo` alwaysInlinePragma { inl_rule = ConLike } `setUnfoldingInfo` wrap_unf `setStrictnessInfo` wrap_sig wrap_arity = dataConRepArity dc @@ -535,7 +535,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con `setArityInfo` wrap_arity -- It's important to specify the arity, so that partial -- applications are treated as values - `setInlinePragInfo` alwaysInlinePragma + `setInlinePragInfo` alwaysInlinePragma { inl_rule = ConLike } `setUnfoldingInfo` wrap_unf `setStrictnessInfo` wrap_sig -- We need to get the CAF info right here because TidyPgm diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 637139c..d33ddb2 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -489,7 +489,8 @@ prepareRhs top_lvl env0 id rhs0 go n_val_args env (Var fun) = return (is_exp, env, Var fun) where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP + is_exp = pprTrace "prepareRhs:isExpandableApp" (ppr fun <+> ppr (isExpandableApp fun n_val_args)) $ + isExpandableApp fun n_val_args -- The fun a constructor or PAP -- See Note [CONLIKE pragma] in BasicTypes -- The definition of is_exp should match that in -- OccurAnal.occAnalApp From git at git.haskell.org Wed Oct 12 11:34:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Oct 2016 11:34:50 +0000 (UTC) Subject: [commit: ghc] master: Add derived shadows only for Wanted constraints (8fa5f5b) Message-ID: <20161012113450.BCB2A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8fa5f5b197542b6e7e9e570991a1488204e606c9/ghc >--------------------------------------------------------------- commit 8fa5f5b197542b6e7e9e570991a1488204e606c9 Author: Simon Peyton Jones Date: Wed Oct 12 12:02:04 2016 +0100 Add derived shadows only for Wanted constraints This patch implements choice (3) of comment:14 on Trac #12660. It cures an infinite loop (caused by the creation of an infinite type) in in compiling the 'singletons' package. See Note [Add derived shadows only for Wanteds] in TcSMonad. >--------------------------------------------------------------- 8fa5f5b197542b6e7e9e570991a1488204e606c9 compiler/typecheck/TcSMonad.hs | 60 +++++++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 19 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 18b6a69..640ed73 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -394,7 +394,7 @@ dictionary to the inert_solved_dicts. In general, we use it to avoid creating a new EvVar when we have a new goal that we have solved in the past. -But in particular, we can use it to create *recursive* dicationaries. +But in particular, we can use it to create *recursive* dictionaries. The simplest, degnerate case is instance C [a] => C [a] where ... If we have @@ -665,11 +665,12 @@ Note [inert_model: the inert model] decomposing injective arguments of type functions, and suchlike. - - A Derived "shadow copy" for every Given or Wanted (a ~N ty) in - inert_eqs. + - A Derived "shadow copy" for every Wanted (a ~N ty) in + inert_eqs. (Originally included every Given too; but + see Note [Add derived shadows only for Wanteds]) * The model is not subject to "kicking-out". Reason: we make a Derived - shadow copy of any Given/Wanted (a ~ ty), and that Derived copy will + shadow copy of any Wanted (a ~ ty), and that Derived copy will be fully rewritten by the model before it is added * The principal reason for maintaining the model is to generate @@ -1123,26 +1124,22 @@ Note [Adding an inert canonical constraint the InertCans] NB: 'a' cannot be in fv(ty), because the constraint is canonical. 2. (DShadow) Do emitDerivedShadows - For every inert G/W constraint c, st + For every inert [W] constraint c, st (a) (a~ty) can rewrite c (see Note [Emitting shadow constraints]), and (b) the model cannot rewrite c kick out a Derived *copy*, leaving the original unchanged. Reason for (b) if the model can rewrite c, then we have already generated a shadow copy + See Note [Add derived shadows only for Wanteds] [Given/Wanted Nominal] [G/W] a ~N ty: 1. Add it to inert_eqs - 2. Emit [D] a~ty - Step (2) is needed to allow the current model to fully - rewrite [D] a~ty before adding it using the [Derived Nominal] - steps above. - - We must do this even for Givens, because - work-item [G] a ~ [b], model has [D] b ~ a. - We need a shadow [D] a ~ [b] in the work-list - When we process it, we'll rewrite to a ~ [a] and get an occurs check - + 2. For [W], Emit [D] a~ty + Step (2) is needed to allow the current model to fully + rewrite [D] a~ty before adding it using the [Derived Nominal] + steps above. + See Note [Add derived shadows only for Wanteds] * Unifying a:=ty, is like adding [G] a~ty, but we can't make a [D] a~ty, as in step (1) of the [G/W] case above. So instead, do @@ -1262,7 +1259,7 @@ emitDerivedShadows IC { inert_eqs = tv_eqs | otherwise = cts want_shadow ct - = not (isDerivedCt ct) -- No need for a shadow of a Derived! + = isWantedCt ct -- See Note [Add shadows only for Wanteds] && (new_tv `elemVarSet` rw_tvs) -- New tv can rewrite ct, yielding a -- different ct && not (modelCanRewrite model rw_tvs)-- We have not already created a @@ -1284,7 +1281,31 @@ mkShadowCt ct derived_ev = CtDerived { ctev_pred = ctEvPred ev , ctev_loc = ctEvLoc ev } -{- Note [Keep CDictCan shadows as CDictCan] +{- Note [Add derived shadows only for Wanteds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We now only add shadows for Wanted constraints. Why add derived +shadows for Givens? After all, Givens can rewrite Deriveds. But +Deriveds can't rewrite Givens. So in principle, if we created a +Derived shadow of a Given, it could be rewritten by other Deriveds, +and that could, conceivably, lead to a useful unification. + +But (a) I have been unable to come up with an example of this +happening and (b) see Trac #12660 for how adding the derived shadows +of a Given led to an infinite loop. For (b) there may be other +ways to solve the loop, but simply reraining from adding +derived shadows of Givens is particularly simple. And it's more +efficient too! + +Still, here's one possible reason for adding derived shadows +for Givens. Consider + work-item [G] a ~ [b], model has [D] b ~ a. +If we added the derived shadow (into the work list) + [D] a ~ [b] +When we process it, we'll rewrite to a ~ [a] and get an +occurs check. Without it we'll miss the occurs check (reporting +inaccessible code); but that's probably OK. + +Note [Keep CDictCan shadows as CDictCan] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have class C a => D a b @@ -1334,7 +1355,8 @@ addInertCan ct -- Emit shadow derived if necessary -- See Note [Emitting shadow constraints] ; let rw_tvs = rewritableTyCoVars ct - ; when (not (isDerivedCt ct) && modelCanRewrite (inert_model ics) rw_tvs) + ; when (isWantedCt ct && modelCanRewrite (inert_model ics) rw_tvs) + -- See Note [Add shadows only for Wanteds] (emitWork [mkShadowCt ct]) ; traceTcS "addInertCan }" $ empty } @@ -2556,7 +2578,7 @@ nestTcS :: TcS a -> TcS a -- Use the current untouchables, augmenting the current -- evidence bindings, and solved dictionaries -- But have no effect on the InertCans, or on the inert_flat_cache --- (the latter because the thing inside a nestTcS does unflattening) +-- (we want to inherit the latter from processing the Givens) nestTcS (TcS thing_inside) = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var }) -> do { inerts <- TcM.readTcRef inerts_var From git at git.haskell.org Wed Oct 12 14:26:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Oct 2016 14:26:55 +0000 (UTC) Subject: [commit: ghc] master: Comments and equation ordering only (d2959df) Message-ID: <20161012142655.267683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2959dfbbbc33a0a44c498d1e6b424615b7d756d/ghc >--------------------------------------------------------------- commit d2959dfbbbc33a0a44c498d1e6b424615b7d756d Author: Simon Peyton Jones Date: Wed Oct 12 15:26:24 2016 +0100 Comments and equation ordering only >--------------------------------------------------------------- d2959dfbbbc33a0a44c498d1e6b424615b7d756d compiler/coreSyn/CorePrep.hs | 6 ++++-- compiler/coreSyn/CoreUtils.hs | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index b3d7817..510b178 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -920,8 +920,10 @@ of the scope of a `seq`, or dropped the `seq` altogether. -} cpe_ExprIsTrivial :: CoreExpr -> Bool --- Version that doesn't consider an scc annotation to be trivial. --- See also 'exprIsTrivial' +-- This function differs from CoreUtils.exprIsTrivial only in its +-- treatment of (Lit l). Otherwise it's identical. +-- No one knows why this difference is important: Trac #11158. +-- Someone should find out cpe_ExprIsTrivial (Var _) = True cpe_ExprIsTrivial (Type _) = True cpe_ExprIsTrivial (Coercion _) = True diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 6a28b9f..a128737 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -803,10 +803,10 @@ exprIsTrivial (Type _) = True exprIsTrivial (Coercion _) = True exprIsTrivial (Lit lit) = litIsTrivial lit exprIsTrivial (App e arg) = not (isRuntimeArg arg) && exprIsTrivial e +exprIsTrivial (Lam b e) = not (isRuntimeVar b) && exprIsTrivial e exprIsTrivial (Tick t e) = not (tickishIsCode t) && exprIsTrivial e -- See Note [Tick trivial] exprIsTrivial (Cast e _) = exprIsTrivial e -exprIsTrivial (Lam b body) = not (isRuntimeVar b) && exprIsTrivial body exprIsTrivial (Case e _ _ []) = exprIsTrivial e -- See Note [Empty case is trivial] exprIsTrivial _ = False From git at git.haskell.org Wed Oct 12 15:52:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Oct 2016 15:52:52 +0000 (UTC) Subject: [commit: ghc] master: RnExpr: Actually fail if patterns found in expression (bce9908) Message-ID: <20161012155252.144AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bce99086e9f54909f51ff5a74cb8c666083bb021/ghc >--------------------------------------------------------------- commit bce99086e9f54909f51ff5a74cb8c666083bb021 Author: Ben Gamari Date: Tue Oct 11 09:26:46 2016 -0400 RnExpr: Actually fail if patterns found in expression This fixes #12584, where wildcard patterns were snuck into an expression, which then crashed the typechecker in TcExpr since EWildPats aren't supposed to appear in the AST after renaming. The problem was that `rnTopSpliceDecl` failed to check for errors from `rnSplice` (as done by other callers to `rnSplice`). Thanks to Shayan for reporting this! Reviewers: simonpj, austin Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2539 GHC Trac Issues: #12584 >--------------------------------------------------------------- bce99086e9f54909f51ff5a74cb8c666083bb021 compiler/rename/RnSplice.hs | 5 ++++- testsuite/tests/rename/should_fail/all.T | 1 + testsuite/tests/rename/should_fail/rnfail016.hs | 2 -- testsuite/tests/rename/should_fail/rnfail016.stderr | 2 -- testsuite/tests/rename/should_fail/{rnfail016.hs => rnfail016a.hs} | 5 +---- testsuite/tests/rename/should_fail/rnfail016a.stderr | 2 ++ 6 files changed, 8 insertions(+), 9 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 4b2e561..557b9f8 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -635,8 +635,11 @@ rnSpliceDecl (SpliceDecl (L loc splice) flg) rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars) -- Declaration splice at the very top level of the module rnTopSpliceDecls splice - = do { (rn_splice, fvs) <- setStage (Splice Untyped) $ + = do { (rn_splice, fvs) <- checkNoErrs $ + setStage (Splice Untyped) $ rnSplice splice + -- As always, be sure to checkNoErrs above lest we end up with + -- holes making it to typechecking, hence #12584. ; traceRn (text "rnTopSpliceDecls: untyped declaration splice") ; (decls, mod_finalizers) <- runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 3ddfea2..9fc13b0 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -13,6 +13,7 @@ test('rnfail013', normal, compile_fail, ['']) test('rnfail015', normal, compile_fail, ['']) test('rnfail016', normal, compile_fail, ['']) +test('rnfail016a', normal, compile_fail, ['']) test('rnfail017', normal, compile_fail, ['']) test('rnfail018', normal, compile_fail, ['']) test('rnfail019', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail016.hs b/testsuite/tests/rename/should_fail/rnfail016.hs index 1bf15b0..7dccaa9 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.hs +++ b/testsuite/tests/rename/should_fail/rnfail016.hs @@ -4,6 +4,4 @@ module ShouldFail where -- !!! Pattern syntax in expressions f x = x @ x -g x = ~ x -h x = _ diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr b/testsuite/tests/rename/should_fail/rnfail016.stderr index 4013255..4743613 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.stderr +++ b/testsuite/tests/rename/should_fail/rnfail016.stderr @@ -2,5 +2,3 @@ rnfail016.hs:6:7: error: Pattern syntax in expression context: x at x Did you mean to enable TypeApplications? - -rnfail016.hs:7:7: error: Pattern syntax in expression context: ~x diff --git a/testsuite/tests/rename/should_fail/rnfail016.hs b/testsuite/tests/rename/should_fail/rnfail016a.hs similarity index 77% copy from testsuite/tests/rename/should_fail/rnfail016.hs copy to testsuite/tests/rename/should_fail/rnfail016a.hs index 1bf15b0..e0d7d65 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.hs +++ b/testsuite/tests/rename/should_fail/rnfail016a.hs @@ -3,7 +3,4 @@ module ShouldFail where -- !!! Pattern syntax in expressions -f x = x @ x -g x = ~ x -h x = _ - +f x = ~ x diff --git a/testsuite/tests/rename/should_fail/rnfail016a.stderr b/testsuite/tests/rename/should_fail/rnfail016a.stderr new file mode 100644 index 0000000..3a59ee7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail016a.stderr @@ -0,0 +1,2 @@ + +rnfail016a.hs:6:7: error: Pattern syntax in expression context: ~x From git at git.haskell.org Wed Oct 12 15:52:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Oct 2016 15:52:54 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump T1969 allocations (577effd) Message-ID: <20161012155254.E491A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/577effd4ac68984d4b89d396832a6fb905eb7925/ghc >--------------------------------------------------------------- commit 577effd4ac68984d4b89d396832a6fb905eb7925 Author: Ben Gamari Date: Wed Oct 12 11:49:55 2016 -0400 testsuite: Bump T1969 allocations >--------------------------------------------------------------- 577effd4ac68984d4b89d396832a6fb905eb7925 testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 28c80e1..cf08465 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -65,7 +65,7 @@ test('T1969', # 2014-06-29 5949188 (x86/Linux) # 2015-07-11 6241108 (x86/Linux, 64bit machine) use +RTS -G1 # 2016-04-06 9093608 (x86/Linux, 64bit machine) - (wordsize(64), 15017528, 15)]), + (wordsize(64), 17285216, 15)]), # 2014-09-10 10463640, 10 # post-AMP-update (somewhat stabelish) # looks like the peak is around ~10M, but we're # unlikely to GC exactly on the peak. @@ -76,6 +76,7 @@ test('T1969', # 2014-11-03 10584344, # ghcspeed reports higher numbers consistently # 2015-07-11 11670120 (amd64/Linux) # 2015-10-28 15017528 (amd64/Linux) emit typeable at definition site + # 2016-10-12 17285216 (amd64/Linux) it's not entirely clear why compiler_stats_num_field('bytes allocated', [(platform('i386-unknown-mingw32'), 301784492, 5), # 215582916 (x86/Windows) From git at git.haskell.org Wed Oct 12 16:00:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Oct 2016 16:00:24 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Make data con wrappers ConLike (and see what happens) (1389be9) Message-ID: <20161012160024.022683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/1389be9c013aae664480eab9d6c042139c79384d/ghc >--------------------------------------------------------------- commit 1389be9c013aae664480eab9d6c042139c79384d Author: Joachim Breitner Date: Tue Oct 11 19:03:51 2016 -0400 Make data con wrappers ConLike (and see what happens) >--------------------------------------------------------------- 1389be9c013aae664480eab9d6c042139c79384d compiler/basicTypes/MkId.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index edbfc5a..c0d38cc 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -491,7 +491,7 @@ mkSimpleDataConRep wrap_name dc `setArityInfo` wrap_arity -- It's important to specify the arity, so that partial -- applications are treated as values - `setInlinePragInfo` alwaysInlinePragma + `setInlinePragInfo` alwaysInlinePragma { inl_rule = ConLike } `setUnfoldingInfo` wrap_unf `setStrictnessInfo` wrap_sig wrap_arity = dataConRepArity dc @@ -535,7 +535,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con `setArityInfo` wrap_arity -- It's important to specify the arity, so that partial -- applications are treated as values - `setInlinePragInfo` alwaysInlinePragma + `setInlinePragInfo` alwaysInlinePragma { inl_rule = ConLike } `setUnfoldingInfo` wrap_unf `setStrictnessInfo` wrap_sig -- We need to get the CAF info right here because TidyPgm From git at git.haskell.org Wed Oct 12 19:03:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Oct 2016 19:03:02 +0000 (UTC) Subject: [commit: ghc] master: Add test for #12411 (184d7cb) Message-ID: <20161012190302.81F343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/184d7cb8278b9c6cb3f9786a96f081d08e4640db/ghc >--------------------------------------------------------------- commit 184d7cb8278b9c6cb3f9786a96f081d08e4640db Author: Ryan Scott Date: Wed Oct 12 14:57:32 2016 -0400 Add test for #12411 The fix for #12584 also fixed the problem in #12411. Let's add a test to ensure that it stays fixed. >--------------------------------------------------------------- 184d7cb8278b9c6cb3f9786a96f081d08e4640db testsuite/tests/{driver/recomp009/Sub2.hs => th/T12411.hs} | 5 +++-- testsuite/tests/th/T12411.stderr | 4 ++++ testsuite/tests/th/all.T | 1 + 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/driver/recomp009/Sub2.hs b/testsuite/tests/th/T12411.hs similarity index 50% copy from testsuite/tests/driver/recomp009/Sub2.hs copy to testsuite/tests/th/T12411.hs index 7ca8b12..fd8f9db 100644 --- a/testsuite/tests/driver/recomp009/Sub2.hs +++ b/testsuite/tests/th/T12411.hs @@ -1,3 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -module Sub where -x = [| 2 |] +module T12411 where + +pure @Q [] diff --git a/testsuite/tests/th/T12411.stderr b/testsuite/tests/th/T12411.stderr new file mode 100644 index 0000000..1f34432 --- /dev/null +++ b/testsuite/tests/th/T12411.stderr @@ -0,0 +1,4 @@ + +T12411.hs:4:1: error: + Pattern syntax in expression context: pure at Q + Did you mean to enable TypeApplications? diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index d6a124c..b2aee12 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -425,6 +425,7 @@ test('T12130', extra_clean(['T12130a.hi','T12130a.o']), test('T12403', omit_ways(['ghci']), compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques']) test('T12407', omit_ways(['ghci']), compile, ['-v0']) +test('T12411', normal, compile_fail, ['']) test('T12478_1', omit_ways(['ghci']), compile_and_run, ['-v0 -dsuppress-uniques']) test('T12478_2', omit_ways(['ghci']), compile_and_run, ['-v0']) From git at git.haskell.org Wed Oct 12 23:19:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Oct 2016 23:19:44 +0000 (UTC) Subject: [commit: ghc] master: Add test for #12589 (042c593) Message-ID: <20161012231944.344663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/042c5930bff239337d21836db5b8d0ebf0180ffc/ghc >--------------------------------------------------------------- commit 042c5930bff239337d21836db5b8d0ebf0180ffc Author: Ryan Scott Date: Wed Oct 12 19:16:46 2016 -0400 Add test for #12589 Commit af21e38855f7d517774542b360178b05045ecb08 fixed #12598. Let's add a test to make sure it stays fixed. >--------------------------------------------------------------- 042c5930bff239337d21836db5b8d0ebf0180ffc testsuite/tests/typecheck/should_fail/T12589.hs | 13 +++++++++++++ testsuite/tests/typecheck/should_fail/T12589.stderr | 2 ++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 16 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T12589.hs b/testsuite/tests/typecheck/should_fail/T12589.hs new file mode 100644 index 0000000..5f45474 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12589.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fdefer-typed-holes #-} +module T12589 where + +import Data.Proxy + +hcpure :: proxy c -> (forall a. c a => f a) -> h f xs +hcpure _ _ = undefined + +a = minBound + & hcpure (Proxy @Bounded) diff --git a/testsuite/tests/typecheck/should_fail/T12589.stderr b/testsuite/tests/typecheck/should_fail/T12589.stderr new file mode 100644 index 0000000..a2587e2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12589.stderr @@ -0,0 +1,2 @@ + +T12589.hs:13:3: error: Variable not in scope: (&) :: t0 -> t1 -> t diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index d040b58..4c16c0d 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -427,3 +427,4 @@ test('T12177', normal, compile_fail, ['']) test('T12406', normal, compile_fail, ['']) test('T12170a', normal, compile_fail, ['']) test('T12124', normal, compile_fail, ['']) +test('T12589', normal, compile_fail, ['']) From git at git.haskell.org Thu Oct 13 01:09:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 01:09:01 +0000 (UTC) Subject: [commit: ghc] master: Add test for #12456 (fef1df4) Message-ID: <20161013010901.A64CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fef1df4bb4f4b74f4a0d0d22c913d29189e140e4/ghc >--------------------------------------------------------------- commit fef1df4bb4f4b74f4a0d0d22c913d29189e140e4 Author: Ryan Scott Date: Wed Oct 12 21:06:48 2016 -0400 Add test for #12456 Commit f352e5cd7bb629fe0ca3b913bfbe7bee43d62f3a fixed #12456. Let's add a test to make sure it stays fixed. >--------------------------------------------------------------- fef1df4bb4f4b74f4a0d0d22c913d29189e140e4 testsuite/tests/ghci/should_run/T12456.script | 3 +++ testsuite/tests/ghci/should_run/all.T | 1 + 2 files changed, 4 insertions(+) diff --git a/testsuite/tests/ghci/should_run/T12456.script b/testsuite/tests/ghci/should_run/T12456.script new file mode 100644 index 0000000..4c0ed53 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T12456.script @@ -0,0 +1,3 @@ +:set -XPatternSynonyms -XViewPatterns +:m + Language.Haskell.TH +pattern A :: ExpQ; pattern A <- (undefined -> ()) where A = undefined diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index f7e5018..b6aa2e9 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -25,3 +25,4 @@ test('T7253', just_ghci, ghci_script, ['T7253.script']) test('T11328', just_ghci, ghci_script, ['T11328.script']) test('T11825', just_ghci, ghci_script, ['T11825.script']) test('T12128', just_ghci, ghci_script, ['T12128.script']) +test('T12456', just_ghci, ghci_script, ['T12456.script']) From git at git.haskell.org Thu Oct 13 02:24:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 02:24:22 +0000 (UTC) Subject: [commit: ghc] master: Add missing @since annotations (57f7a37) Message-ID: <20161013022422.64EFA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/57f7a37d90d77df1de804cd9ddd3d87da094faf4/ghc >--------------------------------------------------------------- commit 57f7a37d90d77df1de804cd9ddd3d87da094faf4 Author: Ryan Scott Date: Wed Oct 12 22:22:43 2016 -0400 Add missing @since annotations >--------------------------------------------------------------- 57f7a37d90d77df1de804cd9ddd3d87da094faf4 libraries/base/Data/Semigroup.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index 63d4285..88942ad 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -483,9 +483,11 @@ instance Ord a => Ord (Arg a b) where instance Bifunctor Arg where bimap f g (Arg a b) = Arg (f a) (g b) +-- | @since 4.10.0.0 instance Bifoldable Arg where bifoldMap f g (Arg a b) = f a `mappend` g b +-- | @since 4.10.0.0 instance Bitraversable Arg where bitraverse f g (Arg a b) = Arg <$> f a <*> g b From git at git.haskell.org Thu Oct 13 11:47:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 11:47:34 +0000 (UTC) Subject: [commit: ghc] master: Further improve error handling in TcRn monad (2fdf21b) Message-ID: <20161013114734.5A3833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2fdf21bf26386ac5558ed5b95105bcf78e31f093/ghc >--------------------------------------------------------------- commit 2fdf21bf26386ac5558ed5b95105bcf78e31f093 Author: Simon Peyton Jones Date: Thu Oct 13 12:24:53 2016 +0100 Further improve error handling in TcRn monad This patch builds on the one for Trac #12124, by dealing properly with out-of-scope "hole" errors. This fixes Trac #12529. The hard error coming from visible type application is still there, but the out-of-scope error is no longer suppressed. (Arguably the VTA message should be suppressed somehow, but that's a battle for another day.) >--------------------------------------------------------------- 2fdf21bf26386ac5558ed5b95105bcf78e31f093 compiler/typecheck/TcRnMonad.hs | 65 ++++++++++++++-------- compiler/typecheck/TcRnTypes.hs | 5 +- .../T11456.hs => typecheck/should_fail/T12529.hs} | 4 +- .../tests/typecheck/should_fail/T12529.stderr | 8 +++ testsuite/tests/typecheck/should_fail/all.T | 2 + 5 files changed, 58 insertions(+), 26 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 2fdf21bf26386ac5558ed5b95105bcf78e31f093 From git at git.haskell.org Thu Oct 13 15:16:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 15:16:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: RnExpr: Actually fail if patterns found in expression (47ae01b) Message-ID: <20161013151613.4A93A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/47ae01bfb7ca426188d85c6ecb33ebbacc837aa6/ghc >--------------------------------------------------------------- commit 47ae01bfb7ca426188d85c6ecb33ebbacc837aa6 Author: Ben Gamari Date: Tue Oct 11 09:26:46 2016 -0400 RnExpr: Actually fail if patterns found in expression This fixes #12584, where wildcard patterns were snuck into an expression, which then crashed the typechecker in TcExpr since EWildPats aren't supposed to appear in the AST after renaming. The problem was that `rnTopSpliceDecl` failed to check for errors from `rnSplice` (as done by other callers to `rnSplice`). Thanks to Shayan for reporting this! Reviewers: simonpj, austin Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2539 GHC Trac Issues: #12584 (cherry picked from commit bce99086e9f54909f51ff5a74cb8c666083bb021) >--------------------------------------------------------------- 47ae01bfb7ca426188d85c6ecb33ebbacc837aa6 compiler/rename/RnSplice.hs | 5 ++++- testsuite/tests/rename/should_fail/all.T | 1 + testsuite/tests/rename/should_fail/rnfail016.hs | 2 -- testsuite/tests/rename/should_fail/rnfail016.stderr | 2 -- testsuite/tests/rename/should_fail/{rnfail016.hs => rnfail016a.hs} | 5 +---- testsuite/tests/rename/should_fail/rnfail016a.stderr | 2 ++ 6 files changed, 8 insertions(+), 9 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 0dc4487..c66886f 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -593,8 +593,11 @@ rnSpliceDecl (SpliceDecl (L loc splice) flg) rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars) -- Declaration splice at the very top level of the module rnTopSpliceDecls splice - = do { (rn_splice, fvs) <- setStage (Splice Untyped) $ + = do { (rn_splice, fvs) <- checkNoErrs $ + setStage (Splice Untyped) $ rnSplice splice + -- As always, be sure to checkNoErrs above lest we end up with + -- holes making it to typechecking, hence #12584. ; traceRn (text "rnTopSpliceDecls: untyped declaration splice") ; (decls, mod_finalizers) <- runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index e9ea297..fc04e5c 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -13,6 +13,7 @@ test('rnfail013', normal, compile_fail, ['']) test('rnfail015', normal, compile_fail, ['']) test('rnfail016', normal, compile_fail, ['']) +test('rnfail016a', normal, compile_fail, ['']) test('rnfail017', normal, compile_fail, ['']) test('rnfail018', normal, compile_fail, ['']) test('rnfail019', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail016.hs b/testsuite/tests/rename/should_fail/rnfail016.hs index 1bf15b0..7dccaa9 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.hs +++ b/testsuite/tests/rename/should_fail/rnfail016.hs @@ -4,6 +4,4 @@ module ShouldFail where -- !!! Pattern syntax in expressions f x = x @ x -g x = ~ x -h x = _ diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr b/testsuite/tests/rename/should_fail/rnfail016.stderr index 4013255..4743613 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.stderr +++ b/testsuite/tests/rename/should_fail/rnfail016.stderr @@ -2,5 +2,3 @@ rnfail016.hs:6:7: error: Pattern syntax in expression context: x at x Did you mean to enable TypeApplications? - -rnfail016.hs:7:7: error: Pattern syntax in expression context: ~x diff --git a/testsuite/tests/rename/should_fail/rnfail016.hs b/testsuite/tests/rename/should_fail/rnfail016a.hs similarity index 77% copy from testsuite/tests/rename/should_fail/rnfail016.hs copy to testsuite/tests/rename/should_fail/rnfail016a.hs index 1bf15b0..e0d7d65 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.hs +++ b/testsuite/tests/rename/should_fail/rnfail016a.hs @@ -3,7 +3,4 @@ module ShouldFail where -- !!! Pattern syntax in expressions -f x = x @ x -g x = ~ x -h x = _ - +f x = ~ x diff --git a/testsuite/tests/rename/should_fail/rnfail016a.stderr b/testsuite/tests/rename/should_fail/rnfail016a.stderr new file mode 100644 index 0000000..3a59ee7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail016a.stderr @@ -0,0 +1,2 @@ + +rnfail016a.hs:6:7: error: Pattern syntax in expression context: ~x From git at git.haskell.org Thu Oct 13 15:16:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 15:16:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add derived shadows only for Wanted constraints (fefc530) Message-ID: <20161013151616.0182F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/fefc53011e6d961c4dd8d61386bbdd36fc83f6d0/ghc >--------------------------------------------------------------- commit fefc53011e6d961c4dd8d61386bbdd36fc83f6d0 Author: Simon Peyton Jones Date: Wed Oct 12 12:02:04 2016 +0100 Add derived shadows only for Wanted constraints This patch implements choice (3) of comment:14 on Trac #12660. It cures an infinite loop (caused by the creation of an infinite type) in in compiling the 'singletons' package. See Note [Add derived shadows only for Wanteds] in TcSMonad. (cherry picked from commit 8fa5f5b197542b6e7e9e570991a1488204e606c9) >--------------------------------------------------------------- fefc53011e6d961c4dd8d61386bbdd36fc83f6d0 compiler/typecheck/TcSMonad.hs | 60 +++++++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 19 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index a7492b4..5607641 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -387,7 +387,7 @@ dictionary to the inert_solved_dicts. In general, we use it to avoid creating a new EvVar when we have a new goal that we have solved in the past. -But in particular, we can use it to create *recursive* dicationaries. +But in particular, we can use it to create *recursive* dictionaries. The simplest, degnerate case is instance C [a] => C [a] where ... If we have @@ -658,11 +658,12 @@ Note [inert_model: the inert model] decomposing injective arguments of type functions, and suchlike. - - A Derived "shadow copy" for every Given or Wanted (a ~N ty) in - inert_eqs. + - A Derived "shadow copy" for every Wanted (a ~N ty) in + inert_eqs. (Originally included every Given too; but + see Note [Add derived shadows only for Wanteds]) * The model is not subject to "kicking-out". Reason: we make a Derived - shadow copy of any Given/Wanted (a ~ ty), and that Derived copy will + shadow copy of any Wanted (a ~ ty), and that Derived copy will be fully rewritten by the model before it is added * The principal reason for maintaining the model is to generate @@ -1116,26 +1117,22 @@ Note [Adding an inert canonical constraint the InertCans] NB: 'a' cannot be in fv(ty), because the constraint is canonical. 2. (DShadow) Do emitDerivedShadows - For every inert G/W constraint c, st + For every inert [W] constraint c, st (a) (a~ty) can rewrite c (see Note [Emitting shadow constraints]), and (b) the model cannot rewrite c kick out a Derived *copy*, leaving the original unchanged. Reason for (b) if the model can rewrite c, then we have already generated a shadow copy + See Note [Add derived shadows only for Wanteds] [Given/Wanted Nominal] [G/W] a ~N ty: 1. Add it to inert_eqs - 2. Emit [D] a~ty - Step (2) is needed to allow the current model to fully - rewrite [D] a~ty before adding it using the [Derived Nominal] - steps above. - - We must do this even for Givens, because - work-item [G] a ~ [b], model has [D] b ~ a. - We need a shadow [D] a ~ [b] in the work-list - When we process it, we'll rewrite to a ~ [a] and get an occurs check - + 2. For [W], Emit [D] a~ty + Step (2) is needed to allow the current model to fully + rewrite [D] a~ty before adding it using the [Derived Nominal] + steps above. + See Note [Add derived shadows only for Wanteds] * Unifying a:=ty, is like adding [G] a~ty, but we can't make a [D] a~ty, as in step (1) of the [G/W] case above. So instead, do @@ -1255,7 +1252,7 @@ emitDerivedShadows IC { inert_eqs = tv_eqs | otherwise = cts want_shadow ct - = not (isDerivedCt ct) -- No need for a shadow of a Derived! + = isWantedCt ct -- See Note [Add shadows only for Wanteds] && (new_tv `elemVarSet` rw_tvs) -- New tv can rewrite ct, yielding a -- different ct && not (modelCanRewrite model rw_tvs)-- We have not already created a @@ -1277,7 +1274,31 @@ mkShadowCt ct derived_ev = CtDerived { ctev_pred = ctEvPred ev , ctev_loc = ctEvLoc ev } -{- Note [Keep CDictCan shadows as CDictCan] +{- Note [Add derived shadows only for Wanteds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We now only add shadows for Wanted constraints. Why add derived +shadows for Givens? After all, Givens can rewrite Deriveds. But +Deriveds can't rewrite Givens. So in principle, if we created a +Derived shadow of a Given, it could be rewritten by other Deriveds, +and that could, conceivably, lead to a useful unification. + +But (a) I have been unable to come up with an example of this +happening and (b) see Trac #12660 for how adding the derived shadows +of a Given led to an infinite loop. For (b) there may be other +ways to solve the loop, but simply reraining from adding +derived shadows of Givens is particularly simple. And it's more +efficient too! + +Still, here's one possible reason for adding derived shadows +for Givens. Consider + work-item [G] a ~ [b], model has [D] b ~ a. +If we added the derived shadow (into the work list) + [D] a ~ [b] +When we process it, we'll rewrite to a ~ [a] and get an +occurs check. Without it we'll miss the occurs check (reporting +inaccessible code); but that's probably OK. + +Note [Keep CDictCan shadows as CDictCan] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have class C a => D a b @@ -1327,7 +1348,8 @@ addInertCan ct -- Emit shadow derived if necessary -- See Note [Emitting shadow constraints] ; let rw_tvs = rewritableTyCoVars ct - ; when (not (isDerivedCt ct) && modelCanRewrite (inert_model ics) rw_tvs) + ; when (isWantedCt ct && modelCanRewrite (inert_model ics) rw_tvs) + -- See Note [Add shadows only for Wanteds] (emitWork [mkShadowCt ct]) ; traceTcS "addInertCan }" $ empty } @@ -2549,7 +2571,7 @@ nestTcS :: TcS a -> TcS a -- Use the current untouchables, augmenting the current -- evidence bindings, and solved dictionaries -- But have no effect on the InertCans, or on the inert_flat_cache --- (the latter because the thing inside a nestTcS does unflattening) +-- (we want to inherit the latter from processing the Givens) nestTcS (TcS thing_inside) = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var }) -> do { inerts <- TcM.readTcRef inerts_var From git at git.haskell.org Thu Oct 13 15:16:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 15:16:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Some tiding up in TcGenDeriv (cec5066) Message-ID: <20161013151618.ABF943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/cec5066594842f046ae7ded99ebbc31f4cdb86b0/ghc >--------------------------------------------------------------- commit cec5066594842f046ae7ded99ebbc31f4cdb86b0 Author: Simon Peyton Jones Date: Mon Feb 8 15:29:12 2016 +0000 Some tiding up in TcGenDeriv ..around newtype deriving instances. See esp the new Note [Newtype-deriving instances] No change in behaviour (cherry picked from commit 96d451450923a80b043b5314c5eaaa9d0eab7c56) >--------------------------------------------------------------- cec5066594842f046ae7ded99ebbc31f4cdb86b0 compiler/typecheck/TcGenDeriv.hs | 103 ++++++++++++++++++++++++++------------- compiler/typecheck/TcType.hs | 20 ++++++++ 2 files changed, 90 insertions(+), 33 deletions(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 8c6bc81..139fdae 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -2137,65 +2137,102 @@ mk_appE_app a b = nlHsApps appE_RDR [a, b] * * ************************************************************************ +Note [Newtype-deriving instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We take every method in the original instance and `coerce` it to fit into the derived instance. We need a type annotation on the argument to `coerce` to make it obvious what instantiation of the method we're -coercing from. +coercing from. So from, say, + class C a b where + op :: a -> [b] -> Int + + newtype T x = MkT + + instance C a => C a (T x) where + op = (coerce + (op :: a -> [] -> Int) + ) :: a -> [T x] -> Int + +Notice that we give the 'coerce' call two type signatures: one to +fix the of the inner call, and one for the expected type. The outer +type signature ought to be redundant, but may improve error messages. +The inner one is essential to fix the type at which 'op' is called. See #8503 for more discussion. + +Here's a wrinkle. Supppose 'op' is locally overloaded: + + class C2 b where + op2 :: forall a. Eq a => a -> [b] -> Int + +Then we could do exactly as above, but it's a bit redundant to +instantiate op, then re-generalise with the inner signature. +(The inner sig is only there to fix the type at which 'op' is +called.) So we just instantiate the signature, and add + + instance C2 => C2 (T x) where + op2 = (coerce + (op2 :: a -> [] -> Int) + ) :: forall a. Eq a => a -> [T x] -> Int -} +gen_Newtype_binds :: SrcSpan + -> Class -- the class being derived + -> [TyVar] -- the tvs in the instance head + -> [Type] -- instance head parameters (incl. newtype) + -> Type -- the representation type (already eta-reduced) + -> LHsBinds RdrName +-- See Note [Newtype-deriving instances] +gen_Newtype_binds loc cls inst_tvs cls_tys rhs_ty + = listToBag $ map mk_bind (classMethods cls) + where + coerce_RDR = getRdrName coerceId + + mk_bind :: Id -> LHsBind RdrName + mk_bind meth_id + = mkRdrFunBind (L loc meth_RDR) [mkSimpleMatch [] rhs_expr] + where + Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty meth_id + + -- See "wrinkle" in Note [Newtype-deriving instances] + (_, _, from_ty') = tcSplitSigmaTy from_ty + + meth_RDR = getRdrName meth_id + + rhs_expr = ( nlHsVar coerce_RDR + `nlHsApp` + (nlHsVar meth_RDR `nlExprWithTySig` toLHsSigWcType from_ty')) + `nlExprWithTySig` toLHsSigWcType to_ty + + + nlExprWithTySig :: LHsExpr RdrName -> LHsSigWcType RdrName -> LHsExpr RdrName + nlExprWithTySig e s = noLoc (ExprWithTySig e s) + mkCoerceClassMethEqn :: Class -- the class being derived -> [TyVar] -- the tvs in the instance head -> [Type] -- instance head parameters (incl. newtype) -> Type -- the representation type (already eta-reduced) -> Id -- the method to look at -> Pair Type +-- See Note [Newtype-deriving instances] +-- The pair is the (from_type, to_type), where to_type is +-- the type of the method we are tyrying to get mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty id - = Pair (substTy rhs_subst user_meth_ty) (substTy lhs_subst user_meth_ty) + = Pair (substTy rhs_subst user_meth_ty) + (substTy lhs_subst user_meth_ty) where cls_tvs = classTyVars cls in_scope = mkInScopeSet $ mkVarSet inst_tvs lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs cls_tys) rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast cls_tys rhs_ty)) (_class_tvs, _class_constraint, user_meth_ty) - = tcSplitSigmaTy (varType id) + = tcSplitMethodTy (varType id) changeLast :: [a] -> a -> [a] changeLast [] _ = panic "changeLast" changeLast [_] x = [x] changeLast (x:xs) x' = x : changeLast xs x' - -gen_Newtype_binds :: SrcSpan - -> Class -- the class being derived - -> [TyVar] -- the tvs in the instance head - -> [Type] -- instance head parameters (incl. newtype) - -> Type -- the representation type (already eta-reduced) - -> LHsBinds RdrName -gen_Newtype_binds loc cls inst_tvs cls_tys rhs_ty - = listToBag $ zipWith mk_bind - (classMethods cls) - (map (mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty) (classMethods cls)) - where - coerce_RDR = getRdrName coerceId - mk_bind :: Id -> Pair Type -> LHsBind RdrName - mk_bind id (Pair tau_ty user_ty) - = mkRdrFunBind (L loc meth_RDR) [mkSimpleMatch [] rhs_expr] - where - meth_RDR = getRdrName id - rhs_expr - = ( nlHsVar coerce_RDR - `nlHsApp` - (nlHsVar meth_RDR `nlExprWithTySig` toLHsSigWcType tau_ty')) - `nlExprWithTySig` toLHsSigWcType user_ty - -- Open the representation type here, so that it's forall'ed type - -- variables refer to the ones bound in the user_ty - (_, _, tau_ty') = tcSplitSigmaTy tau_ty - -nlExprWithTySig :: LHsExpr RdrName -> LHsSigWcType RdrName -> LHsExpr RdrName -nlExprWithTySig e s = noLoc (ExprWithTySig e s) - {- ************************************************************************ * * diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index d26dc5f..e5037d1 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -23,6 +23,7 @@ module TcType ( TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType, TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet, TcKind, TcCoVar, TcTyCoVar, TcTyBinder, TcTyCon, + tcSplitMethodTy, ExpType(..), ExpSigmaType, ExpRhoType, mkCheckExpType, @@ -1397,6 +1398,25 @@ tcSplitDFunTy ty tcSplitDFunHead :: Type -> (Class, [Type]) tcSplitDFunHead = getClassPredTys +tcSplitMethodTy :: Type -> ([TyVar], PredType, Type) +-- A class method (selector) always has a type like +-- forall as. C as => blah +-- So if the class looks like +-- class C a where +-- op :: forall b. (Eq a, Ix b) => a -> b +-- the class method type looks like +-- op :: forall a. C a => forall b. (Eq a, Ix b) => a -> b +-- +-- tcSplitMethodTy just peels off the outer forall and +-- that first predicate +tcSplitMethodTy ty + | (sel_tyvars,sel_rho) <- tcSplitForAllTys ty + , Just (first_pred, local_meth_ty) <- tcSplitPredFunTy_maybe sel_rho + = (sel_tyvars, first_pred, local_meth_ty) + | otherwise + = pprPanic "tcSplitMethodTy" (ppr ty) + +----------------------- tcEqKind :: TcKind -> TcKind -> Bool tcEqKind = tcEqType From git at git.haskell.org Thu Oct 13 15:16:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 15:16:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: validate: Add --build-only (5230fa0) Message-ID: <20161013151621.5C51E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5230fa047cf21da1ecd9f5ece337294ec8d0ec62/ghc >--------------------------------------------------------------- commit 5230fa047cf21da1ecd9f5ece337294ec8d0ec62 Author: Ben Gamari Date: Sat Oct 1 20:11:03 2016 -0400 validate: Add --build-only This will allow us to split up Harbormaster output for the build and test stages of validation. Test Plan: `./validate --build-only && ./validate --testsuite-only` Reviewers: thomie, hvr, austin Differential Revision: https://phabricator.haskell.org/D2553 (cherry picked from commit 4d2b15d5895ea10a64194bffe8c321e447e39683) >--------------------------------------------------------------- 5230fa047cf21da1ecd9f5ece337294ec8d0ec62 validate | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/validate b/validate index c386523..6767773 100755 --- a/validate +++ b/validate @@ -14,6 +14,7 @@ Flags: --no-clean don't make clean first, just carry on from a previous interrupted validation run --testsuite-only don't build the compiler, just run the test suite + --build-only don't test the compiler, just build it --hpc build stage2 with -fhpc, and see how much of the compiler the test suite covers. 2008-07-01: 63% slower than the default. @@ -46,6 +47,7 @@ EOF no_clean=0 testsuite_only=0 +build_only=0 hpc=NO speed=NORMAL use_dph=0 @@ -64,6 +66,9 @@ do --testsuite-only) testsuite_only=1 ;; + --build-only) + build_only=1 + ;; --hpc) hpc=YES ;; @@ -240,6 +245,16 @@ fi # testsuite-only # ----------------------------------------------------------------------------- # Run the testsuite +if [ "$build_only" -eq 1 ]; then + cat < Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c93ad554c9f9788b3e2ec45fa4d0131101721536/ghc >--------------------------------------------------------------- commit c93ad554c9f9788b3e2ec45fa4d0131101721536 Author: Simon Peyton Jones Date: Sun Sep 25 15:50:18 2016 +0100 Fix impredicativity (again) This patch fixes Trac #12616. Dignosis. In TcUnify.tc_sub_type_ds we were going to some trouble to support co- and contra-variance even for impredicative types. With -XImpredicativeTYpes, this allowed a unification variable to be unified with a polytype (probably wrongly) and that caused later trouble in the constraint solver, where -XImpredicativeTypes was /not/ on. In effect, -XImpredicativeTypes can't be switched on locally. Why did we want ImpredicativeTypes locally? Because the program generated by GND for a higher-rank method involved impredicative instantation of 'coerce': op = coerce op -- where op has a higher rank type See Note [Newtype-deriving instances] in TcGenDeriv. Cure. 1. It is ghastly to rely on ImpredicativeTypes (a 100% flaky feature) to instantiate coerce polymorphically. Happily we now have Visible Type Application, so I've used that instead which should be solid and reliable. 2. I deleted the code in tc_sub_type_ds that allows the constraint solver to "look through" a unification variable to find a polytype. That used to be essential in the days of ReturnTv, but it's utterly unreliable and should be consigned to the dustbin of history. (We have ExpType now for the essential uses.) Tests involving ImpredicativeTypes are affected, but I'm not worried about them... it's advertised as a feature you can't rely on, and I want to reform it outright. (cherry picked from commit b612da667fe8fa5277fc78e972a86d4b35f98364) >--------------------------------------------------------------- c93ad554c9f9788b3e2ec45fa4d0131101721536 compiler/hsSyn/HsUtils.hs | 8 +-- compiler/typecheck/TcDeriv.hs | 2 + compiler/typecheck/TcGenDeriv.hs | 28 ++++---- compiler/typecheck/TcUnify.hs | 30 +++------ testsuite/tests/boxy/Base1.hs | 3 + testsuite/tests/boxy/Base1.stderr | 18 +++++ testsuite/tests/boxy/T2193.hs | 2 + testsuite/tests/boxy/all.T | 4 +- testsuite/tests/deriving/should_compile/T12616.hs | 21 ++++++ testsuite/tests/deriving/should_compile/all.T | 1 + testsuite/tests/deriving/should_fail/T4846.stderr | 4 +- testsuite/tests/typecheck/should_compile/T12644.hs | 14 ++++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_compile/tc211.hs | 3 + .../tests/typecheck/should_compile/tc211.stderr | 78 ++++++++++++++++++++-- .../tests/typecheck/should_fail/T10619.stderr | 18 ++--- .../tests/typecheck/should_fail/T2846b.stderr | 3 +- testsuite/tests/typecheck/should_fail/T8428.stderr | 5 +- testsuite/tests/typecheck/should_fail/all.T | 2 +- .../tests/typecheck/should_fail/tcfail016.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail165.hs | 4 +- .../tests/typecheck/should_fail/tcfail165.stderr | 12 ++++ testsuite/tests/typecheck/should_fail/tcfail174.hs | 2 + .../tests/typecheck/should_fail/tcfail174.stderr | 19 ++++-- testsuite/tests/typecheck/should_run/all.T | 2 +- .../tests/typecheck/should_run/tcrun042.stderr | 6 ++ 26 files changed, 218 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 c93ad554c9f9788b3e2ec45fa4d0131101721536 From git at git.haskell.org Thu Oct 13 15:16:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 15:16:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix an assertion that could randomly fail (b7d6e20) Message-ID: <20161013151627.BDAFD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b7d6e20ce342c4a2b46089dfe64498d28337afd9/ghc >--------------------------------------------------------------- commit b7d6e20ce342c4a2b46089dfe64498d28337afd9 Author: Simon Marlow Date: Thu Aug 4 15:57:37 2016 +0100 Fix an assertion that could randomly fail Summary: ASSERT_THREADED_CAPABILITY_INVARIANTS was testing properties of the returning_tasks queue, but that requires cap->lock to access safely. This assertion would randomly fail if stressed enough. Instead I've removed it from the catch-all ASSERT_PARTIAL_CAPABILITIY_INVARIANTS and made it a separate assertion only called under cap->lock. Test Plan: ``` cd testsuite/tests/concurrent/should_run make TEST=setnumcapabilities001 WAY=threaded1 EXTRA_HC_OPTS=-with-rtsopts=-DS CLEANUP=0 while true; do ./setnumcapabilities001.run/setnumcapabilities001 4 9 2000 || break; done ``` Reviewers: niteria, bgamari, ezyang, austin, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2440 GHC Trac Issues: #10860 (cherry picked from commit ce13a9a9f57d61170837532948fed8bc1924a7ab) >--------------------------------------------------------------- b7d6e20ce342c4a2b46089dfe64498d28337afd9 rts/Capability.c | 3 +++ rts/Capability.h | 7 ++++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/rts/Capability.c b/rts/Capability.c index f81816f..80164b3 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -206,6 +206,7 @@ newReturningTask (Capability *cap, Task *task) } cap->returning_tasks_tl = task; cap->n_returning_tasks++; + ASSERT_RETURNING_TASKS(cap,task); } STATIC_INLINE Task * @@ -221,6 +222,7 @@ popReturningTask (Capability *cap) } task->next = NULL; cap->n_returning_tasks--; + ASSERT_RETURNING_TASKS(cap,task); return task; } #endif @@ -470,6 +472,7 @@ releaseCapability_ (Capability* cap, task = cap->running_task; ASSERT_PARTIAL_CAPABILITY_INVARIANTS(cap,task); + ASSERT_RETURNING_TASKS(cap,task); cap->running_task = NULL; diff --git a/rts/Capability.h b/rts/Capability.h index daf3609..d23d270 100644 --- a/rts/Capability.h +++ b/rts/Capability.h @@ -166,13 +166,15 @@ struct Capability_ { ASSERT(task->cap == cap); \ ASSERT_PARTIAL_CAPABILITY_INVARIANTS(cap,task) +// This assert requires cap->lock to be held, so it can't be part of +// ASSERT_PARTIAL_CAPABILITY_INVARIANTS() #if defined(THREADED_RTS) -#define ASSERT_THREADED_CAPABILITY_INVARIANTS(cap,task) \ +#define ASSERT_RETURNING_TASKS(cap,task) \ ASSERT(cap->returning_tasks_hd == NULL ? \ cap->returning_tasks_tl == NULL && cap->n_returning_tasks == 0 \ : 1); #else -#define ASSERT_THREADED_CAPABILITY_INVARIANTS(cap,task) /* nothing */ +#define ASSERT_RETURNING_TASKS(cap,task) /* nothing */ #endif // Sometimes a Task holds a Capability, but the Task is not associated @@ -185,7 +187,6 @@ struct Capability_ { cap->run_queue_tl == END_TSO_QUEUE && cap->n_run_queue == 0 \ : 1); \ ASSERT(cap->suspended_ccalls == NULL ? cap->n_suspended_ccalls == 0 : 1); \ - ASSERT_THREADED_CAPABILITY_INVARIANTS(cap,task); \ ASSERT(myTask() == task); \ ASSERT_TASK_ID(task); From git at git.haskell.org Thu Oct 13 15:16:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 15:16:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: testsuite: Bump T1969 expected bytes allocated (59741e4) Message-ID: <20161013151630.6CF613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/59741e4ffe7804a85b5724b3d3088a083207e404/ghc >--------------------------------------------------------------- commit 59741e4ffe7804a85b5724b3d3088a083207e404 Author: Ben Gamari Date: Wed Oct 12 14:03:10 2016 -0400 testsuite: Bump T1969 expected bytes allocated >--------------------------------------------------------------- 59741e4ffe7804a85b5724b3d3088a083207e404 testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 87d1e4a..a33291f 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -91,7 +91,7 @@ test('T1969', # 2014-06-29 303300692 (x86/Linux) # 2015-07-11 288699104 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 344730660 (x86/Linux, 64-bit machine) - (wordsize(64), 695430728, 5)]), + (wordsize(64), 770088104, 5)]), # 17/11/2009 434845560 (amd64/Linux) # 08/12/2009 459776680 (amd64/Linux) # 17/05/2010 519377728 (amd64/Linux) @@ -111,6 +111,7 @@ test('T1969', # 10/09/2014 630299456 (x86_64/Linux) post-AMP-cleanup # 03/06/2015 581460896 (x86_64/Linux) use +RTS -G1 # 28/10/2015 695430728 (x86_64/Linux) emit Typeable at definition site + # 12/10/2016 770088104 (x86_64/Linux) Likely creep only_ways(['normal']), extra_hc_opts('-dcore-lint -static'), From git at git.haskell.org Thu Oct 13 15:16:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 15:16:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add test for #12456 (243994c) Message-ID: <20161013151633.85C503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/243994c30e70bc8987a5bf8ceaf780ac01c8eb5e/ghc >--------------------------------------------------------------- commit 243994c30e70bc8987a5bf8ceaf780ac01c8eb5e Author: Ryan Scott Date: Wed Oct 12 21:06:48 2016 -0400 Add test for #12456 Commit f352e5cd7bb629fe0ca3b913bfbe7bee43d62f3a fixed #12456. Let's add a test to make sure it stays fixed. (cherry picked from commit fef1df4bb4f4b74f4a0d0d22c913d29189e140e4) >--------------------------------------------------------------- 243994c30e70bc8987a5bf8ceaf780ac01c8eb5e testsuite/tests/ghci/should_run/T12456.script | 3 +++ testsuite/tests/ghci/should_run/all.T | 1 + 2 files changed, 4 insertions(+) diff --git a/testsuite/tests/ghci/should_run/T12456.script b/testsuite/tests/ghci/should_run/T12456.script new file mode 100644 index 0000000..4c0ed53 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T12456.script @@ -0,0 +1,3 @@ +:set -XPatternSynonyms -XViewPatterns +:m + Language.Haskell.TH +pattern A :: ExpQ; pattern A <- (undefined -> ()) where A = undefined diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index f7e5018..b6aa2e9 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -25,3 +25,4 @@ test('T7253', just_ghci, ghci_script, ['T7253.script']) test('T11328', just_ghci, ghci_script, ['T11328.script']) test('T11825', just_ghci, ghci_script, ['T11825.script']) test('T12128', just_ghci, ghci_script, ['T12128.script']) +test('T12456', just_ghci, ghci_script, ['T12456.script']) From git at git.haskell.org Thu Oct 13 16:34:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 16:34:04 +0000 (UTC) Subject: [commit: ghc] master: Cabal submodule update. (015e9e3) Message-ID: <20161013163404.2CF273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/015e9e3d97b6826262c25a6e0504e42d49454bef/ghc >--------------------------------------------------------------- commit 015e9e3d97b6826262c25a6e0504e42d49454bef Author: Edward Z. Yang Date: Thu Oct 13 00:52:20 2016 -0700 Cabal submodule update. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 015e9e3d97b6826262c25a6e0504e42d49454bef libraries/Cabal | 2 +- testsuite/tests/backpack/cabal/bkpcabal01/bkpcabal01.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 36dbbf7..3ece101 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 36dbbf724aba6e23981f5195550965fd679f1b6b +Subproject commit 3ece1013df8ba4c9719d2183afd2b03c4bddf851 diff --git a/testsuite/tests/backpack/cabal/bkpcabal01/bkpcabal01.cabal b/testsuite/tests/backpack/cabal/bkpcabal01/bkpcabal01.cabal index 1ffc575..c46675f 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal01/bkpcabal01.cabal +++ b/testsuite/tests/backpack/cabal/bkpcabal01/bkpcabal01.cabal @@ -24,7 +24,7 @@ library q signatures: I hs-source-dirs: q build-depends: p, impl, base - backpack-includes: impl (H) + mixins: impl (H) default-language: Haskell2010 executable exe From git at git.haskell.org Thu Oct 13 19:24:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 19:24:38 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Introduce ConApp to Core (2670589) Message-ID: <20161013192438.2DCC63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/2670589f2ff53bc04a7396489166a1f82445d2ec/ghc >--------------------------------------------------------------- commit 2670589f2ff53bc04a7396489166a1f82445d2ec Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core This is an all-commits-squashed commit, for the sake of testing this branch on perf.haskell.org without testing the intermediate commits. + This is a combination of 58 commits. + The first commit's message is: Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? + This is the 2nd commit message: Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. + This is the 3rd commit message: ConApp bytecode: Add more ASSERT + This is the 4th commit message: ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. + This is the 5th commit message: ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. + This is the 6th commit message: mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). + This is the 7th commit message: DataCon wrapper: Use ConApp in the body + This is the 8th commit message: mkCoreConApps: Warn about unsaturated use + This is the 9th commit message: Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. + This is the 10th commit message: Use ConApp in tagToEnumRule + This is the 11th commit message: knownCon: Use ConApp in unfolding of scrutinee + This is the 12th commit message: Get rid of unitDataConId (use ConApp instead) + This is the 13th commit message: Always build a wrapper for data types + This is the 14th commit message: Always use ConApp in CoreSyn + This is the 15th commit message: Reserve a unique for the wrapper of a wired in DataCon + This is the 16th commit message: CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. + This is the 17th commit message: Desugar: Use Coercible worker, not wrapper + This is the 18th commit message: Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) + This is the 19th commit message: Deserialize interface tuples to ConApp + This is the 20th commit message: Handle ConApp in "Eliminate Identity Case" + This is the 21st commit message: Use dataConWrapId in unsaturated uses of mkCoreConApps + This is the 22nd commit message: ConApp: More Linting + This is the 23rd commit message: mkSimpleDataConRep: No wrapper for newtypes + This is the 24th commit message: mkCoreConApps: Do not use ConApp for newtypes + This is the 25th commit message: New Lint Check: No data con workers any more, please + This is the 26th commit message: Use ConApp when creating True resp. False + This is the 27th commit message: Include constructor in freeNamesIfExpr + This is the 28th commit message: isTrueLHsExpr: Match on data con wrapper now + This is the 29th commit message: Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. + This is the 30th commit message: maybe_substitute: Detect ConApp + This is the 31st commit message: Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. + This is the 32nd commit message: Do not lint the bodz of the data con worker bindings introduced by CorePrep + This is the 33rd commit message: coreToStgExpr: add con worker to free variables reported + This is the 34th commit message: Handle ConApp in inlineBoringOk + This is the 35th commit message: cpe_ExprIsTrivial: Nullary Constructors are trivial + This is the 36th commit message: Handle nullary Cons in myCollectArgs + This is the 37th commit message: Handle nullary constructors in the byte code generator. + This is the 38th commit message: getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons + This is the 39th commit message: Avoid invalid haddock synatx + This is the 40th commit message: No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. + This is the 41st commit message: Update some test output + This is the 42nd commit message: SetLevels: Do not float nullary data constructors + This is the 43rd commit message: Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. + This is the 44th commit message: Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. + This is the 45th commit message: Nullary data constructors are trivial + This is the 46th commit message: sptModuleInitCode: Look for ConApp + This is the 47th commit message: Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. + This is the 48th commit message: Fix instance Eq (DeBruijn CoreExpr) for ConApp + This is the 49th commit message: Adjust exprIsCheap + This is the 50th commit message: SpecConstr.isValue: Handle ConApp now all tests pass (here) + This is the 51st commit message: Add test case for #12689 which test a few variants of rules involving constructors, including nullary constructors, constructors with wrappers, and unsaturated of constructors. At the moment, all the rules work as expected, despite GHC’s compile time warnings when called with -Wall. + This is the 52nd commit message: Add a broken test case for #12689 A rule with a phase specification trying to match on a constructor with a wrapper will fail to match, as the wrapper will be inlined by then. The fact that it works in the other case is also mostly by accident. (Split into two test cases so that regressions with regard what works so far are caught.) + This is the 53rd commit message: Make data con wrappers ConLike (and see what happens) + This is the 54th commit message: Revert "Make data con wrappers ConLike (and see what happens)" This reverts commit ad72aa0e46d1e58eac3e6ff3c17af080b01e6ff3. + This is the 55th commit message: Use mkSimpleDataConRep in mkDataConRep if nothing fancy goes on as a step towards treating them diffently in the inliner. + This is the 56th commit message: Extend test for #12689 with rule matching late on normal data con + This is the 57th commit message: Make simple DataCon wrappers complusary unfoldings and make sure they are unfolded in simple_opt_expr, even when they are nullary. For that, start paying attention to the arity field in the unfolding guidance. (This design can be revised later.) + This is the 58th commit message: Try to apply rules that match a data con this is slightly annoying, all the rule matching code so far assumes that rules can only apply to function applications, which is just no longer true. >--------------------------------------------------------------- 2670589f2ff53bc04a7396489166a1f82445d2ec compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/Demand.hs | 17 ++- compiler/basicTypes/MkId.hs | 137 ++++++++++++++------- compiler/basicTypes/MkId.hs-boot | 4 +- compiler/basicTypes/Unique.hs | 22 ++-- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++ compiler/coreSyn/CoreLint.hs | 42 +++++++ compiler/coreSyn/CorePrep.hs | 24 ++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 52 +++++--- compiler/coreSyn/CoreSyn.hs | 31 ++++- compiler/coreSyn/CoreTidy.hs | 15 +-- compiler/coreSyn/CoreUnfold.hs | 20 ++- compiler/coreSyn/CoreUtils.hs | 65 ++++++---- compiler/coreSyn/MkCore.hs | 39 +++++- compiler/coreSyn/PprCore.hs | 10 ++ compiler/coreSyn/TrieMap.hs | 80 +++++++----- compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsBinds.hs | 10 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/ByteCodeGen.hs | 42 ++++++- compiler/iface/IfaceSyn.hs | 47 ++++--- compiler/iface/MkIface.hs | 27 ++-- compiler/iface/TcIface.hs | 7 +- compiler/main/StaticPtrTable.hs | 5 + compiler/main/TidyPgm.hs | 2 + compiler/prelude/PrelNames.hs | 17 ++- compiler/prelude/PrelRules.hs | 8 +- compiler/prelude/TysWiredIn.hs | 35 +++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++- compiler/simplCore/FloatIn.hs | 19 +++ compiler/simplCore/FloatOut.hs | 8 ++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++ compiler/simplCore/SAT.hs | 12 ++ compiler/simplCore/SetLevels.hs | 18 ++- compiler/simplCore/SimplUtils.hs | 19 +-- compiler/simplCore/Simplify.hs | 30 ++++- compiler/specialise/Rules.hs | 13 ++ compiler/specialise/SpecConstr.hs | 6 + compiler/specialise/Specialise.hs | 3 + compiler/stgSyn/CoreToStg.hs | 20 +++ compiler/stranal/DmdAnal.hs | 33 +++++ compiler/stranal/WorkWrap.hs | 3 + compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 48 +++++--- compiler/vectorise/Vectorise/Exp.hs | 13 ++ compiler/vectorise/Vectorise/Utils.hs | 6 - mk/warnings.mk | 2 + .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++- .../tests/ghci.debugger/scripts/print006.stdout | 14 +-- .../tests/ghci.debugger/scripts/print008.stdout | 10 +- .../tests/ghci.debugger/scripts/print010.stdout | 7 +- .../tests/ghci.debugger/scripts/print012.stdout | 9 +- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +-- .../tests/ghci.debugger/scripts/print034.stdout | 6 +- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/numeric/should_compile/T7116.stdout | 40 +++--- testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 ++++----- .../tests/roles/should_compile/Roles13.stderr | 70 +++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 +-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 +-- testsuite/tests/roles/should_compile/T8958.stderr | 32 ++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 25 +++- .../tests/simplCore/should_compile/T3717.stderr | 20 +-- .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 47 ++++--- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++-- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 114 ++++++++++------- .../tests/simplCore/should_compile/T7865.stdout | 2 +- .../tests/simplCore/should_compile/T8274.stdout | 34 +++-- .../tests/simplCore/should_compile/T8832.stdout | 20 +-- .../tests/simplCore/should_compile/T8848.stderr | 32 ++--- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../tests/simplCore/should_compile/rule2.stderr | 19 ++- .../simplCore/should_compile/spec-inline.stderr | 133 +++++++++++++------- testsuite/tests/simplCore/should_run/T12689.hs | 33 +++++ testsuite/tests/simplCore/should_run/T12689.stdout | 8 ++ testsuite/tests/simplCore/should_run/T12689a.hs | 27 ++++ .../tests/simplCore/should_run/T12689a.stdout | 6 + .../tests/simplCore/should_run/T12689broken.hs | 9 ++ .../tests/simplCore/should_run/T12689broken.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 3 + testsuite/tests/th/TH_Roles2.stderr | 8 +- 104 files changed, 1487 insertions(+), 732 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 2670589f2ff53bc04a7396489166a1f82445d2ec From git at git.haskell.org Thu Oct 13 20:46:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 20:46:35 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Squashed ConApp commit (b5f98af) Message-ID: <20161013204635.75B9F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/b5f98afdafa7d92796a54897cb49d494abed45f9/ghc >--------------------------------------------------------------- commit b5f98afdafa7d92796a54897cb49d494abed45f9 Author: Joachim Breitner Date: Thu Oct 13 16:46:12 2016 -0400 Squashed ConApp commit commit 03195f67022162318c8fed3d86b188597eb26c6b Author: Joachim Breitner Date: Thu Oct 13 15:20:47 2016 -0400 Try to apply rules that match a data con this is slightly annoying, all the rule matching code so far assumes that rules can only apply to function applications, which is just no longer true. commit 67dbf3a9841e6ffcca9d7c480a06b78c30513c98 Author: Joachim Breitner Date: Thu Oct 13 14:55:34 2016 -0400 Make simple DataCon wrappers complusary unfoldings and make sure they are unfolded in simple_opt_expr, even when they are nullary. For that, start paying attention to the arity field in the unfolding guidance. (This design can be revised later.) commit e6ad487ff9dd77ff4d35b15d671338b02942ac80 Author: Joachim Breitner Date: Thu Oct 13 13:25:49 2016 -0400 Extend test for #12689 with rule matching late on normal data con commit 5ed10e8ea37e3d1d89c6edae5c1a626b483849a3 Author: Joachim Breitner Date: Thu Oct 13 13:11:10 2016 -0400 Use mkSimpleDataConRep in mkDataConRep if nothing fancy goes on as a step towards treating them diffently in the inliner. commit 92b560e6d04e2db290d6e1e8a4fa93c936a5de69 Author: Joachim Breitner Date: Thu Oct 13 13:08:34 2016 -0400 Revert "Make data con wrappers ConLike (and see what happens)" This reverts commit ad72aa0e46d1e58eac3e6ff3c17af080b01e6ff3. commit ad72aa0e46d1e58eac3e6ff3c17af080b01e6ff3 Author: Joachim Breitner Date: Tue Oct 11 19:03:51 2016 -0400 Make data con wrappers ConLike (and see what happens) commit e17608466274b8448bd9d4f1f4f5edaa4894bd63 Author: Joachim Breitner Date: Tue Oct 11 16:50:25 2016 -0400 Add a broken test case for #12689 A rule with a phase specification trying to match on a constructor with a wrapper will fail to match, as the wrapper will be inlined by then. The fact that it works in the other case is also mostly by accident. (Split into two test cases so that regressions with regard what works so far are caught.) commit 6d59834455f8e9c294f030890e96af548079652a Author: Joachim Breitner Date: Tue Oct 11 16:25:05 2016 -0400 Add test case for #12689 which test a few variants of rules involving constructors, including nullary constructors, constructors with wrappers, and unsaturated of constructors. At the moment, all the rules work as expected, despite GHC’s compile time warnings when called with -Wall. commit 0e07dc90aa94673bcc83f10e32b466b7f22ee3ee Author: Joachim Breitner Date: Tue Oct 11 10:57:55 2016 -0400 SpecConstr.isValue: Handle ConApp now all tests pass (here) commit ddbcc7b5cea1fb22697d6d0723e90e0d893a6537 Author: Joachim Breitner Date: Tue Oct 11 10:47:06 2016 -0400 Adjust exprIsCheap commit 54cfb30b0b33246d4e8cb36d659ccbc971e9f094 Author: Joachim Breitner Date: Tue Oct 11 10:11:19 2016 -0400 Fix instance Eq (DeBruijn CoreExpr) for ConApp commit 557166a6b670f3dcd3bed4f79af1119b9a3f4832 Author: Joachim Breitner Date: Mon Oct 10 17:35:36 2016 -0400 Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. commit 5bdf9d042d812fdfeece8db9037c0175c2b8ed6b Author: Joachim Breitner Date: Mon Oct 10 17:27:19 2016 -0400 sptModuleInitCode: Look for ConApp commit 11b0d182da0b283ab73f3682c195cce452c4a57f Author: Joachim Breitner Date: Mon Oct 10 16:37:54 2016 -0400 Nullary data constructors are trivial commit 09f72a920ba786bf7a0c235a38402d8ff8d6f9a5 Author: Simon Peyton Jones Date: Sat Oct 8 00:03:53 2016 +0100 Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. commit 0a5850dab49cbec07c41dcac6771da4c1584d9cd Author: Joachim Breitner Date: Sun Oct 9 17:54:51 2016 -0400 Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. commit 32a2826823c67b8ff54224b47ede9017619a7a23 Author: Joachim Breitner Date: Sun Oct 9 15:51:04 2016 -0400 SetLevels: Do not float nullary data constructors commit 0ae46fea877a38b872ba7eb241e9a620d1c2de1d Author: Joachim Breitner Date: Sun Oct 9 14:43:56 2016 -0400 Update some test output commit 891c903b791b67aa4742a8634cfad71bf61a8d2c Author: Joachim Breitner Date: Sun Oct 9 14:23:04 2016 -0400 No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. commit 33728e85c73918b2e4549ee92f5350a7accce00a Author: Joachim Breitner Date: Sun Oct 9 13:45:08 2016 -0400 Avoid invalid haddock synatx commit 75e5dd948dc4c3db6830383b5cc83231a71005d6 Author: Joachim Breitner Date: Sun Oct 9 13:44:00 2016 -0400 getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons commit 2fee1279c78e39e7233a9f79b27549b02a74d565 Author: Joachim Breitner Date: Sun Oct 9 13:20:59 2016 -0400 Handle nullary constructors in the byte code generator. commit 4068e403fe104e4226939190bb107a1f3c655d0c Author: Joachim Breitner Date: Sun Oct 9 12:38:14 2016 -0400 Handle nullary Cons in myCollectArgs commit d51996444bfd40eb7588e696078f3f6eedd35442 Author: Joachim Breitner Date: Sun Oct 9 12:07:50 2016 -0400 cpe_ExprIsTrivial: Nullary Constructors are trivial commit 518ed7909a9c81d96480b9ed2fd39a0be2fb8fe3 Author: Joachim Breitner Date: Sat Oct 8 22:55:54 2016 -0400 Handle ConApp in inlineBoringOk commit ab230b9fe7142b1a9dcd62f6af2dce848b0d8f59 Author: Joachim Breitner Date: Sat Oct 8 16:59:00 2016 -0400 coreToStgExpr: add con worker to free variables reported commit 7a6203882ee5af9db0cdc5463f23a60989ab7cee Author: Joachim Breitner Date: Fri Oct 7 21:59:46 2016 -0400 Do not lint the bodz of the data con worker bindings introduced by CorePrep commit c9a3415460ab6361ecdaf396800a3a533d62587e Author: Joachim Breitner Date: Fri Oct 7 21:43:24 2016 -0400 Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. commit 5a0b12869b7d9058348a4af42ef016da3d5b83ae Author: Joachim Breitner Date: Fri Oct 7 17:39:42 2016 -0400 maybe_substitute: Detect ConApp commit f0b187303fad8c36df615bc835752b5a16202831 Author: Joachim Breitner Date: Fri Oct 7 15:21:35 2016 -0400 Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. commit 13557d6e3d92315ed034479905aa4a15baff4025 Author: Joachim Breitner Date: Fri Oct 7 09:18:53 2016 -0400 isTrueLHsExpr: Match on data con wrapper now commit cc7e75428218cc02fe7da916fb2ee5a5e3868807 Author: Joachim Breitner Date: Thu Oct 6 23:38:34 2016 -0400 Include constructor in freeNamesIfExpr commit 65ba986828aba20e61ef15b2db09eb40c06259b4 Author: Joachim Breitner Date: Wed Oct 5 23:23:20 2016 -0400 Use ConApp when creating True resp. False commit 70e58e8316a138627274160e2fe6972802084fea Author: Joachim Breitner Date: Wed Oct 5 23:22:48 2016 -0400 New Lint Check: No data con workers any more, please commit ba8341c129bb26e8d92e763dd7de6f0a1e265caf Author: Joachim Breitner Date: Wed Oct 5 23:08:34 2016 -0400 mkCoreConApps: Do not use ConApp for newtypes commit 48877dad6bfd8a7d5cf47da04fde8e2223530146 Author: Joachim Breitner Date: Wed Oct 5 18:21:59 2016 -0400 mkSimpleDataConRep: No wrapper for newtypes commit 3f42e87964b327f4e6b463056727e3de980dfa31 Author: Joachim Breitner Date: Wed Oct 5 18:13:33 2016 -0400 ConApp: More Linting commit 1aa69bff3624beb966136e70e806dd7c7038a795 Author: Joachim Breitner Date: Wed Oct 5 17:50:29 2016 -0400 Use dataConWrapId in unsaturated uses of mkCoreConApps commit d1922185829f5ee2eac8c9797d732aa653b0408d Author: Joachim Breitner Date: Wed Oct 5 17:43:05 2016 -0400 Handle ConApp in "Eliminate Identity Case" commit ef7fc1a15bc64084589d3b63789f2d03f5bf6cf0 Author: Joachim Breitner Date: Wed Oct 5 17:29:53 2016 -0400 Deserialize interface tuples to ConApp commit 395db23544dbde568bfaf71966123b7b8388e971 Author: Joachim Breitner Date: Wed Oct 5 17:16:59 2016 -0400 Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) commit 5be97a0c7aec64260335581ec8de27792be0467a Author: Joachim Breitner Date: Wed Oct 5 13:21:41 2016 -0400 Desugar: Use Coercible worker, not wrapper commit 36143d401423e7fc427cef6ed71cb9dae3c9d561 Author: Joachim Breitner Date: Wed Oct 5 13:15:40 2016 -0400 CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. commit 916c15272fffd7d7457c085488051765c6c8146e Author: Joachim Breitner Date: Wed Oct 5 12:50:32 2016 -0400 Reserve a unique for the wrapper of a wired in DataCon commit 32b47198c2f6b365611e144b0730c9dff12ba206 Author: Joachim Breitner Date: Tue Oct 4 15:46:59 2016 -0400 Always use ConApp in CoreSyn commit 39185a4af6d85087f2eb42fb02f74e990bcb142d Author: Joachim Breitner Date: Tue Oct 4 15:14:45 2016 -0400 Always build a wrapper for data types commit 3733c4dfc50d578bef3e6a287f28841ce16f309a Author: Joachim Breitner Date: Tue Oct 4 14:49:40 2016 -0400 Get rid of unitDataConId (use ConApp instead) commit c3e1cb0b94f527d2a488c19b4566a46cd7d780ce Author: Joachim Breitner Date: Tue Oct 4 14:41:54 2016 -0400 knownCon: Use ConApp in unfolding of scrutinee commit 8399e73a44287d5aa6ce6c61620c628f85033392 Author: Joachim Breitner Date: Tue Oct 4 14:35:23 2016 -0400 Use ConApp in tagToEnumRule commit a40b10315ca752652e23c15be0e7a1d48807f62f Author: Joachim Breitner Date: Tue Oct 4 14:29:17 2016 -0400 Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. commit 6c7668e65cc1901414aa14a8e9d555082cc2c9f3 Author: Joachim Breitner Date: Tue Oct 4 14:23:43 2016 -0400 mkCoreConApps: Warn about unsaturated use commit b486662d3c75ef8a1c96d2d29f8e5ca547c23c25 Author: Joachim Breitner Date: Tue Oct 4 14:20:05 2016 -0400 DataCon wrapper: Use ConApp in the body commit f10cbcb7aab88b38ce1dc17568af4454abf624ae Author: Joachim Breitner Date: Tue Oct 4 14:10:09 2016 -0400 mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). commit 8fa24208a732b877952ded6e2e98f54f526dde19 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. commit 5a7d036452d83c7d456a73b4fc4781aa76c57f62 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. commit e7d8c5a713218329d52954f99aff60a484e00eed Author: Joachim Breitner Date: Sun Oct 2 21:19:49 2016 -0400 ConApp bytecode: Add more ASSERT commit f17b59ef00616ac15405cf84b30bf202fc239592 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. commit 67814af6d68758eba6d424a4454cef6bd7235127 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- b5f98afdafa7d92796a54897cb49d494abed45f9 compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/Demand.hs | 17 ++- compiler/basicTypes/MkId.hs | 137 ++++++++++++++------- compiler/basicTypes/MkId.hs-boot | 4 +- compiler/basicTypes/Unique.hs | 22 ++-- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++ compiler/coreSyn/CoreLint.hs | 42 +++++++ compiler/coreSyn/CorePrep.hs | 24 ++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 52 +++++--- compiler/coreSyn/CoreSyn.hs | 31 ++++- compiler/coreSyn/CoreTidy.hs | 15 +-- compiler/coreSyn/CoreUnfold.hs | 20 ++- compiler/coreSyn/CoreUtils.hs | 65 ++++++---- compiler/coreSyn/MkCore.hs | 39 +++++- compiler/coreSyn/PprCore.hs | 10 ++ compiler/coreSyn/TrieMap.hs | 80 +++++++----- compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsBinds.hs | 10 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/ByteCodeGen.hs | 42 ++++++- compiler/iface/IfaceSyn.hs | 47 ++++--- compiler/iface/MkIface.hs | 27 ++-- compiler/iface/TcIface.hs | 7 +- compiler/main/StaticPtrTable.hs | 5 + compiler/main/TidyPgm.hs | 2 + compiler/prelude/PrelNames.hs | 17 ++- compiler/prelude/PrelRules.hs | 8 +- compiler/prelude/TysWiredIn.hs | 35 +++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++- compiler/simplCore/FloatIn.hs | 19 +++ compiler/simplCore/FloatOut.hs | 8 ++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++ compiler/simplCore/SAT.hs | 12 ++ compiler/simplCore/SetLevels.hs | 18 ++- compiler/simplCore/SimplUtils.hs | 19 +-- compiler/simplCore/Simplify.hs | 30 ++++- compiler/specialise/Rules.hs | 13 ++ compiler/specialise/SpecConstr.hs | 6 + compiler/specialise/Specialise.hs | 3 + compiler/stgSyn/CoreToStg.hs | 20 +++ compiler/stranal/DmdAnal.hs | 33 +++++ compiler/stranal/WorkWrap.hs | 3 + compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 48 +++++--- compiler/vectorise/Vectorise/Exp.hs | 13 ++ compiler/vectorise/Vectorise/Utils.hs | 6 - mk/warnings.mk | 2 + .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++- .../tests/ghci.debugger/scripts/print006.stdout | 14 +-- .../tests/ghci.debugger/scripts/print008.stdout | 10 +- .../tests/ghci.debugger/scripts/print010.stdout | 7 +- .../tests/ghci.debugger/scripts/print012.stdout | 9 +- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +-- .../tests/ghci.debugger/scripts/print034.stdout | 6 +- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/numeric/should_compile/T7116.stdout | 40 +++--- testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 ++++----- .../tests/roles/should_compile/Roles13.stderr | 70 +++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 +-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 +-- testsuite/tests/roles/should_compile/T8958.stderr | 32 ++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 25 +++- .../tests/simplCore/should_compile/T3717.stderr | 20 +-- .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 47 ++++--- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++-- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 114 ++++++++++------- .../tests/simplCore/should_compile/T7865.stdout | 2 +- .../tests/simplCore/should_compile/T8274.stdout | 34 +++-- .../tests/simplCore/should_compile/T8832.stdout | 20 +-- .../tests/simplCore/should_compile/T8848.stderr | 32 ++--- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../tests/simplCore/should_compile/rule2.stderr | 19 ++- .../simplCore/should_compile/spec-inline.stderr | 133 +++++++++++++------- testsuite/tests/simplCore/should_run/T12689.hs | 33 +++++ testsuite/tests/simplCore/should_run/T12689.stdout | 8 ++ testsuite/tests/simplCore/should_run/T12689a.hs | 27 ++++ .../tests/simplCore/should_run/T12689a.stdout | 6 + .../tests/simplCore/should_run/T12689broken.hs | 9 ++ .../tests/simplCore/should_run/T12689broken.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 3 + testsuite/tests/th/TH_Roles2.stderr | 8 +- 104 files changed, 1487 insertions(+), 732 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 b5f98afdafa7d92796a54897cb49d494abed45f9 From git at git.haskell.org Thu Oct 13 22:34:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 22:34:31 +0000 (UTC) Subject: [commit: ghc] wip/names3: Unique: Simplify encoding of sum uniques (4fcff2d) Message-ID: <20161013223431.3D3DA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/names3 Link : http://ghc.haskell.org/trac/ghc/changeset/4fcff2db4b39b44a61c5dde3876c3c490221c1c9/ghc >--------------------------------------------------------------- commit 4fcff2db4b39b44a61c5dde3876c3c490221c1c9 Author: Ben Gamari Date: Sat Aug 20 12:50:49 2016 -0400 Unique: Simplify encoding of sum uniques The previous encoding was entropically a bit better, but harder to encode and decode. Now we just split up the integer part of the unique into a bitfield. >--------------------------------------------------------------- 4fcff2db4b39b44a61c5dde3876c3c490221c1c9 compiler/basicTypes/Unique.hs | 27 +++++++++++---------------- 1 file changed, 11 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..6db4d8a 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -370,31 +370,26 @@ mkTupleDataConUnique Boxed a = mkUnique '7' (3*a) -- ditto (*may* be mkTupleDataConUnique Unboxed a = mkUnique '8' (3*a) -------------------------------------------------- --- Sum arities start from 2. A sum of arity N has N data constructors, so it --- occupies N+1 slots: 1 TyCon + N DataCons. +-- Sum arities start from 2. The encoding is a bit funny: we break up the +-- integral part into bitfields for the arity and alternative index (which is +-- taken to be 0xff in the case of the TyCon) -- --- So arity 2 sum takes uniques 0 (tycon), 1, 2 (2 data cons) --- arity 3 sum takes uniques 3 (tycon), 4, 5, 6 (3 data cons) --- etc. +-- TyCon for sum of arity k: +-- 00000000 kkkkkkkk 11111111 +-- DataCon for sum of arity k and alternative n: +-- 00000000 kkkkkkkk nnnnnnnn mkSumTyConUnique :: Arity -> Unique -mkSumTyConUnique arity = mkUnique 'z' (sumUniqsOccupied arity) +mkSumTyConUnique arity = + ASSERT(arity < 0xff) + mkUnique 'z' (arity `shiftL` 8 .|. 0xff) mkSumDataConUnique :: ConTagZ -> Arity -> Unique mkSumDataConUnique alt arity | alt >= arity = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity) | otherwise - = mkUnique 'z' (sumUniqsOccupied arity + alt + 1 {- skip the tycon -}) - --- How many unique slots occupied by sum types (including constructors) up to --- the given arity? -sumUniqsOccupied :: Arity -> Int -sumUniqsOccupied arity - = ASSERT(arity >= 2) - -- 3 + 4 + ... + arity - ((arity * (arity + 1)) `div` 2) - 3 -{-# INLINE sumUniqsOccupied #-} + = mkUnique 'z' (arity `shiftL` 8 + alt) {- skip the tycon -} -------------------------------------------------- dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique From git at git.haskell.org Thu Oct 13 22:34:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 22:34:35 +0000 (UTC) Subject: [commit: ghc] wip/names3: Handle deserialization of tuples, etc specifically (0dfbea4) Message-ID: <20161013223435.24C6B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/names3 Link : http://ghc.haskell.org/trac/ghc/changeset/0dfbea437a0875516a472f70c896caf5a5868d75/ghc >--------------------------------------------------------------- commit 0dfbea437a0875516a472f70c896caf5a5868d75 Author: Ben Gamari Date: Tue Oct 11 22:59:38 2016 -0400 Handle deserialization of tuples, etc specifically Previously BinIface would build a UniqFM containing all of the known-key things and use this to resolve the Names of known-key things during interface file deserialization. However, this has the disadvantage of building up a rather large map containing all type and data constructors for anonymous sums and tuples. We now instead add codepaths to map a unique back to its associated known key name, allowing us to greatly shrink the size of the map. >--------------------------------------------------------------- 0dfbea437a0875516a472f70c896caf5a5868d75 compiler/basicTypes/Name.hs | 5 +- compiler/basicTypes/Name.hs-boot | 4 - compiler/basicTypes/NameCache.hs | 115 ++++++++++++++ compiler/basicTypes/Unique.hs | 47 ++---- compiler/ghc.cabal.in | 3 + compiler/ghc.mk | 3 + compiler/iface/BinFingerprint.hs | 46 ++++++ compiler/iface/BinIface.hs | 150 ++---------------- compiler/iface/FlagChecker.hs | 4 +- compiler/iface/IfaceEnv.hs | 132 +++------------- compiler/iface/IfaceSyn.hs | 175 ++++++++++++--------- compiler/iface/LoadIface.hs | 4 +- compiler/iface/MkIface.hs | 95 ++++++----- compiler/iface/TcIface.hs | 65 ++++---- compiler/main/HscMain.hs | 39 +---- compiler/main/HscTypes.hs | 20 +-- compiler/main/TidyPgm.hs | 1 + compiler/prelude/KnownUniques.hs | 149 ++++++++++++++++++ compiler/prelude/KnownUniques.hs-boot | 17 ++ compiler/prelude/PrelInfo.hs | 156 ++++++++++++------ compiler/prelude/TysWiredIn.hs | 76 +++++++-- compiler/simplCore/CoreMonad.hs | 1 + compiler/typecheck/TcRnDriver.hs | 11 +- compiler/utils/Binary.hs | 80 ++++++---- compiler/utils/Fingerprint.hsc | 15 +- ghc/Main.hs | 3 +- libraries/base/GHC/Fingerprint.hs | 1 - testsuite/tests/perf/compiler/all.T | 3 +- .../tests/typecheck/should_fail/T12035j.stderr | 2 +- 29 files changed, 838 insertions(+), 584 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 0dfbea437a0875516a472f70c896caf5a5868d75 From git at git.haskell.org Thu Oct 13 22:34:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 22:34:37 +0000 (UTC) Subject: [commit: ghc] wip/names3: Fix some style issues (38c40f3) Message-ID: <20161013223437.C7ACD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/names3 Link : http://ghc.haskell.org/trac/ghc/changeset/38c40f3f6daffe1f4341bd3f4d6cc3f161332cc0/ghc >--------------------------------------------------------------- commit 38c40f3f6daffe1f4341bd3f4d6cc3f161332cc0 Author: Ben Gamari Date: Wed Sep 28 18:25:54 2016 -0400 Fix some style issues >--------------------------------------------------------------- 38c40f3f6daffe1f4341bd3f4d6cc3f161332cc0 compiler/iface/BinFingerprint.hs | 15 ++++++++------- compiler/iface/BinIface.hs | 7 +++++-- compiler/iface/IfaceSyn.hs | 3 ++- compiler/iface/LoadIface.hs | 6 ++++-- 4 files changed, 19 insertions(+), 12 deletions(-) diff --git a/compiler/iface/BinFingerprint.hs b/compiler/iface/BinFingerprint.hs index 645aee0..bbf45d7 100644 --- a/compiler/iface/BinFingerprint.hs +++ b/compiler/iface/BinFingerprint.hs @@ -31,16 +31,17 @@ computeFingerprint :: (Binary a) -> a -> IO Fingerprint computeFingerprint put_nonbinding_name a = do - bh <- openBinMem (3*1024) -- just less than a block - bh <- return $ setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS - put_ bh a - fp <- fingerprintBinMem bh - return fp + bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block + put_ bh a + fp <- fingerprintBinMem bh + return fp + where + set_user_data bh = + setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. putNameLiterally :: BinHandle -> Name -> IO () -putNameLiterally bh name = ASSERT( isExternalName name ) - do +putNameLiterally bh name = ASSERT( isExternalName name ) do put_ bh $! nameModule name put_ bh $! nameOccName name diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index def09fc..005d89e 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -306,7 +306,9 @@ putName _dict BinSymbolTable{ | isKnownKeyName name , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits = -- ASSERT(u < 2^(22 :: Int)) - put_ bh (0x80000000 .|. (fromIntegral (ord c) `shiftL` 22) .|. (fromIntegral u :: Word32)) + put_ bh (0x80000000 + .|. (fromIntegral (ord c) `shiftL` 22) + .|. (fromIntegral u :: Word32)) | otherwise = do symtab_map <- readIORef symtab_map_ref @@ -336,7 +338,8 @@ getSymtabName _ncu _dict symtab bh = do u = mkUnique tag ix in return $! case lookupKnownKeyName u of - Nothing -> pprPanic "getSymtabName:unknown known-key unique" (ppr i $$ ppr (unpkUnique u)) + Nothing -> pprPanic "getSymtabName:unknown known-key unique" + (ppr i $$ ppr (unpkUnique u)) Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index a825454..164452a 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -369,7 +369,8 @@ ifaceConDeclFields x = case x of IfDataTyCon cons is_over labels -> map (help cons is_over) labels IfNewTyCon con is_over labels -> map (help [con] is_over) labels where - help (dc:_) is_over lbl = mkFieldLabelOccs lbl (occName $ ifConName dc) is_over + help (dc:_) is_over lbl = + mkFieldLabelOccs lbl (occName $ ifConName dc) is_over help [] _ _ = error "ifaceConDeclFields: data type has no constructors!" ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName] diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index aba655c..48bc316 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -141,8 +141,10 @@ importDecl name -- Now look it up again; this time we should find it { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of - Just thing -> return (Succeeded thing) - Nothing -> return $ Failed (ifPprDebug (found_things_msg eps $$ empty) $$ not_found_msg) + Just thing -> return $ Succeeded thing + Nothing -> let doc = ifPprDebug (found_things_msg eps $$ empty) + $$ not_found_msg + in return $ Failed doc }}} where nd_doc = text "Need decl for" <+> ppr name From git at git.haskell.org Thu Oct 13 22:34:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 22:34:40 +0000 (UTC) Subject: [commit: ghc] wip/names3: MkIface: Turn a foldr into a foldl' (6a58e04) Message-ID: <20161013223440.AD8973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/names3 Link : http://ghc.haskell.org/trac/ghc/changeset/6a58e0452fe79ca67ce3385c862b9b70f33f2d0a/ghc >--------------------------------------------------------------- commit 6a58e0452fe79ca67ce3385c862b9b70f33f2d0a Author: Ben Gamari Date: Mon Aug 22 23:18:02 2016 -0400 MkIface: Turn a foldr into a foldl' There is no reason why this should be a foldr considering we are building a map. >--------------------------------------------------------------- 6a58e0452fe79ca67ce3385c862b9b70f33f2d0a compiler/iface/MkIface.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 12980e4..1a191db 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -467,8 +467,8 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls -- e.g. a reference to a constructor must be turned into a reference -- to the TyCon for the purposes of calculating dependencies. parent_map :: OccEnv OccName - parent_map = foldr extend emptyOccEnv new_decls - where extend d env = + parent_map = foldl' extend emptyOccEnv new_decls + where extend env d = extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ] where n = getOccName d From git at git.haskell.org Thu Oct 13 22:34:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 22:34:43 +0000 (UTC) Subject: [commit: ghc] wip/names3: Fix RnModIface (7803d1b) Message-ID: <20161013223443.5944A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/names3 Link : http://ghc.haskell.org/trac/ghc/changeset/7803d1bfb26a4cbdcdb8d324ea6945733a363765/ghc >--------------------------------------------------------------- commit 7803d1bfb26a4cbdcdb8d324ea6945733a363765 Author: Ben Gamari Date: Thu Oct 13 18:29:11 2016 -0400 Fix RnModIface >--------------------------------------------------------------- 7803d1bfb26a4cbdcdb8d324ea6945733a363765 compiler/backpack/RnModIface.hs | 38 +++++++++++++++++++++++++++++--------- compiler/iface/IfaceEnv.hs | 2 +- utils/haddock | 2 +- 3 files changed, 31 insertions(+), 11 deletions(-) diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs index b90edd9..371a65e 100644 --- a/compiler/backpack/RnModIface.hs +++ b/compiler/backpack/RnModIface.hs @@ -339,56 +339,69 @@ rnIfaceDecl' (fp, decl) = (,) fp <$> rnIfaceDecl decl rnIfaceDecl :: Rename IfaceDecl rnIfaceDecl d at IfaceId{} = do + name <- rnIfaceGlobal (ifName d) ty <- rnIfaceType (ifType d) details <- rnIfaceIdDetails (ifIdDetails d) info <- rnIfaceIdInfo (ifIdInfo d) - return d { ifType = ty + return d { ifName = name + , ifType = ty , ifIdDetails = details , ifIdInfo = info } rnIfaceDecl d at IfaceData{} = do + name <- rnIfaceGlobal (ifName d) binders <- mapM rnIfaceTyConBinder (ifBinders d) ctxt <- mapM rnIfaceType (ifCtxt d) cons <- rnIfaceConDecls (ifCons d) parent <- rnIfaceTyConParent (ifParent d) - return d { ifBinders = binders + return d { ifName = name + , ifBinders = binders , ifCtxt = ctxt , ifCons = cons , ifParent = parent } rnIfaceDecl d at IfaceSynonym{} = do + name <- rnIfaceGlobal (ifName d) binders <- mapM rnIfaceTyConBinder (ifBinders d) syn_kind <- rnIfaceType (ifResKind d) syn_rhs <- rnIfaceType (ifSynRhs d) - return d { ifBinders = binders + return d { ifName = name + , ifBinders = binders , ifResKind = syn_kind , ifSynRhs = syn_rhs } rnIfaceDecl d at IfaceFamily{} = do + name <- rnIfaceGlobal (ifName d) binders <- mapM rnIfaceTyConBinder (ifBinders d) fam_kind <- rnIfaceType (ifResKind d) fam_flav <- rnIfaceFamTyConFlav (ifFamFlav d) - return d { ifBinders = binders + return d { ifName = name + , ifBinders = binders , ifResKind = fam_kind , ifFamFlav = fam_flav } rnIfaceDecl d at IfaceClass{} = do + name <- rnIfaceGlobal (ifName d) ctxt <- mapM rnIfaceType (ifCtxt d) binders <- mapM rnIfaceTyConBinder (ifBinders d) ats <- mapM rnIfaceAT (ifATs d) sigs <- mapM rnIfaceClassOp (ifSigs d) - return d { ifCtxt = ctxt + return d { ifName = name + , ifCtxt = ctxt , ifBinders = binders , ifATs = ats , ifSigs = sigs } rnIfaceDecl d at IfaceAxiom{} = do + name <- rnIfaceGlobal (ifName d) tycon <- rnIfaceTyCon (ifTyCon d) ax_branches <- mapM rnIfaceAxBranch (ifAxBranches d) - return d { ifTyCon = tycon + return d { ifName = name + , ifTyCon = tycon , ifAxBranches = ax_branches } rnIfaceDecl d at IfacePatSyn{} = do + name <- rnIfaceGlobal (ifName d) let rnPat (n, b) = (,) <$> rnIfaceGlobal n <*> pure b pat_matcher <- rnPat (ifPatMatcher d) pat_builder <- T.traverse rnPat (ifPatBuilder d) @@ -398,7 +411,8 @@ rnIfaceDecl d at IfacePatSyn{} = do pat_req_ctxt <- mapM rnIfaceType (ifPatReqCtxt d) pat_args <- mapM rnIfaceType (ifPatArgs d) pat_ty <- rnIfaceType (ifPatTy d) - return d { ifPatMatcher = pat_matcher + return d { ifName = name + , ifPatMatcher = pat_matcher , ifPatBuilder = pat_builder , ifPatUnivBndrs = pat_univ_bndrs , ifPatExBndrs = pat_ex_bndrs @@ -435,15 +449,18 @@ rnIfaceConDecls (IfAbstractTyCon b) = pure (IfAbstractTyCon b) rnIfaceConDecl :: Rename IfaceConDecl rnIfaceConDecl d = do + con_name <- rnIfaceGlobal (ifConName d) con_ex_tvs <- mapM rnIfaceForAllBndr (ifConExTvs d) let rnIfConEqSpec (n,t) = (,) n <$> rnIfaceType t con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d) con_ctxt <- mapM rnIfaceType (ifConCtxt d) con_arg_tys <- mapM rnIfaceType (ifConArgTys d) + con_fields <- mapM rnIfaceGlobal (ifConFields d) let rnIfaceBang (IfUnpackCo co) = IfUnpackCo <$> rnIfaceCo co rnIfaceBang bang = pure bang con_stricts <- mapM rnIfaceBang (ifConStricts d) - return d { ifConExTvs = con_ex_tvs + return d { ifConName = con_name + , ifConExTvs = con_ex_tvs , ifConEqSpec = con_eq_spec , ifConCtxt = con_ctxt , ifConArgTys = con_arg_tys @@ -451,7 +468,10 @@ rnIfaceConDecl d = do } rnIfaceClassOp :: Rename IfaceClassOp -rnIfaceClassOp (IfaceClassOp n ty dm) = IfaceClassOp n <$> rnIfaceType ty <*> rnMaybeDefMethSpec dm +rnIfaceClassOp (IfaceClassOp n ty dm) = + IfaceClassOp <$> rnIfaceGlobal n + <*> rnIfaceType ty + <*> rnMaybeDefMethSpec dm rnMaybeDefMethSpec :: Rename (Maybe (DefMethSpec IfaceType)) rnMaybeDefMethSpec (Just (GenericDM ty)) = Just . GenericDM <$> rnIfaceType ty diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs index 482ac76..581aa1f 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/iface/IfaceEnv.hs @@ -154,7 +154,7 @@ lookupOrig mod occ -- which does some stuff that modifies the name cache -- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..) mod `seq` occ `seq` return () --- ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ) + ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ) ; updNameCache $ \name_cache -> case lookupOrigNameCache (nsNames name_cache) mod occ of { diff --git a/utils/haddock b/utils/haddock index d73b286..25204dd 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d73b286cb39ad9d02bee4b1a104e817783ceb195 +Subproject commit 25204dd5bf0e7c67d989bde2ca7125468c428e7c From git at git.haskell.org Thu Oct 13 22:34:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 22:34:46 +0000 (UTC) Subject: [commit: ghc] wip/names3's head updated: Fix RnModIface (7803d1b) Message-ID: <20161013223446.8F0733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/names3' now includes: 89facad Add T12520 as a test 1766bb3 RtClosureInspect: Fix off-by-one error in cvReconstructType 613d745 Template Haskell support for unboxed sums 7a86f58 Comments only: Refer to actually existing Notes 8d92b88 DmdAnal: Add a final, safe iteration d6fd2e3 DmdAnal: Testcase about splitFVs and dmdFix abortion ec7fcfd Degrade "case scrutinee not known to diverge for sure" Lint error to warning faaf313 WwLib: Add strictness signature to "let x = absentError …" 1083f45 Fix doc build inconsistency ae66f35 Allow typed holes to be levity-polymorphic a60ea70 Move import to avoid warning 0050aff Fix scoping of type variables in instances ca8c0e2 Typofix in docs. 983f660 Template Haskell support for TypeApplications 822af41 Fix broken Haddock comment f4384ef Remove unused DerivInst constructor for DerivStuff 21c2ebf Missing stderr for T12531. 9d17560 GhcMake: limit Capability count to CPU count in parallel mode a5d26f2 rts: enable parallel GC scan of large (32M+) allocation area 044e81b OccName: Remove unused DrIFT directive ff1931e TcGenDeriv: Typofix d168c41 Fix and complete runghc documentation 6781f37 Clarify pkg selection when multiple versions are available 83b326c Fix binary-trees regression from unnecessary floating in CorePrep. a25bf26 Tag pointers in interpreted constructors ef784c5 Fix handling of package-db entries in .ghc.environment files, etc. 2ee1db6 Fixes #12504: Double-escape paths used to build call to hsc_line 28b71c5 users_guide: More capabilities than processors considered harmful 0e74925 GHC: Expose installSignalHandlers, withCleanupSession 3005fa5 iserv: Show usage message on argument parse failure d790cb9 Bump the default allocation area size to 1MB d40d6df StgCmmPrim: Add missing MO_WriteBarrier d1f2239 Clarify scope of `getQ`/`putQ` state. 22259c1 testsuite: Failing testcase for #12091 2d22026 ErrUtils: Expose accessors of ErrDoc and ErrMsg a07a3ff A failing testcase for T12485 9306db0 TysWiredIn: Use dataConWorkerUnique instead of incrUnique 9cfef16 Add Read1/Read2 methods defined in terms of ReadPrec 1ad770f Add -flocal-ghci-history flag (#9089). 010b07a PPC NCG: Implement minimal stack frame header. ca6d0eb testsuite: Update bytes allocated of parsing001 75321ff Add -fdefer-out-of-scope-variables flag (#12170). e9b0bf4 Remove redundant-constraints from -Wall (#10635) 043604c RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax dad6a88 LoadIFace: Show known names on inconsistent interface file 3fb8f48 Revert "testsuite: Update bytes allocated of parsing001" a69371c users_guide: Document removal of -Wredundant-constraints from -Wall ad1e072 users_guide: Move addModFinalizer mention to 8.0.2 release notes 1f5d4a3 users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes da920f6 users_guide: Move initGhcMonad note to 8.0.2 relnotes a48de37 restore -fmax-worker-args handling (Trac #11565) 1e39c29 Kill vestiages of DEFAULT_TMPDIR 8d35e18 Fix startsVarSym and refactor operator predicates (fixes #4239) b946cf3 Revert "Fix startsVarSym and refactor operator predicates (fixes #4239)" f233f00 Fix startsVarSym and refactor operator predicates (fixes #4239) e5ecb20 Added support for deprecated POSIX functions on Windows. 0cc3931 configure.ac: fix --host= handling 818760d Fix #10923 by fingerprinting optimization level. 36bba47 Typos in notes 33d3527 Protect StablPtr dereference with the StaticPtr table lock. 133a5cc ghc-cabal: accept EXTRA_HC_OPTS make variable f93c363 extend '-fmax-worker-args' limit to specialiser (Trac #11565) ac2ded3 Typo in comment 57aa6bb Fix comment about result f8b139f test #12567: add new testcase with expected plugin behaviour 1805754 accept current (problematic) output cdbb9da cleanup: drop 11 years old performance hack 71dd6e4 Don't ignore addTopDecls in module finalizers. 6ea6242 Turn divInt# and modInt# into bitwise operations when possible 8d00175 Less scary arity mismatch error message when deriving 4ff4929 Make generated Ord instances smaller (per #10858). 34010db Derive the Generic instance in perf/compiler/T5642 05b497e distrib: Fix libdw bindist check a7a960e Make the test for #11108 less fragile dcc4904 Add failing testcase for #12433 feaa31f Remove references to -XRelaxedPolyRec 5eab6a0 Document meaning of order of --package-db flags, fixes #12485. a8238a4 Update unix submodule to latest HEAD. 65d9597 Add hook for creating ghci external interpreter 1b5f920 Make start address of `osReserveHeapMemory` tunable via command line -xb 7b4bb40 Remove -flocal-ghci-history from default flags 710f21c Add platform warning to Foreign.C.Types 158288b Generalise type of mkMatchGroup to unify with mkMatchGroupName 04184a2 Remove uses of mkMatchGroupName 7b7ea8f Fix derived Ix instances for one-constructor GADTs 0e7ccf6 Fix TH ppr output for list comprehensions with only one Stmt 454033b Add hs_try_putmvar() 03541cb Be less picky about reporing inaccessible code 21d0bfe Remove unused exports 35086d4 users_guide: Fix Docbook remnant b451fef users_guide: #8761 is now fixed c6ac1e5 users_guide: TH now partially supports typed holes 6555c6b rts: Disable -hb with multiple capabilities 5eeabe2 Test wibbles for commit 03541cba ec3edd5 Testsuite wibbles, to the same files 505a518 Comments and white space only 8074e03 Comments and white space only 876b00b Comments and white space 86836a2 Fix codegen bug in PIC version of genSwitch (#12433) 9123845 tryGrabCapability should be using TRY_ACQUIRE_LOCK 626db8f Unify CallStack handling in ghc a001299 Comments only a72d798 Comments in TH.Syntax (Trac #12596) 97b47d2 Add test case for #7611 ea310f9 Remove directories from include paths 14c2e8e Codegen for case: Remove redundant void id checks 6886bba Bump Haddock submodule to fix rendering of class methods 8bd3d41 Fix failing test T12504 9cbcdb4 shutdownHaskellAndExit: just do a normal hs_exit() (#5402) 74c4ca0 Expose hs_exit_(rtsFalse) as hs_exit_nowait() 3a17916 Improved documentation for Foreign.Concurrent (#12547) 9766b0c Fix #12442. d122935 Mark mapUnionFV as INLINABLE rather than INLINE 68f72f1 Replace INLINEABLE by INLINABLE (#12613) 55d92cc Update test output bc7c730 Pattern Synonyms documentation update 796f0f2 Print foralls in user format b0ae0dd Remove #ifdef with never fulfilled condition c36904d Fix layout of MultiWayIf expressions (#10807) f897b74 TH: Use atomicModifyIORef' for fresh names 0b6024c Comments and manual only: spelling 13d3b53 Test Trac #12634 f21eedb Check.hs: Use actual import lists instead of comments 0b533a2 A bit of tracing about flattening 2fbfbca Fix desugaring of pattern bindings (again) 66a8c19 Fix a bug in occurs checking 3012c43 Add Outputable Report in TcErrors b612da6 Fix impredicativity (again) fc4ef66 Comments only 5d473cd Add missing stderr file 3f27237 Make tcrun042 fail 28a00ea Correct spelling in note references b3d55e2 Document Safe Haskell restrictions on Generic instances 9e86276 Implement deriving strategies b61b7c2 CodeGen X86: fix unsafe foreign calls wrt inlining 59d7ee5 GHCi: Don't remove shadowed bindings from typechecker scope. 3c17905 Support more than 64 logical processors on Windows 151edd8 Recognise US spelling for specialisation flags. f869b23 Move -dno-debug-output to the end of the test flags d1b4fec Mark T11978a as broken due to #12019 1e795a0 Use check stacking on Windows. c93813d Add NUMA support for Windows 2d6642b Fix interaction of record pattern synonyms and record wildcards 1851349 Don't warn about name shadowing when renaming the patten in a PatSyn decl ce3370e PPC/CodeGen: fix lwa instruction generation 48ff084 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) 0014fa5 ghc-pkg: Allow unregistering multiple packages in one call b0d53a8 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again f547b44 Eliminate some unsafeCoerce#s with deriving strategies 23cf32d Disallow standalone deriving declarations involving unboxed tuples or sums 4d2b15d validate: Add --build-only 42f1d86 runghc: use executeFile to run ghc process on POSIX 3630ad3 Mark #6132 as broken on OS X 8cab9bd Ignore output from derefnull and divbyzero on Darwin e9104d4 DynFlags: Fix absolute import path to generated header eda5a4a testsuite: Mark test for #12355 as unbroken on Darwin. 22c6b7f Update Cabal submodule to latest version. 8952cc3 runghc: Fix import of System.Process on Windows 7a6731c genapply: update source file in autogenerated text c5d6288 Mark zipWithAndUnzipM as INLINABLE rather than INLINE e4cf962 Bring Note in TcDeriv up to date 465c6c5 Improve error handling in TcRnMonad 58ecdf8 Remove unused T12124.srderr 4a03012 Refactor TcDeriv and TcGenDeriv a2bedb5 RegAlloc: Make some pattern matched complete 57a207c Remove dead code “mkHsConApp” cbe11d5 Add compact to packages so it gets cleaned on make clean. e41b9c6 Fix memory leak from #12664 f3be304 Don't suggest deprecated flags in error messages 76aaa6e Simplify implementation of wWarningFlags 082991a Tc267, tests what happens if you forgot to knot-tie. 3b9e45e Note about external interface changes. 940ded8 Remove reexports from ghc-boot, help bootstrap with GHC 8. 887485a Exclude Cabal PackageTests from gen_contents_index. 00b530d The Backpack patch. 4e8a060 Distinguish between UnitId and InstalledUnitId. 5bd8e8d Make InstalledUnitId be ONLY a FastString. 027a086 Update haddock.Cabal perf for Cabal update. 61b143a Report that we support Backpack in --info. 46b78e6 Cabal submodule update. e660f4b Rework renaming of children in export lists. f2d80de Add trailing comma to fix the build. 21647bc Fix build 7b060e1 Generate a unique symbol for signature object stub files, fixes #12673 bcd3445 Do not segfault if no common root can be found 8dc72f3 Cleanup PosixSource.h 6c47f2e Default +RTS -qn to the number of cores 85e81a8 Turn on -n4m with -A16m or greater 1a9705c Escape lambda. b255ae7 Orient improvement constraints better b5c8963 Rename a parameter; trivial refactor 88eb773 Delete orphan where clause 76a5477 Move zonking out of tcFamTyPats cc5ca21 Improved stats for Trac #1969 a6111b8 More tests for Trac #12522 b5be2ec Add test case for #12689 f8d2c20 Add a broken test case for #12689 4fcff2d Unique: Simplify encoding of sum uniques 0dfbea4 Handle deserialization of tuples, etc specifically 38c40f3 Fix some style issues 6a58e04 MkIface: Turn a foldr into a foldl' 7803d1b Fix RnModIface From git at git.haskell.org Thu Oct 13 22:41:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 22:41:45 +0000 (UTC) Subject: [commit: ghc] wip/names3: Fix haddock submodule (82f3f6c) Message-ID: <20161013224145.AEA973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/names3 Link : http://ghc.haskell.org/trac/ghc/changeset/82f3f6c68018d93b855d808c36865ce6046514bb/ghc >--------------------------------------------------------------- commit 82f3f6c68018d93b855d808c36865ce6046514bb Author: Ben Gamari Date: Thu Oct 13 18:41:28 2016 -0400 Fix haddock submodule >--------------------------------------------------------------- 82f3f6c68018d93b855d808c36865ce6046514bb utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 25204dd..23ec4c2 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 25204dd5bf0e7c67d989bde2ca7125468c428e7c +Subproject commit 23ec4c2e170e5edab3ba51529f68c81f63b42b85 From git at git.haskell.org Thu Oct 13 23:22:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Oct 2016 23:22:34 +0000 (UTC) Subject: [commit: ghc] wip/names3: Fix DFun renaming (37cca26) Message-ID: <20161013232234.21CC73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/names3 Link : http://ghc.haskell.org/trac/ghc/changeset/37cca2646e4503c572fd386f47479b24aadd1711/ghc >--------------------------------------------------------------- commit 37cca2646e4503c572fd386f47479b24aadd1711 Author: Ben Gamari Date: Thu Oct 13 19:04:12 2016 -0400 Fix DFun renaming >--------------------------------------------------------------- 37cca2646e4503c572fd386f47479b24aadd1711 compiler/backpack/RnModIface.hs | 27 +++++++++++++++++---------- compiler/iface/IfaceEnv.hs | 23 +++-------------------- 2 files changed, 20 insertions(+), 30 deletions(-) diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs index 371a65e..a7f7c10 100644 --- a/compiler/backpack/RnModIface.hs +++ b/compiler/backpack/RnModIface.hs @@ -241,6 +241,18 @@ rnIfaceGlobal n = do let nsubst = mkNameShape (moduleName m) (mi_exports iface) return (substNameShape nsubst n) +-- | Rename a DFun name. Here is where we ensure that DFuns have the correct +-- module as described in Note [Bogus DFun renamings]. +rnIfaceDFun :: Name -> ShIfM Name +rnIfaceDFun name = do + hmap <- getHoleSubst + dflags <- getDynFlags + iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv + let m = renameHoleModule dflags hmap $ nameModule name + -- Doublecheck that this DFun was, indeed, locally defined. + MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m ) + setNameModule (Just m) name + -- PILES AND PILES OF BOILERPLATE -- | Rename an 'IfaceClsInst', with special handling for an associated @@ -250,9 +262,6 @@ rnIfaceClsInst cls_inst = do n <- rnIfaceGlobal (ifInstCls cls_inst) tys <- mapM rnMaybeIfaceTyCon (ifInstTys cls_inst) - hmap <- getHoleSubst - dflags <- getDynFlags - -- Note [Bogus DFun renamings] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Every 'IfaceClsInst' is associated with a DFun; in fact, when @@ -312,12 +321,7 @@ rnIfaceClsInst cls_inst = do -- are unique; for instantiation, the final interface never -- mentions DFuns since they are implicitly exported.) The -- important thing is that it's consistent everywhere. - - iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv - let m = renameHoleModule dflags hmap $ nameModule (ifDFun cls_inst) - -- Doublecheck that this DFun was, indeed, locally defined. - MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m ) - dfun <- setNameModule (Just m) (ifDFun cls_inst) + dfun <- rnIfaceDFun (ifDFun cls_inst) return cls_inst { ifInstCls = n , ifInstTys = tys , ifDFun = dfun @@ -339,7 +343,9 @@ rnIfaceDecl' (fp, decl) = (,) fp <$> rnIfaceDecl decl rnIfaceDecl :: Rename IfaceDecl rnIfaceDecl d at IfaceId{} = do - name <- rnIfaceGlobal (ifName d) + name <- case ifIdDetails d of + IfDFunId -> rnIfaceDFun (ifName d) + _ -> rnIfaceGlobal (ifName d) ty <- rnIfaceType (ifType d) details <- rnIfaceIdDetails (ifIdDetails d) info <- rnIfaceIdInfo (ifIdInfo d) @@ -464,6 +470,7 @@ rnIfaceConDecl d = do , ifConEqSpec = con_eq_spec , ifConCtxt = con_ctxt , ifConArgTys = con_arg_tys + , ifConFields = con_fields , ifConStricts = con_stricts } diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs index 581aa1f..46bc0e9 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/iface/IfaceEnv.hs @@ -255,27 +255,10 @@ extendIfaceEnvs tcvs thing_inside ************************************************************************ -} +-- | Look up a top-level name from the current Iface module lookupIfaceTop :: OccName -> IfL Name --- Look up a top-level name from the current Iface module -lookupIfaceTop occ = do - lcl_env <- getLclEnv - -- NB: this is a semantic module, see - -- Note [Identity versus semantic module] - mod <- getIfModule - case if_nsubst lcl_env of - -- NOT substNameShape because 'getIfModule' returns the - -- renamed module (d'oh!) - Just nsubst -> - case lookupOccEnv (ns_map nsubst) occ of - Just n' -> - -- I thought this would be help but it turns out - -- n' doesn't have any useful information. Drat! - -- return (setNameLoc n' (nameSrcSpan n)) - return n' - -- This case can occur when we encounter a DFun; - -- see Note [Bogus DFun renamings] - Nothing -> lookupOrig mod occ - _ -> lookupOrig mod occ +lookupIfaceTop occ + = do { env <- getLclEnv; lookupOrig (if_mod env) occ } newIfaceName :: OccName -> IfL Name newIfaceName occ From git at git.haskell.org Fri Oct 14 02:58:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 02:58:52 +0000 (UTC) Subject: [commit: ghc] master: Unique: Simplify encoding of sum uniques (1cccb64) Message-ID: <20161014025852.9C6D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1cccb646e2e4bcf3bbb1f2ad01737f7e745b5f1b/ghc >--------------------------------------------------------------- commit 1cccb646e2e4bcf3bbb1f2ad01737f7e745b5f1b Author: Ben Gamari Date: Thu Oct 13 21:52:57 2016 -0400 Unique: Simplify encoding of sum uniques The previous encoding was entropically a bit better, but harder to encode and decode. Now we just split up the integer part of the unique into a bitfield. Test Plan: Validate Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2468 >--------------------------------------------------------------- 1cccb646e2e4bcf3bbb1f2ad01737f7e745b5f1b compiler/basicTypes/Unique.hs | 27 +++++++++++---------------- 1 file changed, 11 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index c933d61..6db4d8a 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -370,31 +370,26 @@ mkTupleDataConUnique Boxed a = mkUnique '7' (3*a) -- ditto (*may* be mkTupleDataConUnique Unboxed a = mkUnique '8' (3*a) -------------------------------------------------- --- Sum arities start from 2. A sum of arity N has N data constructors, so it --- occupies N+1 slots: 1 TyCon + N DataCons. +-- Sum arities start from 2. The encoding is a bit funny: we break up the +-- integral part into bitfields for the arity and alternative index (which is +-- taken to be 0xff in the case of the TyCon) -- --- So arity 2 sum takes uniques 0 (tycon), 1, 2 (2 data cons) --- arity 3 sum takes uniques 3 (tycon), 4, 5, 6 (3 data cons) --- etc. +-- TyCon for sum of arity k: +-- 00000000 kkkkkkkk 11111111 +-- DataCon for sum of arity k and alternative n: +-- 00000000 kkkkkkkk nnnnnnnn mkSumTyConUnique :: Arity -> Unique -mkSumTyConUnique arity = mkUnique 'z' (sumUniqsOccupied arity) +mkSumTyConUnique arity = + ASSERT(arity < 0xff) + mkUnique 'z' (arity `shiftL` 8 .|. 0xff) mkSumDataConUnique :: ConTagZ -> Arity -> Unique mkSumDataConUnique alt arity | alt >= arity = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity) | otherwise - = mkUnique 'z' (sumUniqsOccupied arity + alt + 1 {- skip the tycon -}) - --- How many unique slots occupied by sum types (including constructors) up to --- the given arity? -sumUniqsOccupied :: Arity -> Int -sumUniqsOccupied arity - = ASSERT(arity >= 2) - -- 3 + 4 + ... + arity - ((arity * (arity + 1)) `div` 2) - 3 -{-# INLINE sumUniqsOccupied #-} + = mkUnique 'z' (arity `shiftL` 8 + alt) {- skip the tycon -} -------------------------------------------------- dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique From git at git.haskell.org Fri Oct 14 02:58:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 02:58:56 +0000 (UTC) Subject: [commit: ghc] master: Clean up handling of known-key Names in interface files (34d933d) Message-ID: <20161014025856.8EAD53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34d933d6a821edf5abfcbee76d9325362fc28a13/ghc >--------------------------------------------------------------- commit 34d933d6a821edf5abfcbee76d9325362fc28a13 Author: Ben Gamari Date: Thu Oct 13 21:53:13 2016 -0400 Clean up handling of known-key Names in interface files Previously BinIface had some dedicated logic for handling tuple names in the symbol table. As it turns out, this logic was essentially dead code as it was superceded by the special handling of known-key things. Here we cull the tuple code-path and use the known-key codepath for all tuple-ish things. This had a surprising number of knock-on effects, * constraint tuple datacons had to be made known-key (previously they were not) * IfaceTopBndr was changed from being a synonym of OccName to a synonym of Name (since we now need to be able to deserialize Names directly from interface files) * the change to IfaceTopBndr complicated fingerprinting, since we need to ensure that we don't go looking for the fingerprint of the thing we are currently fingerprinting in the fingerprint environment (see notes in MkIface). Handling this required distinguishing between binding and non-binding Name occurrences in the Binary serializers. * the original name cache logic which previously lived in IfaceEnv has been moved to a new NameCache module * I ripped tuples and sums out of knownKeyNames since they introduce a very large number of entries. During interface file deserialization we use static functions (defined in the new KnownUniques module) to map from a Unique to a known-key Name (the Unique better correspond to a known-key name!) When we need to do an original name cache lookup we rely on the parser implemented in isBuiltInOcc_maybe. * HscMain.allKnownKeyNames was folded into PrelInfo.knownKeyNames. * Lots of comments were sprinkled about describing the new scheme. Updates haddock submodule. Test Plan: Validate Reviewers: niteria, simonpj, austin, hvr Reviewed By: simonpj Subscribers: simonmar, niteria, thomie Differential Revision: https://phabricator.haskell.org/D2467 GHC Trac Issues: #12532, #12415 >--------------------------------------------------------------- 34d933d6a821edf5abfcbee76d9325362fc28a13 compiler/backpack/RnModIface.hs | 66 ++++++-- compiler/basicTypes/Name.hs | 5 +- compiler/basicTypes/Name.hs-boot | 4 - compiler/basicTypes/NameCache.hs | 118 ++++++++++++++ compiler/basicTypes/Unique.hs | 49 ++---- compiler/ghc.cabal.in | 3 + compiler/ghc.mk | 3 + compiler/iface/BinFingerprint.hs | 47 ++++++ compiler/iface/BinIface.hs | 158 +++--------------- compiler/iface/FlagChecker.hs | 4 +- compiler/iface/IfaceEnv.hs | 157 ++++-------------- compiler/iface/IfaceSyn.hs | 181 +++++++++++++-------- compiler/iface/LoadIface.hs | 8 +- compiler/iface/MkIface.hs | 95 ++++++----- compiler/iface/TcIface.hs | 66 ++++---- compiler/main/HscMain.hs | 39 +---- compiler/main/HscTypes.hs | 20 +-- compiler/main/TidyPgm.hs | 1 + compiler/prelude/KnownUniques.hs | 150 +++++++++++++++++ compiler/prelude/KnownUniques.hs-boot | 17 ++ compiler/prelude/PrelInfo.hs | 176 ++++++++++++++------ compiler/prelude/PrelNames.hs | 49 +++--- compiler/prelude/TysWiredIn.hs | 76 +++++++-- compiler/simplCore/CoreMonad.hs | 1 + compiler/typecheck/TcRnDriver.hs | 11 +- compiler/utils/Binary.hs | 80 +++++---- compiler/utils/Fingerprint.hsc | 15 +- ghc/Main.hs | 3 +- libraries/base/GHC/Fingerprint.hs | 1 - testsuite/tests/perf/compiler/all.T | 3 +- testsuite/tests/perf/space_leaks/all.T | 3 +- .../tests/typecheck/should_fail/T12035j.stderr | 2 +- utils/haddock | 2 +- 33 files changed, 963 insertions(+), 650 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 34d933d6a821edf5abfcbee76d9325362fc28a13 From git at git.haskell.org Fri Oct 14 02:58:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 02:58:59 +0000 (UTC) Subject: [commit: ghc] master: MkIface: Turn a foldr into a foldl' (3991da4) Message-ID: <20161014025859.41FB93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3991da46102191b0258cbac9c4e00b7771a9b721/ghc >--------------------------------------------------------------- commit 3991da46102191b0258cbac9c4e00b7771a9b721 Author: Ben Gamari Date: Mon Aug 22 23:18:02 2016 -0400 MkIface: Turn a foldr into a foldl' There is no reason why this should be a foldr considering we are building a map. >--------------------------------------------------------------- 3991da46102191b0258cbac9c4e00b7771a9b721 compiler/iface/MkIface.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 12980e4..1a191db 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -467,8 +467,8 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls -- e.g. a reference to a constructor must be turned into a reference -- to the TyCon for the purposes of calculating dependencies. parent_map :: OccEnv OccName - parent_map = foldr extend emptyOccEnv new_decls - where extend d env = + parent_map = foldl' extend emptyOccEnv new_decls + where extend env d = extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ] where n = getOccName d From git at git.haskell.org Fri Oct 14 02:59:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 02:59:01 +0000 (UTC) Subject: [commit: ghc] master: PrelInfo: Fix style (90df91a) Message-ID: <20161014025901.E61613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/90df91a067ec6a2fccc4b740cb3006e6ff3258cf/ghc >--------------------------------------------------------------- commit 90df91a067ec6a2fccc4b740cb3006e6ff3258cf Author: Ben Gamari Date: Thu Oct 13 20:42:59 2016 -0400 PrelInfo: Fix style >--------------------------------------------------------------- 90df91a067ec6a2fccc4b740cb3006e6ff3258cf compiler/prelude/PrelInfo.hs | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 59a9980..b9eb9da 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -101,11 +101,10 @@ Note [About wired-in things] -} +-- | This list is used to ensure that when you say "Prelude.map" in your source +-- code, or in an interface file, you get a Name with the correct known key (See +-- Note [Known-key names] in PrelNames) knownKeyNames :: [Name] --- This list is used to ensure that when you say "Prelude.map" --- in your source code, or in an interface file, --- you get a Name with the correct known key --- (See Note [Known-key names] in PrelNames) knownKeyNames | debugIsOn , Just badNamesStr <- knownKeyNamesOkay all_names @@ -119,18 +118,18 @@ knownKeyNames where all_names = concat [ wired_tycon_kk_names funTyCon - , concatMap wired_tycon_kk_names primTyCons + , concatMap wired_tycon_kk_names primTyCons - , concatMap wired_tycon_kk_names wiredInTyCons - -- Does not include tuples + , concatMap wired_tycon_kk_names wiredInTyCons + -- Does not include tuples - , concatMap wired_tycon_kk_names typeNatTyCons + , concatMap wired_tycon_kk_names typeNatTyCons - , map idName wiredInIds - , map (idName . primOpId) allThePrimOps - , basicKnownKeyNames - , templateHaskellNames - ] + , map idName wiredInIds + , map (idName . primOpId) allThePrimOps + , basicKnownKeyNames + , templateHaskellNames + ] -- All of the names associated with a wired-in TyCon. -- This includes the TyCon itself, its DataCons and promoted TyCons. wired_tycon_kk_names :: TyCon -> [Name] From git at git.haskell.org Fri Oct 14 02:59:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 02:59:04 +0000 (UTC) Subject: [commit: ghc] master: Improve find_lbl panic message (aa06883) Message-ID: <20161014025904.948F73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa06883c4cffcd8d064122f4ed83d02a7bd221f2/ghc >--------------------------------------------------------------- commit aa06883c4cffcd8d064122f4ed83d02a7bd221f2 Author: Ben Gamari Date: Thu Oct 13 19:42:21 2016 -0400 Improve find_lbl panic message >--------------------------------------------------------------- aa06883c4cffcd8d064122f4ed83d02a7bd221f2 compiler/iface/TcIface.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index eba52e4..ee51b5d 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -765,7 +765,10 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons ; let lbl_names = map find_lbl my_lbls find_lbl x = case find (\ fl -> flSelector fl == x) field_lbls of Just fl -> fl - Nothing -> error $ "find_lbl missing " ++ occNameString (occName x) + Nothing -> pprPanic "TcIface.find_lbl" not_found + where + not_found = text "missing:" <+> ppr (occName x) + $$ text "known labels:" <+> ppr field_lbls -- Remember, tycon is the representation tycon ; let orig_res_ty = mkFamilyTyConApp tycon From git at git.haskell.org Fri Oct 14 14:33:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 14:33:15 +0000 (UTC) Subject: [commit: ghc] master: Add missing Semigroup instances for Monoidal datatypes in base (8c6a3d6) Message-ID: <20161014143315.135223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c6a3d68c0301bb985aa2a462936bbcf7584ae9c/ghc >--------------------------------------------------------------- commit 8c6a3d68c0301bb985aa2a462936bbcf7584ae9c Author: Ryan Scott Date: Fri Oct 14 10:30:54 2016 -0400 Add missing Semigroup instances for Monoidal datatypes in base Summary: There are currently three datatypes that are exposed in `base` that have `Monoid` instances, but no `Semigroup` instances: * `IO` * `Event` (from `GHC.Event`) * `Lifetime` (from `GHC.Event`) (There is also `EventLifetime` in `GHC.Event.Internal`, but it is not exported directly, so I didn't bother with it.) Adding the `Semigroup` instances for these types directly in the modules in which they're defined resulted in some horrific import cycles, so I opted to take the easy approach of defining all of these instances in `Data.Semigroup`. (When `Semigroup` becomes a superclass of `Monoid`, these instances will have to be moved somehow.) Fixes #12464. Test Plan: It compiles Reviewers: hvr, ekmett, austin, bgamari Reviewed By: ekmett Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2588 GHC Trac Issues: #12464 >--------------------------------------------------------------- 8c6a3d68c0301bb985aa2a462936bbcf7584ae9c libraries/base/Data/Semigroup.hs | 15 +++++++++++++++ libraries/base/changelog.md | 3 +++ 2 files changed, 18 insertions(+) diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index 88942ad..2cb1bb7 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -83,6 +83,7 @@ import Data.Monoid (All (..), Any (..), Dual (..), Endo (..), import Data.Monoid (Alt (..)) import qualified Data.Monoid as Monoid import Data.Void +import GHC.Event (Event, Lifetime (..)) import GHC.Generics infixr 6 <> @@ -705,3 +706,17 @@ instance Semigroup (Proxy s) where _ <> _ = Proxy sconcat _ = Proxy stimes _ _ = Proxy + +-- | @since 4.10.0.0 +instance Semigroup a => Semigroup (IO a) where + (<>) = liftA2 (<>) + +-- | @since 4.10.0.0 +instance Semigroup Event where + (<>) = mappend + stimes = stimesMonoid + +-- | @since 4.10.0.0 +instance Semigroup Lifetime where + (<>) = mappend + stimes = stimesMonoid diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index d2cc421..a01c878 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -23,6 +23,9 @@ `ReadS`, as well as related combinators, have been added to `Data.Functor.Classes` (#12358) + * Add `Semigroup` instance for `IO`, as well as for `Event` and `Lifetime` + from `GHC.Event` (#12464) + ## 4.9.0.0 *May 2016* * Bundled with GHC 8.0 From git at git.haskell.org Fri Oct 14 17:27:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 17:27:46 +0000 (UTC) Subject: [commit: ghc] master: Check for empty entity string in "prim" foreign imports (6c73932) Message-ID: <20161014172746.8104E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c7393261e723af3651f47bcee9af8db6bb6cf17/ghc >--------------------------------------------------------------- commit 6c7393261e723af3651f47bcee9af8db6bb6cf17 Author: Sylvain HENRY Date: Fri Oct 14 10:43:30 2016 -0400 Check for empty entity string in "prim" foreign imports Foreign imports with "prim" convention require a valid symbol identifier (see linked issue). We check this. Fix line too long Test Plan: Validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2563 GHC Trac Issues: #12355 >--------------------------------------------------------------- 6c7393261e723af3651f47bcee9af8db6bb6cf17 compiler/parser/RdrHsSyn.hs | 58 +++++++++++++++++---------- testsuite/tests/codeGen/should_compile/all.T | 2 +- testsuite/tests/ffi/should_fail/T10461.stderr | 2 +- 3 files changed, 38 insertions(+), 24 deletions(-) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 4fc1c9c..3c1792b 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -1301,28 +1301,42 @@ mkImport :: Located CCallConv -> Located Safety -> (Located StringLiteral, Located RdrName, LHsSigType RdrName) -> P (HsDecl RdrName) -mkImport (L lc cconv) (L ls safety) (L loc (StringLiteral esrc entity), v, ty) - | cconv == PrimCallConv = do - let funcTarget = CFunction (StaticTarget esrc entity Nothing True) - importSpec = CImport (L lc PrimCallConv) (L ls safety) Nothing funcTarget - (L loc esrc) - return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty - , fd_co = noForeignImportCoercionYet - , fd_fi = importSpec })) - | cconv == JavaScriptCallConv = do - let funcTarget = CFunction (StaticTarget esrc entity Nothing True) - importSpec = CImport (L lc JavaScriptCallConv) (L ls safety) Nothing - funcTarget (L loc (unpackFS entity)) - return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty - , fd_co = noForeignImportCoercionYet - , fd_fi = importSpec })) - | otherwise = do - case parseCImport (L lc cconv) (L ls safety) (mkExtName (unLoc v)) - (unpackFS entity) (L loc (unpackFS entity)) of - Nothing -> parseErrorSDoc loc (text "Malformed entity string") - Just importSpec -> return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty - , fd_co = noForeignImportCoercionYet - , fd_fi = importSpec })) +mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) = + case cconv of + L _ CCallConv -> mkCImport + L _ CApiConv -> mkCImport + L _ StdCallConv -> mkCImport + L _ PrimCallConv -> mkOtherImport + L _ JavaScriptCallConv -> mkOtherImport + where + -- Parse a C-like entity string of the following form: + -- "[static] [chname] [&] [cid]" | "dynamic" | "wrapper" + -- If 'cid' is missing, the function name 'v' is used instead as symbol + -- name (cf section 8.5.1 in Haskell 2010 report). + mkCImport = do + let e = unpackFS entity + case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc e) of + Nothing -> parseErrorSDoc loc (text "Malformed entity string") + Just importSpec -> returnSpec importSpec + + -- currently, all the other import conventions only support a symbol name in + -- the entity string. If it is missing, we use the function name instead. + mkOtherImport = returnSpec importSpec + where + entity' = if nullFS entity + then mkExtName (unLoc v) + else entity + funcTarget = CFunction (StaticTarget esrc entity' Nothing True) + importSpec = CImport cconv safety Nothing funcTarget (L loc esrc) + + returnSpec spec = return $ ForD $ ForeignImport + { fd_name = v + , fd_sig_ty = ty + , fd_co = noForeignImportCoercionYet + , fd_fi = spec + } + + -- the string "foo" is ambiguous: either a header or a C identifier. The -- C identifier case comes first in the alternatives below, so we pick diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index dad755e..e3fad18 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -37,4 +37,4 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], compile, ['-g']) test('T12115', normal, compile, ['']) -test('T12355', when(not opsys('darwin'), expect_broken(12355)), compile, ['']) +test('T12355', normal, compile, ['']) diff --git a/testsuite/tests/ffi/should_fail/T10461.stderr b/testsuite/tests/ffi/should_fail/T10461.stderr index 7962582..fae0f50 100644 --- a/testsuite/tests/ffi/should_fail/T10461.stderr +++ b/testsuite/tests/ffi/should_fail/T10461.stderr @@ -4,4 +4,4 @@ T10461.hs:6:1: error: ‘Word#’ cannot be marshalled in a foreign call To marshal unlifted types, use UnliftedFFITypes When checking declaration: - foreign import prim safe "static " cheneycopy :: Any -> Word# + foreign import prim safe "static cheneycopy" cheneycopy :: Any -> Word# From git at git.haskell.org Fri Oct 14 17:27:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 17:27:49 +0000 (UTC) Subject: [commit: ghc] master: Build ghc-iserv with --export-dynamic (3ce0e0b) Message-ID: <20161014172749.65E893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ce0e0baad05352e2e1ca439794b6f9f2325ef2b/ghc >--------------------------------------------------------------- commit 3ce0e0baad05352e2e1ca439794b6f9f2325ef2b Author: Simon Marlow Date: Fri Oct 14 10:43:10 2016 -0400 Build ghc-iserv with --export-dynamic This enables loading dynamic libraries that refer to the RTS. I just came across somewhere I needed to do that, and without `--export-dynamic` it's impossible. For now we'll only support that when using `-fexternal-interpreter`, because the dynamic symbol table for GHC itself is much bigger. Test Plan: validate Reviewers: niteria, austin, erikd, bgamari Reviewed By: bgamari Subscribers: Phyx, thomie Differential Revision: https://phabricator.haskell.org/D2590 >--------------------------------------------------------------- 3ce0e0baad05352e2e1ca439794b6f9f2325ef2b iserv/ghc.mk | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/iserv/ghc.mk b/iserv/ghc.mk index 83691bc..cab432a 100644 --- a/iserv/ghc.mk +++ b/iserv/ghc.mk @@ -24,6 +24,16 @@ iserv_stage2_MORE_HC_OPTS += -threaded iserv_stage2_p_MORE_HC_OPTS += -threaded iserv_stage2_dyn_MORE_HC_OPTS += -threaded +# Add -Wl,--export-dynamic enables GHCi to load dynamic objects that +# refer to the RTS. This is harmless if you don't use it (adds a bit +# of overhead to startup and increases the binary sizes) but if you +# need it there's no alternative. +ifeq "$(TargetElf)" "YES" +iserv_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic +iserv_stage2_p_MORE_HC_OPTS += -optl-Wl,--export-dynamic +iserv_stage2_dyn_MORE_HC_OPTS += -optl-Wl,--export-dynamic +endif + # Override the default way, because we want a specific version of this # program for each way. Note that it's important to do this even for # the vanilla version, otherwise we get a dynamic executable when From git at git.haskell.org Fri Oct 14 17:27:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 17:27:53 +0000 (UTC) Subject: [commit: ghc] master: Make error when deriving an instance for a typeclass less misleading (d5a4e49) Message-ID: <20161014172753.5B99D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5a4e49d657682eeb6e86ae464d281974ce2f5e2/ghc >--------------------------------------------------------------- commit d5a4e49d657682eeb6e86ae464d281974ce2f5e2 Author: Ryan Scott Date: Fri Oct 14 10:40:56 2016 -0400 Make error when deriving an instance for a typeclass less misleading Before, when you attempted to derive an instance for a typeclass, e.g., ``` class C1 (a :: Constraint) where class C2 where deriving instance C1 C2 ``` GHC would complain that `C2`'s data constructors aren't in scope. But that makes no sense, since typeclasses don't have constructors! By refining the checks that GHC performs when deriving, we can make the error message a little more sensible. This also cleans up a related `DeriveAnyClass` infelicity. Before, you wouldn't have been able to compile code like this: ``` import System.IO (Handle) class C a deriving instance C Handle ``` Since GHC was requiring that all data constructors of `Handle` be in scope. But `DeriveAnyClass` doesn't even generate code that mentions any data constructors, so this requirement is silly! Fixes #11509. Test Plan: make test TEST=T11509 Reviewers: simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie, simonpj Differential Revision: https://phabricator.haskell.org/D2558 GHC Trac Issues: #11509 >--------------------------------------------------------------- d5a4e49d657682eeb6e86ae464d281974ce2f5e2 compiler/typecheck/TcDeriv.hs | 134 +++++++++++++++------ compiler/typecheck/TcDerivUtils.hs | 41 +++++-- docs/users_guide/8.2.1-notes.rst | 14 +++ docs/users_guide/glasgow_exts.rst | 11 ++ .../tests/deriving/should_compile/T11509_2.hs | 13 ++ .../tests/deriving/should_compile/T11509_3.hs | 9 ++ testsuite/tests/deriving/should_compile/all.T | 2 + testsuite/tests/deriving/should_fail/T11509_1.hs | 52 ++++++++ .../tests/deriving/should_fail/T11509_1.stderr | 7 ++ testsuite/tests/deriving/should_fail/all.T | 2 + 10 files changed, 242 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 d5a4e49d657682eeb6e86ae464d281974ce2f5e2 From git at git.haskell.org Fri Oct 14 17:27:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 17:27:56 +0000 (UTC) Subject: [commit: ghc] master: Disable T-signals-child test on single-threaded runtime (0d9524a) Message-ID: <20161014172756.059733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d9524a813a381dd13d461e731fc4ec8c0404aef/ghc >--------------------------------------------------------------- commit 0d9524a813a381dd13d461e731fc4ec8c0404aef Author: Michael Snoyman Date: Fri Oct 14 10:53:40 2016 -0400 Disable T-signals-child test on single-threaded runtime As identified by Joachim, this test broke the Travis build. It appears that this is due to the usage of the single-threaded runtime there. I've confirmed that this fix causes the Travis build to pass: https://travis-ci.org/snoyberg/ghc/builds/167368988. Test Plan: Confirm tests now pass Reviewers: austin, nomeata, bgamari Reviewed By: nomeata, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2593 >--------------------------------------------------------------- 0d9524a813a381dd13d461e731fc4ec8c0404aef testsuite/tests/runghc/T-signals-child.hs | 9 +++++++-- testsuite/tests/runghc/all.T | 4 +++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/runghc/T-signals-child.hs b/testsuite/tests/runghc/T-signals-child.hs index 21c1b64..ee36f62 100644 --- a/testsuite/tests/runghc/T-signals-child.hs +++ b/testsuite/tests/runghc/T-signals-child.hs @@ -1,7 +1,7 @@ import Control.Concurrent.MVar (readMVar) import System.Environment (getArgs) import System.Exit (ExitCode (ExitFailure), exitFailure) -import System.IO (hGetLine, hPutStrLn) +import System.IO (hClose, hGetLine, hPutStrLn) import System.Posix.Process (exitImmediately, getProcessID) import System.Posix.Signals (Handler (Catch), installHandler, sigHUP, signalProcess) @@ -9,6 +9,7 @@ import System.Process (StdStream (CreatePipe), createProcess, proc, std_in, std_out, waitForProcess) import System.Process.Internals (ProcessHandle (..), ProcessHandle__ (OpenHandle)) +import System.Timeout (timeout) main :: IO () main = do @@ -46,6 +47,7 @@ runParent runghc = do -- Send the child some input so that it will exit if it didn't -- have a sigHUP handler installed. hPutStrLn inH "" + hClose inH -- Read out the rest of stdout from the child, which will be -- either "NOSIGNAL\n" or "HUP\n" @@ -95,7 +97,10 @@ runChild = do -- Block until we receive input, giving a chance for the signal -- handler to be triggered, and if the signal handler isn't -- triggered, gives us an escape route from this function. - _ <- getLine + -- + -- Include a reasonable timeout to prevent this from running for + -- too long + _ <- timeout 10000000 getLine -- Reaching this point indicates a failure of the test. Print some -- non HUP message and exit with a non HUP exit diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index 107f35b..01337bc 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -10,6 +10,8 @@ test('T11247', [req_interp, expect_broken(11247)], run_command, test('T6132', [when(opsys('darwin'), expect_broken(6132))], compile, ['']) test('T-signals-child', - [when(opsys('mingw32'), skip), req_interp], + [ when(opsys('mingw32'), skip), req_interp + , only_ways(['threaded1', 'threaded2']) + ], run_command, ['$MAKE --no-print-directory -s T-signals-child']) From git at git.haskell.org Fri Oct 14 17:29:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 17:29:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Further improve error handling in TcRn monad (1ef2742) Message-ID: <20161014172908.C17F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/1ef274298978369e2e07b5c43e635a5ca529a0af/ghc >--------------------------------------------------------------- commit 1ef274298978369e2e07b5c43e635a5ca529a0af Author: Simon Peyton Jones Date: Thu Oct 13 12:24:53 2016 +0100 Further improve error handling in TcRn monad This patch builds on the one for Trac #12124, by dealing properly with out-of-scope "hole" errors. This fixes Trac #12529. The hard error coming from visible type application is still there, but the out-of-scope error is no longer suppressed. (Arguably the VTA message should be suppressed somehow, but that's a battle for another day.) (cherry picked from commit 2fdf21bf26386ac5558ed5b95105bcf78e31f093) >--------------------------------------------------------------- 1ef274298978369e2e07b5c43e635a5ca529a0af compiler/typecheck/TcRnMonad.hs | 79 +++++++++++++++------- compiler/typecheck/TcRnTypes.hs | 5 +- .../T11456.hs => typecheck/should_fail/T12529.hs} | 4 +- .../tests/typecheck/should_fail/T12529.stderr | 8 +++ testsuite/tests/typecheck/should_fail/all.T | 2 + 5 files changed, 69 insertions(+), 29 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 1ef274298978369e2e07b5c43e635a5ca529a0af From git at git.haskell.org Fri Oct 14 18:48:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 18:48:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Disable T-signals-child test on single-threaded runtime (1aaa6f6) Message-ID: <20161014184810.A5D9A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/1aaa6f62f4330cefad2a0f89ca8ffd70b62c455a/ghc >--------------------------------------------------------------- commit 1aaa6f62f4330cefad2a0f89ca8ffd70b62c455a Author: Michael Snoyman Date: Fri Oct 14 10:53:40 2016 -0400 Disable T-signals-child test on single-threaded runtime As identified by Joachim, this test broke the Travis build. It appears that this is due to the usage of the single-threaded runtime there. I've confirmed that this fix causes the Travis build to pass: https://travis-ci.org/snoyberg/ghc/builds/167368988. Test Plan: Confirm tests now pass Reviewers: austin, nomeata, bgamari Reviewed By: nomeata, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2593 (cherry picked from commit 0d9524a813a381dd13d461e731fc4ec8c0404aef) >--------------------------------------------------------------- 1aaa6f62f4330cefad2a0f89ca8ffd70b62c455a testsuite/tests/runghc/T-signals-child.hs | 9 +++++++-- testsuite/tests/runghc/all.T | 4 +++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/runghc/T-signals-child.hs b/testsuite/tests/runghc/T-signals-child.hs index 21c1b64..ee36f62 100644 --- a/testsuite/tests/runghc/T-signals-child.hs +++ b/testsuite/tests/runghc/T-signals-child.hs @@ -1,7 +1,7 @@ import Control.Concurrent.MVar (readMVar) import System.Environment (getArgs) import System.Exit (ExitCode (ExitFailure), exitFailure) -import System.IO (hGetLine, hPutStrLn) +import System.IO (hClose, hGetLine, hPutStrLn) import System.Posix.Process (exitImmediately, getProcessID) import System.Posix.Signals (Handler (Catch), installHandler, sigHUP, signalProcess) @@ -9,6 +9,7 @@ import System.Process (StdStream (CreatePipe), createProcess, proc, std_in, std_out, waitForProcess) import System.Process.Internals (ProcessHandle (..), ProcessHandle__ (OpenHandle)) +import System.Timeout (timeout) main :: IO () main = do @@ -46,6 +47,7 @@ runParent runghc = do -- Send the child some input so that it will exit if it didn't -- have a sigHUP handler installed. hPutStrLn inH "" + hClose inH -- Read out the rest of stdout from the child, which will be -- either "NOSIGNAL\n" or "HUP\n" @@ -95,7 +97,10 @@ runChild = do -- Block until we receive input, giving a chance for the signal -- handler to be triggered, and if the signal handler isn't -- triggered, gives us an escape route from this function. - _ <- getLine + -- + -- Include a reasonable timeout to prevent this from running for + -- too long + _ <- timeout 10000000 getLine -- Reaching this point indicates a failure of the test. Print some -- non HUP message and exit with a non HUP exit diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index ef3cb94..36cd6da 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -5,6 +5,8 @@ test('T8601', req_interp, run_command, ['$MAKE --no-print-directory -s T8601']) test('T-signals-child', - [when(opsys('mingw32'), skip), req_interp], + [ when(opsys('mingw32'), skip), req_interp + , only_ways(['threaded1', 'threaded2']) + ], run_command, ['$MAKE --no-print-directory -s T-signals-child']) From git at git.haskell.org Fri Oct 14 18:48:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 18:48:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: testsuite: Add testcase for #12355 (0f9a8a9) Message-ID: <20161014184813.EE6EE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/0f9a8a9096b3b236b80fe82f2570ca3865903518/ghc >--------------------------------------------------------------- commit 0f9a8a9096b3b236b80fe82f2570ca3865903518 Author: Ben Gamari Date: Fri Jul 1 14:29:54 2016 +0200 testsuite: Add testcase for #12355 Test Plan: Validate Reviewers: austin, osa1 Reviewed By: osa1 Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2377 GHC Trac Issues: #12355 (cherry picked from commit afec447cde1f97438bbc5bf7a31000e948c721eb) >--------------------------------------------------------------- 0f9a8a9096b3b236b80fe82f2570ca3865903518 testsuite/tests/codeGen/should_compile/T12355.hs | 7 +++++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 2 files changed, 8 insertions(+) diff --git a/testsuite/tests/codeGen/should_compile/T12355.hs b/testsuite/tests/codeGen/should_compile/T12355.hs new file mode 100644 index 0000000..9ad9ebe --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T12355.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GHCForeignImportPrim, UnliftedFFITypes, MagicHash #-} + +module Lib where + +import GHC.Prim + +foreign import prim f1 :: Int# -> Int# diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 5364c3d..d7cd6fe 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -33,3 +33,4 @@ test('T9964', normal, compile, ['-O']) test('T10518', [cmm_src], compile, ['']) test('T10667', normal, compile, ['-g']) test('T12115', normal, compile, ['']) +test('T12355', expect_broken(12355), compile, ['']) From git at git.haskell.org Fri Oct 14 18:48:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 18:48:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Check for empty entity string in "prim" foreign imports (5eab189) Message-ID: <20161014184816.A01993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5eab189b329344630f76b8751c1289ce480ca46b/ghc >--------------------------------------------------------------- commit 5eab189b329344630f76b8751c1289ce480ca46b Author: Sylvain HENRY Date: Fri Oct 14 10:43:30 2016 -0400 Check for empty entity string in "prim" foreign imports Foreign imports with "prim" convention require a valid symbol identifier (see linked issue). We check this. Fix line too long Test Plan: Validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2563 GHC Trac Issues: #12355 (cherry picked from commit 6c7393261e723af3651f47bcee9af8db6bb6cf17) >--------------------------------------------------------------- 5eab189b329344630f76b8751c1289ce480ca46b compiler/parser/RdrHsSyn.hs | 58 +++++++++++++++++---------- testsuite/tests/codeGen/should_compile/all.T | 2 +- testsuite/tests/ffi/should_fail/T10461.stderr | 2 +- 3 files changed, 38 insertions(+), 24 deletions(-) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 3ed972e..d79ac66 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -1274,28 +1274,42 @@ mkImport :: Located CCallConv -> Located Safety -> (Located StringLiteral, Located RdrName, LHsSigType RdrName) -> P (HsDecl RdrName) -mkImport (L lc cconv) (L ls safety) (L loc (StringLiteral esrc entity), v, ty) - | cconv == PrimCallConv = do - let funcTarget = CFunction (StaticTarget esrc entity Nothing True) - importSpec = CImport (L lc PrimCallConv) (L ls safety) Nothing funcTarget - (L loc esrc) - return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty - , fd_co = noForeignImportCoercionYet - , fd_fi = importSpec })) - | cconv == JavaScriptCallConv = do - let funcTarget = CFunction (StaticTarget esrc entity Nothing True) - importSpec = CImport (L lc JavaScriptCallConv) (L ls safety) Nothing - funcTarget (L loc (unpackFS entity)) - return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty - , fd_co = noForeignImportCoercionYet - , fd_fi = importSpec })) - | otherwise = do - case parseCImport (L lc cconv) (L ls safety) (mkExtName (unLoc v)) - (unpackFS entity) (L loc (unpackFS entity)) of - Nothing -> parseErrorSDoc loc (text "Malformed entity string") - Just importSpec -> return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty - , fd_co = noForeignImportCoercionYet - , fd_fi = importSpec })) +mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) = + case cconv of + L _ CCallConv -> mkCImport + L _ CApiConv -> mkCImport + L _ StdCallConv -> mkCImport + L _ PrimCallConv -> mkOtherImport + L _ JavaScriptCallConv -> mkOtherImport + where + -- Parse a C-like entity string of the following form: + -- "[static] [chname] [&] [cid]" | "dynamic" | "wrapper" + -- If 'cid' is missing, the function name 'v' is used instead as symbol + -- name (cf section 8.5.1 in Haskell 2010 report). + mkCImport = do + let e = unpackFS entity + case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc e) of + Nothing -> parseErrorSDoc loc (text "Malformed entity string") + Just importSpec -> returnSpec importSpec + + -- currently, all the other import conventions only support a symbol name in + -- the entity string. If it is missing, we use the function name instead. + mkOtherImport = returnSpec importSpec + where + entity' = if nullFS entity + then mkExtName (unLoc v) + else entity + funcTarget = CFunction (StaticTarget esrc entity' Nothing True) + importSpec = CImport cconv safety Nothing funcTarget (L loc esrc) + + returnSpec spec = return $ ForD $ ForeignImport + { fd_name = v + , fd_sig_ty = ty + , fd_co = noForeignImportCoercionYet + , fd_fi = spec + } + + -- the string "foo" is ambiguous: either a header or a C identifier. The -- C identifier case comes first in the alternatives below, so we pick diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index d7cd6fe..65e59bc 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -33,4 +33,4 @@ test('T9964', normal, compile, ['-O']) test('T10518', [cmm_src], compile, ['']) test('T10667', normal, compile, ['-g']) test('T12115', normal, compile, ['']) -test('T12355', expect_broken(12355), compile, ['']) +test('T12355', normal, compile, ['']) diff --git a/testsuite/tests/ffi/should_fail/T10461.stderr b/testsuite/tests/ffi/should_fail/T10461.stderr index 7962582..fae0f50 100644 --- a/testsuite/tests/ffi/should_fail/T10461.stderr +++ b/testsuite/tests/ffi/should_fail/T10461.stderr @@ -4,4 +4,4 @@ T10461.hs:6:1: error: ‘Word#’ cannot be marshalled in a foreign call To marshal unlifted types, use UnliftedFFITypes When checking declaration: - foreign import prim safe "static " cheneycopy :: Any -> Word# + foreign import prim safe "static cheneycopy" cheneycopy :: Any -> Word# From git at git.haskell.org Fri Oct 14 19:39:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 19:39:17 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Have SimpleWrapperUnfoldings (be4a16d) Message-ID: <20161014193917.EB1D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/be4a16dbc727fe35315a5bc47878d7e09e5f6288/ghc >--------------------------------------------------------------- commit be4a16dbc727fe35315a5bc47878d7e09e5f6288 Author: Joachim Breitner Date: Fri Oct 14 15:34:23 2016 -0400 Have SimpleWrapperUnfoldings to keep them apart from compulsory unfoldings for now, to avoid accidential unrelated effects of this patch. >--------------------------------------------------------------- be4a16dbc727fe35315a5bc47878d7e09e5f6288 compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/CoreSubst.hs | 6 +++--- compiler/coreSyn/CoreSyn.hs | 15 +++++++++++---- compiler/coreSyn/CoreUnfold.hs | 8 ++++---- 4 files changed, 19 insertions(+), 12 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 5daf492..ff1a530 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -499,7 +499,7 @@ mkSimpleDataConRep wrap_name dc -- Somewhat ugly, but there is no code generated for wrappers -- for unboxed tuples. Let's just get rid of them as soon as possible. | is_unbox_tup = mkCompulsoryUnfolding wrap_rhs - | otherwise = mkCompulsorySatUnfolding wrap_arity wrap_rhs + | otherwise = mkSimpleWrapperUnfolding wrap_arity wrap_rhs wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR dc) wrap_arg_dmds = replicate wrap_arity topDmd rep_strs = [ NotMarkedStrict | _ <- arg_tys ] diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 81bd3a8..de6e10a 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -927,8 +927,7 @@ simple_opt_expr subst expr where in_scope_env = (substInScope subst, simpleUnfoldingFun) - go (Var v) | isSatCompulsoryUnfolding (idUnfolding v) 0 - , isAlwaysActive (idInlineActivation v) + go (Var v) | isSimpleWrapperUnfolding (idUnfolding v) 0 = go (unfoldingTemplate (idUnfolding v)) go (Var v) = lookupIdSubst (text "simpleOptExpr") subst v go (App e1 e2) = simple_app subst e1 [go e2] @@ -1006,7 +1005,8 @@ simple_app subst (Lam b e) (a:as) (subst', b') = subst_opt_bndr subst b b2 = add_info subst' b b' simple_app subst (Var v) as - | isSatCompulsoryUnfolding (idUnfolding v) (length as) + | isCompulsoryUnfolding (idUnfolding v) || + isSimpleWrapperUnfolding (idUnfolding v) (length as) , isAlwaysActive (idInlineActivation v) -- See Note [Unfold compulsory unfoldings in LHSs] = simple_app subst (unfoldingTemplate (idUnfolding v)) as diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 724d61c..7bdbf39 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -57,7 +57,7 @@ module CoreSyn ( maybeUnfoldingTemplate, otherCons, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, - isSatCompulsoryUnfolding, + isSimpleWrapperUnfolding, isStableUnfolding, hasStableCoreUnfolding_maybe, isClosedUnfolding, hasSomeUnfolding, isBootUnfolding, @@ -1065,6 +1065,12 @@ data UnfoldingSource -- -- See Note [InlineRules] + | InlineWrapper -- A simple wrapper (e.g. for data constructors). Simple means that + -- it applies in all phases, and the right hand side is simple + -- enough so that it may occur on the LHS of a rule + -- (no case expressions, for example). + -- Such unfolding are applied in the LHS of a rule! + | InlineCompulsory -- Something that *has* no binding, so you *must* inline it -- Only a few primop-like things have this property -- (see MkId.hs, calls to mkCompulsoryUnfolding). @@ -1180,6 +1186,7 @@ isStableSource :: UnfoldingSource -> Bool -- Keep the unfolding template isStableSource InlineCompulsory = True isStableSource InlineStable = True +isStableSource InlineWrapper = True isStableSource InlineRhs = False -- | Retrieves the template of an unfolding: panics if none is known @@ -1259,13 +1266,13 @@ isCompulsoryUnfolding :: Unfolding -> Bool isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True isCompulsoryUnfolding _ = False -isSatCompulsoryUnfolding :: Unfolding -> Arity -> Bool -isSatCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory, uf_guidance = guidance }) arity +isSimpleWrapperUnfolding :: Unfolding -> Arity -> Bool +isSimpleWrapperUnfolding (CoreUnfolding { uf_src = InlineWrapper, uf_guidance = guidance }) arity | arity_ok guidance = True where arity_ok (UnfWhen { ug_arity = ug_arity }) = ug_arity <= arity arity_ok _ = True -isSatCompulsoryUnfolding _ _ +isSimpleWrapperUnfolding _ _ = False isStableUnfolding :: Unfolding -> Bool diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 958e3df..146f8c7 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -24,7 +24,7 @@ module CoreUnfold ( mkUnfolding, mkCoreUnfolding, mkTopUnfolding, mkSimpleUnfolding, mkWorkerUnfolding, mkInlineUnfolding, mkInlinableUnfolding, mkWwInlineRule, - mkCompulsoryUnfolding, mkCompulsorySatUnfolding, mkDFunUnfolding, + mkCompulsoryUnfolding, mkSimpleWrapperUnfolding, mkDFunUnfolding, specUnfolding, ArgSummary(..), @@ -125,9 +125,9 @@ mkWorkerUnfolding dflags work_fn mkWorkerUnfolding _ _ _ = noUnfolding -- Inline very early, even in gentle, but only if saturated. -mkCompulsorySatUnfolding :: Arity -> CoreExpr -> Unfolding -mkCompulsorySatUnfolding arity expr - = mkCoreUnfolding InlineCompulsory True +mkSimpleWrapperUnfolding :: Arity -> CoreExpr -> Unfolding +mkSimpleWrapperUnfolding arity expr + = mkCoreUnfolding InlineWrapper True (simpleOptExpr expr) (UnfWhen { ug_arity = arity , ug_unsat_ok = False From git at git.haskell.org Fri Oct 14 20:42:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Oct 2016 20:42:34 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Have SimpleWrapperUnfoldings (6419c31) Message-ID: <20161014204234.E50A33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/6419c314762cbac3020dd8c1091e9d205da8463b/ghc >--------------------------------------------------------------- commit 6419c314762cbac3020dd8c1091e9d205da8463b Author: Joachim Breitner Date: Fri Oct 14 15:34:23 2016 -0400 Have SimpleWrapperUnfoldings to keep them apart from compulsory unfoldings for now, to avoid accidential unrelated effects of this patch. >--------------------------------------------------------------- 6419c314762cbac3020dd8c1091e9d205da8463b compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/CoreSubst.hs | 6 +++--- compiler/coreSyn/CoreSyn.hs | 15 +++++++++++---- compiler/coreSyn/CoreUnfold.hs | 8 ++++---- compiler/coreSyn/PprCore.hs | 1 + compiler/iface/IfaceSyn.hs | 13 ++++++++++++- compiler/iface/MkIface.hs | 5 +++++ compiler/iface/TcIface.hs | 6 ++++++ 8 files changed, 43 insertions(+), 13 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 6419c314762cbac3020dd8c1091e9d205da8463b From git at git.haskell.org Sat Oct 15 02:30:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Oct 2016 02:30:44 +0000 (UTC) Subject: [commit: ghc] master: Fix Windows build following D2588 (e39589e) Message-ID: <20161015023044.3FFE73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e39589e2e4f788565c4a7f02cb85802214a95757/ghc >--------------------------------------------------------------- commit e39589e2e4f788565c4a7f02cb85802214a95757 Author: Ryan Scott Date: Fri Oct 14 22:28:29 2016 -0400 Fix Windows build following D2588 Commit 8c6a3d68c0301bb985aa2a462936bbcf7584ae9c inadvertently broke the build on Windows. This restores Windows compatibility. >--------------------------------------------------------------- e39589e2e4f788565c4a7f02cb85802214a95757 libraries/base/Data/Semigroup.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index 2cb1bb7..1c3d9da 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} @@ -83,7 +84,9 @@ import Data.Monoid (All (..), Any (..), Dual (..), Endo (..), import Data.Monoid (Alt (..)) import qualified Data.Monoid as Monoid import Data.Void -import GHC.Event (Event, Lifetime (..)) +#ifndef mingw32_HOST_OS +import GHC.Event (Event, Lifetime) +#endif import GHC.Generics infixr 6 <> @@ -711,6 +714,7 @@ instance Semigroup (Proxy s) where instance Semigroup a => Semigroup (IO a) where (<>) = liftA2 (<>) +#ifndef mingw32_HOST_OS -- | @since 4.10.0.0 instance Semigroup Event where (<>) = mappend @@ -720,3 +724,4 @@ instance Semigroup Event where instance Semigroup Lifetime where (<>) = mappend stimes = stimesMonoid +#endif From git at git.haskell.org Sat Oct 15 03:33:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Oct 2016 03:33:02 +0000 (UTC) Subject: [commit: ghc] wip/T12618: magictDict built-in rule: Also match ConApp (27cab4f) Message-ID: <20161015033302.BD4D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/27cab4fa5556f962e63234c36d6d8a8e049da4ee/ghc >--------------------------------------------------------------- commit 27cab4fa5556f962e63234c36d6d8a8e049da4ee Author: Joachim Breitner Date: Fri Oct 14 23:20:12 2016 -0400 magictDict built-in rule: Also match ConApp >--------------------------------------------------------------- 27cab4fa5556f962e63234c36d6d8a8e049da4ee compiler/prelude/PrelRules.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index f637fd3..231cec1 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -31,7 +31,7 @@ import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon, unwrapNewTyCon_maybe ) -import DataCon ( dataConTag, dataConTyCon ) +import DataCon ( dataConTag, dataConTyCon, dataConRepType ) import CoreUtils ( cheapEqExpr, exprIsHNF ) import CoreUnfold ( exprIsConApp_maybe ) import Type @@ -1187,6 +1187,14 @@ match_inline _ = Nothing -- See Note [magicDictId magic] in `basicTypes/MkId.hs` -- for a description of what is going on here. match_magicDict :: [Expr CoreBndr] -> Maybe (Expr CoreBndr) +match_magicDict [Type _, ConApp dc [Type a, Type _ , f], x, y ] + | Just (fieldTy, _) <- splitFunTy_maybe $ dropForAlls $ dataConRepType dc + , Just (dictTy, _) <- splitFunTy_maybe fieldTy + , Just dictTc <- tyConAppTyCon_maybe dictTy + , Just (_,_,co) <- unwrapNewTyCon_maybe dictTc + = Just + $ f `App` Cast x (mkSymCo (mkUnbranchedAxInstCo Representational co [a] [])) + `App` y match_magicDict [Type _, Var wrap `App` Type a `App` Type _ `App` f, x, y ] | Just (fieldTy, _) <- splitFunTy_maybe $ dropForAlls $ idType wrap , Just (dictTy, _) <- splitFunTy_maybe fieldTy From git at git.haskell.org Sat Oct 15 15:12:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Oct 2016 15:12:57 +0000 (UTC) Subject: [commit: ghc] master: Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings (b501709) Message-ID: <20161015151257.E3D693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b501709ed79ba03e72518ef9dd101ce2d03db2de/ghc >--------------------------------------------------------------- commit b501709ed79ba03e72518ef9dd101ce2d03db2de Author: Ryan Scott Date: Sat Oct 15 11:11:20 2016 -0400 Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings Summary: To fix this issue, we simply disable `RebindableSyntax` whenever we rename the code generated from a deriving clause. Fixes #12688. Test Plan: make test TEST=T12688 Reviewers: simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2591 GHC Trac Issues: #12688 >--------------------------------------------------------------- b501709ed79ba03e72518ef9dd101ce2d03db2de compiler/typecheck/TcDeriv.hs | 41 ++++++++++++++++++++--- compiler/typecheck/TcRnMonad.hs | 6 +++- docs/users_guide/8.0.2-notes.rst | 4 +++ docs/users_guide/glasgow_exts.rst | 27 +++++++++++++++ testsuite/tests/deriving/should_compile/T12688.hs | 15 +++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 6 files changed, 88 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 524273c..af5e730 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -288,11 +288,17 @@ renameDeriv is_boot inst_infos bagBinds , emptyValBindsOut, usesOnly (plusFVs fvs)) } | otherwise - = discardWarnings $ -- Discard warnings about unused bindings etc - setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have - -- case x of {} - setXOptM LangExt.ScopedTypeVariables $ -- Derived decls (for newtype-deriving) can - setXOptM LangExt.KindSignatures $ -- used ScopedTypeVariables & KindSignatures + = discardWarnings $ + -- Discard warnings about unused bindings etc + setXOptM LangExt.EmptyCase $ + -- Derived decls (for empty types) can have + -- case x of {} + setXOptM LangExt.ScopedTypeVariables $ + setXOptM LangExt.KindSignatures $ + -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & + -- KindSignatures + unsetXOptM LangExt.RebindableSyntax $ + -- See Note [Avoid RebindableSyntax when deriving] do { -- Bring the extra deriving stuff into scope -- before renaming the instances themselves @@ -362,6 +368,31 @@ dropped patterns have. Also, this technique carries over the kind substitution from deriveTyData nicely. +Note [Avoid RebindableSyntax when deriving] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The RebindableSyntax extension interacts awkwardly with the derivation of +any stock class whose methods require the use of string literals. The Show +class is a simple example (see Trac #12688): + + {-# LANGUAGE RebindableSyntax, OverloadedStrings #-} + newtype Text = Text String + fromString :: String -> Text + fromString = Text + + data Foo = Foo deriving Show + +This will generate code to the effect of: + + instance Show Foo where + showsPrec _ Foo = showString "Foo" + +But because RebindableSyntax and OverloadedStrings are enabled, the "Foo" +string literal is now of type Text, not String, which showString doesn't +accept! This causes the generated Show instance to fail to typecheck. + +To avoid this kind of scenario, we simply turn off RebindableSyntax entirely +in derived code. + ************************************************************************ * * From HsSyn to DerivSpec diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 5f4f979..563e5aa 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -18,7 +18,7 @@ module TcRnMonad( setGblEnv, getLclEnv, updLclEnv, setLclEnv, getEnvs, setEnvs, xoptM, doptM, goptM, woptM, - setXOptM, unsetGOptM, unsetWOptM, + setXOptM, unsetXOptM, unsetGOptM, unsetWOptM, whenDOptM, whenGOptM, whenWOptM, whenXOptM, getGhcMode, withDoDynamicToo, @@ -460,6 +460,10 @@ setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a setXOptM flag = updTopEnv (\top -> top { hsc_dflags = xopt_set (hsc_dflags top) flag}) +unsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +unsetXOptM flag = + updTopEnv (\top -> top { hsc_dflags = xopt_unset (hsc_dflags top) flag}) + unsetGOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a unsetGOptM flag = updTopEnv (\top -> top { hsc_dflags = gopt_unset (hsc_dflags top) flag}) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 82c214e..c8e76ed 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -25,6 +25,10 @@ Language - A bug has been fixed that caused standalone derived ``Ix`` instances to fail for GADTs with exactly one constructor (:ghc-ticket:`12583`). +- A bug has been fixed that caused derived ``Show`` instances to fail in the + presence of :ghc-flag:`-XRebindableSyntax` and + :ghc-flag:`-XOverloadedStrings` (:ghc-ticket:`12688`). + Compiler ~~~~~~~~ diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index e76465a..9f0a755 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -1460,6 +1460,33 @@ Be warned: this is an experimental facility, with fewer checks than usual. Use ``-dcore-lint`` to typecheck the desugared program. If Core Lint is happy you should be all right. +Things unaffected by :ghc-flag:`-XRebindableSyntax` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +:ghc-flag:`-XRebindableSyntax` does not apply to any code generated from a +``deriving`` clause or declaration. To see why, consider the following code: :: + + {-# LANGUAGE RebindableSyntax, OverloadedStrings #-} + newtype Text = Text String + + fromString :: String -> Text + fromString = Text + + data Foo = Foo deriving Show + +This will generate code to the effect of: :: + + instance Show Foo where + showsPrec _ Foo = showString "Foo" + +But because :ghc-flag:`-XRebindableSyntax` and :ghc-flag:`-XOverloadedStrings` +are enabled, the ``"Foo"`` string literal would now be of type ``Text``, not +``String``, which ``showString`` doesn't accept! This causes the generated +``Show`` instance to fail to typecheck. It's hard to imagine any scenario where +it would be desirable have :ghc-flag:`-XRebindableSyntax` behavior within +derived code, so GHC simply ignores :ghc-flag:`-XRebindableSyntax` entirely +when checking derived code. + .. _postfix-operators: Postfix operators diff --git a/testsuite/tests/deriving/should_compile/T12688.hs b/testsuite/tests/deriving/should_compile/T12688.hs new file mode 100644 index 0000000..0735a81 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T12688.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE RebindableSyntax, OverloadedStrings #-} +module T12688 where + +import Prelude (String,Show(..)) + +newtype Text = Text String + +fromString :: String -> Text +fromString = Text + +x :: Text +x = "x" + +newtype Foo = Foo () + deriving (Show) diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 26312df..bd1f07a 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -76,3 +76,4 @@ test('T12245', normal, compile, ['']) test('T12399', normal, compile, ['']) test('T12583', normal, compile, ['']) test('T12616', normal, compile, ['']) +test('T12688', normal, compile, ['']) From git at git.haskell.org Sat Oct 15 22:35:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Oct 2016 22:35:30 +0000 (UTC) Subject: [commit: ghc] master: Add a forward reference for a Note (512541b) Message-ID: <20161015223530.5A4EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/512541bc6b1b81e1bda503754d02cf4dc4248dc4/ghc >--------------------------------------------------------------- commit 512541bc6b1b81e1bda503754d02cf4dc4248dc4 Author: Ryan Scott Date: Sat Oct 15 18:33:06 2016 -0400 Add a forward reference for a Note And fix a typo within said Note. [ci skip] >--------------------------------------------------------------- 512541bc6b1b81e1bda503754d02cf4dc4248dc4 compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcType.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 563e5aa..b871daf 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -1484,7 +1484,7 @@ pushTcLevelM_ :: TcM a -> TcM a pushTcLevelM_ x = updLclEnv (\ env -> env { tcl_tclvl = pushTcLevel (tcl_tclvl env) }) x pushTcLevelM :: TcM a -> TcM (a, TcLevel) --- See Note [TcLevel assignment] +-- See Note [TcLevel assignment] in TcType pushTcLevelM thing_inside = do { env <- getLclEnv ; let tclvl' = pushTcLevel (tcl_tclvl env) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index e77a34d..1888578 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -654,7 +654,7 @@ We arrange the TcLevels like this ...etc... The even-numbered levels are for the flatten-meta-variables assigned -at the next level in. Eg for a second-level implication conststraint +at the next level in. Eg for a second-level implication constraint (level 5), the flatten meta-vars are level 4, which makes them untouchable. The flatten meta-vars could equally well all have level 0, or just NotALevel since they do not live across implications. From git at git.haskell.org Sun Oct 16 17:41:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 16 Oct 2016 17:41:40 +0000 (UTC) Subject: [commit: ghc] master: Correct name of makeStableName in haddock (afdde48) Message-ID: <20161016174140.C40D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/afdde48baf98e552b860cf1aec093d71ccad1363/ghc >--------------------------------------------------------------- commit afdde48baf98e552b860cf1aec093d71ccad1363 Author: Reid Barton Date: Sun Oct 16 13:40:11 2016 -0400 Correct name of makeStableName in haddock >--------------------------------------------------------------- afdde48baf98e552b860cf1aec093d71ccad1363 libraries/base/System/Mem/StableName.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index f2f2c2b..dcd5273 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -53,7 +53,7 @@ import GHC.Base ( Int(..), StableName#, makeStableName# The reverse is not necessarily true: if two stable names are not equal, then the objects they name may still be equal. Note in particular - that `mkStableName` may return a different `StableName` after an + that `makeStableName` may return a different `StableName` after an object is evaluated. Stable Names are similar to Stable Pointers ("Foreign.StablePtr"), From git at git.haskell.org Mon Oct 17 07:42:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:42:25 +0000 (UTC) Subject: [commit: ghc] master: Comments about -Wredundant-constraints (3174beb) Message-ID: <20161017074225.32F743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3174beb68919bf706ae5ec7d7d58d11759ba3584/ghc >--------------------------------------------------------------- commit 3174beb68919bf706ae5ec7d7d58d11759ba3584 Author: Simon Peyton Jones Date: Fri Oct 14 10:41:14 2016 +0100 Comments about -Wredundant-constraints >--------------------------------------------------------------- 3174beb68919bf706ae5ec7d7d58d11759ba3584 compiler/typecheck/TcErrors.hs | 1 + compiler/typecheck/TcSimplify.hs | 24 +++++++++++++++++------- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index d49ca64..4837f52 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -367,6 +367,7 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given _ -> [] warnRedundantConstraints :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [EvVar] -> TcM () +-- See Note [Tracking redundant constraints] in TcSimplify warnRedundantConstraints ctxt env info ev_vars | null redundant_evs = return () diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 39b2d83..d146c73 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1511,13 +1511,23 @@ works: ----- Shortcomings -Consider (see Trac #9939) - f2 :: (Eq a, Ord a) => a -> a -> Bool - -- Ord a redundant, but Eq a is reported - f2 x y = (x == y) - -We report (Eq a) as redundant, whereas actually (Ord a) is. But it's -really not easy to detect that! +After I introduced -Wredundant-constraints there was extensive discussion +about cases where it reported a redundant constraint but the programmer +really wanted it. See + + * #11370 (removed it from -Wdefault) + * #10635 (removed it from -Wall as well) + * #12142 + * #11474, #10100 (class not used, but its fundeps are) + * #11099 (redundant, but still desired) + * #10183 (constraint necessary to exclude omitted case) + + * #9939: f2 :: (Eq a, Ord a) => a -> a -> Bool + -- Ord a redundant, but Eq a is reported + f2 x y = (x == y) + + We report (Eq a) as redundant, whereas actually (Ord a) is. + But it's really not easy to detect that! Note [Cutting off simpl_loop] From git at git.haskell.org Mon Oct 17 07:42:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:42:27 +0000 (UTC) Subject: [commit: ghc] master: Fix comment typo (82b54fc) Message-ID: <20161017074227.D686A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/82b54fcf815ccd80be8887401dd69ab7a488386e/ghc >--------------------------------------------------------------- commit 82b54fcf815ccd80be8887401dd69ab7a488386e Author: Simon Peyton Jones Date: Fri Oct 14 10:41:45 2016 +0100 Fix comment typo >--------------------------------------------------------------- 82b54fcf815ccd80be8887401dd69ab7a488386e 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 714212c..dca9717 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -3020,7 +3020,7 @@ If -fprint-equality-relations or -dppr-debug or we are in If ...something about heterogeneous equalities -Ohherwise print 'Coercible' for (~#), and "~" for the others. +Otherwise print 'Coercible' for (~R#), and "~" for the others. This is all a bit ad-hoc, trying to print out the best representation of equalities. If you see a better design, go for it. From git at git.haskell.org Mon Oct 17 07:42:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:42:30 +0000 (UTC) Subject: [commit: ghc] master: Fix shadowing in mkWwBodies (692c8df) Message-ID: <20161017074230.80E443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/692c8df03969ee6a0de5158f05907b16689945d0/ghc >--------------------------------------------------------------- commit 692c8df03969ee6a0de5158f05907b16689945d0 Author: Simon Peyton Jones Date: Fri Oct 14 12:05:46 2016 +0100 Fix shadowing in mkWwBodies This bug, exposed by Trac #12562 was very obscure, and has been lurking for a long time. What happened was that, in the worker/wrapper split a tyvar binder for a worker function accidentally shadowed an in-scope term variable that was mentioned in the body of the function It's jolly hard to provoke, so I have not even attempted to make a test case. There's a Note [Freshen WW arguments] to explain. Interestingly, fixing the bug (which meant fresher type variables) revealed a second lurking bug: I'd failed to apply the substitution to the coercion in the second last case of mkWWArgs, which introduces a Cast. >--------------------------------------------------------------- 692c8df03969ee6a0de5158f05907b16689945d0 compiler/stranal/WorkWrap.hs | 4 ++- compiler/stranal/WwLib.hs | 78 +++++++++++++++++++++++++++++--------------- 2 files changed, 55 insertions(+), 27 deletions(-) diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 80d966b..9acc461 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -10,6 +10,7 @@ module WorkWrap ( wwTopBinds ) where import CoreSyn import CoreUnfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding ) import CoreUtils ( exprType, exprIsHNF ) +import CoreFVs ( exprFreeVars ) import Var import Id import IdInfo @@ -365,7 +366,7 @@ splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> DmdResult -> splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) do -- The arity should match the signature - stuff <- mkWwBodies dflags fam_envs fun_ty wrap_dmds res_info + stuff <- mkWwBodies dflags fam_envs rhs_fvs fun_ty wrap_dmds res_info case stuff of Just (work_demands, wrap_fn, work_fn) -> do work_uniq <- getUniqueM @@ -432,6 +433,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs Nothing -> return [(fn_id, rhs)] where + rhs_fvs = exprFreeVars rhs fun_ty = idType fn_id inl_prag = inlinePragInfo fn_info rule_match_info = inlinePragmaRuleMatchInfo inl_prag diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 64de0e0..1370bbc 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -24,6 +24,7 @@ import MkId ( voidArgId, voidPrimId ) import TysPrim ( voidPrimTy ) import TysWiredIn ( tupleDataCon ) import VarEnv ( mkInScopeSet ) +import VarSet ( VarSet ) import Type import RepType ( isVoidTy ) import Coercion @@ -109,14 +110,19 @@ the unusable strictness-info into the interfaces. @mkWwBodies@ is called when doing the worker\/wrapper split inside a module. -} +type WwResult + = ([Demand], -- Demands for worker (value) args + Id -> CoreExpr, -- Wrapper body, lacking only the worker Id + CoreExpr -> CoreExpr) -- Worker body, lacking the original function rhs + mkWwBodies :: DynFlags -> FamInstEnvs - -> Type -- Type of original function - -> [Demand] -- Strictness of original function - -> DmdResult -- Info about function result - -> UniqSM (Maybe ([Demand], -- Demands for worker (value) args - Id -> CoreExpr, -- Wrapper body, lacking only the worker Id - CoreExpr -> CoreExpr)) -- Worker body, lacking the original function rhs + -> VarSet -- Free vars of RHS + -- See Note [Freshen WW arguments] + -> Type -- Type of original function + -> [Demand] -- Strictness of original function + -> DmdResult -- Info about function result + -> UniqSM (Maybe WwResult) -- wrap_fn_args E = \x y -> E -- work_fn_args E = E x y @@ -129,8 +135,9 @@ mkWwBodies :: DynFlags -- let x = (a,b) in -- E -mkWwBodies dflags fam_envs fun_ty demands res_info - = do { let empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType fun_ty)) +mkWwBodies dflags fam_envs rhs_fvs fun_ty demands res_info + = do { let empty_subst = mkEmptyTCvSubst (mkInScopeSet rhs_fvs) + -- See Note [Freshen WW arguments] ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs empty_subst fun_ty demands ; (useful1, work_args, wrap_fn_str, work_fn_str) <- mkWWstr dflags fam_envs wrap_args @@ -296,7 +303,7 @@ the \x to get what we want. -- and keeps repeating that until it's satisfied the supplied arity mkWWargs :: TCvSubst -- Freshening substitution to apply to the type - -- See Note [Freshen type variables] + -- See Note [Freshen WW arguments] -> Type -- The type of the function -> [Demand] -- Demands and one-shot info for value arguments -> UniqSM ([Var], -- Wrapper args @@ -321,9 +328,9 @@ mkWWargs subst fun_ty demands res_ty) } | Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty - = do { let (subst', tv') = substTyVarBndr subst tv - -- This substTyVarBndr clones the type variable when necy - -- See Note [Freshen type variables] + = do { uniq <- getUniqueM + ; let (subst', tv') = cloneTyVarBndr subst tv uniq + -- See Note [Freshen WW arguments] ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs subst' fun_ty' demands ; return (tv' : wrap_args, @@ -342,9 +349,10 @@ mkWWargs subst fun_ty demands = do { (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs subst rep_ty demands - ; return (wrap_args, - \e -> Cast (wrap_fn_args e) (mkSymCo co), - \e -> work_fn_args (Cast e co), + ; let co' = substCo subst co + ; return (wrap_args, + \e -> Cast (wrap_fn_args e) (mkSymCo co'), + \e -> work_fn_args (Cast e co'), res_ty) } | otherwise @@ -359,17 +367,35 @@ mk_wrap_arg uniq ty dmd = mkSysLocalOrCoVar (fsLit "w") uniq ty `setIdDemandInfo` dmd -{- -Note [Freshen type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Wen we do a worker/wrapper split, we must not use shadowed names, -else we'll get - f = /\ a /\a. fw a a -which is obviously wrong. Type variables can can in principle shadow, -within a type (e.g. forall a. a -> forall a. a->a). But type -variables *are* mentioned in , so we must substitute. - -That's why we carry the TCvSubst through mkWWargs +{- Note [Freshen WW arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Wen we do a worker/wrapper split, we must not in-scope names as the arguments +of the worker, else we'll get name capture. E.g. + + -- y1 is in scope from further out + f x = ..y1.. + +If we accidentally choose y1 as a worker argument disaster results: + + fww y1 y2 = let x = (y1,y2) in ...y1... + +To avoid this: + + * We use a fresh unique for both type-variable and term-variable binders + Originally we lacked this freshness for type variables, and that led + to the very obscure Trac #12562. (A type varaible in the worker shadowed + an outer term-variable binding.) + + * Because of this cloning we have to substitute in the type/kind of the + new binders. That's why we carry the TCvSubst through mkWWargs. + + So we need a decent in-scope set, just in case that type/kind + itself has foralls. We get this from the free vars of the RHS of the + function since those are the only variables that might be captured. + It's a lazy thunk, which will only be poked if the type/kind has a forall. + + Another tricky case was when f :: forall a. a -> forall a. a->a + (i.e. with shadowing), and then the worker used the same 'a' twice. ************************************************************************ * * From git at git.haskell.org Mon Oct 17 07:42:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:42:33 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment (609d2c8) Message-ID: <20161017074233.4DA093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/609d2c813b6e9cf059e88d2bc05e0295a9f56007/ghc >--------------------------------------------------------------- commit 609d2c813b6e9cf059e88d2bc05e0295a9f56007 Author: Simon Peyton Jones Date: Fri Oct 14 15:52:15 2016 +0100 Typo in comment >--------------------------------------------------------------- 609d2c813b6e9cf059e88d2bc05e0295a9f56007 compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 1888578..f814a5f 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1123,7 +1123,7 @@ isRuntimeUnkSkol x mkSigmaTy :: [TyVarBinder] -> [PredType] -> Type -> Type mkSigmaTy bndrs theta tau = mkForAllTys bndrs (mkPhiTy theta tau) --- | Make a sigma ty wherea ll type variables are 'Inferred'. That is, +-- | Make a sigma ty where all type variables are 'Inferred'. That is, -- they cannot be used with visible type application. mkInfSigmaTy :: [TyVar] -> [PredType] -> Type -> Type mkInfSigmaTy tyvars ty = mkSigmaTy (mkTyVarBinders Inferred tyvars) ty From git at git.haskell.org Mon Oct 17 07:42:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:42:36 +0000 (UTC) Subject: [commit: ghc] master: Correct order of existentials in pattern synonyms (a693d1c) Message-ID: <20161017074236.494E23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a693d1cb0ee9499af3145d73b1aebe5b6df0da98/ghc >--------------------------------------------------------------- commit a693d1cb0ee9499af3145d73b1aebe5b6df0da98 Author: Simon Peyton Jones Date: Fri Oct 14 15:54:14 2016 +0100 Correct order of existentials in pattern synonyms Trac #12698 exposed a nasty bug in the typechecking for pattern synonmys: the existential type variables weren't being put in properly-scoped order. For some reason TcPatSyn.tcCollectEx was colleting them as a set, not as a list! Easily fixed. >--------------------------------------------------------------- a693d1cb0ee9499af3145d73b1aebe5b6df0da98 compiler/hsSyn/HsPat.hs | 1 + compiler/typecheck/TcPatSyn.hs | 35 +++++++------- testsuite/tests/patsyn/should_compile/T12698.hs | 62 +++++++++++++++++++++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 4 files changed, 81 insertions(+), 18 deletions(-) diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 56e736a..ec5578f 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -175,6 +175,7 @@ data Pat id -- the type of the pattern pat_tvs :: [TyVar], -- Existentially bound type variables + -- in correctly-scoped order e.g. [k:*, x:k] pat_dicts :: [EvVar], -- Ditto *coercion variables* and *dictionaries* -- One reason for putting coercion variable here, I think, -- is to ensure their kinds are zonked diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 548b746..e6c5074 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -48,7 +48,6 @@ import FieldLabel import Bag import Util import ErrUtils -import FV import Control.Monad ( zipWithM ) import Data.List( partition ) @@ -84,12 +83,13 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, ; (qtvs, req_dicts, ev_binds) <- simplifyInfer tclvl NoRestrictions [] named_taus wanted - ; let ((ex_tvs, ex_vars), prov_dicts) = tcCollectEx lpat' - univ_tvs = filter (not . (`elemVarSet` ex_vars)) qtvs + ; let (ex_tvs, prov_dicts) = tcCollectEx lpat' + ex_tv_set = mkVarSet ex_tvs + univ_tvs = filterOut (`elemVarSet` ex_tv_set) qtvs prov_theta = map evVarPred prov_dicts req_theta = map evVarPred req_dicts - ; traceTc "tcInferPatSynDecl }" $ ppr name + ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs) ; tc_patsyn_finish lname dir is_infix lpat' (mkTyVarBinders Inferred univ_tvs , req_theta, ev_binds, req_dicts) @@ -802,17 +802,16 @@ nonBidirectionalErr name = failWithTc $ -- to be passed these pattern-bound evidences. tcCollectEx :: LPat Id - -> ( ([Var], VarSet) -- Existentially-bound type variables as a - -- deterministically ordered list and a set. - -- See Note [Deterministic FV] in FV - , [EvVar] - ) -tcCollectEx pat = let (fv, evs) = go pat in (fvVarListVarSet fv, evs) + -> ( [TyVar] -- Existentially-bound type variables + -- in correctly-scoped order; e.g. [ k:*, x:k ] + , [EvVar] ) -- and evidence variables + +tcCollectEx pat = go pat where - go :: LPat Id -> (FV, [EvVar]) + go :: LPat Id -> ([TyVar], [EvVar]) go = go1 . unLoc - go1 :: Pat Id -> (FV, [EvVar]) + go1 :: Pat Id -> ([TyVar], [EvVar]) go1 (LazyPat p) = go p go1 (AsPat _ p) = go p go1 (ParPat p) = go p @@ -822,23 +821,23 @@ tcCollectEx pat = let (fv, evs) = go pat in (fvVarListVarSet fv, evs) go1 (SumPat p _ _ _) = go p go1 (PArrPat ps _) = mergeMany . map go $ ps go1 (ViewPat _ p _) = go p - go1 con at ConPatOut{} = merge (FV.mkFVs (pat_tvs con), pat_dicts con) $ - goConDetails $ pat_args con + go1 con at ConPatOut{} = merge (pat_tvs con, pat_dicts con) $ + goConDetails $ pat_args con go1 (SigPatOut p _) = go p go1 (CoPat _ p _) = go1 p go1 (NPlusKPat n k _ geq subtract _) = pprPanic "TODO: NPlusKPat" $ ppr n $$ ppr k $$ ppr geq $$ ppr subtract go1 _ = empty - goConDetails :: HsConPatDetails Id -> (FV, [EvVar]) + goConDetails :: HsConPatDetails Id -> ([TyVar], [EvVar]) goConDetails (PrefixCon ps) = mergeMany . map go $ ps goConDetails (InfixCon p1 p2) = go p1 `merge` go p2 goConDetails (RecCon HsRecFields{ rec_flds = flds }) = mergeMany . map goRecFd $ flds - goRecFd :: LHsRecField Id (LPat Id) -> (FV, [EvVar]) + goRecFd :: LHsRecField Id (LPat Id) -> ([TyVar], [EvVar]) goRecFd (L _ HsRecField{ hsRecFieldArg = p }) = go p - merge (vs1, evs1) (vs2, evs2) = (vs1 `unionFV` vs2, evs1 ++ evs2) + merge (vs1, evs1) (vs2, evs2) = (vs1 ++ vs2, evs1 ++ evs2) mergeMany = foldr merge empty - empty = (emptyFV, []) + empty = ([], []) diff --git a/testsuite/tests/patsyn/should_compile/T12698.hs b/testsuite/tests/patsyn/should_compile/T12698.hs new file mode 100644 index 0000000..6ba45e4 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12698.hs @@ -0,0 +1,62 @@ +{-# Language ViewPatterns, TypeOperators, KindSignatures, PolyKinds, + TypeInType, StandaloneDeriving, GADTs, RebindableSyntax, + RankNTypes, LambdaCase, PatternSynonyms, TypeApplications #-} + +module T12698 where + +import GHC.Types +import Prelude hiding ( fromInteger ) +import Data.Type.Equality +import Data.Kind +import qualified Prelude + +class Ty (a :: k) where ty :: T a +instance Ty Int where ty = TI +instance Ty Bool where ty = TB +instance Ty a => Ty [a] where ty = TA TL ty +instance Ty [] where ty = TL +instance Ty (,) where ty = TP + +data AppResult (t :: k) where + App :: T a -> T b -> AppResult (a b) + +data T :: forall k. k -> Type where + TI :: T Int + TB :: T Bool + TL :: T [] + TP :: T (,) + TA :: T f -> T x -> T (f x) +deriving instance Show (T a) + +splitApp :: T a -> Maybe (AppResult a) +splitApp = \case + TI -> Nothing + TB -> Nothing + TL -> Nothing + TP -> Nothing + TA f x -> Just (App f x) + +data (a :: k1) :~~: (b :: k2) where + HRefl :: a :~~: a + +eqT :: T a -> T b -> Maybe (a :~~: b) +eqT a b = + case (a, b) of + (TI, TI) -> Just HRefl + (TB, TB) -> Just HRefl + (TL, TL) -> Just HRefl + (TP, TP) -> Just HRefl + +pattern List :: () => [] ~~ b => T b +pattern List <- (eqT (ty @(Type -> Type) @[]) -> Just HRefl) + where List = ty + +pattern Int :: () => Int ~~ b => T b +pattern Int <- (eqT (ty @Type @Int) -> Just HRefl) + where Int = ty + +pattern (:<->:) :: () => fx ~ f x => T f -> T x -> T fx +pattern f :<->: x <- (splitApp -> Just (App f x)) + where f :<->: x = TA f x + +pattern Foo <- List :<->: Int diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index d26fc84..4426c74 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -60,3 +60,4 @@ test('T12108', normal, compile, ['']) test('T12484', normal, compile, ['']) test('T11987', normal, multimod_compile, ['T11987', '-v0']) test('T12615', normal, compile, ['']) +test('T12698', normal, compile, ['']) From git at git.haskell.org Mon Oct 17 07:42:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:42:39 +0000 (UTC) Subject: [commit: ghc] master: Fix wrapping order in matchExpectedConTy (f7278a9) Message-ID: <20161017074239.6C3713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7278a9068dab28f50351c18177cc352d6570285/ghc >--------------------------------------------------------------- commit f7278a9068dab28f50351c18177cc352d6570285 Author: Simon Peyton Jones Date: Fri Oct 14 17:13:43 2016 +0100 Fix wrapping order in matchExpectedConTy The wrappers in matchExpectedConTy were being composed back to front, resulting in a Core Lint error. Yikes! This has been here a long time. Fixes Trac #12676. >--------------------------------------------------------------- f7278a9068dab28f50351c18177cc352d6570285 compiler/typecheck/TcPat.hs | 24 +++++++++++++--------- .../tests/indexed-types/should_compile/T12676.hs | 9 ++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 24 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index dd88992..2f115c6 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -885,21 +885,24 @@ matchExpectedConTy :: PatEnv -> TcM (HsWrapper, [TcSigmaType]) -- See Note [Matching constructor patterns] -- Returns a wrapper : pat_ty "->" T ty1 ... tyn -matchExpectedConTy (PE { pe_orig = orig }) data_tc pat_ty +matchExpectedConTy (PE { pe_orig = orig }) data_tc exp_pat_ty | Just (fam_tc, fam_args, co_tc) <- tyConFamInstSig_maybe data_tc -- Comments refer to Note [Matching constructor patterns] -- co_tc :: forall a. T [a] ~ T7 a - = do { pat_ty <- expTypeToType pat_ty - ; (wrap, pat_ty) <- topInstantiate orig pat_ty + = do { pat_ty <- expTypeToType exp_pat_ty + ; (wrap, pat_rho) <- topInstantiate orig pat_ty ; (subst, tvs') <- newMetaTyVars (tyConTyVars data_tc) -- tys = [ty1,ty2] ; traceTc "matchExpectedConTy" (vcat [ppr data_tc, ppr (tyConTyVars data_tc), - ppr fam_tc, ppr fam_args]) - ; co1 <- unifyType noThing (mkTyConApp fam_tc (substTys subst fam_args)) pat_ty - -- co1 : T (ty1,ty2) ~N pat_ty + ppr fam_tc, ppr fam_args, + ppr exp_pat_ty, + ppr pat_ty, + ppr pat_rho, ppr wrap]) + ; co1 <- unifyType noThing (mkTyConApp fam_tc (substTys subst fam_args)) pat_rho + -- co1 : T (ty1,ty2) ~N pat_rho -- could use tcSubType here... but it's the wrong way round -- for actual vs. expected in error messages. @@ -907,12 +910,13 @@ matchExpectedConTy (PE { pe_orig = orig }) data_tc pat_ty co2 = mkTcUnbranchedAxInstCo co_tc tys' [] -- co2 : T (ty1,ty2) ~R T7 ty1 ty2 - ; return ( wrap <.> (mkWpCastR $ - mkTcSubCo (mkTcSymCo co1) `mkTcTransCo` co2) - , tys') } + full_co = mkTcSubCo (mkTcSymCo co1) `mkTcTransCo` co2 + -- full_co :: pat_rho ~R T7 ty1 ty2 + + ; return ( mkWpCastR full_co <.> wrap, tys') } | otherwise - = do { pat_ty <- expTypeToType pat_ty + = do { pat_ty <- expTypeToType exp_pat_ty ; (wrap, pat_rho) <- topInstantiate orig pat_ty ; (coi, tys) <- matchExpectedTyConApp data_tc pat_rho ; return (mkWpCastN (mkTcSymCo coi) <.> wrap, tys) } diff --git a/testsuite/tests/indexed-types/should_compile/T12676.hs b/testsuite/tests/indexed-types/should_compile/T12676.hs new file mode 100644 index 0000000..feb1403 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12676.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RankNTypes, TypeFamilies #-} + +module T12676 where + +data family T a +data instance T () = MkT + +foo :: (forall s. T ()) -> () +foo MkT = () diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index eab93ac..05c9ad3 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -276,3 +276,4 @@ test('T11581', normal, compile, ['']) test('T12175', normal, compile, ['']) test('T12522', normal, compile, ['']) test('T12522b', normal, compile, ['']) +test('T12676', normal, compile, ['']) From git at git.haskell.org Mon Oct 17 07:42:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:42:42 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12681 (1790762) Message-ID: <20161017074242.8ACF93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/179076260624ead5a6c5d96e94f551cfeac9dec9/ghc >--------------------------------------------------------------- commit 179076260624ead5a6c5d96e94f551cfeac9dec9 Author: Simon Peyton Jones Date: Mon Oct 17 08:40:16 2016 +0100 Test Trac #12681 >--------------------------------------------------------------- 179076260624ead5a6c5d96e94f551cfeac9dec9 testsuite/tests/rename/should_fail/T12681.hs | 4 ++++ testsuite/tests/rename/should_fail/T12681.stderr | 4 ++++ testsuite/tests/rename/should_fail/T12681a.hs | 2 ++ testsuite/tests/rename/should_fail/all.T | 1 + 4 files changed, 11 insertions(+) diff --git a/testsuite/tests/rename/should_fail/T12681.hs b/testsuite/tests/rename/should_fail/T12681.hs new file mode 100644 index 0000000..34e9c2f --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12681.hs @@ -0,0 +1,4 @@ +module T12681 where +import qualified T12681a + +x = T12681a.A { a = 0 } diff --git a/testsuite/tests/rename/should_fail/T12681.stderr b/testsuite/tests/rename/should_fail/T12681.stderr new file mode 100644 index 0000000..547cf4c --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12681.stderr @@ -0,0 +1,4 @@ + +T12681.hs:4:17: error: + Not in scope: ‘a’ + Perhaps you meant ‘T12681a.a’ (imported from T12681a) diff --git a/testsuite/tests/rename/should_fail/T12681a.hs b/testsuite/tests/rename/should_fail/T12681a.hs new file mode 100644 index 0000000..6e8bfe2 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12681a.hs @@ -0,0 +1,2 @@ +module T12681a where + data A = A { a :: Int } diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 9fc13b0..f956bde 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -140,3 +140,4 @@ test('T11071', normal, compile_fail, ['']) test('T11071a', normal, compile_fail, ['']) test('T11663', normal, compile_fail, ['']) test('T12229', normal, compile, ['']) +test('T12681', normal, multimod_compile_fail, ['T12681','-v0']) From git at git.haskell.org Mon Oct 17 07:55:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:55:53 +0000 (UTC) Subject: [commit: ghc] master: Add more variants of T3064 (in comments) (156db6b) Message-ID: <20161017075553.654D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/156db6b2e2b7be13f6d22316eea7e1ba8d312f18/ghc >--------------------------------------------------------------- commit 156db6b2e2b7be13f6d22316eea7e1ba8d312f18 Author: Simon Peyton Jones Date: Fri Oct 14 17:42:00 2016 +0100 Add more variants of T3064 (in comments) >--------------------------------------------------------------- 156db6b2e2b7be13f6d22316eea7e1ba8d312f18 testsuite/tests/perf/compiler/T3064.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/testsuite/tests/perf/compiler/T3064.hs b/testsuite/tests/perf/compiler/T3064.hs index 53a87b5..dacca79 100644 --- a/testsuite/tests/perf/compiler/T3064.hs +++ b/testsuite/tests/perf/compiler/T3064.hs @@ -56,20 +56,23 @@ runCA action = runCtxM (runCAT (unCA action)) runCtxM :: (forall c. CtxM c v) -> IO v runCtxM action = runReaderT (unResourceT action) Ctx --- test11 :: IO () --- test11 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn( --- newRgn(newRgn(newRgn(newRgn(return())))))))))) +{- --- test12 :: IO () --- test12 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn( --- newRgn(newRgn(newRgn(newRgn(return()))))))))))) +test4 :: IO () +test4 = runCA(newRgn(newRgn(newRgn(newRgn(return()))))) --- test13 :: IO () --- test13 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn( --- newRgn(newRgn(newRgn(newRgn(return())))))))))))) +test11 :: IO () +test11 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn( + newRgn(newRgn(newRgn(newRgn(return())))))))))) +test12 :: IO () +test12 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn( + newRgn(newRgn(newRgn(newRgn(return()))))))))))) + +test13 :: IO () +test13 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn( + newRgn(newRgn(newRgn(newRgn(return())))))))))))) -{- test14 :: IO () test14 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn( newRgn(newRgn(newRgn(newRgn(return()))))))))))))) From git at git.haskell.org Mon Oct 17 07:55:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:55:56 +0000 (UTC) Subject: [commit: ghc] master: Reduce trace output slightly (db71d97) Message-ID: <20161017075556.3787E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db71d971379c74dd1d2b958c11dc6c9e718a3e61/ghc >--------------------------------------------------------------- commit db71d971379c74dd1d2b958c11dc6c9e718a3e61 Author: Simon Peyton Jones Date: Fri Oct 14 17:40:51 2016 +0100 Reduce trace output slightly >--------------------------------------------------------------- db71d971379c74dd1d2b958c11dc6c9e718a3e61 compiler/typecheck/TcSMonad.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 640ed73..fa4b169 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -3107,13 +3107,11 @@ matchFam tycon args = wrapTcS $ matchFamTcM tycon args matchFamTcM :: TyCon -> [Type] -> TcM (Maybe (Coercion, TcType)) -- Given (F tys) return (ty, co), where co :: F tys ~ ty matchFamTcM tycon args - = do { fam_envs@(_,lcl) <- FamInst.tcGetFamInstEnvs - ; let match_fam_result + = do { let match_fam_result = reduceTyFamApp_maybe fam_envs Nominal tycon args ; TcM.traceTc "matchFamTcM" $ vcat [ text "Matching:" <+> ppr (mkTyConApp tycon args) - , ppr_res match_fam_result - , text "Lcl fam env:" <+> ppr lcl ] + , ppr_res match_fam_result ] ; return match_fam_result } where ppr_res Nothing = text "Match failed" From git at git.haskell.org Mon Oct 17 07:55:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 07:55:58 +0000 (UTC) Subject: [commit: ghc] master: Comments only (a391a38) Message-ID: <20161017075558.E4C183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a391a386e6cf00b8192c5d52a898a86a1e436eb8/ghc >--------------------------------------------------------------- commit a391a386e6cf00b8192c5d52a898a86a1e436eb8 Author: Simon Peyton Jones Date: Fri Oct 14 17:50:28 2016 +0100 Comments only >--------------------------------------------------------------- a391a386e6cf00b8192c5d52a898a86a1e436eb8 testsuite/tests/perf/compiler/T5030.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/testsuite/tests/perf/compiler/T5030.hs b/testsuite/tests/perf/compiler/T5030.hs index 6bb7478..4983ee6 100644 --- a/testsuite/tests/perf/compiler/T5030.hs +++ b/testsuite/tests/perf/compiler/T5030.hs @@ -169,6 +169,19 @@ instance CPU DummyCPU where ------------------------------------------------------------------------------- -- Long compiling program. +{- cnst has very simple code, and should be fast to typecheck + But if you insist on normalising (Immediate DummyCPU) you get + + Immediate DummyCPU = Const (ImmSize DummyCPU) + -> Const SIZE12 + = Const (DPlus SIX SIX) + ...etc... + +similarly for (RegVar DummyCPU). + +So you get a lot of work and big coercions, for no gain. +-} + cnst :: Integer -> Either (Immediate DummyCPU) (RegVar DummyCPU) cnst x = Left (Const x) From git at git.haskell.org Mon Oct 17 08:07:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 08:07:14 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (f43db14) Message-ID: <20161017080714.13ED73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f43db14e2cae9cd181b283cdc7d7940903689bf6/ghc >--------------------------------------------------------------- commit f43db14e2cae9cd181b283cdc7d7940903689bf6 Author: Gabor Greif Date: Mon Oct 17 10:05:45 2016 +0200 Typos in comments >--------------------------------------------------------------- f43db14e2cae9cd181b283cdc7d7940903689bf6 compiler/ghci/ByteCodeGen.hs | 2 +- compiler/hsSyn/HsUtils.hs | 2 +- compiler/nativeGen/PPC/CodeGen.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 90e2174..0e7aea4 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -433,7 +433,7 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) Just data_con <- isDataConWorkId_maybe v, dataConRepArity data_con == length args_r_to_l = do -- Special case for a non-recursive let whose RHS is a - -- saturatred constructor application. + -- saturated constructor application. -- Just allocate the constructor and carry on alloc_code <- mkConAppCode d s p data_con args_r_to_l body_code <- schemeE (d+1) s (Map.insert x d p) body diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 903ff38..de77360 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -774,7 +774,7 @@ collectLocalBinders (HsIPBinds _) = [] collectLocalBinders EmptyLocalBinds = [] collectHsIdBinders, collectHsValBinders :: HsValBindsLR idL idR -> [idL] --- Collect Id binders only, or Ids + pattern synonmys, respectively +-- Collect Id binders only, or Ids + pattern synonyms, respectively collectHsIdBinders = collect_hs_val_binders True collectHsValBinders = collect_hs_val_binders False diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index ead122b..849516f 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -744,7 +744,7 @@ temporary, then do the other computation, and then use the temporary: {- Note [Power instruction format] In some instructions the 16 bit offset must be a multiple of 4, i.e. -the two least significant bits mus be zero. The "Power ISA" specification +the two least significant bits must be zero. The "Power ISA" specification calls these instruction formats "DS-FORM" and the instructions with arbitrary 16 bit offsets are "D-FORM". diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index e6c5074..dc973da 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -243,7 +243,7 @@ unify x := [a] during type checking, and then use the instantiating type dl = $dfunEqList d in k [a] dl ys -This "concealing" story works for /uni-directional/ pattern synonmys, +This "concealing" story works for /uni-directional/ pattern synonyms, but obviously not for bidirectional ones. So in the bidirectional case we use SigTv, rather than a generic TauTv, meta-tyvar so that. And we should really check that those SigTvs don't get unified with each From git at git.haskell.org Mon Oct 17 08:25:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 08:25:45 +0000 (UTC) Subject: [commit: ghc] master: Re-add accidentally-deleted line (3adaacd) Message-ID: <20161017082545.327653A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3adaacde6b8ad6f41e1554598a9fd93d9e605bc2/ghc >--------------------------------------------------------------- commit 3adaacde6b8ad6f41e1554598a9fd93d9e605bc2 Author: Simon Peyton Jones Date: Mon Oct 17 09:23:50 2016 +0100 Re-add accidentally-deleted line This adds a line I deleted by mistake in commit db71d971379c74dd1d2b958c11dc6c9e718a3e61 Author: Simon Peyton Jones Date: Fri Oct 14 17:40:51 2016 +0100 Reduce trace output slightly Sorry about that! >--------------------------------------------------------------- 3adaacde6b8ad6f41e1554598a9fd93d9e605bc2 compiler/typecheck/TcSMonad.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index fa4b169..37740bd 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -3107,7 +3107,8 @@ matchFam tycon args = wrapTcS $ matchFamTcM tycon args matchFamTcM :: TyCon -> [Type] -> TcM (Maybe (Coercion, TcType)) -- Given (F tys) return (ty, co), where co :: F tys ~ ty matchFamTcM tycon args - = do { let match_fam_result + = do { fam_envs <- FamInst.tcGetFamInstEnvs + ; let match_fam_result = reduceTyFamApp_maybe fam_envs Nominal tycon args ; TcM.traceTc "matchFamTcM" $ vcat [ text "Matching:" <+> ppr (mkTyConApp tycon args) From git at git.haskell.org Mon Oct 17 19:02:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:23 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Work around #12554 (9cb4459) Message-ID: <20161017190223.618D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9cb4459893c1c56553b413786cea3171b4e665ca/ghc >--------------------------------------------------------------- commit 9cb4459893c1c56553b413786cea3171b4e665ca Author: Ben Gamari Date: Sat Oct 15 18:18:14 2016 +0000 testsuite: Work around #12554 It seems that Python 2.7.11 and "recent" msys2 releases are broken, holding open file locks unexpected. This causes rmtree to intermittently fail. Even worse, it would fail silently (since we pass ignore_errors=True), causing makedirs to fail later. We now explicitly check for the existence of the test directory before attempting to delete it and disable ignore_errors. Moreover, on Windows we now try multiple times to rmtree the testdir, working around the apparently msys bug. This is all just terrible, but Phyx and I spent several hours trying to track down the issue to no available. The workaround is better than nothing. >--------------------------------------------------------------- 9cb4459893c1c56553b413786cea3171b4e665ca testsuite/driver/testlib.py | 44 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index a39a2de..f2098d2 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1850,8 +1850,48 @@ def find_expected_file(name, suff): return basename -def cleanup(): - shutil.rmtree(getTestOpts().testdir, ignore_errors=True) +# Windows seems to exhibit a strange behavior where processes' executables +# remain locked even after the process itself has died. When this happens +# rmtree will fail with either Error 5 or Error 32. It takes some time for this +# to resolve so we try several times to delete the directory, only eventually +# failing if things seem really stuck. See #12554. +if config.msys: + try: + from exceptions import WindowsError + except: + pass + import stat + def cleanup(): + def on_error(function, path, excinfo): + # At least one test (T11489) removes the write bit from a file it + # produces. Windows refuses to delete read-only files with a + # permission error. Try setting the write bit and try again. + if excinfo[1].errno == 13: + os.chmod(path, stat.S_IWRITE) + os.unlink(path) + + testdir = getTestOpts().testdir + attempts = 0 + max_attempts = 10 + while attempts < max_attempts and os.path.exists(testdir): + try: + shutil.rmtree(testdir, ignore_errors=False, onerror=on_error) + except WindowsError as e: + #print('failed deleting %s: %s' % (testdir, e)) + if e.winerror in [5, 32]: + attempts += 1 + if attempts == max_attempts: + raise e + else: + time.sleep(0.1) + else: + raise e +else: + def cleanup(): + testdir = getTestOpts().testdir + if os.path.exists(testdir): + shutil.rmtree(testdir, ignore_errors=False) + # ----------------------------------------------------------------------------- # Return a list of all the files ending in '.T' below directories roots. From git at git.haskell.org Mon Oct 17 19:02:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:26 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Eliminate unnecessary compile_timeout_multiplier (5b55e4b) Message-ID: <20161017190226.12B303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5b55e4b54f4e8ef0d45e9a2d410e783bc9b170e5/ghc >--------------------------------------------------------------- commit 5b55e4b54f4e8ef0d45e9a2d410e783bc9b170e5 Author: Ben Gamari Date: Sun Oct 16 20:49:46 2016 -0400 testsuite: Eliminate unnecessary compile_timeout_multiplier tc266 was failing intermittently on Windows due to a very small compile_timeout_multiplier. This test was added in e907e1f12f4dedc0ec13c7a501c8810bcfc03583 which doesn't appear to have any timng dependence, so I see no reason to retain the multiplier at all. Test Plan: Validate Reviewers: ezyang, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2601 >--------------------------------------------------------------- 5b55e4b54f4e8ef0d45e9a2d410e783bc9b170e5 testsuite/tests/typecheck/should_compile/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index c40255e..52b1df8 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -359,7 +359,7 @@ test('tc263', multimod_compile, ['tc263','-v0']) test('tc265', compile_timeout_multiplier(0.01), compile, ['']) test('tc266', - [extra_clean(['Tc266.hi-boot', 'Tc266.o-boot', 'Tc266a.hi', 'Tc266a.o', 'Tc266.hi', 'Tc266.o']), run_timeout_multiplier(0.01)] , + [extra_clean(['Tc266.hi-boot', 'Tc266.o-boot', 'Tc266a.hi', 'Tc266a.o', 'Tc266.hi', 'Tc266.o'])] , run_command, ['$MAKE -s --no-print-directory tc266']) test('Tc267', From git at git.haskell.org Mon Oct 17 19:02:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:28 +0000 (UTC) Subject: [commit: ghc] master: testsuite/driver: More Unicode awareness (7d2df32) Message-ID: <20161017190228.B57243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d2df32091dfe94f4da34868a64bea56ca74843e/ghc >--------------------------------------------------------------- commit 7d2df32091dfe94f4da34868a64bea56ca74843e Author: Ben Gamari Date: Sun Oct 16 20:49:36 2016 -0400 testsuite/driver: More Unicode awareness Explicitly specify utf8 encoding in a few spots which were failing on Windows with Python 3. Test Plan: Validate Reviewers: austin, thomie Differential Revision: https://phabricator.haskell.org/D2602 GHC Trac Issues: #9184 >--------------------------------------------------------------- 7d2df32091dfe94f4da34868a64bea56ca74843e testsuite/driver/runtests.py | 9 +++++++-- testsuite/driver/testlib.py | 18 +++++++++--------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 8a11f44..abbf3c8 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -208,7 +208,7 @@ from testlib import * # On Windows we need to set $PATH to include the paths to all the DLLs # in order for the dynamic library tests to work. if windows or darwin: - pkginfo = getStdout([config.ghc_pkg, 'dump']) + pkginfo = str(getStdout([config.ghc_pkg, 'dump'])) topdir = config.libdir if windows: mingw = os.path.join(topdir, '../mingw/bin') @@ -303,7 +303,12 @@ for file in t_files: if_verbose(2, '====> Scanning %s' % file) newTestDir(tempdir, os.path.dirname(file)) try: - exec(open(file).read()) + if PYTHON3: + src = io.open(file, encoding='utf8').read() + else: + src = open(file).read() + + exec(src) except Exception as e: traceback.print_exc() framework_fail(file, '', str(e)) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index f2098d2..55d209e 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -826,9 +826,9 @@ def do_test(name, way, func, args, files): src_makefile = in_srcdir('Makefile') dst_makefile = in_testdir('Makefile') if os.path.exists(src_makefile): - with open(src_makefile, 'r') as src: + with io.open(src_makefile, 'r', encoding='utf8') as src: makefile = re.sub('TOP=.*', 'TOP=' + config.top, src.read(), 1) - with open(dst_makefile, 'w') as dst: + with io.open(dst_makefile, 'w', encoding='utf8') as dst: dst.write(makefile) if config.use_threads: @@ -1289,20 +1289,20 @@ def interpreter_run(name, way, extra_hc_opts, top_mod): delimiter = '===== program output begins here\n' - with open(script, 'w') as f: + with io.open(script, 'w', encoding='utf8') as f: # set the prog name and command-line args to match the compiled # environment. - f.write(':set prog ' + name + '\n') - f.write(':set args ' + opts.extra_run_opts + '\n') + f.write(u':set prog ' + name + u'\n') + f.write(u':set args ' + opts.extra_run_opts + u'\n') # Add marker lines to the stdout and stderr output files, so we # can separate GHCi's output from the program's. - f.write(':! echo ' + delimiter) - f.write(':! echo 1>&2 ' + delimiter) + f.write(u':! echo ' + delimiter) + f.write(u':! echo 1>&2 ' + delimiter) # Set stdout to be line-buffered to match the compiled environment. - f.write('System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering\n') + f.write(u'System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering\n') # wrapping in GHC.TopHandler.runIO ensures we get the same output # in the event of an exception as for the compiled program. - f.write('GHC.TopHandler.runIOFastExit Main.main Prelude.>> Prelude.return ()\n') + f.write(u'GHC.TopHandler.runIOFastExit Main.main Prelude.>> Prelude.return ()\n') stdin = in_testdir(opts.stdin if opts.stdin else add_suffix(name, 'stdin')) if os.path.exists(stdin): From git at git.haskell.org Mon Oct 17 19:02:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:31 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark break011 as broken (deed418) Message-ID: <20161017190231.6CA2A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/deed4189b5c84a5dfbe3dca3be7968d66f2a67f4/ghc >--------------------------------------------------------------- commit deed4189b5c84a5dfbe3dca3be7968d66f2a67f4 Author: Ben Gamari Date: Sun Oct 16 02:05:50 2016 +0000 testsuite: Mark break011 as broken See #12712. >--------------------------------------------------------------- deed4189b5c84a5dfbe3dca3be7968d66f2a67f4 testsuite/tests/ghci.debugger/scripts/all.T | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 6571c7f..6313335 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -48,7 +48,10 @@ test('break007', extra_clean(['Break007.o', 'Break007.hi']), test('break008', normal, ghci_script, ['break008.script']) test('break009', combined_output, ghci_script, ['break009.script']) test('break010', normal, ghci_script, ['break010.script']) -test('break011', combined_output, ghci_script, ['break011.script']) +test('break011', + [combined_output, + when(msys(), expect_broken(12712))], + ghci_script, ['break011.script']) test('break012', normal, ghci_script, ['break012.script']) test('break013', normal, ghci_script, ['break013.script']) test('break014', normal, ghci_script, ['break014.script']) From git at git.haskell.org Mon Oct 17 19:02:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:34 +0000 (UTC) Subject: [commit: ghc] master: validate: Allow user to override Python interpreter (17d696f) Message-ID: <20161017190234.1D8B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/17d696f1a8dcc28074886a2830036144eced6d87/ghc >--------------------------------------------------------------- commit 17d696f1a8dcc28074886a2830036144eced6d87 Author: Ben Gamari Date: Sun Oct 16 20:49:26 2016 -0400 validate: Allow user to override Python interpreter Due to #12554 and #12661 we must be quite picky about our choice of Python interpreter on Windows. Allow the user to override it. Test Plan: `PYTHON=/usr/bin/python2 ./validate` on Windows Reviewers: austin, Phyx Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2603 GHC Trac Issues: #12554, #12661 >--------------------------------------------------------------- 17d696f1a8dcc28074886a2830036144eced6d87 validate | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/validate b/validate index cf45648..8caa0e2 100755 --- a/validate +++ b/validate @@ -284,10 +284,16 @@ if [ $be_quiet -eq 1 ] && [ -z $VERBOSE ]; then TEST_VERBOSITY="VERBOSE=1" fi +# We need to be quite picky on Windows about which Python interpreter we use +# (#12554, #12661). Allow the user to override it. +if [ "z$PYTHON" != "z" ]; then + PYTHON_ARG="PYTHON=$PYTHON" +fi + rm -f testsuite_summary.txt testsuite_summary_stage1.txt # Use LOCAL=0, see Note [Running tests in /tmp]. -$make -C testsuite/tests $BINDIST \ +$make -C testsuite/tests $BINDIST $PYTHON_ARG \ $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ 2>&1 | tee testlog @@ -295,7 +301,7 @@ $make -C testsuite/tests $BINDIST \ # Run a few tests using the stage1 compiler. # See Note [Why is there no stage1 setup function?]. # Don't use BINDIST=YES, as stage1 is not available in a bindist. -$make -C testsuite/tests/stage1 \ +$make -C testsuite/tests/stage1 $PYTHON_ARG \ $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ 2>&1 | tee testlog-stage1 From git at git.haskell.org Mon Oct 17 19:02:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:36 +0000 (UTC) Subject: [commit: ghc] master: testsuite/timeout: Ensure that processes are cleaned up on Windows (c6ee773) Message-ID: <20161017190236.C14C43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6ee773a93397c197caa09db9f8d8145d9d930b0/ghc >--------------------------------------------------------------- commit c6ee773a93397c197caa09db9f8d8145d9d930b0 Author: Ben Gamari Date: Sun Oct 16 20:49:15 2016 -0400 testsuite/timeout: Ensure that processes are cleaned up on Windows Previously if the test is interrupted (e.g. with Ctrl-C) any processes which it spawned may not be properly terminated. Here we catch any exception and ensure that we job is terminated. Test Plan: Validate on Windows Reviewers: Phyx, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2599 >--------------------------------------------------------------- c6ee773a93397c197caa09db9f8d8145d9d930b0 testsuite/timeout/timeout.hs | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs index 3684b91..c015eb6 100644 --- a/testsuite/timeout/timeout.hs +++ b/testsuite/timeout/timeout.hs @@ -110,23 +110,26 @@ run secs cmd = unless b $ errorWin "createProcessW" pi <- peek p_pi assignProcessToJobObject job (piProcess pi) - resumeThread (piThread pi) + let handleInterrupt action = + action `onException` terminateJobObject job 99 + handleInterrupt $ do + resumeThread (piThread pi) - -- The program is now running + -- The program is now running - let handle = piProcess pi - let millisecs = secs * 1000 - rc <- waitForSingleObject handle (fromIntegral millisecs) - if rc == cWAIT_TIMEOUT - then do terminateJobObject job 99 - exitWith (ExitFailure 99) - else alloca $ \p_exitCode -> - do r <- getExitCodeProcess handle p_exitCode - if r then do ec <- peek p_exitCode - let ec' = if ec == 0 - then ExitSuccess - else ExitFailure $ fromIntegral ec - exitWith ec' - else errorWin "getExitCodeProcess" + let handle = piProcess pi + let millisecs = secs * 1000 + rc <- waitForSingleObject handle (fromIntegral millisecs) + if rc == cWAIT_TIMEOUT + then do terminateJobObject job 99 + exitWith (ExitFailure 99) + else alloca $ \p_exitCode -> + do r <- getExitCodeProcess handle p_exitCode + if r then do ec <- peek p_exitCode + let ec' = if ec == 0 + then ExitSuccess + else ExitFailure $ fromIntegral ec + exitWith ec' + else errorWin "getExitCodeProcess" #endif From git at git.haskell.org Mon Oct 17 19:02:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:39 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark T9405 as broken on Windows (3325435) Message-ID: <20161017190239.6FE243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/332543587eea41825ad7ad5addcb0de6b3bfa2f1/ghc >--------------------------------------------------------------- commit 332543587eea41825ad7ad5addcb0de6b3bfa2f1 Author: Ben Gamari Date: Sun Oct 16 02:53:06 2016 +0000 testsuite: Mark T9405 as broken on Windows There seems to be a runtime system bug here, as described in #12714. >--------------------------------------------------------------- 332543587eea41825ad7ad5addcb0de6b3bfa2f1 testsuite/tests/rts/Makefile | 4 +++- testsuite/tests/rts/all.T | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile index 94f38fa..a6d2482 100644 --- a/testsuite/tests/rts/Makefile +++ b/testsuite/tests/rts/Makefile @@ -52,7 +52,9 @@ T9405: sleep 0.2; \ kill -2 $$!; \ wait $$!; \ - [ -s T9405.ticky ] && echo Ticky-Ticky + [ -e T9405.ticky ] || echo "Error: Ticky profile doesn't exist"; \ + [ -s T9405.ticky ] || echo "Error: Ticky profile is empty"; \ + echo Ticky-Ticky; # Naming convention: 'T5423_' obj-way '_' obj-src # obj-way ::= v | dyn diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index fc37f8d..1c13b97 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -357,7 +357,7 @@ test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ], test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), only_ways(['threaded2'])], compile_and_run, ['']) -test('T9405', [extra_clean(['T9405.ticky'])], +test('T9405', [extra_clean(['T9405.ticky']), when(msys(), expect_broken(12714))], run_command, ['$MAKE -s --no-print-directory T9405']) test('T11788', when(ghc_dynamic(), skip), From git at git.haskell.org Mon Oct 17 19:02:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:42 +0000 (UTC) Subject: [commit: ghc] master: testsuite/driver: Never symlink on Windows (8bb960e) Message-ID: <20161017190242.1E3823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8bb960eff05ef8171ce2632a62db89b4e96aff74/ghc >--------------------------------------------------------------- commit 8bb960eff05ef8171ce2632a62db89b4e96aff74 Author: Ben Gamari Date: Sun Oct 16 20:49:00 2016 -0400 testsuite/driver: Never symlink on Windows While msys' mingw Python 3 does indeed export `os.symlink`, it is unusable since creating symbolic links on Windows requires permissions that essentially no one has. Test Plan: Validate on Windows Reviewers: austin, Phyx, thomie Differential Revision: https://phabricator.haskell.org/D2604 >--------------------------------------------------------------- 8bb960eff05ef8171ce2632a62db89b4e96aff74 testsuite/driver/testutil.py | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index 2862a44..b4159d1 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -1,5 +1,6 @@ import errno import os +import platform import subprocess import shutil @@ -44,9 +45,14 @@ def lndir(srcdir, dstdir): os.mkdir(dst) lndir(src, dst) -# On Windows, os.symlink is not defined. Except when using msys2, as ghc -# does. Then it copies the source file, instead of creating a symbolic -# link to it. We define the following function to make this magic more -# explicit/discoverable. You are enouraged to use it instead of -# os.symlink. -link_or_copy_file = getattr(os, "symlink", shutil.copyfile) +# On Windows, os.symlink is not defined with Python 2.7, but is in Python 3 +# when using msys2, as GHC does. Unfortunately, only Administrative users have +# the privileges necessary to create symbolic links by default. Consequently we +# are forced to just copy instead. +# +# We define the following function to make this magic more +# explicit/discoverable. You are enouraged to use it instead of os.symlink. +if platform.system() == 'Windows': + link_or_copy_file = shutil.copyfile +else: + link_or_copy_file = os.symlink From git at git.haskell.org Mon Oct 17 19:02:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:44 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark T10858 as broken on Windows (8b84b4f) Message-ID: <20161017190244.D8BFB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b84b4fdae1becdaf534faf456a4aced9966e99b/ghc >--------------------------------------------------------------- commit 8b84b4fdae1becdaf534faf456a4aced9966e99b Author: Ben Gamari Date: Sun Oct 16 02:25:50 2016 +0000 testsuite: Mark T10858 as broken on Windows Strangely the allocation numbers on Windows differ significantly from those on Linux. Usually I would just update the number, but I would really like to understand why this is the case. This is a rather large deviation in the compilation of a program which really shouldn't have any appreciable platform dependence. >--------------------------------------------------------------- 8b84b4fdae1becdaf534faf456a4aced9966e99b testsuite/tests/deriving/perf/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/deriving/perf/all.T b/testsuite/tests/deriving/perf/all.T index 4d5996b..b45f724 100644 --- a/testsuite/tests/deriving/perf/all.T +++ b/testsuite/tests/deriving/perf/all.T @@ -1,7 +1,8 @@ test('T10858', [compiler_stats_num_field('bytes allocated', [ (wordsize(64), 241655120, 8) ]), - only_ways(['normal']) + only_ways(['normal']), + when(msys(), expect_broken(12713)) ], compile, ['-O']) From git at git.haskell.org Mon Oct 17 19:02:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:47 +0000 (UTC) Subject: [commit: ghc] master: testsuite/driver: Allow threading on Windows (2864ad7) Message-ID: <20161017190247.90DD73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2864ad79ab44f5ca039c30dc3dec816c77dd5cfa/ghc >--------------------------------------------------------------- commit 2864ad79ab44f5ca039c30dc3dec816c77dd5cfa Author: Ben Gamari Date: Sun Oct 16 20:49:57 2016 -0400 testsuite/driver: Allow threading on Windows It seems that threading now works fine. The only caveat here is that it makes some race conditions more likely (e.g. #12554), although these also appear to affect single-threaded runs. Test Plan: Validate on Windows Reviewers: austin, Phyx Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2600 GHC Trac Issues: #10510 >--------------------------------------------------------------- 2864ad79ab44f5ca039c30dc3dec816c77dd5cfa testsuite/driver/runtests.py | 3 --- 1 file changed, 3 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index abbf3c8..f36725e 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -139,9 +139,6 @@ if config.use_threads == 1: print("Warning: Ignoring request to use threads as python version is 2.7.2") print("See http://bugs.python.org/issue13817 for details.") config.use_threads = 0 - if windows: # See Trac ticket #10510. - print("Warning: Ignoring request to use threads as running on Windows") - config.use_threads = 0 config.cygwin = False config.msys = False From git at git.haskell.org Mon Oct 17 19:02:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:50 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark T7037 as broken on Windows (c5c6d80) Message-ID: <20161017190250.77D903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5c6d80d2129b259809606387d0ca9dbb16dcfc5/ghc >--------------------------------------------------------------- commit c5c6d80d2129b259809606387d0ca9dbb16dcfc5 Author: Ben Gamari Date: Mon Oct 17 08:57:12 2016 -0400 testsuite: Mark T7037 as broken on Windows Due to #12725. >--------------------------------------------------------------- c5c6d80d2129b259809606387d0ca9dbb16dcfc5 testsuite/tests/rts/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 1c13b97..f5c7587 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -199,7 +199,8 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), compile_and_run, ['T6006_c.c -no-hs-main']) test('T7037', - [ extra_clean(['T7037_main.o','T7037_main']) ], + [ extra_clean(['T7037_main.o','T7037_main']), + when(opsys("mingw32"), expect_broken(12725))], run_command, ['$MAKE -s --no-print-directory T7037']) From git at git.haskell.org Mon Oct 17 19:02:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Oct 2016 19:02:53 +0000 (UTC) Subject: [commit: ghc] master: Bump parallel submodule (cf5eec3) Message-ID: <20161017190253.4A25A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf5eec3eaa638719fd9768c20271f8aa2b2eac1f/ghc >--------------------------------------------------------------- commit cf5eec3eaa638719fd9768c20271f8aa2b2eac1f Author: Ben Gamari Date: Mon Oct 17 14:34:25 2016 -0400 Bump parallel submodule Includes testsuite fix for Python 3. >--------------------------------------------------------------- cf5eec3eaa638719fd9768c20271f8aa2b2eac1f libraries/parallel | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/parallel b/libraries/parallel index ec04d05..b01d6da 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit ec04d059b13fc348789d87adfbabb9351f8574db +Subproject commit b01d6daa5a12c31439cdb6f75f89de8820a295a4 From git at git.haskell.org Tue Oct 18 08:47:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 08:47:14 +0000 (UTC) Subject: [commit: ghc] master: Track dep_finsts in exports hash, as it affects downstream deps. (8fa2cdb) Message-ID: <20161018084714.624A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8fa2cdb16c4db8141b889f2364d8e5fccc62cde3/ghc >--------------------------------------------------------------- commit 8fa2cdb16c4db8141b889f2364d8e5fccc62cde3 Author: Edward Z. Yang Date: Mon Oct 17 14:06:18 2016 -0700 Track dep_finsts in exports hash, as it affects downstream deps. Summary: I also added some more comments about the orphan and family instance hashing business. Fixes #12723. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2607 GHC Trac Issues: #12723 >--------------------------------------------------------------- 8fa2cdb16c4db8141b889f2364d8e5fccc62cde3 compiler/iface/MkIface.hs | 61 ++++++++++++++++++++++ compiler/main/HscTypes.hs | 7 ++- compiler/rename/RnNames.hs | 5 ++ compiler/typecheck/FamInst.hs | 13 ++++- testsuite/driver/extra_files.py | 1 + .../scripts/T8469a.hs => driver/recomp016/A.hs} | 4 +- .../scripts/T8469a.hs => driver/recomp016/A2.hs} | 4 +- .../scripts/break022 => driver/recomp016}/C.hs | 3 -- testsuite/tests/driver/recomp016/D.hs | 2 + testsuite/tests/driver/recomp016/E.hs | 3 ++ testsuite/tests/driver/recomp016/Makefile | 19 +++++++ testsuite/tests/driver/recomp016/all.T | 7 +++ .../recomp016.stdout} | 8 ++- 13 files changed, 123 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 8fa2cdb16c4db8141b889f2364d8e5fccc62cde3 From git at git.haskell.org Tue Oct 18 16:20:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 16:20:18 +0000 (UTC) Subject: [commit: ghc] master: Add option to not retain CAFs to the linker API (f148513) Message-ID: <20161018162018.4F8EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f148513ccd93b927ed36152584228980597c6ebd/ghc >--------------------------------------------------------------- commit f148513ccd93b927ed36152584228980597c6ebd Author: Simon Marlow Date: Thu Oct 13 12:51:33 2016 +0100 Add option to not retain CAFs to the linker API >--------------------------------------------------------------- f148513ccd93b927ed36152584228980597c6ebd libraries/ghci/GHCi/ObjLink.hs | 25 +++++++++++++++++++++++-- libraries/ghci/GHCi/Run.hs | 2 +- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/libraries/ghci/GHCi/ObjLink.hs b/libraries/ghci/GHCi/ObjLink.hs index d422813..05a0a16 100644 --- a/libraries/ghci/GHCi/ObjLink.hs +++ b/libraries/ghci/GHCi/ObjLink.hs @@ -11,7 +11,7 @@ -- | Primarily, this module consists of an interface to the C-land -- dynamic linker. module GHCi.ObjLink - ( initObjLinker + ( initObjLinker, ShouldRetainCAFs(..) , loadDLL , loadArchive , loadObj @@ -33,10 +33,31 @@ import GHC.Exts import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath ) import System.FilePath ( dropExtension, normalise ) + + + -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- +data ShouldRetainCAFs + = RetainCAFs + -- ^ Retain CAFs unconditionally in linked Haskell code. + -- Note that this prevents any code from being unloaded. + -- It should not be necessary unless you are GHCi or + -- hs-plugins, which needs to be able call any function + -- in the compiled code. + | DontRetainCAFs + -- ^ Do not retain CAFs. Everything reachable from foreign + -- exports will be retained, due to the StablePtrs + -- created by the module initialisation code. unloadObj + -- frees these StablePtrs, which will allow the CAFs to + -- be GC'd and the code to be removed. + +initObjLinker :: ShouldRetainCAFs -> IO () +initObjLinker RetainCAFs = c_initLinker_ 1 +initObjLinker _ = c_initLinker_ 0 + lookupSymbol :: String -> IO (Maybe (Ptr a)) lookupSymbol str_in = do let str = prefixUnderscore str_in @@ -128,7 +149,7 @@ resolveObjs = do -- --------------------------------------------------------------------------- foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString -foreign import ccall unsafe "initLinker" initObjLinker :: IO () +foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs index a577480..fefbdc3 100644 --- a/libraries/ghci/GHCi/Run.hs +++ b/libraries/ghci/GHCi/Run.hs @@ -45,7 +45,7 @@ import Unsafe.Coerce run :: Message a -> IO a run m = case m of - InitLinker -> initObjLinker + InitLinker -> initObjLinker RetainCAFs LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str LookupClosure str -> lookupClosure str LoadDLL str -> loadDLL str From git at git.haskell.org Tue Oct 18 16:20:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 16:20:21 +0000 (UTC) Subject: [commit: ghc] master: remove unnecessary ifdef (1275994) Message-ID: <20161018162021.1ACC03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1275994613222285b674e4cf7641dd29fb5954e6/ghc >--------------------------------------------------------------- commit 1275994613222285b674e4cf7641dd29fb5954e6 Author: Simon Marlow Date: Tue Oct 18 11:35:12 2016 +0100 remove unnecessary ifdef >--------------------------------------------------------------- 1275994613222285b674e4cf7641dd29fb5954e6 rts/RtsStartup.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 7c2be0d..86a3228 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -435,10 +435,8 @@ hs_exit_(rtsBool wait_foreign) // Free the various argvs freeRtsArgs(); -#ifndef CMINUSMINUS // Free threading resources freeThreadingResources(); -#endif } // Flush stdout and stderr. We do this during shutdown so that it From git at git.haskell.org Tue Oct 18 16:20:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 16:20:23 +0000 (UTC) Subject: [commit: ghc] master: fixup! Add option to not retain CAFs to the linker API (46f5f02) Message-ID: <20161018162023.C6FA23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46f5f0284aa2cbe2e57716e1a4df5cb15037082f/ghc >--------------------------------------------------------------- commit 46f5f0284aa2cbe2e57716e1a4df5cb15037082f Author: Simon Marlow Date: Tue Oct 18 15:18:28 2016 +0100 fixup! Add option to not retain CAFs to the linker API >--------------------------------------------------------------- 46f5f0284aa2cbe2e57716e1a4df5cb15037082f testsuite/tests/rts/T2615.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/rts/T2615.hs b/testsuite/tests/rts/T2615.hs index 6a81185..a7aa5dd 100644 --- a/testsuite/tests/rts/T2615.hs +++ b/testsuite/tests/rts/T2615.hs @@ -3,7 +3,7 @@ import GHCi.ObjLink library_name = "libfoo_script_T2615.so" -- this is really a linker script main = do - initObjLinker + initObjLinker RetainCAFs result <- loadDLL library_name case result of Nothing -> putStrLn (library_name ++ " loaded successfully") From git at git.haskell.org Tue Oct 18 17:55:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 17:55:08 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Handle ConApp in more points in the Specializer (74d26f8) Message-ID: <20161018175508.43F013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/74d26f835f7107fee3748deaa07d23705fd715e1/ghc >--------------------------------------------------------------- commit 74d26f835f7107fee3748deaa07d23705fd715e1 Author: Joachim Breitner Date: Tue Oct 18 13:51:58 2016 -0400 Handle ConApp in more points in the Specializer >--------------------------------------------------------------- 74d26f835f7107fee3748deaa07d23705fd715e1 compiler/specialise/Rules.hs | 1 + compiler/specialise/SpecConstr.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 6297d88..a2cf5ae 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -209,6 +209,7 @@ roughTopName (Type ty) = case tcSplitTyConApp_maybe ty of Just (tc,_) -> Just (getName tc) Nothing -> Nothing roughTopName (Coercion _) = Nothing +roughTopName (ConApp dc _) = Just (dataConWorkId dc) roughTopName (App f _) = roughTopName f roughTopName (Var f) | isGlobalId f -- Note [Care with roughTopName] , isDataConWorkId f || idArity f > 0 diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs index dbc32e6..5c6944b 100644 --- a/compiler/specialise/SpecConstr.hs +++ b/compiler/specialise/SpecConstr.hs @@ -2106,6 +2106,7 @@ samePat (vs1, as1) (vs2, as2) same (Lit l1) (Lit l2) = l1==l2 same (App f1 a1) (App f2 a2) = same f1 f2 && same a1 a2 + same (ConApp dc1 args1) (ConApp dc2 args2) = dc1 == dc2 && all2 same args1 args2 same (Type {}) (Type {}) = True -- Note [Ignore type differences] same (Coercion {}) (Coercion {}) = True From git at git.haskell.org Tue Oct 18 19:29:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 19:29:07 +0000 (UTC) Subject: [commit: ghc] master: DynamicLoading: Replace map + zip with zipWith (7129861) Message-ID: <20161018192907.AEAD73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7129861397f8e1ea9dbe299708633d118a3085fa/ghc >--------------------------------------------------------------- commit 7129861397f8e1ea9dbe299708633d118a3085fa Author: Ömer Sinan Ağacan Date: Tue Oct 18 15:05:16 2016 -0400 DynamicLoading: Replace map + zip with zipWith >--------------------------------------------------------------- 7129861397f8e1ea9dbe299708633d118a3085fa compiler/main/DynamicLoading.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index 2b2365f..5658f2f 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -71,12 +71,12 @@ import Data.List ( intercalate ) loadPlugins :: HscEnv -> IO [(ModuleName, Plugin, [CommandLineOption])] loadPlugins hsc_env = do { plugins <- mapM (loadPlugin hsc_env) to_load - ; return $ map attachOptions $ to_load `zip` plugins } + ; return $ zipWith attachOptions to_load plugins } where dflags = hsc_dflags hsc_env to_load = pluginModNames dflags - attachOptions (mod_nm, plug) = (mod_nm, plug, options) + attachOptions mod_nm plug = (mod_nm, plug, options) where options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags , opt_mod_nm == mod_nm ] From git at git.haskell.org Tue Oct 18 19:29:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 19:29:10 +0000 (UTC) Subject: [commit: ghc] master: ghc/Main.hs: Add import list to DynamicLoading (161f463) Message-ID: <20161018192910.638C23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/161f463045668055b6f31a276498931ddfb3807f/ghc >--------------------------------------------------------------- commit 161f463045668055b6f31a276498931ddfb3807f Author: Ömer Sinan Ağacan Date: Tue Oct 18 15:24:23 2016 -0400 ghc/Main.hs: Add import list to DynamicLoading >--------------------------------------------------------------- 161f463045668055b6f31a276498931ddfb3807f ghc/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 79e29b5..83d5238 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -31,7 +31,7 @@ import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) -- Frontend plugins #ifdef GHCI -import DynamicLoading +import DynamicLoading ( loadFrontendPlugin ) import Plugins #else import DynamicLoading ( pluginError ) From git at git.haskell.org Tue Oct 18 19:36:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 19:36:57 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Squashed commit of adding ConApp (1c4c643) Message-ID: <20161018193657.02C573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/1c4c64385bbc315deaff203fbebc423ce79f3f93/ghc >--------------------------------------------------------------- commit 1c4c64385bbc315deaff203fbebc423ce79f3f93 Author: Joachim Breitner Date: Tue Oct 18 15:36:33 2016 -0400 Squashed commit of adding ConApp commit 6b35f6643d539e047a2e89124ba11e92a9159a0c Author: Joachim Breitner Date: Tue Oct 18 15:29:20 2016 -0400 Add eta-expanded variants of RULE foldr/id and foldr/app this is annoying. commit f62ba67f44bdbfb18686f15563ff851df391156b Author: Joachim Breitner Date: Tue Oct 18 14:58:22 2016 -0400 specExpr: Reverse ConArg traversal, to reduce diff commit c2189250a803ba73a98d0378d94ae2a3f11a122f Author: Joachim Breitner Date: Tue Oct 18 13:51:58 2016 -0400 Handle ConApp in more points in the Specializer commit fb0ca506618c6e9c93f3c7cdef90ed1b5849f8e3 Author: Joachim Breitner Date: Fri Oct 14 23:20:12 2016 -0400 magictDict built-in rule: Also match ConApp commit 5b1e66568e5d6ca3c43e8f0ae0d7e5b9915bba68 Author: Joachim Breitner Date: Fri Oct 14 15:34:23 2016 -0400 Have SimpleWrapperUnfoldings to keep them apart from compulsory unfoldings for now, to avoid accidential unrelated effects of this patch. commit 03195f67022162318c8fed3d86b188597eb26c6b Author: Joachim Breitner Date: Thu Oct 13 15:20:47 2016 -0400 Try to apply rules that match a data con this is slightly annoying, all the rule matching code so far assumes that rules can only apply to function applications, which is just no longer true. commit 67dbf3a9841e6ffcca9d7c480a06b78c30513c98 Author: Joachim Breitner Date: Thu Oct 13 14:55:34 2016 -0400 Make simple DataCon wrappers complusary unfoldings and make sure they are unfolded in simple_opt_expr, even when they are nullary. For that, start paying attention to the arity field in the unfolding guidance. (This design can be revised later.) commit e6ad487ff9dd77ff4d35b15d671338b02942ac80 Author: Joachim Breitner Date: Thu Oct 13 13:25:49 2016 -0400 Extend test for #12689 with rule matching late on normal data con commit 5ed10e8ea37e3d1d89c6edae5c1a626b483849a3 Author: Joachim Breitner Date: Thu Oct 13 13:11:10 2016 -0400 Use mkSimpleDataConRep in mkDataConRep if nothing fancy goes on as a step towards treating them diffently in the inliner. commit 92b560e6d04e2db290d6e1e8a4fa93c936a5de69 Author: Joachim Breitner Date: Thu Oct 13 13:08:34 2016 -0400 Revert "Make data con wrappers ConLike (and see what happens)" This reverts commit ad72aa0e46d1e58eac3e6ff3c17af080b01e6ff3. commit ad72aa0e46d1e58eac3e6ff3c17af080b01e6ff3 Author: Joachim Breitner Date: Tue Oct 11 19:03:51 2016 -0400 Make data con wrappers ConLike (and see what happens) commit e17608466274b8448bd9d4f1f4f5edaa4894bd63 Author: Joachim Breitner Date: Tue Oct 11 16:50:25 2016 -0400 Add a broken test case for #12689 A rule with a phase specification trying to match on a constructor with a wrapper will fail to match, as the wrapper will be inlined by then. The fact that it works in the other case is also mostly by accident. (Split into two test cases so that regressions with regard what works so far are caught.) commit 6d59834455f8e9c294f030890e96af548079652a Author: Joachim Breitner Date: Tue Oct 11 16:25:05 2016 -0400 Add test case for #12689 which test a few variants of rules involving constructors, including nullary constructors, constructors with wrappers, and unsaturated of constructors. At the moment, all the rules work as expected, despite GHC’s compile time warnings when called with -Wall. commit 0e07dc90aa94673bcc83f10e32b466b7f22ee3ee Author: Joachim Breitner Date: Tue Oct 11 10:57:55 2016 -0400 SpecConstr.isValue: Handle ConApp now all tests pass (here) commit ddbcc7b5cea1fb22697d6d0723e90e0d893a6537 Author: Joachim Breitner Date: Tue Oct 11 10:47:06 2016 -0400 Adjust exprIsCheap commit 54cfb30b0b33246d4e8cb36d659ccbc971e9f094 Author: Joachim Breitner Date: Tue Oct 11 10:11:19 2016 -0400 Fix instance Eq (DeBruijn CoreExpr) for ConApp commit 557166a6b670f3dcd3bed4f79af1119b9a3f4832 Author: Joachim Breitner Date: Mon Oct 10 17:35:36 2016 -0400 Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. commit 5bdf9d042d812fdfeece8db9037c0175c2b8ed6b Author: Joachim Breitner Date: Mon Oct 10 17:27:19 2016 -0400 sptModuleInitCode: Look for ConApp commit 11b0d182da0b283ab73f3682c195cce452c4a57f Author: Joachim Breitner Date: Mon Oct 10 16:37:54 2016 -0400 Nullary data constructors are trivial commit 09f72a920ba786bf7a0c235a38402d8ff8d6f9a5 Author: Simon Peyton Jones Date: Sat Oct 8 00:03:53 2016 +0100 Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. commit 0a5850dab49cbec07c41dcac6771da4c1584d9cd Author: Joachim Breitner Date: Sun Oct 9 17:54:51 2016 -0400 Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. commit 32a2826823c67b8ff54224b47ede9017619a7a23 Author: Joachim Breitner Date: Sun Oct 9 15:51:04 2016 -0400 SetLevels: Do not float nullary data constructors commit 0ae46fea877a38b872ba7eb241e9a620d1c2de1d Author: Joachim Breitner Date: Sun Oct 9 14:43:56 2016 -0400 Update some test output commit 891c903b791b67aa4742a8634cfad71bf61a8d2c Author: Joachim Breitner Date: Sun Oct 9 14:23:04 2016 -0400 No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. commit 33728e85c73918b2e4549ee92f5350a7accce00a Author: Joachim Breitner Date: Sun Oct 9 13:45:08 2016 -0400 Avoid invalid haddock synatx commit 75e5dd948dc4c3db6830383b5cc83231a71005d6 Author: Joachim Breitner Date: Sun Oct 9 13:44:00 2016 -0400 getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons commit 2fee1279c78e39e7233a9f79b27549b02a74d565 Author: Joachim Breitner Date: Sun Oct 9 13:20:59 2016 -0400 Handle nullary constructors in the byte code generator. commit 4068e403fe104e4226939190bb107a1f3c655d0c Author: Joachim Breitner Date: Sun Oct 9 12:38:14 2016 -0400 Handle nullary Cons in myCollectArgs commit d51996444bfd40eb7588e696078f3f6eedd35442 Author: Joachim Breitner Date: Sun Oct 9 12:07:50 2016 -0400 cpe_ExprIsTrivial: Nullary Constructors are trivial commit 518ed7909a9c81d96480b9ed2fd39a0be2fb8fe3 Author: Joachim Breitner Date: Sat Oct 8 22:55:54 2016 -0400 Handle ConApp in inlineBoringOk commit ab230b9fe7142b1a9dcd62f6af2dce848b0d8f59 Author: Joachim Breitner Date: Sat Oct 8 16:59:00 2016 -0400 coreToStgExpr: add con worker to free variables reported commit 7a6203882ee5af9db0cdc5463f23a60989ab7cee Author: Joachim Breitner Date: Fri Oct 7 21:59:46 2016 -0400 Do not lint the bodz of the data con worker bindings introduced by CorePrep commit c9a3415460ab6361ecdaf396800a3a533d62587e Author: Joachim Breitner Date: Fri Oct 7 21:43:24 2016 -0400 Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. commit 5a0b12869b7d9058348a4af42ef016da3d5b83ae Author: Joachim Breitner Date: Fri Oct 7 17:39:42 2016 -0400 maybe_substitute: Detect ConApp commit f0b187303fad8c36df615bc835752b5a16202831 Author: Joachim Breitner Date: Fri Oct 7 15:21:35 2016 -0400 Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. commit 13557d6e3d92315ed034479905aa4a15baff4025 Author: Joachim Breitner Date: Fri Oct 7 09:18:53 2016 -0400 isTrueLHsExpr: Match on data con wrapper now commit cc7e75428218cc02fe7da916fb2ee5a5e3868807 Author: Joachim Breitner Date: Thu Oct 6 23:38:34 2016 -0400 Include constructor in freeNamesIfExpr commit 65ba986828aba20e61ef15b2db09eb40c06259b4 Author: Joachim Breitner Date: Wed Oct 5 23:23:20 2016 -0400 Use ConApp when creating True resp. False commit 70e58e8316a138627274160e2fe6972802084fea Author: Joachim Breitner Date: Wed Oct 5 23:22:48 2016 -0400 New Lint Check: No data con workers any more, please commit ba8341c129bb26e8d92e763dd7de6f0a1e265caf Author: Joachim Breitner Date: Wed Oct 5 23:08:34 2016 -0400 mkCoreConApps: Do not use ConApp for newtypes commit 48877dad6bfd8a7d5cf47da04fde8e2223530146 Author: Joachim Breitner Date: Wed Oct 5 18:21:59 2016 -0400 mkSimpleDataConRep: No wrapper for newtypes commit 3f42e87964b327f4e6b463056727e3de980dfa31 Author: Joachim Breitner Date: Wed Oct 5 18:13:33 2016 -0400 ConApp: More Linting commit 1aa69bff3624beb966136e70e806dd7c7038a795 Author: Joachim Breitner Date: Wed Oct 5 17:50:29 2016 -0400 Use dataConWrapId in unsaturated uses of mkCoreConApps commit d1922185829f5ee2eac8c9797d732aa653b0408d Author: Joachim Breitner Date: Wed Oct 5 17:43:05 2016 -0400 Handle ConApp in "Eliminate Identity Case" commit ef7fc1a15bc64084589d3b63789f2d03f5bf6cf0 Author: Joachim Breitner Date: Wed Oct 5 17:29:53 2016 -0400 Deserialize interface tuples to ConApp commit 395db23544dbde568bfaf71966123b7b8388e971 Author: Joachim Breitner Date: Wed Oct 5 17:16:59 2016 -0400 Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) commit 5be97a0c7aec64260335581ec8de27792be0467a Author: Joachim Breitner Date: Wed Oct 5 13:21:41 2016 -0400 Desugar: Use Coercible worker, not wrapper commit 36143d401423e7fc427cef6ed71cb9dae3c9d561 Author: Joachim Breitner Date: Wed Oct 5 13:15:40 2016 -0400 CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. commit 916c15272fffd7d7457c085488051765c6c8146e Author: Joachim Breitner Date: Wed Oct 5 12:50:32 2016 -0400 Reserve a unique for the wrapper of a wired in DataCon commit 32b47198c2f6b365611e144b0730c9dff12ba206 Author: Joachim Breitner Date: Tue Oct 4 15:46:59 2016 -0400 Always use ConApp in CoreSyn commit 39185a4af6d85087f2eb42fb02f74e990bcb142d Author: Joachim Breitner Date: Tue Oct 4 15:14:45 2016 -0400 Always build a wrapper for data types commit 3733c4dfc50d578bef3e6a287f28841ce16f309a Author: Joachim Breitner Date: Tue Oct 4 14:49:40 2016 -0400 Get rid of unitDataConId (use ConApp instead) commit c3e1cb0b94f527d2a488c19b4566a46cd7d780ce Author: Joachim Breitner Date: Tue Oct 4 14:41:54 2016 -0400 knownCon: Use ConApp in unfolding of scrutinee commit 8399e73a44287d5aa6ce6c61620c628f85033392 Author: Joachim Breitner Date: Tue Oct 4 14:35:23 2016 -0400 Use ConApp in tagToEnumRule commit a40b10315ca752652e23c15be0e7a1d48807f62f Author: Joachim Breitner Date: Tue Oct 4 14:29:17 2016 -0400 Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. commit 6c7668e65cc1901414aa14a8e9d555082cc2c9f3 Author: Joachim Breitner Date: Tue Oct 4 14:23:43 2016 -0400 mkCoreConApps: Warn about unsaturated use commit b486662d3c75ef8a1c96d2d29f8e5ca547c23c25 Author: Joachim Breitner Date: Tue Oct 4 14:20:05 2016 -0400 DataCon wrapper: Use ConApp in the body commit f10cbcb7aab88b38ce1dc17568af4454abf624ae Author: Joachim Breitner Date: Tue Oct 4 14:10:09 2016 -0400 mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). commit 8fa24208a732b877952ded6e2e98f54f526dde19 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. commit 5a7d036452d83c7d456a73b4fc4781aa76c57f62 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. commit e7d8c5a713218329d52954f99aff60a484e00eed Author: Joachim Breitner Date: Sun Oct 2 21:19:49 2016 -0400 ConApp bytecode: Add more ASSERT commit f17b59ef00616ac15405cf84b30bf202fc239592 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. commit 67814af6d68758eba6d424a4454cef6bd7235127 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 1c4c64385bbc315deaff203fbebc423ce79f3f93 compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/Demand.hs | 17 ++- compiler/basicTypes/MkId.hs | 137 ++++++++++++++------- compiler/basicTypes/MkId.hs-boot | 4 +- compiler/basicTypes/Unique.hs | 22 ++-- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++ compiler/coreSyn/CoreLint.hs | 42 +++++++ compiler/coreSyn/CorePrep.hs | 24 ++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 52 +++++--- compiler/coreSyn/CoreSyn.hs | 38 +++++- compiler/coreSyn/CoreTidy.hs | 15 +-- compiler/coreSyn/CoreUnfold.hs | 20 ++- compiler/coreSyn/CoreUtils.hs | 65 ++++++---- compiler/coreSyn/MkCore.hs | 39 +++++- compiler/coreSyn/PprCore.hs | 11 ++ compiler/coreSyn/TrieMap.hs | 80 +++++++----- compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsBinds.hs | 10 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/ByteCodeGen.hs | 42 ++++++- compiler/iface/IfaceSyn.hs | 60 ++++++--- compiler/iface/MkIface.hs | 32 +++-- compiler/iface/TcIface.hs | 13 +- compiler/main/StaticPtrTable.hs | 5 + compiler/main/TidyPgm.hs | 2 + compiler/prelude/PrelNames.hs | 17 ++- compiler/prelude/PrelRules.hs | 16 ++- compiler/prelude/TysWiredIn.hs | 35 +++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++- compiler/simplCore/FloatIn.hs | 19 +++ compiler/simplCore/FloatOut.hs | 8 ++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++ compiler/simplCore/SAT.hs | 12 ++ compiler/simplCore/SetLevels.hs | 18 ++- compiler/simplCore/SimplUtils.hs | 19 +-- compiler/simplCore/Simplify.hs | 30 ++++- compiler/specialise/Rules.hs | 15 +++ compiler/specialise/SpecConstr.hs | 7 ++ compiler/specialise/Specialise.hs | 3 + compiler/stgSyn/CoreToStg.hs | 20 +++ compiler/stranal/DmdAnal.hs | 33 +++++ compiler/stranal/WorkWrap.hs | 3 + compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 48 +++++--- compiler/vectorise/Vectorise/Exp.hs | 13 ++ compiler/vectorise/Vectorise/Utils.hs | 6 - libraries/base/GHC/Base.hs | 2 + mk/warnings.mk | 2 + .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++- .../tests/ghci.debugger/scripts/print006.stdout | 14 +-- .../tests/ghci.debugger/scripts/print008.stdout | 10 +- .../tests/ghci.debugger/scripts/print010.stdout | 7 +- .../tests/ghci.debugger/scripts/print012.stdout | 9 +- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +-- .../tests/ghci.debugger/scripts/print034.stdout | 6 +- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/numeric/should_compile/T7116.stdout | 40 +++--- testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 ++++----- .../tests/roles/should_compile/Roles13.stderr | 70 +++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 +-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 +-- testsuite/tests/roles/should_compile/T8958.stderr | 32 ++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 25 +++- .../tests/simplCore/should_compile/T3717.stderr | 20 +-- .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 47 ++++--- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++-- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 114 ++++++++++------- .../tests/simplCore/should_compile/T7865.stdout | 2 +- .../tests/simplCore/should_compile/T8274.stdout | 34 +++-- .../tests/simplCore/should_compile/T8832.stdout | 20 +-- .../tests/simplCore/should_compile/T8848.stderr | 32 ++--- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../tests/simplCore/should_compile/rule2.stderr | 19 ++- .../simplCore/should_compile/spec-inline.stderr | 133 +++++++++++++------- testsuite/tests/simplCore/should_run/T12689.hs | 33 +++++ testsuite/tests/simplCore/should_run/T12689.stdout | 8 ++ testsuite/tests/simplCore/should_run/T12689a.hs | 27 ++++ .../tests/simplCore/should_run/T12689a.stdout | 6 + .../tests/simplCore/should_run/T12689broken.hs | 9 ++ .../tests/simplCore/should_run/T12689broken.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 3 + testsuite/tests/th/TH_Roles2.stderr | 8 +- 105 files changed, 1531 insertions(+), 733 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 1c4c64385bbc315deaff203fbebc423ce79f3f93 From git at git.haskell.org Tue Oct 18 19:48:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 19:48:21 +0000 (UTC) Subject: [commit: ghc] master: fix build failure on Solaris caused by usage of --export-dynamic (fa8940e) Message-ID: <20161018194821.ABE9A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa8940e80138fed457e8903d59e2cd011741fa29/ghc >--------------------------------------------------------------- commit fa8940e80138fed457e8903d59e2cd011741fa29 Author: Karel Gardas Date: Tue Oct 18 21:47:35 2016 +0200 fix build failure on Solaris caused by usage of --export-dynamic Summary: This patch fixes build failure on Solaris which is caused by usage --export-dynamic linker parameter. This parameter is not supported by Solaris linker. The param itself was added by D2590 Reviewers: bgamari, simonmar, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2606 >--------------------------------------------------------------- fa8940e80138fed457e8903d59e2cd011741fa29 iserv/ghc.mk | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/iserv/ghc.mk b/iserv/ghc.mk index cab432a..8497313 100644 --- a/iserv/ghc.mk +++ b/iserv/ghc.mk @@ -29,10 +29,14 @@ iserv_stage2_dyn_MORE_HC_OPTS += -threaded # of overhead to startup and increases the binary sizes) but if you # need it there's no alternative. ifeq "$(TargetElf)" "YES" +ifneq "$(TargetOS_CPP)" "solaris2" +# The Solaris linker does not support --export-dynamic option. It also +# does not need it since it exports all dynamic symbols by default iserv_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic iserv_stage2_p_MORE_HC_OPTS += -optl-Wl,--export-dynamic iserv_stage2_dyn_MORE_HC_OPTS += -optl-Wl,--export-dynamic endif +endif # Override the default way, because we want a specific version of this # program for each way. Note that it's important to do this even for From git at git.haskell.org Tue Oct 18 22:45:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 22:45:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Correct order of existentials in pattern synonyms (5c02b84) Message-ID: <20161018224530.145423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5c02b842fa64bb06766d4e89615af84bc4db992b/ghc >--------------------------------------------------------------- commit 5c02b842fa64bb06766d4e89615af84bc4db992b Author: Simon Peyton Jones Date: Fri Oct 14 15:54:14 2016 +0100 Correct order of existentials in pattern synonyms Trac #12698 exposed a nasty bug in the typechecking for pattern synonmys: the existential type variables weren't being put in properly-scoped order. For some reason TcPatSyn.tcCollectEx was colleting them as a set, not as a list! Easily fixed. (cherry picked from commit a693d1cb0ee9499af3145d73b1aebe5b6df0da98) >--------------------------------------------------------------- 5c02b842fa64bb06766d4e89615af84bc4db992b compiler/hsSyn/HsPat.hs | 1 + compiler/typecheck/TcPatSyn.hs | 35 +++++++------- testsuite/tests/patsyn/should_compile/T12698.hs | 62 +++++++++++++++++++++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 4 files changed, 81 insertions(+), 18 deletions(-) diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 09a38a9..13e348b 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -157,6 +157,7 @@ data Pat id -- the type of the pattern pat_tvs :: [TyVar], -- Existentially bound type variables + -- in correctly-scoped order e.g. [k:*, x:k] pat_dicts :: [EvVar], -- Ditto *coercion variables* and *dictionaries* -- One reason for putting coercion variable here, I think, -- is to ensure their kinds are zonked diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 73c46e8..6a1f0e7 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -47,7 +47,6 @@ import FieldLabel import Bag import Util import ErrUtils -import FV import Control.Monad ( unless, zipWithM ) import Data.List( partition ) #if __GLASGOW_HASKELL__ < 709 @@ -222,12 +221,13 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, ; (qtvs, req_dicts, ev_binds) <- simplifyInfer tclvl False [] named_taus wanted - ; let ((ex_tvs, ex_vars), prov_dicts) = tcCollectEx lpat' - univ_tvs = filter (not . (`elemVarSet` ex_vars)) qtvs + ; let (ex_tvs, prov_dicts) = tcCollectEx lpat' + ex_tv_set = mkVarSet ex_tvs + univ_tvs = filterOut (`elemVarSet` ex_tv_set) qtvs prov_theta = map evVarPred prov_dicts req_theta = map evVarPred req_dicts - ; traceTc "tcInferPatSynDecl }" $ ppr name + ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs) ; tc_patsyn_finish lname dir is_infix lpat' (univ_tvs, mkNamedBinders Invisible univ_tvs , req_theta, ev_binds, req_dicts) @@ -954,17 +954,16 @@ nonBidirectionalErr name = failWithTc $ -- to be passed these pattern-bound evidences. tcCollectEx :: LPat Id - -> ( ([Var], VarSet) -- Existentially-bound type variables as a - -- deterministically ordered list and a set. - -- See Note [Deterministic FV] in FV - , [EvVar] - ) -tcCollectEx pat = let (fv, evs) = go pat in (fvVarListVarSet fv, evs) + -> ( [TyVar] -- Existentially-bound type variables + -- in correctly-scoped order; e.g. [ k:*, x:k ] + , [EvVar] ) -- and evidence variables + +tcCollectEx pat = go pat where - go :: LPat Id -> (FV, [EvVar]) + go :: LPat Id -> ([TyVar], [EvVar]) go = go1 . unLoc - go1 :: Pat Id -> (FV, [EvVar]) + go1 :: Pat Id -> ([TyVar], [EvVar]) go1 (LazyPat p) = go p go1 (AsPat _ p) = go p go1 (ParPat p) = go p @@ -973,23 +972,23 @@ tcCollectEx pat = let (fv, evs) = go pat in (fvVarListVarSet fv, evs) go1 (TuplePat ps _ _) = mergeMany . map go $ ps go1 (PArrPat ps _) = mergeMany . map go $ ps go1 (ViewPat _ p _) = go p - go1 con at ConPatOut{} = merge (FV.mkFVs (pat_tvs con), pat_dicts con) $ - goConDetails $ pat_args con + go1 con at ConPatOut{} = merge (pat_tvs con, pat_dicts con) $ + goConDetails $ pat_args con go1 (SigPatOut p _) = go p go1 (CoPat _ p _) = go1 p go1 (NPlusKPat n k _ geq subtract _) = pprPanic "TODO: NPlusKPat" $ ppr n $$ ppr k $$ ppr geq $$ ppr subtract go1 _ = empty - goConDetails :: HsConPatDetails Id -> (FV, [EvVar]) + goConDetails :: HsConPatDetails Id -> ([TyVar], [EvVar]) goConDetails (PrefixCon ps) = mergeMany . map go $ ps goConDetails (InfixCon p1 p2) = go p1 `merge` go p2 goConDetails (RecCon HsRecFields{ rec_flds = flds }) = mergeMany . map goRecFd $ flds - goRecFd :: LHsRecField Id (LPat Id) -> (FV, [EvVar]) + goRecFd :: LHsRecField Id (LPat Id) -> ([TyVar], [EvVar]) goRecFd (L _ HsRecField{ hsRecFieldArg = p }) = go p - merge (vs1, evs1) (vs2, evs2) = (vs1 `unionFV` vs2, evs1 ++ evs2) + merge (vs1, evs1) (vs2, evs2) = (vs1 ++ vs2, evs1 ++ evs2) mergeMany = foldr merge empty - empty = (emptyFV, []) + empty = ([], []) diff --git a/testsuite/tests/patsyn/should_compile/T12698.hs b/testsuite/tests/patsyn/should_compile/T12698.hs new file mode 100644 index 0000000..6ba45e4 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12698.hs @@ -0,0 +1,62 @@ +{-# Language ViewPatterns, TypeOperators, KindSignatures, PolyKinds, + TypeInType, StandaloneDeriving, GADTs, RebindableSyntax, + RankNTypes, LambdaCase, PatternSynonyms, TypeApplications #-} + +module T12698 where + +import GHC.Types +import Prelude hiding ( fromInteger ) +import Data.Type.Equality +import Data.Kind +import qualified Prelude + +class Ty (a :: k) where ty :: T a +instance Ty Int where ty = TI +instance Ty Bool where ty = TB +instance Ty a => Ty [a] where ty = TA TL ty +instance Ty [] where ty = TL +instance Ty (,) where ty = TP + +data AppResult (t :: k) where + App :: T a -> T b -> AppResult (a b) + +data T :: forall k. k -> Type where + TI :: T Int + TB :: T Bool + TL :: T [] + TP :: T (,) + TA :: T f -> T x -> T (f x) +deriving instance Show (T a) + +splitApp :: T a -> Maybe (AppResult a) +splitApp = \case + TI -> Nothing + TB -> Nothing + TL -> Nothing + TP -> Nothing + TA f x -> Just (App f x) + +data (a :: k1) :~~: (b :: k2) where + HRefl :: a :~~: a + +eqT :: T a -> T b -> Maybe (a :~~: b) +eqT a b = + case (a, b) of + (TI, TI) -> Just HRefl + (TB, TB) -> Just HRefl + (TL, TL) -> Just HRefl + (TP, TP) -> Just HRefl + +pattern List :: () => [] ~~ b => T b +pattern List <- (eqT (ty @(Type -> Type) @[]) -> Just HRefl) + where List = ty + +pattern Int :: () => Int ~~ b => T b +pattern Int <- (eqT (ty @Type @Int) -> Just HRefl) + where Int = ty + +pattern (:<->:) :: () => fx ~ f x => T f -> T x -> T fx +pattern f :<->: x <- (splitApp -> Just (App f x)) + where f :<->: x = TA f x + +pattern Foo <- List :<->: Int diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 9841462..875449c 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -58,3 +58,4 @@ test('T11959', expect_broken(11959), multimod_compile, ['T11959', '-v0']) test('T12615', normal, compile, ['']) test('T11987', normal, multimod_compile, ['T11987', '-v0']) test('T12615', normal, compile, ['']) +test('T12698', normal, compile, ['']) From git at git.haskell.org Tue Oct 18 22:45:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 22:45:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix wrapping order in matchExpectedConTy (bfaa770) Message-ID: <20161018224533.3011F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/bfaa770fdf97954e776f2d877270a59ec1bdc73d/ghc >--------------------------------------------------------------- commit bfaa770fdf97954e776f2d877270a59ec1bdc73d Author: Simon Peyton Jones Date: Fri Oct 14 17:13:43 2016 +0100 Fix wrapping order in matchExpectedConTy The wrappers in matchExpectedConTy were being composed back to front, resulting in a Core Lint error. Yikes! This has been here a long time. Fixes Trac #12676. (cherry picked from commit f7278a9068dab28f50351c18177cc352d6570285) >--------------------------------------------------------------- bfaa770fdf97954e776f2d877270a59ec1bdc73d compiler/typecheck/TcPat.hs | 24 +++++++++++++--------- .../tests/indexed-types/should_compile/T12676.hs | 9 ++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 24 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index e689c0d..6ba6401 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -889,21 +889,24 @@ matchExpectedConTy :: PatEnv -> TcM (HsWrapper, [TcSigmaType]) -- See Note [Matching constructor patterns] -- Returns a wrapper : pat_ty "->" T ty1 ... tyn -matchExpectedConTy (PE { pe_orig = orig }) data_tc pat_ty +matchExpectedConTy (PE { pe_orig = orig }) data_tc exp_pat_ty | Just (fam_tc, fam_args, co_tc) <- tyConFamInstSig_maybe data_tc -- Comments refer to Note [Matching constructor patterns] -- co_tc :: forall a. T [a] ~ T7 a - = do { pat_ty <- expTypeToType pat_ty - ; (wrap, pat_ty) <- topInstantiate orig pat_ty + = do { pat_ty <- expTypeToType exp_pat_ty + ; (wrap, pat_rho) <- topInstantiate orig pat_ty ; (subst, tvs') <- newMetaTyVars (tyConTyVars data_tc) -- tys = [ty1,ty2] ; traceTc "matchExpectedConTy" (vcat [ppr data_tc, ppr (tyConTyVars data_tc), - ppr fam_tc, ppr fam_args]) - ; co1 <- unifyType noThing (mkTyConApp fam_tc (substTys subst fam_args)) pat_ty - -- co1 : T (ty1,ty2) ~N pat_ty + ppr fam_tc, ppr fam_args, + ppr exp_pat_ty, + ppr pat_ty, + ppr pat_rho, ppr wrap]) + ; co1 <- unifyType noThing (mkTyConApp fam_tc (substTys subst fam_args)) pat_rho + -- co1 : T (ty1,ty2) ~N pat_rho -- could use tcSubType here... but it's the wrong way round -- for actual vs. expected in error messages. @@ -911,12 +914,13 @@ matchExpectedConTy (PE { pe_orig = orig }) data_tc pat_ty co2 = mkTcUnbranchedAxInstCo co_tc tys' [] -- co2 : T (ty1,ty2) ~R T7 ty1 ty2 - ; return ( wrap <.> (mkWpCastR $ - mkTcSubCo (mkTcSymCo co1) `mkTcTransCo` co2) - , tys') } + full_co = mkTcSubCo (mkTcSymCo co1) `mkTcTransCo` co2 + -- full_co :: pat_rho ~R T7 ty1 ty2 + + ; return ( mkWpCastR full_co <.> wrap, tys') } | otherwise - = do { pat_ty <- expTypeToType pat_ty + = do { pat_ty <- expTypeToType exp_pat_ty ; (wrap, pat_rho) <- topInstantiate orig pat_ty ; (coi, tys) <- matchExpectedTyConApp data_tc pat_rho ; return (mkWpCastN (mkTcSymCo coi) <.> wrap, tys) } diff --git a/testsuite/tests/indexed-types/should_compile/T12676.hs b/testsuite/tests/indexed-types/should_compile/T12676.hs new file mode 100644 index 0000000..feb1403 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12676.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RankNTypes, TypeFamilies #-} + +module T12676 where + +data family T a +data instance T () = MkT + +foo :: (forall s. T ()) -> () +foo MkT = () diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index ab49be4..d23e074 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -276,3 +276,4 @@ test('T11361a', normal, compile_fail, ['']) test('T12175', normal, compile, ['']) test('T12522', normal, compile, ['']) test('T12522b', normal, compile, ['']) +test('T12676', normal, compile, ['']) From git at git.haskell.org Tue Oct 18 22:45:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 22:45:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Don't omit any evidence bindings (be94aeb) Message-ID: <20161018224535.D9C373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/be94aebb63aa355b6015c3873426f2f89ce384d6/ghc >--------------------------------------------------------------- commit be94aebb63aa355b6015c3873426f2f89ce384d6 Author: Simon Peyton Jones Date: Fri Jun 24 15:49:05 2016 +0100 Don't omit any evidence bindings This fixes Trac #12156, where we were omitting to make an evidence binding (because cec_suppress was on), but yet the program was compiled and run. The fix is easy, and involves deleting code :-). (cherry picked from commit af21e38855f7d517774542b360178b05045ecb08) >--------------------------------------------------------------- be94aebb63aa355b6015c3873426f2f89ce384d6 testsuite/tests/partial-sigs/should_compile/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index 3cec3e0..6687a03 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -64,3 +64,4 @@ test('T11016', normal, compile, ['']) test('T11192', normal, compile, ['']) test('T12156', normal, compile_fail, ['-fdefer-typed-holes']) test('T12531', normal, compile, ['-fdefer-typed-holes']) +test('T12156', normal, compile, ['-fdefer-typed-holes']) From git at git.haskell.org Tue Oct 18 22:45:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 22:45:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add test for #12589 (9467dfa) Message-ID: <20161018224539.3B5393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9467dfa8cc63de5742a27caf0cdab997156c7409/ghc >--------------------------------------------------------------- commit 9467dfa8cc63de5742a27caf0cdab997156c7409 Author: Ryan Scott Date: Wed Oct 12 19:16:46 2016 -0400 Add test for #12589 Commit af21e38855f7d517774542b360178b05045ecb08 fixed #12598. Let's add a test to make sure it stays fixed. (cherry picked from commit 042c5930bff239337d21836db5b8d0ebf0180ffc) >--------------------------------------------------------------- 9467dfa8cc63de5742a27caf0cdab997156c7409 testsuite/tests/typecheck/should_fail/T12589.hs | 13 +++++++++++++ testsuite/tests/typecheck/should_fail/T12589.stderr | 2 ++ testsuite/tests/typecheck/should_fail/all.T | 2 +- 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_fail/T12589.hs b/testsuite/tests/typecheck/should_fail/T12589.hs new file mode 100644 index 0000000..5f45474 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12589.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fdefer-typed-holes #-} +module T12589 where + +import Data.Proxy + +hcpure :: proxy c -> (forall a. c a => f a) -> h f xs +hcpure _ _ = undefined + +a = minBound + & hcpure (Proxy @Bounded) diff --git a/testsuite/tests/typecheck/should_fail/T12589.stderr b/testsuite/tests/typecheck/should_fail/T12589.stderr new file mode 100644 index 0000000..a2587e2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12589.stderr @@ -0,0 +1,2 @@ + +T12589.hs:13:3: error: Variable not in scope: (&) :: t0 -> t1 -> t diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 985a7c4..1c28f11 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -426,4 +426,4 @@ test('T11990a', normal, compile_fail, ['']) test('T11990b', normal, compile_fail, ['']) test('T12124', normal, compile_fail, ['']) test('T12529', normal, compile_fail, ['']) - +test('T12589', normal, compile_fail, ['']) From git at git.haskell.org Tue Oct 18 22:45:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 22:45:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add test for #12411 (d84a824) Message-ID: <20161018224542.57D1A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d84a824cebe94711528727bcb587bfc369ec36a2/ghc >--------------------------------------------------------------- commit d84a824cebe94711528727bcb587bfc369ec36a2 Author: Ryan Scott Date: Wed Oct 12 14:57:32 2016 -0400 Add test for #12411 The fix for #12584 also fixed the problem in #12411. Let's add a test to ensure that it stays fixed. (cherry picked from commit 184d7cb8278b9c6cb3f9786a96f081d08e4640db) >--------------------------------------------------------------- d84a824cebe94711528727bcb587bfc369ec36a2 testsuite/tests/{driver/recomp009/Sub2.hs => th/T12411.hs} | 5 +++-- testsuite/tests/th/T12411.stderr | 4 ++++ testsuite/tests/th/all.T | 1 + 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/driver/recomp009/Sub2.hs b/testsuite/tests/th/T12411.hs similarity index 50% copy from testsuite/tests/driver/recomp009/Sub2.hs copy to testsuite/tests/th/T12411.hs index 7ca8b12..fd8f9db 100644 --- a/testsuite/tests/driver/recomp009/Sub2.hs +++ b/testsuite/tests/th/T12411.hs @@ -1,3 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -module Sub where -x = [| 2 |] +module T12411 where + +pure @Q [] diff --git a/testsuite/tests/th/T12411.stderr b/testsuite/tests/th/T12411.stderr new file mode 100644 index 0000000..1f34432 --- /dev/null +++ b/testsuite/tests/th/T12411.stderr @@ -0,0 +1,4 @@ + +T12411.hs:4:1: error: + Pattern syntax in expression context: pure at Q + Did you mean to enable TypeApplications? diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 74a1d4b..a59a4e1 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -416,3 +416,4 @@ test('T11484', normal, compile, ['-v0']) test('T12130', extra_clean(['T12130a.hi','T12130a.o']), multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) test('T12407', omit_ways(['ghci']), compile, ['-v0']) +test('T12411', normal, compile_fail, ['']) From git at git.haskell.org Tue Oct 18 22:45:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 22:45:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix shadowing in mkWwBodies (8ab454d) Message-ID: <20161018224545.1B22A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8ab454d9a39655d34664be6e65a67e1697dc17bf/ghc >--------------------------------------------------------------- commit 8ab454d9a39655d34664be6e65a67e1697dc17bf Author: Simon Peyton Jones Date: Fri Oct 14 12:05:46 2016 +0100 Fix shadowing in mkWwBodies This bug, exposed by Trac #12562 was very obscure, and has been lurking for a long time. What happened was that, in the worker/wrapper split a tyvar binder for a worker function accidentally shadowed an in-scope term variable that was mentioned in the body of the function It's jolly hard to provoke, so I have not even attempted to make a test case. There's a Note [Freshen WW arguments] to explain. Interestingly, fixing the bug (which meant fresher type variables) revealed a second lurking bug: I'd failed to apply the substitution to the coercion in the second last case of mkWWArgs, which introduces a Cast. (cherry picked from commit 692c8df03969ee6a0de5158f05907b16689945d0) >--------------------------------------------------------------- 8ab454d9a39655d34664be6e65a67e1697dc17bf compiler/stranal/WorkWrap.hs | 4 ++- compiler/stranal/WwLib.hs | 72 ++++++++++++++++++++++++++++++-------------- 2 files changed, 52 insertions(+), 24 deletions(-) diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 8a5ed67..e7258df 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -11,6 +11,7 @@ import CoreSyn import CoreUnfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding ) import CoreUtils ( exprType, exprIsHNF ) import CoreArity ( exprArity ) +import CoreFVs ( exprFreeVars ) import Var import Id import IdInfo @@ -330,7 +331,7 @@ splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> DmdResult -> splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) do -- The arity should match the signature - stuff <- mkWwBodies dflags fam_envs fun_ty wrap_dmds res_info one_shots + stuff <- mkWwBodies dflags fam_envs rhs_fvs fun_ty wrap_dmds res_info one_shots case stuff of Just (work_demands, wrap_fn, work_fn) -> do work_uniq <- getUniqueM @@ -385,6 +386,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs Nothing -> return [(fn_id, rhs)] where + rhs_fvs = exprFreeVars rhs fun_ty = idType fn_id inl_prag = inlinePragInfo fn_info rule_match_info = inlinePragmaRuleMatchInfo inl_prag diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 09bc204..56f30ae 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -28,6 +28,7 @@ import Coercion import FamInstEnv import BasicTypes ( Boxity(..), OneShotInfo(..), worstOneShot ) import Literal ( absentLiteralOf ) +import VarSet import TyCon import UniqSupply import Unique @@ -107,15 +108,20 @@ the unusable strictness-info into the interfaces. @mkWwBodies@ is called when doing the worker\/wrapper split inside a module. -} +type WwResult + = ([Demand], -- Demands for worker (value) args + Id -> CoreExpr, -- Wrapper body, lacking only the worker Id + CoreExpr -> CoreExpr) -- Worker body, lacking the original function rhs + mkWwBodies :: DynFlags -> FamInstEnvs + -> VarSet -- Free vars of RHS + -- See Note [Freshen WW arguments] -> Type -- Type of original function -> [Demand] -- Strictness of original function -> DmdResult -- Info about function result -> [OneShotInfo] -- One-shot-ness of the function, value args only - -> UniqSM (Maybe ([Demand], -- Demands for worker (value) args - Id -> CoreExpr, -- Wrapper body, lacking only the worker Id - CoreExpr -> CoreExpr)) -- Worker body, lacking the original function rhs + -> UniqSM (Maybe WwResult) -- wrap_fn_args E = \x y -> E -- work_fn_args E = E x y @@ -128,10 +134,11 @@ mkWwBodies :: DynFlags -- let x = (a,b) in -- E -mkWwBodies dflags fam_envs fun_ty demands res_info one_shots +mkWwBodies dflags fam_envs rhs_fvs fun_ty demands res_info one_shots = do { let arg_info = demands `zip` (one_shots ++ repeat NoOneShotInfo) all_one_shots = foldr (worstOneShot . snd) OneShotLam arg_info - empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType fun_ty)) + empty_subst = mkEmptyTCvSubst (mkInScopeSet rhs_fvs) + -- See Note [Freshen WW arguments] ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs empty_subst fun_ty arg_info ; (useful1, work_args, wrap_fn_str, work_fn_str) <- mkWWstr dflags fam_envs wrap_args @@ -292,7 +299,7 @@ the \x to get what we want. -- and keeps repeating that until it's satisfied the supplied arity mkWWargs :: TCvSubst -- Freshening substitution to apply to the type - -- See Note [Freshen type variables] + -- See Note [Freshen WW arguments] -> Type -- The type of the function -> [(Demand,OneShotInfo)] -- Demands and one-shot info for value arguments -> UniqSM ([Var], -- Wrapper args @@ -317,9 +324,9 @@ mkWWargs subst fun_ty arg_info res_ty) } | Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty - = do { let (subst', tv') = substTyVarBndr subst tv - -- This substTyVarBndr clones the type variable when necy - -- See Note [Freshen type variables] + = do { uniq <- getUniqueM + ; let (subst', tv') = cloneTyVarBndr subst tv uniq + -- See Note [Freshen WW arguments] ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs subst' fun_ty' arg_info ; return (tv' : wrap_args, @@ -338,9 +345,10 @@ mkWWargs subst fun_ty arg_info = do { (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs subst rep_ty arg_info - ; return (wrap_args, - \e -> Cast (wrap_fn_args e) (mkSymCo co), - \e -> work_fn_args (Cast e co), + ; let co' = substCo subst co + ; return (wrap_args, + \e -> Cast (wrap_fn_args e) (mkSymCo co'), + \e -> work_fn_args (Cast e co'), res_ty) } | otherwise @@ -356,17 +364,35 @@ mk_wrap_arg uniq ty dmd one_shot `setIdDemandInfo` dmd `setIdOneShotInfo` one_shot -{- -Note [Freshen type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Wen we do a worker/wrapper split, we must not use shadowed names, -else we'll get - f = /\ a /\a. fw a a -which is obviously wrong. Type variables can can in principle shadow, -within a type (e.g. forall a. a -> forall a. a->a). But type -variables *are* mentioned in , so we must substitute. - -That's why we carry the TCvSubst through mkWWargs +{- Note [Freshen WW arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Wen we do a worker/wrapper split, we must not in-scope names as the arguments +of the worker, else we'll get name capture. E.g. + + -- y1 is in scope from further out + f x = ..y1.. + +If we accidentally choose y1 as a worker argument disaster results: + + fww y1 y2 = let x = (y1,y2) in ...y1... + +To avoid this: + + * We use a fresh unique for both type-variable and term-variable binders + Originally we lacked this freshness for type variables, and that led + to the very obscure Trac #12562. (A type varaible in the worker shadowed + an outer term-variable binding.) + + * Because of this cloning we have to substitute in the type/kind of the + new binders. That's why we carry the TCvSubst through mkWWargs. + + So we need a decent in-scope set, just in case that type/kind + itself has foralls. We get this from the free vars of the RHS of the + function since those are the only variables that might be captured. + It's a lazy thunk, which will only be poked if the type/kind has a forall. + + Another tricky case was when f :: forall a. a -> forall a. a->a + (i.e. with shadowing), and then the worker used the same 'a' twice. ************************************************************************ * * From git at git.haskell.org Tue Oct 18 22:45:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Oct 2016 22:45:48 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings (d7a1f68) Message-ID: <20161018224548.5F5D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d7a1f682af766e6c1529932b24bada9053d5c4da/ghc >--------------------------------------------------------------- commit d7a1f682af766e6c1529932b24bada9053d5c4da Author: Ryan Scott Date: Sat Oct 15 11:11:20 2016 -0400 Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings Summary: To fix this issue, we simply disable `RebindableSyntax` whenever we rename the code generated from a deriving clause. Fixes #12688. Test Plan: make test TEST=T12688 Reviewers: simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2591 GHC Trac Issues: #12688 (cherry picked from commit b501709ed79ba03e72518ef9dd101ce2d03db2de) >--------------------------------------------------------------- d7a1f682af766e6c1529932b24bada9053d5c4da compiler/typecheck/TcDeriv.hs | 41 ++++++++++++++++++++--- compiler/typecheck/TcRnMonad.hs | 6 +++- docs/users_guide/8.0.2-notes.rst | 4 +++ docs/users_guide/glasgow_exts.rst | 27 +++++++++++++++ testsuite/tests/deriving/should_compile/T12688.hs | 15 +++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 6 files changed, 88 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index c72772a..9a84952 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -439,11 +439,17 @@ renameDeriv is_boot inst_infos bagBinds , emptyValBindsOut, usesOnly (plusFVs fvs)) } | otherwise - = discardWarnings $ -- Discard warnings about unused bindings etc - setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have - -- case x of {} - setXOptM LangExt.ScopedTypeVariables $ -- Derived decls (for newtype-deriving) can - setXOptM LangExt.KindSignatures $ -- used ScopedTypeVariables & KindSignatures + = discardWarnings $ + -- Discard warnings about unused bindings etc + setXOptM LangExt.EmptyCase $ + -- Derived decls (for empty types) can have + -- case x of {} + setXOptM LangExt.ScopedTypeVariables $ + setXOptM LangExt.KindSignatures $ + -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & + -- KindSignatures + unsetXOptM LangExt.RebindableSyntax $ + -- See Note [Avoid RebindableSyntax when deriving] do { -- Bring the extra deriving stuff into scope -- before renaming the instances themselves @@ -513,6 +519,31 @@ dropped patterns have. Also, this technique carries over the kind substitution from deriveTyData nicely. +Note [Avoid RebindableSyntax when deriving] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The RebindableSyntax extension interacts awkwardly with the derivation of +any stock class whose methods require the use of string literals. The Show +class is a simple example (see Trac #12688): + + {-# LANGUAGE RebindableSyntax, OverloadedStrings #-} + newtype Text = Text String + fromString :: String -> Text + fromString = Text + + data Foo = Foo deriving Show + +This will generate code to the effect of: + + instance Show Foo where + showsPrec _ Foo = showString "Foo" + +But because RebindableSyntax and OverloadedStrings are enabled, the "Foo" +string literal is now of type Text, not String, which showString doesn't +accept! This causes the generated Show instance to fail to typecheck. + +To avoid this kind of scenario, we simply turn off RebindableSyntax entirely +in derived code. + ************************************************************************ * * From HsSyn to DerivSpec diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 21035d6..278082e 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -18,7 +18,7 @@ module TcRnMonad( setGblEnv, getLclEnv, updLclEnv, setLclEnv, getEnvs, setEnvs, xoptM, doptM, goptM, woptM, - setXOptM, unsetGOptM, unsetWOptM, + setXOptM, unsetXOptM, unsetGOptM, unsetWOptM, whenDOptM, whenGOptM, whenWOptM, whenXOptM, getGhcMode, withDoDynamicToo, @@ -447,6 +447,10 @@ setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a setXOptM flag = updTopEnv (\top -> top { hsc_dflags = xopt_set (hsc_dflags top) flag}) +unsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +unsetXOptM flag = + updTopEnv (\top -> top { hsc_dflags = xopt_unset (hsc_dflags top) flag}) + unsetGOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a unsetGOptM flag = updTopEnv (\top -> top { hsc_dflags = gopt_unset (hsc_dflags top) flag}) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 668474a..b1568ae 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -21,6 +21,10 @@ Language - TODO FIXME. +- A bug has been fixed that caused derived ``Show`` instances to fail in the + presence of :ghc-flag:`-XRebindableSyntax` and + :ghc-flag:`-XOverloadedStrings` (:ghc-ticket:`12688`). + Compiler ~~~~~~~~ diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index d7ba481..5153d07 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -1464,6 +1464,33 @@ Be warned: this is an experimental facility, with fewer checks than usual. Use ``-dcore-lint`` to typecheck the desugared program. If Core Lint is happy you should be all right. +Things unaffected by :ghc-flag:`-XRebindableSyntax` +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +:ghc-flag:`-XRebindableSyntax` does not apply to any code generated from a +``deriving`` clause or declaration. To see why, consider the following code: :: + + {-# LANGUAGE RebindableSyntax, OverloadedStrings #-} + newtype Text = Text String + + fromString :: String -> Text + fromString = Text + + data Foo = Foo deriving Show + +This will generate code to the effect of: :: + + instance Show Foo where + showsPrec _ Foo = showString "Foo" + +But because :ghc-flag:`-XRebindableSyntax` and :ghc-flag:`-XOverloadedStrings` +are enabled, the ``"Foo"`` string literal would now be of type ``Text``, not +``String``, which ``showString`` doesn't accept! This causes the generated +``Show`` instance to fail to typecheck. It's hard to imagine any scenario where +it would be desirable have :ghc-flag:`-XRebindableSyntax` behavior within +derived code, so GHC simply ignores :ghc-flag:`-XRebindableSyntax` entirely +when checking derived code. + .. _postfix-operators: Postfix operators diff --git a/testsuite/tests/deriving/should_compile/T12688.hs b/testsuite/tests/deriving/should_compile/T12688.hs new file mode 100644 index 0000000..0735a81 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T12688.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE RebindableSyntax, OverloadedStrings #-} +module T12688 where + +import Prelude (String,Show(..)) + +newtype Text = Text String + +fromString :: String -> Text +fromString = Text + +x :: Text +x = "x" + +newtype Foo = Foo () + deriving (Show) diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index d79aa6d..1261aaa 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -74,3 +74,4 @@ test('T11837', normal, compile, ['']) test('T12399', normal, compile, ['']) test('T12583', normal, compile, ['']) test('T12616', normal, compile, ['']) +test('T12688', normal, compile, ['']) From git at git.haskell.org Wed Oct 19 02:46:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Oct 2016 02:46:34 +0000 (UTC) Subject: [commit: ghc] master: Add some missing RTS symbols (a3bc93e) Message-ID: <20161019024634.940D93A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a3bc93e58f917c0e03aed1a08fe56bddb16ca773/ghc >--------------------------------------------------------------- commit a3bc93e58f917c0e03aed1a08fe56bddb16ca773 Author: Simon Marlow Date: Tue Oct 18 22:13:55 2016 -0400 Add some missing RTS symbols Test Plan: validate Reviewers: austin, bgamari, erikd Reviewed By: bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2589 >--------------------------------------------------------------- a3bc93e58f917c0e03aed1a08fe56bddb16ca773 rts/RtsSymbols.c | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index 1390036..36b2b43 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -572,10 +572,15 @@ SymI_HasProto(genericRaise) \ SymI_HasProto(getProgArgv) \ SymI_HasProto(getFullProgArgv) \ + SymI_HasProto(setFullProgArgv) \ + SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getStablePtr) \ SymI_HasProto(foreignExportStablePtr) \ SymI_HasProto(hs_init) \ + SymI_HasProto(hs_init_with_rtsopts) \ + SymI_HasProto(hs_init_ghc) \ SymI_HasProto(hs_exit) \ + SymI_HasProto(hs_exit_nowait) \ SymI_HasProto(hs_set_argv) \ SymI_HasProto(hs_add_root) \ SymI_HasProto(hs_perform_gc) \ @@ -586,6 +591,9 @@ SymI_HasProto(hs_free_fun_ptr) \ SymI_HasProto(hs_hpc_rootModule) \ SymI_HasProto(hs_hpc_module) \ + SymI_HasProto(hs_thread_done) \ + SymI_HasProto(hs_try_putmvar) \ + SymI_HasProto(defaultRtsConfig) \ SymI_HasProto(initLinker) \ SymI_HasProto(initLinker_) \ SymI_HasProto(stg_unpackClosurezh) \ @@ -702,6 +710,7 @@ SymI_HasProto(rtsSupportsBoundThreads) \ SymI_HasProto(rts_isProfiled) \ SymI_HasProto(rts_isDynamic) \ + SymI_HasProto(rts_setInCallCapability) \ SymI_HasProto(rts_getThreadAllocationCounter) \ SymI_HasProto(rts_setThreadAllocationCounter) \ SymI_HasProto(rts_enableThreadAllocationLimit) \ From git at git.haskell.org Wed Oct 19 02:46:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Oct 2016 02:46:38 +0000 (UTC) Subject: [commit: ghc] master: Compute export hash based on ALL transitive orphan modules. (3866481) Message-ID: <20161019024638.C50E83A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3866481f228b28687c4021d9deb16e2138fdc008/ghc >--------------------------------------------------------------- commit 3866481f228b28687c4021d9deb16e2138fdc008 Author: Edward Z. Yang Date: Tue Oct 18 22:17:10 2016 -0400 Compute export hash based on ALL transitive orphan modules. Previously we pruned out orphan modules from external packages but this was wrong. Fixes #12733 (which has more discussion.) Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, bgamari, austin Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2610 GHC Trac Issues: #12733 >--------------------------------------------------------------- 3866481f228b28687c4021d9deb16e2138fdc008 compiler/iface/MkIface.hs | 40 ++++++++++++++++------ testsuite/driver/extra_files.py | 1 + .../cabal/bkpcabal01 => cabal/T12733}/.gitignore | 1 - testsuite/tests/cabal/T12733/Makefile | 31 +++++++++++++++++ .../cabal/bkpcabal01 => cabal/T12733}/Setup.hs | 0 testsuite/tests/cabal/T12733/T12733.stderr | 5 +++ testsuite/tests/cabal/{cabal03 => T12733}/all.T | 4 +-- testsuite/tests/cabal/T12733/p/P.hs.in1 | 3 ++ testsuite/tests/cabal/T12733/p/P.hs.in2 | 5 +++ .../cabal/bkpcabal01 => cabal/T12733/p}/Setup.hs | 0 .../tests/cabal/{cabal08/p2 => T12733/p}/p.cabal | 3 -- .../bkpcabal01/q/Q.hs.in1 => cabal/T12733/q/Q.hs} | 1 - testsuite/tests/cabal/T12733/q/Q2.hs | 4 +++ .../cabal/bkpcabal01 => cabal/T12733/q}/Setup.hs | 0 .../tests/cabal/{cabal06 => T12733}/q/q.cabal | 7 ++-- 15 files changed, 84 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 3866481f228b28687c4021d9deb16e2138fdc008 From git at git.haskell.org Wed Oct 19 02:46:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Oct 2016 02:46:41 +0000 (UTC) Subject: [commit: ghc] master: cmm/Hoopl/Dataflow: remove unused code (02f2f21) Message-ID: <20161019024641.83AD43A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02f2f21ce4a9969406cf1772dc5955a97386777a/ghc >--------------------------------------------------------------- commit 02f2f21ce4a9969406cf1772dc5955a97386777a Author: Michal Terepeta Date: Tue Oct 18 22:17:49 2016 -0400 cmm/Hoopl/Dataflow: remove unused code We had *a lot* of code copied from Hoopl that is for rewriting. But GHC doesn't use it (it only uses some forked Hoopl code for analysis). So we can safely kill all this code and make it much easier to refactor and improve the parts that we do use. Signed-off-by: Michal Terepeta Test Plan: ./validate Reviewers: austin, simonmar, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2612 >--------------------------------------------------------------- 02f2f21ce4a9969406cf1772dc5955a97386777a compiler/cmm/CmmUtils.hs | 40 +--- compiler/cmm/Hoopl.hs | 106 --------- compiler/cmm/Hoopl/Dataflow.hs | 530 +---------------------------------------- 3 files changed, 11 insertions(+), 665 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 02f2f21ce4a9969406cf1772dc5955a97386777a From git at git.haskell.org Wed Oct 19 11:24:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Oct 2016 11:24:10 +0000 (UTC) Subject: [commit: ghc] master: Test for newtype with unboxed argument (1f09c16) Message-ID: <20161019112410.61B6B3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f09c16c38a2112322d8eab95cd1269daaf5a818/ghc >--------------------------------------------------------------- commit 1f09c16c38a2112322d8eab95cd1269daaf5a818 Author: Simon Peyton Jones Date: Wed Oct 19 12:22:11 2016 +0100 Test for newtype with unboxed argument Newtypes cannot (currently) have an unboxed argument type. But Trac #12729 showed that this was only being checked for newtypes in H98 syntax; in GADT snytax they were let through. This patch moves the test to checkValidDataCon, where it properly belongs. >--------------------------------------------------------------- 1f09c16c38a2112322d8eab95cd1269daaf5a818 compiler/typecheck/TcHsType.hs | 13 +----- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcTyClsDecls.hs | 50 ++++++++++++---------- testsuite/tests/typecheck/should_fail/T12729.hs | 11 +++++ .../tests/typecheck/should_fail/T12729.stderr | 10 +++++ testsuite/tests/typecheck/should_fail/all.T | 2 +- .../tests/typecheck/should_fail/tcfail079.stderr | 9 ++-- 7 files changed, 56 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 1f09c16c38a2112322d8eab95cd1269daaf5a818 From git at git.haskell.org Wed Oct 19 13:33:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Oct 2016 13:33:07 +0000 (UTC) Subject: [commit: ghc] master: StgCmmPrim: Add missing write barrier. (2cb8cc2) Message-ID: <20161019133307.DA8643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2cb8cc26df6af431d30b6964710ea2d859ca2bcd/ghc >--------------------------------------------------------------- commit 2cb8cc26df6af431d30b6964710ea2d859ca2bcd Author: Peter Trommler Date: Wed Oct 19 09:02:54 2016 -0400 StgCmmPrim: Add missing write barrier. On architectures with weak memory consistency a write barrier is needed before the write to the pointer array. Fixes #12469 Test Plan: rebuilt Stackage nightly twice on powerpc64le Reviewers: hvr, rrnewton, erikd, austin, simonmar, bgamari Reviewed By: erikd, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2525 GHC Trac Issues: #12469 >--------------------------------------------------------------- 2cb8cc26df6af431d30b6964710ea2d859ca2bcd compiler/codeGen/StgCmmPrim.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 2169465..34c2d06 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -1350,6 +1350,10 @@ doWritePtrArrayOp :: CmmExpr doWritePtrArrayOp addr idx val = do dflags <- getDynFlags let ty = cmmExprType dflags val + -- This write barrier is to ensure that the heap writes to the object + -- referred to by val have happened before we write val into the array. + -- See #12469 for details. + emitPrimCall [] MO_WriteBarrier [] mkBasicIndexedWrite (arrPtrsHdrSize dflags) Nothing addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel))) -- the write barrier. We must write a byte into the mark table: From git at git.haskell.org Thu Oct 20 09:43:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:43:45 +0000 (UTC) Subject: [commit: ghc] master: configure.ac: Report Unregisterised setting (a6094fa) Message-ID: <20161020094345.6BBC33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6094fa08360cfc7e32023b033317be45c1b91b2/ghc >--------------------------------------------------------------- commit a6094fa08360cfc7e32023b033317be45c1b91b2 Author: Erik de Castro Lopo Date: Thu Oct 20 05:21:25 2016 +1100 configure.ac: Report Unregisterised setting Showing the value of this configure option in the configure output can help debugging issues in build bots etc. Test Plan: N/A Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2616 >--------------------------------------------------------------- a6094fa08360cfc7e32023b033317be45c1b91b2 configure.ac | 1 + 1 file changed, 1 insertion(+) diff --git a/configure.ac b/configure.ac index 0fceb16..629624a 100644 --- a/configure.ac +++ b/configure.ac @@ -1171,6 +1171,7 @@ echo ["\ Using $CompilerName : $CC which is version : $GccVersion Building a cross compiler : $CrossCompiling + Unregisterised : $Unregisterised hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ld : $LdCmd From git at git.haskell.org Thu Oct 20 09:44:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:33 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: wip (384439f) Message-ID: <20161020094433.A1A8E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/384439fab5ced4c884cb77019d75e1c36de2008a/ghc >--------------------------------------------------------------- commit 384439fab5ced4c884cb77019d75e1c36de2008a Author: Erik de Castro Lopo Date: Fri Jul 1 20:21:26 2016 +1000 wip >--------------------------------------------------------------- 384439fab5ced4c884cb77019d75e1c36de2008a rts/posix/OSMem.c | 9 ++++----- rts/posix/OSThreads.c | 2 +- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index f2177b4..7865623 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -10,7 +10,6 @@ // #include "PosixSource.h" #include "Rts.h" - #include "RtsUtils.h" #include "sm/OSMem.h" #include "sm/HeapAlloc.h" @@ -306,7 +305,7 @@ void osBindMBlocksToNode( StgWord size STG_UNUSED, uint32_t node STG_UNUSED) { -#if HAVE_LIBNUMA +#if USE_LIBNUMA int ret; StgWord mask = 0; mask |= 1 << node; @@ -564,7 +563,7 @@ void osReleaseHeapMemory(void) rtsBool osNumaAvailable(void) { -#if HAVE_LIBNUMA +#if USE_LIBNUMA return (numa_available() != -1); #else return rtsFalse; @@ -573,7 +572,7 @@ rtsBool osNumaAvailable(void) uint32_t osNumaNodes(void) { -#if HAVE_LIBNUMA +#if USE_LIBNUMA return numa_num_configured_nodes(); #else return 1; @@ -582,7 +581,7 @@ uint32_t osNumaNodes(void) StgWord osNumaMask(void) { -#if HAVE_LIBNUMA +#if USE_LIBNUMA struct bitmask *mask; mask = numa_get_mems_allowed(); if (mask->size > sizeof(StgWord)*8) { diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c index f0444b7..04658e1 100644 --- a/rts/posix/OSThreads.c +++ b/rts/posix/OSThreads.c @@ -325,7 +325,7 @@ setThreadAffinity (uint32_t n STG_UNUSED, } #endif -#if HAVE_LIBNUMA +#if USE_LIBNUMA void setThreadNode (uint32_t node) { if (numa_run_on_node(node) == -1) { From git at git.haskell.org Thu Oct 20 09:44:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:36 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: fixup (d96f656) Message-ID: <20161020094436.51F543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/d96f6566c3d694d0f44b559afa817d6e38cb7567/ghc >--------------------------------------------------------------- commit d96f6566c3d694d0f44b559afa817d6e38cb7567 Author: Erik de Castro Lopo Date: Mon Jun 13 09:37:26 2016 +1000 fixup >--------------------------------------------------------------- d96f6566c3d694d0f44b559afa817d6e38cb7567 includes/rts/OSThreads.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/includes/rts/OSThreads.h b/includes/rts/OSThreads.h index 1b5a6ce..25e833b 100644 --- a/includes/rts/OSThreads.h +++ b/includes/rts/OSThreads.h @@ -15,6 +15,8 @@ #ifndef RTS_OSTHREADS_H #define RTS_OSTHREADS_H +#include + #if defined(THREADED_RTS) /* to near the end */ #if defined(HAVE_PTHREAD_H) && !mingw32_HOST_OS From git at git.haskell.org Thu Oct 20 09:44:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:39 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: wip (51308bc) Message-ID: <20161020094439.00DF73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/51308bc6c5248dc40c15dfe9d04b839001caa801/ghc >--------------------------------------------------------------- commit 51308bc6c5248dc40c15dfe9d04b839001caa801 Author: Erik de Castro Lopo Date: Fri Jul 1 19:36:06 2016 +1000 wip >--------------------------------------------------------------- 51308bc6c5248dc40c15dfe9d04b839001caa801 iserv/cbits/iservmain.c | 1 - rts/Linker.c | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/iserv/cbits/iservmain.c b/iserv/cbits/iservmain.c index eeee2db..b76b021 100644 --- a/iserv/cbits/iservmain.c +++ b/iserv/cbits/iservmain.c @@ -1,4 +1,3 @@ -#include "PosixSource.h" #include "Rts.h" #include "HsFFI.h" diff --git a/rts/Linker.c b/rts/Linker.c index 95bcbc6..12ca4b6 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -269,7 +269,7 @@ static pathchar* pathdup(pathchar *path) static pathchar* pathdir(pathchar *path) { pathchar *ret; -#if defined(mingw32_HOST_OS) +#if mingw32_HOST_OS pathchar *drive, *dirName; size_t memberLen = pathlen(path) + 1; dirName = stgMallocBytes(pathsize * memberLen, "pathdir(path)"); From git at git.haskell.org Thu Oct 20 09:44:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:41 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: wip (a5b2e8f) Message-ID: <20161020094441.A9DF23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/a5b2e8f559c82887e5beb4010d2d8ab2fcbc9e05/ghc >--------------------------------------------------------------- commit a5b2e8f559c82887e5beb4010d2d8ab2fcbc9e05 Author: Erik de Castro Lopo Date: Fri Jul 1 21:19:22 2016 +1000 wip >--------------------------------------------------------------- a5b2e8f559c82887e5beb4010d2d8ab2fcbc9e05 rts/posix/OSMem.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index ba55a02..9c2ae28 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -9,6 +9,8 @@ // This is non-posix compliant. // #include "PosixSource.h" +#include "Rts.h" + #include "RtsUtils.h" #include "sm/OSMem.h" #include "sm/HeapAlloc.h" From git at git.haskell.org Thu Oct 20 09:44:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:44 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: rts: Add `-Wundef` to CFLAGS and fix warnings (f734afd) Message-ID: <20161020094444.D5B8F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/f734afdc057385e45928bea84bef28a053b979eb/ghc >--------------------------------------------------------------- commit f734afdc057385e45928bea84bef28a053b979eb Author: Erik de Castro Lopo Date: Wed May 18 20:04:26 2016 +1000 rts: Add `-Wundef` to CFLAGS and fix warnings >--------------------------------------------------------------- f734afdc057385e45928bea84bef28a053b979eb compiler/utils/Panic.hs | 4 +- ghc/GHCi/UI.hs | 2 +- ghc/hschooks.c | 1 - includes/MachineDefines.h | 134 +++++++++++++++++++++++ includes/Rts.h | 8 +- includes/RtsAPI.h | 2 +- includes/Stg.h | 6 +- includes/rts/IOManager.h | 2 +- includes/rts/Linker.h | 2 +- includes/rts/Messages.h | 2 +- includes/rts/OSThreads.h | 6 +- includes/rts/Threads.h | 2 +- includes/rts/storage/GC.h | 2 +- includes/rts/storage/InfoTables.h | 2 +- includes/rts/storage/TSO.h | 4 +- includes/stg/DLL.h | 6 +- includes/stg/MachRegs.h | 26 ++--- includes/stg/RtsMachRegs.h | 2 + includes/stg/SMP.h | 15 +-- includes/stg/Types.h | 2 +- libraries/base/GHC/Conc/IO.hs | 22 ++-- libraries/base/GHC/Conc/Sync.hs | 2 +- libraries/base/GHC/Conc/Windows.hs | 2 +- libraries/base/cbits/DarwinUtils.c | 2 +- libraries/base/cbits/PrelIOUtils.c | 2 +- libraries/base/include/HsBase.h | 2 +- libraries/ghc-prim/cbits/ctz.c | 2 +- rts/Adjustor.c | 79 +++++++------- rts/BeginPrivate.h | 2 +- rts/Capability.c | 6 +- rts/Capability.h | 2 +- rts/EndPrivate.h | 2 +- rts/Excn.h | 2 +- rts/HeapStackCheck.cmm | 2 +- rts/Interpreter.c | 7 +- rts/Libdw.c | 4 +- rts/Linker.c | 209 ++++++++++++++++++------------------ rts/LinkerInternals.h | 7 +- rts/PosixSource.h | 4 +- rts/PrimOps.cmm | 12 +-- rts/Profiling.c | 2 +- rts/RaiseAsync.c | 8 +- rts/RaiseAsync.h | 2 +- rts/RtsFlags.c | 14 +-- rts/RtsMessages.c | 14 +-- rts/RtsSignals.h | 4 +- rts/RtsStartup.c | 14 +-- rts/RtsSymbols.c | 26 ++--- rts/RtsUtils.c | 10 +- rts/Schedule.c | 8 +- rts/Stats.h | 2 +- rts/StgCRun.c | 54 +++++----- rts/StgRun.h | 2 +- rts/Task.h | 8 +- rts/Threads.c | 4 +- rts/Trace.c | 2 +- rts/eventlog/EventLog.c | 2 +- rts/ghc.mk | 3 + rts/posix/Clock.h | 2 +- rts/posix/GetEnv.c | 2 +- rts/posix/GetTime.c | 6 +- rts/posix/Itimer.c | 6 +- rts/posix/OSMem.c | 2 +- rts/posix/OSThreads.c | 24 ++--- rts/posix/Signals.c | 6 +- rts/sm/Evac.h | 2 +- rts/sm/GCTDecl.h | 7 +- rts/sm/GCUtils.c | 2 +- rts/sm/GCUtils.h | 2 +- rts/sm/Storage.c | 15 +-- testsuite/tests/rts/T5435_asm.c | 4 +- testsuite/tests/rts/linker_error.c | 6 +- testsuite/tests/rts/linker_unload.c | 2 +- testsuite/tests/rts/spalign.c | 6 +- utils/ghc-pkg/Main.hs | 14 +-- utils/runghc/Main.hs | 10 +- 76 files changed, 526 insertions(+), 373 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 f734afdc057385e45928bea84bef28a053b979eb From git at git.haskell.org Thu Oct 20 09:44:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:47 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: wip (a154d14) Message-ID: <20161020094447.8B2C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/a154d14dff04bf2745223a60b80d2eacdc63c707/ghc >--------------------------------------------------------------- commit a154d14dff04bf2745223a60b80d2eacdc63c707 Author: Erik de Castro Lopo Date: Fri Jul 1 20:26:58 2016 +1000 wip >--------------------------------------------------------------- a154d14dff04bf2745223a60b80d2eacdc63c707 rts/posix/OSMem.c | 1 - 1 file changed, 1 deletion(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 7865623..ba55a02 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -9,7 +9,6 @@ // This is non-posix compliant. // #include "PosixSource.h" -#include "Rts.h" #include "RtsUtils.h" #include "sm/OSMem.h" #include "sm/HeapAlloc.h" From git at git.haskell.org Thu Oct 20 09:44:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:50 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: wip (1ee8879) Message-ID: <20161020094450.6B2CF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/1ee88795cde68d8d4effe129f54f616cd47fb30e/ghc >--------------------------------------------------------------- commit 1ee88795cde68d8d4effe129f54f616cd47fb30e Author: Erik de Castro Lopo Date: Fri Jul 1 19:05:46 2016 +1000 wip >--------------------------------------------------------------- 1ee88795cde68d8d4effe129f54f616cd47fb30e ghc/hschooks.c | 1 - iserv/cbits/iservmain.c | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/ghc/hschooks.c b/ghc/hschooks.c index 46a0944..b4ce060 100644 --- a/ghc/hschooks.c +++ b/ghc/hschooks.c @@ -4,7 +4,6 @@ for various bits of the RTS. They are linked in instead of the defaults. */ -#include "../rts/PosixSource.h" #include "Rts.h" #include "HsFFI.h" diff --git a/iserv/cbits/iservmain.c b/iserv/cbits/iservmain.c index daefd35..eeee2db 100644 --- a/iserv/cbits/iservmain.c +++ b/iserv/cbits/iservmain.c @@ -1,4 +1,4 @@ -#include "../rts/PosixSource.h" +#include "PosixSource.h" #include "Rts.h" #include "HsFFI.h" From git at git.haskell.org Thu Oct 20 09:44:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:53 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: fixup (2552617) Message-ID: <20161020094453.3B4BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/25526177e63ebc0e6fa90c2b1820b454b593f2e1/ghc >--------------------------------------------------------------- commit 25526177e63ebc0e6fa90c2b1820b454b593f2e1 Author: Erik de Castro Lopo Date: Mon Jun 13 17:35:21 2016 +1000 fixup >--------------------------------------------------------------- 25526177e63ebc0e6fa90c2b1820b454b593f2e1 ghc/hschooks.c | 1 + 1 file changed, 1 insertion(+) diff --git a/ghc/hschooks.c b/ghc/hschooks.c index b4ce060..46a0944 100644 --- a/ghc/hschooks.c +++ b/ghc/hschooks.c @@ -4,6 +4,7 @@ for various bits of the RTS. They are linked in instead of the defaults. */ +#include "../rts/PosixSource.h" #include "Rts.h" #include "HsFFI.h" From git at git.haskell.org Thu Oct 20 09:44:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:44:55 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: wip (ba36d63) Message-ID: <20161020094455.DEBAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/ba36d63018493e374a217d0ed123eb81e37c2a74/ghc >--------------------------------------------------------------- commit ba36d63018493e374a217d0ed123eb81e37c2a74 Author: Erik de Castro Lopo Date: Thu Oct 20 20:41:48 2016 +1100 wip >--------------------------------------------------------------- ba36d63018493e374a217d0ed123eb81e37c2a74 rts/Linker.c | 2 +- rts/sm/CNF.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index 12ca4b6..066804b 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1370,7 +1370,7 @@ static SymbolAddr* lookupSymbol_ (SymbolName* lbl) return NULL; # endif } else { -#if defined(mingw32_HOST_OS) +#if mingw32_HOST_OS // If Windows, perform initialization of uninitialized // Symbols from the C runtime which was loaded above. // We do this on lookup to prevent the hit when diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c index f8e706a..fa743dc 100644 --- a/rts/sm/CNF.c +++ b/rts/sm/CNF.c @@ -1334,7 +1334,7 @@ compactFixupPointers(StgCompactNFData *str, dbl_link_onto(bd, &g0->compact_objects); RELEASE_SM_LOCK; -#if DEBUG +#if defined(DEBUG) if (root) verify_consistency_loop(str); #endif From git at git.haskell.org Thu Oct 20 09:45:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:45:01 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts's head updated: wip (ba36d63) Message-ID: <20161020094501.05E223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/erikd/rts' now includes: 6ace660 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined 9130867 Skip retc001 on OSX b40e1b4 Fix incorrect calculated relocations on Windows x86_64 29e1464 Disable T12031 on linux 2bb6ba6 rts: Fix NUMA when cross compiling d25cb61 Kill off redundant SigTv check in occurCheckExpand 15b9bf4 Improve typechecking of let-bindings c28dde3 Tidy up zonkQuantifiedTyVar 7afb7ad Get in-scope set right in top_instantiate 35c9de7 Move the constraint-kind validity check 1f66128 Beef up mkNakedCastTy 15fc528 Fix the in-scope set for extendTvSubstWithClone 599d912 Beef up isPredTy 8104f7c Remove some traceTc calls e064f50 Add to .gitignore 921ebc9 Test Trac #12055 1dcb32d A second test for Trac #12055 5cee88d Add thin library support to Windows too 7de776c Kill unused foldModuleEnv 586d558 Use UniqFM for SigOf 0497ee5 Make the Ord Module independent of Unique order d55a9b4 Update Haddock to follow change in LHsSigWcType 4f35646 Adjust error message slightly 8dfd4ae Build system: mention ghc version in bindist's `configure --help` docdir a2deee0 Testsuite: enable ghci.prog010 (#2542) 23b73c9 Don't GC sparks for CAFs 9d22fbe Rename cmpType to nonDetCmpType 753c5b2 Simplify readProcessEnvWithExitCode + set LANGUAGE=C 70a4589 Revert "Make the Ord Module independent of Unique order" e33ca0e Fix testsuite wibble 77bb092 Re-add FunTy (big patch) e368f32 Major patch to introduce TyConBinder c56f8bd CoreMonad: Update error msg function docs 930a525 Abort the build when a Core plugin pass is specified in stage1 compiler a7f65b8 Remove dead code: countOnce, countMany 498ed26 NUMA cleanups 8d33af9 CoreLint: Slightly improve case type annotation error msgs 3e8c495 CmmNode: Make CmmTickScope's Unique strict 2396d9b llvmGen: Make metadata ids a newtype 85e09b1 llvmGen: Consolidate MetaExpr pretty-printing 9bb0578 Revert accidental submodule updates e02beb1 Driver: `ghc ../Test` (without file extension) should work f72f23f Testsuite: run tests in .run instead of /tmp 6f6f515 Testsuite: write "\n" instead of "\r\n" when using mingw Python d94c405 Testsuite: validate the tests/stage1 directory with the stage1 compiler a4c8532 Validate: use `rm -f` instead of `rm` 6354991 VarEnv: Comment only 270d545 Add Bifoldable and Bitraversable to base 9649fc0 Refactor derived Generic instances to reduce allocations 4d71cc8 Avoid find_tycon panic if datacon is not in scope f12fb8a Fix trac #10647: Notice about lack of SIMD support 2897be7 PPC NCG: Fix float parameter passing on 64-bit. f4b0488 PPC NCG: Fix and refactor TOC handling. 0be38a2 llvmGen: Add strictness to metadata fields 0e92af9 Remove use of KProxy in GHC.Generics 0ba34b6 ApplicativeDo: allow "return $ e" e7e42c8 Fix double-free in T5644 (#12208) cdc14b4 Testsuite: remove Windows CR again.. [skip ci] 9cdde38 Testsuite: remove Windows CR [skip ci] cf6e656 Testsuite: remove Windows CR [skip ci] 3dc1202 Testsuite: tabs -> spaces [skip ci] 7e7094f Testsuite: tabs -> spaces [skip ci] 46ff80f Testsuite: tabs -> spaces [skip ci] 915e07c Testsuite: tabs -> spaces [skip ci] 5b03dc6 Testsuite: tabs -> spaces [skip ci] a7160fa Testsuite: tabs -> spaces [skip ci] 4a4bdda Testsuite: recover from utf8 decoding errors 6d0a4fc Testsuite: fix WAY=ghci when LOCAL=0 1ddc10b Testsuite: *do* replace backslashes in config.libdir 1d938aa Testsuite: mark tests expect broken 3b49f8f Testsuite: remove `-fforce-recomp` from default flags (#11980) 82f7f18 Testsuite: delete TEST_HC_OPTS_NO_RECOMP 135fc86 Testsuite: remove `-Wno-warn-tabs` from default flags ebaf26b Testsuite: delete dead code + cleanup e170d19 Testsuite: assume timeout_prog always exists ee3bde7 Expand and clarify the docs for ApplicativeDo (#11835) 7301404 Typos in comments d09e982 Don't quantify over Refl in a RULE 97a50f8 Delete commented-out code 1230629 Make checkFamInstConsistency less expensive a47b62c Second attempt to fix sizeExpr c0583a9 Fix build breakage due to rebase 9d62d09 Hopefully fix all the rebase-induced breakage 4e7d835 Typos in comments [skip ci] 6199588 More typos in comments [skip ci] 93f40cb Don't error on GCC inlining warning in rts 348f2db Make the Ord Module independent of Unique order (2nd try) 15641b0 Accept new (lower) allocations for T7257 7e7aeab Comments only cc92a44 Improve error message in deriving( Functor ) a1b3359 Remove unused arg to tcSuperClasses ce97b72 Expand given superclasses more eagerly 210a2e1 Test Trac #12163 3e0af46 Give lookupGRE_Name a better API e556f76 Remove unused import 643706e Narrow the warning for simplifiable constraints 2f8cd14 Narrow the use of record wildcards slightly 7fc20b0 Have Core linter accept programs using StaticPointers and -fhpc. 35d1564 Provide Uniquable version of SCC bb74021 Remove Ord TyCon 7f5d560 Very confusing typo in error message. 9a34bf1 Fix #11974 by adding a more smarts to TcDefaults. 8035d1a Fix #10963 and #11975 by adding new cmds to GHCi. 4ae950f Release notes for #11975 and #10963 df9611e Testsuite: do not copy .hi/.o files to testdir (#12112) d2958bd Improve typechecking of instance defaults c871ce4 Comments around invisibility 393928d Fix renamer panic f86a337 Remove bogus comment on ForAllTy bb84ee4 Improve pretty-printing of Avail 12c4449 Implement ReifyConStrictness for -fexternal-interpreter (#12219) d2006d0 Run all TH tests with -fexternal-interpreter (#12219) bdb0d24 Remote GHCi: separate out message types eb73219 Remote GHCi: comments only 0bab375 Fix T8761 (#12219, #12077) dadd8b8 Test Trac #12229 9bc2233 Fix typo in Data.Bitraverse Haddocks 31b5806 Clean up outdated comments in template-haskell changelog a33b498 Add template-haskell changelog note for #8761 5fdb854 s/Invisible/Inferred/g s/Visible/Required/g 4cc5a39 Refactor tcInferArgs and add comments. 8c1cedd Allow building static libs. da60e3e rts/Linker.c: Improve ugly C pre-processor hack 7843c71 Make T8761 deterministic, I hope ff1cc26 Don't run the run_command tests with ext-interp 82282e8 Remove some `undefined`s 60c24b2 Typos in user manual and code: recurisve -> recursive afa6e83 rts/Linker.c: Rename ONLY_USED_x86_64_HOST_ARCH macro bbf0aa2 Testsuite: never pick up .T files in .run directories 7593c2f Testsuite: report duplicate testnames when `make TEST=` 1f45bce Testsuite: remove one level of indentation [skip ci] 206b4a1 Testsuite: simplify extra_file handling bafd615 Testsuite: do not print timeout message 58f0086 Testsuite: open/close stdin/stdout/stderr explicitly d8e9b87 Testsuite: cleanup printing of summary 782cacf Testsuite: framework failure improvements (#11165) 6b3b631 Testsuite: run all indexed-types ways on ./validate --slow 0eb0378 Testsuite: do not add -debug explicitly in .T file 3fb9837 Testsuite: mark tests expect_broken af21e38 Don't omit any evidence bindings 23b80ac Deal correctly with unused imports for 'coerce' dc62a22 Wibble error message for #11471 dd92c67 Stop the simplifier from removing StaticPtr binds. 2e9079f Test Trac #12185 848e3ce Testsuite: fixes for python2.6 support 9a645a1 Refactor match to not use Unique order 8f7194f Double the file descriptor limit for openFile008 1084d37 Testsuite: use ignore_stderr/stdout instead of ignore_output 24194a6 Fix pretty-printer for IfaceCo e8d6271 Testsuite: do not depend on sys.stdout.encoding fb6e2c7 Delete Ord Unique 9854f14 Add a new determinism test b6b20a5 Reorganize some determinism tests 480e066 Remove ufmToList b8b3e30 Axe RecFlag on TyCons. 0701db1 Updates to handle new Cabal 430f5c8 Trac #11554 fix loopy GADTs 6a5d13c nativeGen: Allow -fregs-graph to be used f68d40c ghc-pkg: Drop trailing slashes in computing db paths f1e16e9 CmmExpr: remove unused `vgcFlag` function b65363d Fix check_uniques in non-unicode locale 0afc41b Testsuite: be less strict about topHandler03's stderr c27ce26 users-guide: Fix markup in release notes 81b437b Add NamedThing (GenLocated l e) instance b412d82 Allow one type signature for multiple pattern synonyms 6ba4197 rules/sphinx.mk: stop xelatex on error ee8d1fa Remove unused oc->isImportLib (#12230) 6377757 Linker: some extra debugging / logging cbfeff4 Remove uniqSetToList 0d522b8 Document some benign nondeterminism 0ab63cf Kill varEnvElts in seqDmdEnv 01f449f Fix 32-bit build failures 9031382 MkCore: Fix some note names a6819a0 base: Add release date to changelog bf7cbe7 users-guide: Note multiple pattern signature change in relnotes afec447 testsuite: Add testcase for #12355 2a3af15 Treat duplicate pattern synonym signatures as an error 3b2deca users-guide: Remove static field type from rts-flag 331febf CallArity: Use not . null instead of length > 0 0bd7c4b Enum: Ensure that operations on Word fuse 18e71e4 Revert "Fix 32-bit build failures" 890ec98 Revert "Linker: some extra debugging / logging" e10497b Kill some varEnvElts 85aa6ef Check generic-default method for ambiguity 1267048 Extra ASSERTs for nameModule 55e43a6 Use DVarEnv for vectInfoVar 5f79394 Delete out-of-date comment 895eefa Make unique auxiliary function names in deriving cbe30fd Tidy up tidying f2d36ea White space only 6cedef0 Test Trac #12133 27fc75b Document codegen nondeterminism 18b782e Kill varEnvElts in zonkEnvIds 1b058d4 Remove varEnvElts b7b130c Fix GetTime.c on Darwin with clock_gettime f560a03 Adds x86_64-apple-darwin14 target. 567dbd9 Have addModFinalizer expose the local type environment. 56f47d4 Mention addModFinalizer changes in release notes. 672314c Switch to LLVM version 3.8 b9cea81 Show testcase where demand analysis abortion code fails 979baec --without-libcharset disables the use of libcharset bedd620 Style changes for UniqFM 6ed7c47 Document some codegen nondeterminism 9858552 Use deterministic maps for FamInstEnv 34085b5 Correct the message displayed for syntax error (#12146) 64bce8c Add Note [FamInstEnv determinism] 6e280c2 Utils: Fix `lengthIs` and `lengthExceeds` for negative args 0481324 Use UniqDFM for InstEnv b8cd94d GHC.Stack.CCS: Fix typo in Haddocks 91fd87e FastString: Reduce allocations of concatFS 15751f2 FastString: Add IsString instance c4a9dca FastString: Supply mconcat implementation fc53d36 OccName: Implement startsWithUnderscore in terms of headFS eb3d659 OccName: Avoid re-encoding derived OccNames 4f21a51 Kill eltsUFM in classifyTyCons 6c7c193 DsExpr: Remove usage of concatFS in fingerprintName 0177c85 Testsuite: expose TEST_CC (path to gcc) f53d761 TysWiredIn: Use UniqFM lookup for built-in OccNames 9a3df1f check-api-annotations utility loads by filename 17d0b84 Add -package-env to the flags reference 372dbc4 Pretty: delete really old changelog 45d8f4e Demand analyser: Implement LetUp rule (#12370) 18ac80f tidyType: Rename variables of nested forall at once cd0750e tidyOccNames: Rename variables fairly 37aeff6 Added type family dependency to Data.Type.Bool.Not b35e01c Bring comments in TcGenGenerics up to date a9bc547 Log heap profiler samples to event log ffe4660 IfaceEnv: Only check for built-in OccNames if mod is GHC.Types 24f5f36 Binary: Use ByteString's copy in getBS 0f0cdb6 Bugfix for bug 11632: `readLitChar` should consume null characters 1ba79fa CodeGen: Way to dump cmm only once (#11717) 89a8be7 Pretty: remove a harmful $! (#12227) 5df92f6 hp2ps: fix invalid PostScript for names with parentheses d213ab3 Fix misspellings of the word "instance" in comments 3fa3fe8 Make DeriveFunctor work with unboxed tuples 514c4a4 Fix Template Haskell reification of unboxed tuple types 1fc41d3 Make okConIdOcc recognize unboxed tuples 0df3f4c Fix PDF build for the User's Guide. 98b2c50 Support SCC pragmas in declaration context e46b768 Make Data.{Bifoldable,Bitraversable} -XSafe 908f8e2 TcInteract: Add braces to matchClassInst trace output 8de6e13 Fix bytecode generator panic cac3fb0 Cleanup PosixSource.h a0f83a6 Data.Either: Add fromLeft and fromRight (#12402) 627c767 Update docs for partial type signatures (#12365) ed48098 InstEnv: Ensure that instance visibility check is lazy 9513fe6 Clean up interaction between name cache and built-in syntax a4f2b76 testsuite: Add regression test for #12381 93acc02 Add another testcase for #12082 cf989ff Compact Regions 83e4f49 Revert "Clean up interaction between name cache and built-in syntax" 714bebf Implement unboxed sum primitive type a09c0e3 Comments only 9c54185 Comments + tiny refactor of isNullarySrcDataCon 8d4760f Comments re ApThunks + small refactor in mkRhsClosure 6a4dc89 Bump Haddock submodule 8265c78 Fix and document Unique generation for sum TyCon and DataCons e710f8f Correct a few mistyped words in prose/comments bbf36f8 More typos in comments fb34b27 Revert "Cleanup PosixSource.h" 86b1522 Unboxed sums: More unit tests bfef2eb StgCmmBind: Some minor simplifications c4f3d91 Add deepseq dependency and a few NFData instances 648fd73 Squash space leaks in the result of byteCodeGen 7f0f1d7 -fprof-auto-top 1fe5c89 UNPACK the size field of SizedSeq d068220 Fix the non-Linux build 4036c1f Testsuite: fix T10482a 1967d74 Some typos in comments a9251c6 MonadUtils: Typos in comments 1783011 Fix productivity calculation (#12424) 9d62f0d Accept better stats for T9675 8f63ba3 Compute boot-defined TyCon names from ModIface. b0a5144 Add mblocks_allocated to GC stats API e98edbd Move stat_startGCSync d3feb16 Make Unique a newtype c06e3f4 Add atomic operations to package.conf.in 89ae1e8 Relevant Bindings no longer reports shadowed bindings (fixes #12176) 750553a Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) 2078909 Typo in comment 36565a9 ForeignCall.hs: Remove DrIFT directives 55f5aed Track the lengths of the thread queues 988ad8b Fix to thread migration d1fe08e Only trace cap/capset events if we're tracing anything else 4dcbbd1 Remove the DEBUG_ variables, use RtsFlags directly 9df9490 StgSyn: Remove unused StgLiveVars types 2f79e79 Add comment about lexing of INLINE and INLINABLE pragma 0c37aef Update old comment InlinePragma b1e6415 More comments about InlinePragmas 7a06b22 Typo in comment [skip ci] 7a8ef01 Remove `setUnfoldingInfoLazily` a13fda7 Clarify comment on makeCorePair d85b26d CmmLive: Remove some redundant exports 8ecac25 CmmLayoutStack: Minor simplification fc66415 Replace an unsafeCoerce with coerce db5a226 Fix omission in haddock instance head 1101045 Trim all spaces after 'version:' fe4008f Remove identity update of field componentsConfigs f09d654 check that the number of parallel build is greater than 0 e3e2e49 codeGen: Remove binutils<2.17 hack, fixes T11758 ca7e1ad Expanded abbreviations in Haddock documentation ce13a9a Fix an assertion that could randomly fail 89fa4e9 Another try to get thread migration right 8fe1672 Bump `hoopl` submodule, mostly cosmetics 253fc38 Temporarily mark T1969 perf test as broken (#12437) 7354f93 StgCmm: Remove unused Bool field of Return sequel 02614fd Replace some `length . filter` with `count` 9aa5d87 Util.count: Implement as a left-fold instead of a right-fold affcec7 rts/Printer.h: fix constness of argument declaration 03af399 AsmCodeGen: Give linear-scan and coloring reg. allocators different cc names 3bfe6a5 RegAlloc: Remove duplicate seqList (use seqList from Util) bd51064 RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps 7a2e933 Use Data.Functor.Const to implement Data.Data internals 6fe2355 configure.ac: Remove checks for bug 9439 773e3aa T1969: Enable it again but bump the max residency temporarily 4d9c22d Fix typo in Data.Bitraversable Haddocks fe19be2 Cabal submodule update. dd23a4c Actually update haddock.Cabal stats. e79bb2c Fix a bug in unboxed sum layout generation 9684dbb Remove StgRubbishArg and CmmArg ac0e112 Improve missing-sig warning bd0c310 Fix GHCi perf-llvm build on x86_64 37a7bcb Update `nofib` submodule to newest commit 7ad3b49 Misspellings in comments [skip ci] 18f0687 Fix configure detection. ffd4029 fix compilation failure on OpenBSD with system supplied GNU C 4.2.1 fc1432a Update hoopl submodule (extra .gitignore entry) 3551e62 refactor test for __builtin_unreachable into Rts.h macro RTS_UNREACHABLE da99a7f Darwin: Detect broken NM program at configure time f9a11a2 When in sanity mode, un-zero malloc'd memory; fix uninitialized memory bugs. d331ace Minor typofix. b222ef7 Typofix in System.Environment docs. 34da8e5 Typo in comment efc0372 Not-in-scope variables are always errors f352e5c Keep the bindings local during defaultCallStacks 58e7316 Refactor nestImplicTcS d610274 Revert "T1969: Enable it again but bump the max residency temporarily" 113d50b Add gcoerceWith to Data.Type.Coercion b2c5e4c Revert "codeGen: Remove binutils<2.17 hack, fixes T11758" 896d216 Annotate initIfaceCheck with usage information. e907e1f Axe initIfaceTc, tie the knot through HPT (or if_rec_types). 704913c Support for noinline magic function. 1f1bd92 Introduce BootUnfolding, set when unfolding is absent due to hs-boot file. 5a8fa2e When a value Id comes from hi-boot, insert noinline. Fixes #10083. 8fd1848 Retypecheck both before and after finishing hs-boot loops in --make. e528061 We also need to retypecheck before when we do parallel make. 0d3bf62 Fix #12472 by looking for noinline/lazy inside oversaturated applications. f9aa996 pass -z wxneeded or -Wl,-zwxneeded for linking on OpenBSD fb0d87f Splice singleton unboxed tuples correctly with Template Haskell 1f75440 Extra comments, as per SPJ in #12035. acdbd16 Move #12403, #12513 users guide notes to 8.2.1 release notes 89facad Add T12520 as a test 1766bb3 RtClosureInspect: Fix off-by-one error in cvReconstructType 613d745 Template Haskell support for unboxed sums 7a86f58 Comments only: Refer to actually existing Notes 8d92b88 DmdAnal: Add a final, safe iteration d6fd2e3 DmdAnal: Testcase about splitFVs and dmdFix abortion ec7fcfd Degrade "case scrutinee not known to diverge for sure" Lint error to warning faaf313 WwLib: Add strictness signature to "let x = absentError …" 1083f45 Fix doc build inconsistency ae66f35 Allow typed holes to be levity-polymorphic a60ea70 Move import to avoid warning 0050aff Fix scoping of type variables in instances ca8c0e2 Typofix in docs. 983f660 Template Haskell support for TypeApplications 822af41 Fix broken Haddock comment f4384ef Remove unused DerivInst constructor for DerivStuff 21c2ebf Missing stderr for T12531. 9d17560 GhcMake: limit Capability count to CPU count in parallel mode a5d26f2 rts: enable parallel GC scan of large (32M+) allocation area 044e81b OccName: Remove unused DrIFT directive ff1931e TcGenDeriv: Typofix d168c41 Fix and complete runghc documentation 6781f37 Clarify pkg selection when multiple versions are available 83b326c Fix binary-trees regression from unnecessary floating in CorePrep. a25bf26 Tag pointers in interpreted constructors ef784c5 Fix handling of package-db entries in .ghc.environment files, etc. 2ee1db6 Fixes #12504: Double-escape paths used to build call to hsc_line 28b71c5 users_guide: More capabilities than processors considered harmful 0e74925 GHC: Expose installSignalHandlers, withCleanupSession 3005fa5 iserv: Show usage message on argument parse failure d790cb9 Bump the default allocation area size to 1MB d40d6df StgCmmPrim: Add missing MO_WriteBarrier d1f2239 Clarify scope of `getQ`/`putQ` state. 22259c1 testsuite: Failing testcase for #12091 2d22026 ErrUtils: Expose accessors of ErrDoc and ErrMsg a07a3ff A failing testcase for T12485 9306db0 TysWiredIn: Use dataConWorkerUnique instead of incrUnique 9cfef16 Add Read1/Read2 methods defined in terms of ReadPrec 1ad770f Add -flocal-ghci-history flag (#9089). 010b07a PPC NCG: Implement minimal stack frame header. ca6d0eb testsuite: Update bytes allocated of parsing001 75321ff Add -fdefer-out-of-scope-variables flag (#12170). e9b0bf4 Remove redundant-constraints from -Wall (#10635) 043604c RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax dad6a88 LoadIFace: Show known names on inconsistent interface file 3fb8f48 Revert "testsuite: Update bytes allocated of parsing001" a69371c users_guide: Document removal of -Wredundant-constraints from -Wall ad1e072 users_guide: Move addModFinalizer mention to 8.0.2 release notes 1f5d4a3 users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes da920f6 users_guide: Move initGhcMonad note to 8.0.2 relnotes a48de37 restore -fmax-worker-args handling (Trac #11565) 1e39c29 Kill vestiages of DEFAULT_TMPDIR 8d35e18 Fix startsVarSym and refactor operator predicates (fixes #4239) b946cf3 Revert "Fix startsVarSym and refactor operator predicates (fixes #4239)" f233f00 Fix startsVarSym and refactor operator predicates (fixes #4239) e5ecb20 Added support for deprecated POSIX functions on Windows. 0cc3931 configure.ac: fix --host= handling 818760d Fix #10923 by fingerprinting optimization level. 36bba47 Typos in notes 33d3527 Protect StablPtr dereference with the StaticPtr table lock. 133a5cc ghc-cabal: accept EXTRA_HC_OPTS make variable f93c363 extend '-fmax-worker-args' limit to specialiser (Trac #11565) ac2ded3 Typo in comment 57aa6bb Fix comment about result f8b139f test #12567: add new testcase with expected plugin behaviour 1805754 accept current (problematic) output cdbb9da cleanup: drop 11 years old performance hack 71dd6e4 Don't ignore addTopDecls in module finalizers. 6ea6242 Turn divInt# and modInt# into bitwise operations when possible 8d00175 Less scary arity mismatch error message when deriving 4ff4929 Make generated Ord instances smaller (per #10858). 34010db Derive the Generic instance in perf/compiler/T5642 05b497e distrib: Fix libdw bindist check a7a960e Make the test for #11108 less fragile dcc4904 Add failing testcase for #12433 feaa31f Remove references to -XRelaxedPolyRec 5eab6a0 Document meaning of order of --package-db flags, fixes #12485. a8238a4 Update unix submodule to latest HEAD. 65d9597 Add hook for creating ghci external interpreter 1b5f920 Make start address of `osReserveHeapMemory` tunable via command line -xb 7b4bb40 Remove -flocal-ghci-history from default flags 710f21c Add platform warning to Foreign.C.Types 158288b Generalise type of mkMatchGroup to unify with mkMatchGroupName 04184a2 Remove uses of mkMatchGroupName 7b7ea8f Fix derived Ix instances for one-constructor GADTs 0e7ccf6 Fix TH ppr output for list comprehensions with only one Stmt 454033b Add hs_try_putmvar() 03541cb Be less picky about reporing inaccessible code 21d0bfe Remove unused exports 35086d4 users_guide: Fix Docbook remnant b451fef users_guide: #8761 is now fixed c6ac1e5 users_guide: TH now partially supports typed holes 6555c6b rts: Disable -hb with multiple capabilities 5eeabe2 Test wibbles for commit 03541cba ec3edd5 Testsuite wibbles, to the same files 505a518 Comments and white space only 8074e03 Comments and white space only 876b00b Comments and white space 86836a2 Fix codegen bug in PIC version of genSwitch (#12433) 9123845 tryGrabCapability should be using TRY_ACQUIRE_LOCK 626db8f Unify CallStack handling in ghc a001299 Comments only a72d798 Comments in TH.Syntax (Trac #12596) 97b47d2 Add test case for #7611 ea310f9 Remove directories from include paths 14c2e8e Codegen for case: Remove redundant void id checks 6886bba Bump Haddock submodule to fix rendering of class methods 8bd3d41 Fix failing test T12504 9cbcdb4 shutdownHaskellAndExit: just do a normal hs_exit() (#5402) 74c4ca0 Expose hs_exit_(rtsFalse) as hs_exit_nowait() 3a17916 Improved documentation for Foreign.Concurrent (#12547) 9766b0c Fix #12442. d122935 Mark mapUnionFV as INLINABLE rather than INLINE 68f72f1 Replace INLINEABLE by INLINABLE (#12613) 55d92cc Update test output bc7c730 Pattern Synonyms documentation update 796f0f2 Print foralls in user format b0ae0dd Remove #ifdef with never fulfilled condition c36904d Fix layout of MultiWayIf expressions (#10807) f897b74 TH: Use atomicModifyIORef' for fresh names 0b6024c Comments and manual only: spelling 13d3b53 Test Trac #12634 f21eedb Check.hs: Use actual import lists instead of comments 0b533a2 A bit of tracing about flattening 2fbfbca Fix desugaring of pattern bindings (again) 66a8c19 Fix a bug in occurs checking 3012c43 Add Outputable Report in TcErrors b612da6 Fix impredicativity (again) fc4ef66 Comments only 5d473cd Add missing stderr file 3f27237 Make tcrun042 fail 28a00ea Correct spelling in note references b3d55e2 Document Safe Haskell restrictions on Generic instances 9e86276 Implement deriving strategies b61b7c2 CodeGen X86: fix unsafe foreign calls wrt inlining 59d7ee5 GHCi: Don't remove shadowed bindings from typechecker scope. 3c17905 Support more than 64 logical processors on Windows 151edd8 Recognise US spelling for specialisation flags. f869b23 Move -dno-debug-output to the end of the test flags d1b4fec Mark T11978a as broken due to #12019 1e795a0 Use check stacking on Windows. c93813d Add NUMA support for Windows 2d6642b Fix interaction of record pattern synonyms and record wildcards 1851349 Don't warn about name shadowing when renaming the patten in a PatSyn decl ce3370e PPC/CodeGen: fix lwa instruction generation 48ff084 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) 0014fa5 ghc-pkg: Allow unregistering multiple packages in one call b0d53a8 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again f547b44 Eliminate some unsafeCoerce#s with deriving strategies 23cf32d Disallow standalone deriving declarations involving unboxed tuples or sums 4d2b15d validate: Add --build-only 42f1d86 runghc: use executeFile to run ghc process on POSIX 3630ad3 Mark #6132 as broken on OS X 8cab9bd Ignore output from derefnull and divbyzero on Darwin e9104d4 DynFlags: Fix absolute import path to generated header eda5a4a testsuite: Mark test for #12355 as unbroken on Darwin. 22c6b7f Update Cabal submodule to latest version. 8952cc3 runghc: Fix import of System.Process on Windows 7a6731c genapply: update source file in autogenerated text c5d6288 Mark zipWithAndUnzipM as INLINABLE rather than INLINE e4cf962 Bring Note in TcDeriv up to date 465c6c5 Improve error handling in TcRnMonad 58ecdf8 Remove unused T12124.srderr 4a03012 Refactor TcDeriv and TcGenDeriv a2bedb5 RegAlloc: Make some pattern matched complete 57a207c Remove dead code “mkHsConApp” cbe11d5 Add compact to packages so it gets cleaned on make clean. e41b9c6 Fix memory leak from #12664 f3be304 Don't suggest deprecated flags in error messages 76aaa6e Simplify implementation of wWarningFlags 082991a Tc267, tests what happens if you forgot to knot-tie. 3b9e45e Note about external interface changes. 940ded8 Remove reexports from ghc-boot, help bootstrap with GHC 8. 887485a Exclude Cabal PackageTests from gen_contents_index. 00b530d The Backpack patch. 4e8a060 Distinguish between UnitId and InstalledUnitId. 5bd8e8d Make InstalledUnitId be ONLY a FastString. 027a086 Update haddock.Cabal perf for Cabal update. 61b143a Report that we support Backpack in --info. 46b78e6 Cabal submodule update. e660f4b Rework renaming of children in export lists. f2d80de Add trailing comma to fix the build. 21647bc Fix build 7b060e1 Generate a unique symbol for signature object stub files, fixes #12673 bcd3445 Do not segfault if no common root can be found 8dc72f3 Cleanup PosixSource.h 6c47f2e Default +RTS -qn to the number of cores 85e81a8 Turn on -n4m with -A16m or greater 1a9705c Escape lambda. b255ae7 Orient improvement constraints better b5c8963 Rename a parameter; trivial refactor 88eb773 Delete orphan where clause 76a5477 Move zonking out of tcFamTyPats cc5ca21 Improved stats for Trac #1969 a6111b8 More tests for Trac #12522 b5be2ec Add test case for #12689 f8d2c20 Add a broken test case for #12689 8fa5f5b Add derived shadows only for Wanted constraints d2959df Comments and equation ordering only bce9908 RnExpr: Actually fail if patterns found in expression 577effd testsuite: Bump T1969 allocations 184d7cb Add test for #12411 042c593 Add test for #12589 fef1df4 Add test for #12456 57f7a37 Add missing @since annotations 2fdf21b Further improve error handling in TcRn monad 015e9e3 Cabal submodule update. 1cccb64 Unique: Simplify encoding of sum uniques 34d933d Clean up handling of known-key Names in interface files 3991da4 MkIface: Turn a foldr into a foldl' aa06883 Improve find_lbl panic message 90df91a PrelInfo: Fix style 8c6a3d6 Add missing Semigroup instances for Monoidal datatypes in base d5a4e49 Make error when deriving an instance for a typeclass less misleading 3ce0e0b Build ghc-iserv with --export-dynamic 6c73932 Check for empty entity string in "prim" foreign imports 0d9524a Disable T-signals-child test on single-threaded runtime e39589e Fix Windows build following D2588 b501709 Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings 512541b Add a forward reference for a Note afdde48 Correct name of makeStableName in haddock 3174beb Comments about -Wredundant-constraints 82b54fc Fix comment typo 692c8df Fix shadowing in mkWwBodies 609d2c8 Typo in comment a693d1c Correct order of existentials in pattern synonyms f7278a9 Fix wrapping order in matchExpectedConTy 1790762 Test Trac #12681 db71d97 Reduce trace output slightly 156db6b Add more variants of T3064 (in comments) a391a38 Comments only f43db14 Typos in comments 3adaacd Re-add accidentally-deleted line 9cb4459 testsuite: Work around #12554 deed418 testsuite: Mark break011 as broken 8b84b4f testsuite: Mark T10858 as broken on Windows 3325435 testsuite: Mark T9405 as broken on Windows 8bb960e testsuite/driver: Never symlink on Windows c6ee773 testsuite/timeout: Ensure that processes are cleaned up on Windows 17d696f validate: Allow user to override Python interpreter 7d2df32 testsuite/driver: More Unicode awareness 5b55e4b testsuite: Eliminate unnecessary compile_timeout_multiplier 2864ad7 testsuite/driver: Allow threading on Windows c5c6d80 testsuite: Mark T7037 as broken on Windows cf5eec3 Bump parallel submodule 8fa2cdb Track dep_finsts in exports hash, as it affects downstream deps. f148513 Add option to not retain CAFs to the linker API 1275994 remove unnecessary ifdef 46f5f02 fixup! Add option to not retain CAFs to the linker API 7129861 DynamicLoading: Replace map + zip with zipWith 161f463 ghc/Main.hs: Add import list to DynamicLoading fa8940e fix build failure on Solaris caused by usage of --export-dynamic a3bc93e Add some missing RTS symbols 3866481 Compute export hash based on ALL transitive orphan modules. 02f2f21 cmm/Hoopl/Dataflow: remove unused code 1f09c16 Test for newtype with unboxed argument 2cb8cc2 StgCmmPrim: Add missing write barrier. a6094fa configure.ac: Report Unregisterised setting f734afd rts: Add `-Wundef` to CFLAGS and fix warnings d96f656 fixup 2552617 fixup 1ee8879 wip 51308bc wip 384439f wip a154d14 wip a5b2e8f wip ba36d63 wip From git at git.haskell.org Thu Oct 20 09:54:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 09:54:22 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: rts: Add `-Wundef` to CFLAGS and fix warnings (397fa9a) Message-ID: <20161020095422.41AA83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/397fa9a52807b38a259bc89c38a470c2901b3a05/ghc >--------------------------------------------------------------- commit 397fa9a52807b38a259bc89c38a470c2901b3a05 Author: Erik de Castro Lopo Date: Thu Oct 20 20:53:16 2016 +1000 rts: Add `-Wundef` to CFLAGS and fix warnings >--------------------------------------------------------------- 397fa9a52807b38a259bc89c38a470c2901b3a05 compiler/utils/Panic.hs | 4 +- ghc/GHCi/UI.hs | 2 +- ghc/hschooks.c | 1 - includes/MachineDefines.h | 134 +++++++++++++++++++++++ includes/Rts.h | 8 +- includes/RtsAPI.h | 2 +- includes/Stg.h | 6 +- includes/rts/IOManager.h | 2 +- includes/rts/Linker.h | 2 +- includes/rts/Messages.h | 2 +- includes/rts/OSThreads.h | 8 +- includes/rts/Threads.h | 2 +- includes/rts/storage/GC.h | 2 +- includes/rts/storage/InfoTables.h | 2 +- includes/rts/storage/TSO.h | 4 +- includes/stg/DLL.h | 6 +- includes/stg/MachRegs.h | 26 ++--- includes/stg/RtsMachRegs.h | 2 + includes/stg/SMP.h | 15 ++- includes/stg/Types.h | 2 +- iserv/cbits/iservmain.c | 1 - libraries/base/GHC/Conc/IO.hs | 22 ++-- libraries/base/GHC/Conc/Sync.hs | 2 +- libraries/base/GHC/Conc/Windows.hs | 2 +- libraries/base/cbits/DarwinUtils.c | 2 +- libraries/base/cbits/PrelIOUtils.c | 2 +- libraries/base/include/HsBase.h | 2 +- libraries/ghc-prim/cbits/ctz.c | 2 +- rts/Adjustor.c | 79 ++++++------- rts/BeginPrivate.h | 2 +- rts/Capability.c | 6 +- rts/Capability.h | 2 +- rts/EndPrivate.h | 2 +- rts/Excn.h | 2 +- rts/HeapStackCheck.cmm | 2 +- rts/Interpreter.c | 7 +- rts/Libdw.c | 4 +- rts/Linker.c | 213 ++++++++++++++++++------------------ rts/LinkerInternals.h | 7 +- rts/PosixSource.h | 4 +- rts/PrimOps.cmm | 12 +- rts/Profiling.c | 2 +- rts/RaiseAsync.c | 8 +- rts/RaiseAsync.h | 2 +- rts/RtsFlags.c | 14 +-- rts/RtsMessages.c | 14 +-- rts/RtsSignals.h | 4 +- rts/RtsStartup.c | 14 +-- rts/RtsSymbols.c | 26 ++--- rts/RtsUtils.c | 10 +- rts/Schedule.c | 8 +- rts/Stats.h | 2 +- rts/StgCRun.c | 54 ++++----- rts/StgRun.h | 2 +- rts/Task.h | 8 +- rts/Threads.c | 4 +- rts/Trace.c | 2 +- rts/eventlog/EventLog.c | 2 +- rts/ghc.mk | 3 + rts/posix/Clock.h | 2 +- rts/posix/GetEnv.c | 2 +- rts/posix/GetTime.c | 6 +- rts/posix/Itimer.c | 6 +- rts/posix/OSMem.c | 10 +- rts/posix/OSThreads.c | 26 ++--- rts/posix/Signals.c | 6 +- rts/sm/CNF.c | 2 +- rts/sm/Evac.h | 2 +- rts/sm/GCTDecl.h | 7 +- rts/sm/GCUtils.c | 2 +- rts/sm/GCUtils.h | 2 +- rts/sm/Storage.c | 15 ++- testsuite/tests/rts/T5435_asm.c | 4 +- testsuite/tests/rts/linker_error.c | 6 +- testsuite/tests/rts/linker_unload.c | 2 +- testsuite/tests/rts/spalign.c | 6 +- utils/ghc-pkg/Main.hs | 14 +-- utils/runghc/Main.hs | 10 +- 78 files changed, 536 insertions(+), 382 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 397fa9a52807b38a259bc89c38a470c2901b3a05 From git at git.haskell.org Thu Oct 20 19:29:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 19:29:13 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: fixup (dc9c1ca) Message-ID: <20161020192913.1CC4B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/dc9c1caa5719f23eb8eaec3dd4782fa88e25129e/ghc >--------------------------------------------------------------- commit dc9c1caa5719f23eb8eaec3dd4782fa88e25129e Author: Erik de Castro Lopo Date: Thu Oct 20 21:15:57 2016 +1100 fixup >--------------------------------------------------------------- dc9c1caa5719f23eb8eaec3dd4782fa88e25129e ghc/hschooks.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ghc/hschooks.c b/ghc/hschooks.c index b4ce060..7e1ef91 100644 --- a/ghc/hschooks.c +++ b/ghc/hschooks.c @@ -4,6 +4,8 @@ for various bits of the RTS. They are linked in instead of the defaults. */ +#define __USE_MINGW_ANSI_STDIO 1 + #include "Rts.h" #include "HsFFI.h" From git at git.haskell.org Thu Oct 20 19:29:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 19:29:15 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: fixup (1e18f88) Message-ID: <20161020192915.D09603A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/1e18f886068608c68e5545feedcdc7777947931d/ghc >--------------------------------------------------------------- commit 1e18f886068608c68e5545feedcdc7777947931d Author: Erik de Castro Lopo Date: Fri Oct 21 06:28:53 2016 +1100 fixup >--------------------------------------------------------------- 1e18f886068608c68e5545feedcdc7777947931d ghc/hschooks.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ghc/hschooks.c b/ghc/hschooks.c index 7e1ef91..7ebbcc3 100644 --- a/ghc/hschooks.c +++ b/ghc/hschooks.c @@ -48,7 +48,9 @@ defaultsHook (void) void StackOverflowHook (StgWord stack_size) /* in bytes */ { - fprintf(stderr, "GHC stack-space overflow: current limit is %zu bytes.\nUse the `-K' option to increase it.\n", (size_t)stack_size); + fprintf(stderr, "GHC stack-space overflow: current limit is %" FMT_Word + " bytes.\nUse the `-K' option to increase it.\n", + (StgWord) stack_size); } int main (int argc, char *argv[]) From git at git.haskell.org Thu Oct 20 19:45:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 19:45:57 +0000 (UTC) Subject: [commit: ghc] master: New story for abstract data types in hsig files. (518f289) Message-ID: <20161020194557.8FD4F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/518f28959ec56cf27d6a8096a14a6ce9bc8b9816/ghc >--------------------------------------------------------------- commit 518f28959ec56cf27d6a8096a14a6ce9bc8b9816 Author: Edward Z. Yang Date: Wed Oct 12 23:55:41 2016 -0700 New story for abstract data types in hsig files. Summary: In the old implementation of hsig files, we directly reused the implementation of abstract data types from hs-boot files. However, this was WRONG. Consider the following program (an abridged version of bkpfail24): {-# LANGUAGE GADTs #-} unit p where signature H1 where data T signature H2 where data T module M where import qualified H1 import qualified H2 f :: H1.T ~ H2.T => a -> b f x = x Prior to this patch, M was accepted, because the type inference engine concluded that H1.T ~ H2.T does not hold (indeed, *presently*, it does not). However, if we subsequently instantiate p with the same module for H1 and H2, H1.T ~ H2.T does hold! Unsound. The key is that abstract types from signatures need to be treated like *skolem variables*, since you can interpret a Backpack unit as a record which is universally quantified over all of its abstract types, as such (with some fake syntax for structural records): p :: forall t1 t2. { f :: t1 ~ t2 => a -> b } p = { f = \x -> x } -- ill-typed Clearly t1 ~ t2 is not solvable inside p, and also clearly it could be true at some point in the future, so we better not treat the lambda expression after f as inaccessible. The fix seems to be simple: do NOT eagerly fail when trying to simplify the given constraints. Instead, treat H1.T ~ H2.T as an irreducible constraint (rather than an insoluble one); this causes GHC to treat f as accessible--now we will typecheck the rest of the function (and correctly fail). Per the OutsideIn(X) paper, it's always sound to fail less when simplifying givens. We do NOT apply this fix to hs-boot files, where abstract data is also guaranteed to be nominally distinct (since it can't be implemented via a reexport or a type synonym.) This is a somewhat unnatural state of affairs (there's no way to really interpret this in Haskell land) but no reason to change behavior. I deleted "representationally distinct abstract data", which is never used anywhere in GHC. In the process of constructing this fix, I also realized our implementation of type synonym matching against abstract data was not sufficiently restrictive. In order for a type synonym T to be well-formed type, it must be a nullary synonym (i.e., type T :: * -> *, not type T a = ...). Furthermore, since we use abstract data when defining instances, they must not have any type family applications. More details in #12680. This probably deserves some sort of short paper report. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: goldfire, simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2594 >--------------------------------------------------------------- 518f28959ec56cf27d6a8096a14a6ce9bc8b9816 compiler/iface/BuildTyCl.hs | 5 -- compiler/iface/IfaceSyn.hs | 9 ++- compiler/typecheck/TcCanonical.hs | 5 ++ compiler/typecheck/TcRnDriver.hs | 46 +++++++++--- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 21 ++++-- compiler/types/TyCon.hs | 82 ++++++++++++++++++++-- testsuite/tests/backpack/should_compile/all.T | 2 + testsuite/tests/backpack/should_compile/bkp37.bkp | 11 +++ .../tests/backpack/should_compile/bkp37.stderr | 10 +++ testsuite/tests/backpack/should_compile/bkp38.bkp | 16 +++++ .../tests/backpack/should_compile/bkp38.stderr | 10 +++ testsuite/tests/backpack/should_fail/all.T | 5 ++ .../tests/backpack/should_fail/bkpfail10.stderr | 2 +- testsuite/tests/backpack/should_fail/bkpfail23.bkp | 16 +++++ .../tests/backpack/should_fail/bkpfail23.stderr | 20 ++++++ testsuite/tests/backpack/should_fail/bkpfail24.bkp | 19 +++++ .../tests/backpack/should_fail/bkpfail24.stderr | 32 +++++++++ testsuite/tests/backpack/should_fail/bkpfail25.bkp | 24 +++++++ .../tests/backpack/should_fail/bkpfail25.stderr | 22 ++++++ testsuite/tests/backpack/should_fail/bkpfail26.bkp | 18 +++++ .../tests/backpack/should_fail/bkpfail26.stderr | 19 +++++ testsuite/tests/backpack/should_fail/bkpfail27.bkp | 18 +++++ .../tests/backpack/should_fail/bkpfail27.stderr | 18 +++++ 24 files changed, 401 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 518f28959ec56cf27d6a8096a14a6ce9bc8b9816 From git at git.haskell.org Thu Oct 20 19:46:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 19:46:01 +0000 (UTC) Subject: [commit: ghc] master: Support constraint synonym implementations of abstract classes. (7e77c4b) Message-ID: <20161020194601.57DF03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e77c4b2ee08d7f88df8ba47537640ec1bd70bfe/ghc >--------------------------------------------------------------- commit 7e77c4b2ee08d7f88df8ba47537640ec1bd70bfe Author: Edward Z. Yang Date: Thu Oct 13 21:34:17 2016 -0700 Support constraint synonym implementations of abstract classes. Summary: Test Plan: validate Reviewers: goldfire, simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2595 GHC Trac Issues: #12679 >--------------------------------------------------------------- 7e77c4b2ee08d7f88df8ba47537640ec1bd70bfe compiler/iface/TcIface.hs | 1 + compiler/typecheck/TcRnDriver.hs | 46 +++++++++++++++++++++- testsuite/tests/backpack/should_compile/all.T | 2 + testsuite/tests/backpack/should_compile/bkp39.bkp | 17 ++++++++ .../tests/backpack/should_compile/bkp39.stderr | 12 ++++++ testsuite/tests/backpack/should_compile/bkp40.bkp | 41 +++++++++++++++++++ .../tests/backpack/should_compile/bkp40.stderr | 19 +++++++++ 7 files changed, 137 insertions(+), 1 deletion(-) 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 7e77c4b2ee08d7f88df8ba47537640ec1bd70bfe From git at git.haskell.org Thu Oct 20 19:46:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 19:46:04 +0000 (UTC) Subject: [commit: ghc] master: Only delete instances when merging when there is an exact match. (9df4ce4) Message-ID: <20161020194604.1B7673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9df4ce4f89b6d999822ae30ff777bdaf26665c06/ghc >--------------------------------------------------------------- commit 9df4ce4f89b6d999822ae30ff777bdaf26665c06 Author: Edward Z. Yang Date: Fri Oct 14 00:11:10 2016 -0700 Only delete instances when merging when there is an exact match. Summary: Previously, we deleted if the heads matched, which meant that we effectively were picking an arbitrary instance if there were incompatible instances. The new behavior makes more sense, although without incoherent instances you are unlikely to be able to do anything useful with the instances. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2596 >--------------------------------------------------------------- 9df4ce4f89b6d999822ae30ff777bdaf26665c06 compiler/backpack/RnModIface.hs | 5 ++- compiler/typecheck/TcBackpack.hs | 88 ++++++++++++++++++++++++++++++++-------- compiler/types/InstEnv.hs | 9 ++-- 3 files changed, 78 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 9df4ce4f89b6d999822ae30ff777bdaf26665c06 From git at git.haskell.org Thu Oct 20 19:46:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 19:46:07 +0000 (UTC) Subject: [commit: ghc] master: Mark previously failing backpack tests as passing, with correct output. (01490b4) Message-ID: <20161020194607.967793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01490b4c1222b66029d18e1661ebd7c6cf216948/ghc >--------------------------------------------------------------- commit 01490b4c1222b66029d18e1661ebd7c6cf216948 Author: Edward Z. Yang Date: Fri Oct 14 00:13:44 2016 -0700 Mark previously failing backpack tests as passing, with correct output. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 01490b4c1222b66029d18e1661ebd7c6cf216948 testsuite/tests/backpack/should_compile/all.T | 3 +-- testsuite/tests/backpack/should_compile/bkp35.bkp | 15 +++--------- .../should_compile/{bkp34.stderr => bkp35.stderr} | 0 testsuite/tests/backpack/should_fail/all.T | 8 +++---- testsuite/tests/backpack/should_fail/bkpfail07.bkp | 7 +++--- .../tests/backpack/should_fail/bkpfail07.stderr | 28 ++++++++++++---------- .../tests/backpack/should_fail/bkpfail15.stderr | 17 +++++++++++++ testsuite/tests/backpack/should_fail/bkpfail22.bkp | 1 + .../tests/backpack/should_fail/bkpfail22.stderr | 21 +++++++++++++++- .../bkp34.bkp => should_fail/bkpfail28.bkp} | 12 +++++----- .../tests/backpack/should_fail/bkpfail28.stderr | 27 +++++++++++++++++++++ 11 files changed, 98 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 01490b4c1222b66029d18e1661ebd7c6cf216948 From git at git.haskell.org Thu Oct 20 20:07:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 20:07:03 +0000 (UTC) Subject: [commit: ghc] master: Fix Mac OS X build by removing space after ASSERT. (c2142ca) Message-ID: <20161020200703.2C9A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c2142ca6707ca0b8b1ea96b8cfa954b20eab717c/ghc >--------------------------------------------------------------- commit c2142ca6707ca0b8b1ea96b8cfa954b20eab717c Author: Edward Z. Yang Date: Thu Oct 20 13:06:51 2016 -0700 Fix Mac OS X build by removing space after ASSERT. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- c2142ca6707ca0b8b1ea96b8cfa954b20eab717c compiler/typecheck/TcRnDriver.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index f73c0af..9f94c12 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -983,7 +983,7 @@ checkBootTyCon is_boot tc1 tc2 `andThenCheck` -- Don't report roles errors unless the type synonym is nullary checkUnless (not (null tvs)) $ - ASSERT ( null roles2 ) + ASSERT( null roles2 ) -- If we have something like: -- -- signature H where From git at git.haskell.org Thu Oct 20 20:17:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Oct 2016 20:17:44 +0000 (UTC) Subject: [commit: ghc] master: check-cpp: Make it more robust (c23dc61) Message-ID: <20161020201744.B509B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c23dc6164d54eacc654516b885104dc8b7678f16/ghc >--------------------------------------------------------------- commit c23dc6164d54eacc654516b885104dc8b7678f16 Author: Ben Gamari Date: Thu Oct 20 16:13:46 2016 -0400 check-cpp: Make it more robust Catch more than one space >--------------------------------------------------------------- c23dc6164d54eacc654516b885104dc8b7678f16 .arc-linters/check-cpp.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.arc-linters/check-cpp.py b/.arc-linters/check-cpp.py index 2f32f9b..52961e6 100755 --- a/.arc-linters/check-cpp.py +++ b/.arc-linters/check-cpp.py @@ -6,6 +6,7 @@ import sys import logging import os +import re import json def setup_logging(logger): @@ -24,10 +25,11 @@ logger.debug(sys.argv) path = sys.argv[1] warnings = [] +r = re.compile(r'ASSERT\s+\(') if os.path.isfile(path): with open(path) as f: for lineno, line in enumerate(f): - if 'ASSERT (' in line: + if r.search(line): warning = { 'severity': 'warning', 'message': 'CPP macros should not have a space between the macro name and their argument list', From git at git.haskell.org Fri Oct 21 14:56:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 14:56:36 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (ff225b4) Message-ID: <20161021145636.D7C913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff225b4957ded752dc017446fccb9708a1f4ec56/ghc >--------------------------------------------------------------- commit ff225b4957ded752dc017446fccb9708a1f4ec56 Author: Gabor Greif Date: Fri Oct 21 16:55:02 2016 +0200 Typos in comments >--------------------------------------------------------------- ff225b4957ded752dc017446fccb9708a1f4ec56 compiler/typecheck/TcErrors.hs | 4 ++-- compiler/types/TyCoRep.hs | 2 +- rts/ghc.mk | 2 +- utils/hp2ps/hp2ps.1 | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 4837f52..f82fc47 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -624,7 +624,7 @@ mkGivenErrorReporter ctxt cts {- Note [Given errors] ~~~~~~~~~~~~~~~~~~~~~~ -Given constaints reprsent things for which we have (or will have) +Given constraints represent things for which we have (or will have) evidence, so they aren't errors. But if a Given constraint is insoluble, this code is inaccessible, and we might want to at least warn about that. A classic case is @@ -679,7 +679,7 @@ reportGroup :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg) -> ReportErrCtxt reportGroup mk_err ctxt cts = case partition isMonadFailInstanceMissing cts of -- Only warn about missing MonadFail constraint when - -- there are no other missing contstraints! + -- there are no other missing constraints! (monadFailCts, []) -> do { err <- mk_err ctxt monadFailCts ; reportWarning (Reason Opt_WarnMissingMonadFailInstances) err } diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index dca9717..a9dcbcb 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -693,7 +693,7 @@ mkPiTys :: [TyBinder] -> Type -> Type mkPiTys tbs ty = foldr mkPiTy ty tbs -- | Does this type classify a core (unlifted) Coercion? --- At either role nominal or reprsentational +-- At either role nominal or representational -- (t1 ~# t2) or (t1 ~R# t2) isCoercionType :: Type -> Bool isCoercionType (TyConApp tc tys) diff --git a/rts/ghc.mk b/rts/ghc.mk index 49eaab5..d3daec5 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -321,7 +321,7 @@ rts_HC_OPTS += -dcmm-lint # StgClosure, StgMVar, etc.), and without -fno-strict-aliasing gcc is # allowed to assume that these pointers do not alias. eg. without # this flag we get problems in sm/Evac.c:copy() with gcc 3.4.3, the -# upd_evacee() assigments get moved before the object copy. +# upd_evacuee() assignments get moved before the object copy. rts_CC_OPTS += -fno-strict-aliasing rts_CC_OPTS += -fno-common diff --git a/utils/hp2ps/hp2ps.1 b/utils/hp2ps/hp2ps.1 index 6698b97..11d9949 100644 --- a/utils/hp2ps/hp2ps.1 +++ b/utils/hp2ps/hp2ps.1 @@ -43,7 +43,7 @@ sorts the shaded bands for each identifier. The default sort ordering is for the bands with the largest area to be stacked on top of the smaller ones. The .B \-d -option causes rougher bands (those reprsenting series of values with the +option causes rougher bands (those representing series of values with the largest standard deviations) to be stacked on top of smoother ones. .IP "\fB\-b\fP" Normally, From git at git.haskell.org Fri Oct 21 15:19:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 15:19:31 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Compress arguments to ConApp (fef52ca) Message-ID: <20161021151931.C09013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/fef52ca6c771f2c1ce08215b500b6141a2cb7620/ghc >--------------------------------------------------------------- commit fef52ca6c771f2c1ce08215b500b6141a2cb7620 Author: Joachim Breitner Date: Thu Oct 20 19:11:37 2016 -0400 Compress arguments to ConApp I really wish I could use pattern synonyms (with exhaustiveness checks) here, would make the code much nicer. ConApp stores compressed arguments, mkConApp and collectConArgs compress resp. decompress. A promising number of places to not have to decompress the arguments! >--------------------------------------------------------------- fef52ca6c771f2c1ce08215b500b6141a2cb7620 compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/CoreFVs.hs | 17 +++++++----- compiler/coreSyn/CoreLint.hs | 6 ++++- compiler/coreSyn/CorePrep.hs | 28 ++++++++++---------- compiler/coreSyn/CoreSeq.hs | 2 +- compiler/coreSyn/CoreStats.hs | 2 +- compiler/coreSyn/CoreSubst.hs | 11 ++++---- compiler/coreSyn/CoreSyn.hs | 9 ++++--- compiler/coreSyn/CoreTidy.hs | 2 +- compiler/coreSyn/CoreUnfold.hs | 6 ++--- compiler/coreSyn/CoreUtils.hs | 53 ++++++++++++++++++++++++++++--------- compiler/coreSyn/MkCore.hs | 6 ++--- compiler/coreSyn/PprCore.hs | 13 ++++----- compiler/coreSyn/TrieMap.hs | 12 +++++---- compiler/deSugar/DsBinds.hs | 3 ++- compiler/deSugar/DsCCall.hs | 6 ++--- compiler/deSugar/DsListComp.hs | 8 +++--- compiler/deSugar/DsUtils.hs | 4 +-- compiler/ghc.cabal.in | 1 + compiler/ghc.mk | 1 + compiler/iface/MkIface.hs | 6 +++-- compiler/iface/TcIface.hs | 2 +- compiler/main/StaticPtrTable.hs | 4 ++- compiler/main/TidyPgm.hs | 4 +-- compiler/prelude/PrelRules.hs | 13 ++++----- compiler/simplCore/CSE.hs | 2 +- compiler/simplCore/CallArity.hs | 6 ++--- compiler/simplCore/FloatOut.hs | 6 ++--- compiler/simplCore/LiberateCase.hs | 2 +- compiler/simplCore/OccurAnal.hs | 7 ++--- compiler/simplCore/SAT.hs | 5 ++-- compiler/simplCore/Simplify.hs | 17 ++++++------ compiler/specialise/Rules.hs | 6 ++--- compiler/specialise/SpecConstr.hs | 14 ++++++---- compiler/specialise/Specialise.hs | 6 ++--- compiler/stgSyn/CoreToStg.hs | 6 ++--- compiler/stranal/DmdAnal.hs | 6 ++--- compiler/stranal/WorkWrap.hs | 4 +-- compiler/types/CompressArgs.hs | 46 ++++++++++++++++++++++++++++++++ compiler/types/Type.hs | 7 +++++ compiler/vectorise/Vectorise/Exp.hs | 6 +++-- 41 files changed, 238 insertions(+), 129 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 fef52ca6c771f2c1ce08215b500b6141a2cb7620 From git at git.haskell.org Fri Oct 21 15:37:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 15:37:18 +0000 (UTC) Subject: [commit: ghc] wip/T12618: ConApp compression: Fix collectStaticPtrSatArgs (c312228) Message-ID: <20161021153718.09F4F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/c312228f666b4048df68f9cc4017c9a589ae2737/ghc >--------------------------------------------------------------- commit c312228f666b4048df68f9cc4017c9a589ae2737 Author: Joachim Breitner Date: Fri Oct 21 11:37:08 2016 -0400 ConApp compression: Fix collectStaticPtrSatArgs >--------------------------------------------------------------- c312228f666b4048df68f9cc4017c9a589ae2737 compiler/coreSyn/CoreUtils.hs | 23 ++++++++++++++++++----- compiler/deSugar/DsBinds.hs | 2 +- compiler/simplCore/SetLevels.hs | 5 ++--- 3 files changed, 21 insertions(+), 9 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 49d5d08..c2d4eba 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -50,7 +50,7 @@ module CoreUtils ( stripTicksE, stripTicksT, -- * StaticPtr - collectStaticPtrSatArgs + collectStaticPtrSatArgs, isStaticPtrApp ) where #include "HsVersions.h" @@ -2265,11 +2265,11 @@ isEmptyTy ty -- and @s = StaticPtr@ and the application of @StaticPtr@ is saturated. -- -- Yields @Nothing@ otherwise. -collectStaticPtrSatArgs :: Expr b -> Maybe (Expr b, [Arg b]) -collectStaticPtrSatArgs (ConApp dc cargs) +collectStaticPtrSatArgs :: CoreExpr -> Maybe (CoreExpr, [CoreArg]) +collectStaticPtrSatArgs e@(ConApp dc _) | dataConName dc == staticPtrDataConName - -- the StaticPtr con has no compressible arguments - , let args = cargs + -- the StaticPtr con has one compressible argument, which we ignore here + , let args = collectConArgs e , length args == 5 = Just (Var (dataConWorkId dc), args) -- TODO #12618 hack collectStaticPtrSatArgs e @@ -2280,3 +2280,16 @@ collectStaticPtrSatArgs e = Just (fun, args) collectStaticPtrSatArgs _ = Nothing + +isStaticPtrApp :: Expr b -> Bool +isStaticPtrApp e@(ConApp dc _) + | dataConName dc == staticPtrDataConName + = True +isStaticPtrApp e + | (fun@(Var b), args, _) <- collectArgsTicks (const True) e + , Just con <- isDataConId_maybe b + , dataConName con == staticPtrDataConName + , length args == 5 + = True +isStaticPtrApp _ + = False diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 2fcdfda..457bbf7 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -825,7 +825,7 @@ decomposeRuleLhs orig_bndrs orig_lhs -- We do not represent data con using their workers, but the rule code really likes -- having IDs around, so lets return that here. The matcher will know what to do with it. - collectArgs' e@(ConApp dc cargs) = (Var (dataConWorkId dc), args) + collectArgs' e@(ConApp dc _) = (Var (dataConWorkId dc), args) where args = collectConArgs e collectArgs' e = collectArgs e diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 0d1ad99..efec696 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -67,7 +67,7 @@ import CoreMonad ( FloatOutSwitches(..) ) import CoreUtils ( exprType , exprOkForSpeculation , exprIsBottom - , collectStaticPtrSatArgs + , isStaticPtrApp ) import CoreArity ( exprBotStrictness_maybe ) import CoreFVs -- all of it @@ -90,7 +90,6 @@ import Outputable import FastString import UniqDFM import FV -import Data.Maybe {- ************************************************************************ @@ -1121,7 +1120,7 @@ newLvlVar lvld_rhs is_bot rhs_ty = exprType de_tagged_rhs mk_id uniq -- See Note [Grand plan for static forms] in SimplCore. - | isJust (collectStaticPtrSatArgs lvld_rhs) + | isStaticPtrApp lvld_rhs = mkExportedVanillaId (mkSystemVarName uniq (mkFastString "static_ptr")) rhs_ty | otherwise From git at git.haskell.org Fri Oct 21 15:49:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 15:49:17 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Compress arguments to ConApp (e1b85d5) Message-ID: <20161021154917.E57673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/e1b85d57311537dfa784abbe62c7b2fff702eb36/ghc >--------------------------------------------------------------- commit e1b85d57311537dfa784abbe62c7b2fff702eb36 Author: Joachim Breitner Date: Thu Oct 20 19:11:37 2016 -0400 Compress arguments to ConApp I really wish I could use pattern synonyms (with exhaustiveness checks) here, would make the code much nicer. ConApp stores compressed arguments, mkConApp and collectConArgs compress resp. decompress. A promising number of places to not have to decompress the arguments! >--------------------------------------------------------------- e1b85d57311537dfa784abbe62c7b2fff702eb36 compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/CoreFVs.hs | 17 +++++---- compiler/coreSyn/CoreLint.hs | 6 +++- compiler/coreSyn/CorePrep.hs | 28 +++++++-------- compiler/coreSyn/CoreSeq.hs | 2 +- compiler/coreSyn/CoreStats.hs | 2 +- compiler/coreSyn/CoreSubst.hs | 11 +++--- compiler/coreSyn/CoreSyn.hs | 9 ++--- compiler/coreSyn/CoreTidy.hs | 2 +- compiler/coreSyn/CoreUnfold.hs | 6 ++-- compiler/coreSyn/CoreUtils.hs | 70 +++++++++++++++++++++++++++++-------- compiler/coreSyn/MkCore.hs | 6 ++-- compiler/coreSyn/PprCore.hs | 13 +++---- compiler/coreSyn/TrieMap.hs | 12 ++++--- compiler/deSugar/DsBinds.hs | 3 +- compiler/deSugar/DsCCall.hs | 6 ++-- compiler/deSugar/DsListComp.hs | 8 ++--- compiler/deSugar/DsUtils.hs | 4 +-- compiler/ghc.cabal.in | 1 + compiler/ghc.mk | 1 + compiler/ghci/ByteCodeGen.hs | 3 +- compiler/iface/MkIface.hs | 6 ++-- compiler/iface/TcIface.hs | 2 +- compiler/main/StaticPtrTable.hs | 4 ++- compiler/main/TidyPgm.hs | 4 +-- compiler/prelude/PrelRules.hs | 13 +++---- compiler/simplCore/CSE.hs | 2 +- compiler/simplCore/CallArity.hs | 6 ++-- compiler/simplCore/FloatOut.hs | 6 ++-- compiler/simplCore/LiberateCase.hs | 2 +- compiler/simplCore/OccurAnal.hs | 7 ++-- compiler/simplCore/SAT.hs | 5 +-- compiler/simplCore/SetLevels.hs | 5 ++- compiler/simplCore/Simplify.hs | 17 ++++----- compiler/specialise/Rules.hs | 6 ++-- compiler/specialise/SpecConstr.hs | 14 +++++--- compiler/specialise/Specialise.hs | 6 ++-- compiler/stgSyn/CoreToStg.hs | 6 ++-- compiler/stranal/DmdAnal.hs | 6 ++-- compiler/stranal/WorkWrap.hs | 4 +-- compiler/types/CompressArgs.hs | 46 ++++++++++++++++++++++++ compiler/types/Type.hs | 7 ++++ compiler/vectorise/Vectorise/Exp.hs | 6 ++-- 43 files changed, 256 insertions(+), 136 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 e1b85d57311537dfa784abbe62c7b2fff702eb36 From git at git.haskell.org Fri Oct 21 16:16:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:23 +0000 (UTC) Subject: [commit: ghc] master: Refactor typechecking of pattern bindings (45bfd1a) Message-ID: <20161021161623.18A883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/45bfd1a65978ee282d8d2cc1ddb7e3e5f4cd4717/ghc >--------------------------------------------------------------- commit 45bfd1a65978ee282d8d2cc1ddb7e3e5f4cd4717 Author: Simon Peyton Jones Date: Wed Aug 31 09:28:39 2016 +0100 Refactor typechecking of pattern bindings This patch fixes a regression introduced, post 8.0.1, by this major commit: commit 15b9bf4ba4ab47e6809bf2b3b36ec16e502aea72 Author: Simon Peyton Jones Date: Sat Jun 11 23:49:27 2016 +0100 Improve typechecking of let-bindings This major commit was initially triggered by #11339, but it spiraled into a major review of the way in which type signatures for bindings are handled, especially partial type signatures. I didn't get the typechecking of pattern bindings right, leading to Trac #12427. In fixing this I found that this program doesn't work: data T where T :: a -> ((forall b. [b]->[b]) -> Int) -> T h1 y = case y of T _ v -> v Works in 7.10, but not in 8.0.1. There's a happy ending. I found a way to fix this, and improve pattern bindings too. Not only does this fix #12427, but it also allows In particular,we now can accept data T where MkT :: a -> Int -> T ... let { MkT _ q = t } in ... Previously this elicited "my head exploded" but it's really fine since q::Int. The approach is described in detail in TcBinds Note [Typechecking pattern bindings] Super cool. And not even a big patch! >--------------------------------------------------------------- 45bfd1a65978ee282d8d2cc1ddb7e3e5f4cd4717 compiler/typecheck/TcBinds.hs | 226 +++++++++++++-------- compiler/typecheck/TcPat.hs | 193 ++++++++++-------- .../tests/typecheck/should_compile/T12427a.hs | 40 ++++ .../tests/typecheck/should_compile/T12427b.hs | 20 ++ testsuite/tests/typecheck/should_compile/all.T | 2 + 5 files changed, 304 insertions(+), 177 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 45bfd1a65978ee282d8d2cc1ddb7e3e5f4cd4717 From git at git.haskell.org Fri Oct 21 16:16:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:26 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12507 (cdbc73a) Message-ID: <20161021161626.3AD7B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cdbc73aea2d8220dc2c3467afbac5c17db96453a/ghc >--------------------------------------------------------------- commit cdbc73aea2d8220dc2c3467afbac5c17db96453a Author: Simon Peyton Jones Date: Wed Sep 21 15:51:52 2016 +0100 Test Trac #12507 This is now working apparently. It relates to when a polymorphic function gets instantiated, under some implicit paramter bindings. >--------------------------------------------------------------- cdbc73aea2d8220dc2c3467afbac5c17db96453a testsuite/tests/typecheck/should_compile/T12507.hs | 16 ++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 17 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T12507.hs b/testsuite/tests/typecheck/should_compile/T12507.hs new file mode 100644 index 0000000..b4cfd0e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12507.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs, ConstraintKinds, Rank2Types, ImplicitParams #-} + +module T12507 where + +data Rec fields where + Rec :: fields => Rec fields + +qn :: Rec fields -> (fields => r) -> r +qn Rec e = e + +record :: Rec (?a :: Int, ?b :: String) +record = Rec where ?a=42 + ?b="hey" + +access :: Int +access = qn record ?a diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 92b81c6..3961b23 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -547,3 +547,4 @@ test('T12466a', normal, compile, ['']) test('T12644', normal, compile, ['']) test('T12427a', normal, compile_fail, ['']) test('T12427b', normal, compile, ['']) +test('T12507', normal, compile, ['']) From git at git.haskell.org Fri Oct 21 16:16:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:28 +0000 (UTC) Subject: [commit: ghc] master: Comments and trivial refactoring (82efad7) Message-ID: <20161021161628.E15033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/82efad788ed331ae16b586a4fbe4c4a4f92ee638/ghc >--------------------------------------------------------------- commit 82efad788ed331ae16b586a4fbe4c4a4f92ee638 Author: Simon Peyton Jones Date: Mon Sep 19 10:08:29 2016 +0100 Comments and trivial refactoring >--------------------------------------------------------------- 82efad788ed331ae16b586a4fbe4c4a4f92ee638 compiler/basicTypes/BasicTypes.hs | 2 +- compiler/hsSyn/HsBinds.hs | 4 +++- compiler/simplCore/CoreMonad.hs | 16 ---------------- compiler/simplCore/SimplCore.hs | 16 ++++++++++++++++ compiler/typecheck/TcInstDcls.hs | 6 +++--- 5 files changed, 23 insertions(+), 21 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 0429a43..4f57435 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -987,7 +987,7 @@ data InlinePragma -- Note [InlinePragma] -- That is, inl_sat describes the number of *source-code* -- arguments the thing must be applied to. We add on the -- number of implicit, dictionary arguments when making - -- the InlineRule, and don't look at inl_sat further + -- the Unfolding, and don't look at inl_sat further , inl_act :: Activation -- Says during which phases inlining is allowed diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index 236892e..4878592 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -593,6 +593,7 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars pprLHsBinds val_binds ppr_monobind (AbsBindsSig { abs_tvs = tyvars , abs_ev_vars = dictvars + , abs_sig_export = poly_id , abs_sig_ev_bind = ev_bind , abs_sig_bind = bind }) = sdocWithDynFlags $ \ dflags -> @@ -600,7 +601,8 @@ ppr_monobind (AbsBindsSig { abs_tvs = tyvars hang (text "AbsBindsSig" <+> brackets (interpp'SP tyvars) <+> brackets (interpp'SP dictvars)) 2 $ braces $ vcat - [ text "Bind:" <+> ppr bind + [ text "Exported type:" <+> pprBndr LetBind poly_id + , text "Bind:" <+> ppr bind , text "Evidence:" <+> ppr ev_bind ] else ppr bind diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index a12607b..314d094 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -239,22 +239,6 @@ runMaybe (Just x) f = f x runMaybe Nothing _ = CoreDoNothing {- -Note [RULEs enabled in SimplGently] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -RULES are enabled when doing "gentle" simplification. Two reasons: - - * We really want the class-op cancellation to happen: - op (df d1 d2) --> $cop3 d1 d2 - because this breaks the mutual recursion between 'op' and 'df' - - * I wanted the RULE - lift String ===> ... - to work in Template Haskell when simplifying - splices, so we get simpler code for literal strings - -But watch out: list fusion can prevent floating. So use phase control -to switch off those rules until after floating. - ************************************************************************ * * diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 8bc0392..0af167e 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -367,6 +367,22 @@ addPluginPasses builtin_passes #endif {- +Note [RULEs enabled in SimplGently] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +RULES are enabled when doing "gentle" simplification. Two reasons: + + * We really want the class-op cancellation to happen: + op (df d1 d2) --> $cop3 d1 d2 + because this breaks the mutual recursion between 'op' and 'df' + + * I wanted the RULE + lift String ===> ... + to work in Template Haskell when simplifying + splices, so we get simpler code for literal strings + +But watch out: list fusion can prevent floating. So use phase control +to switch off those rules until after floating. + ************************************************************************ * * The CoreToDo interpreter diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index c18d69d..ab5b75c 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -1323,15 +1323,15 @@ tcMethodBody clas tyvars dfun_ev_vars inst_tys -- Substitute the local_meth_name for the binder -- NB: the binding is always a FunBind - ; global_meth_id <- addInlinePrags global_meth_id prags - ; spec_prags <- tcSpecPrags global_meth_id prags - -- taking instance signature into account might change the type of -- the local_meth_id ; (meth_implic, ev_binds_var, tc_bind) <- checkInstConstraints $ tcMethodBodyHelp sig_fn sel_id local_meth_id (L bind_loc lm_bind) + ; global_meth_id <- addInlinePrags global_meth_id prags + ; spec_prags <- tcSpecPrags global_meth_id prags + ; let specs = mk_meth_spec_prags global_meth_id spec_inst_prags spec_prags export = ABE { abe_poly = global_meth_id , abe_mono = local_meth_id From git at git.haskell.org Fri Oct 21 16:16:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:31 +0000 (UTC) Subject: [commit: ghc] master: Make TcLevel increase by 1 not 2 (d61c7e8) Message-ID: <20161021161631.962473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d61c7e8d418331e4db783dace9c7ad75306ce05a/ghc >--------------------------------------------------------------- commit d61c7e8d418331e4db783dace9c7ad75306ce05a Author: Simon Peyton Jones Date: Tue Sep 20 23:29:51 2016 +0100 Make TcLevel increase by 1 not 2 Make the TcLevel of a flatten-meta-var be always zero. See TcType.fmvTcLevel. This allows the levels of implication constraints to to up by 1 each time instead of 2, which is less confusing. This change has no effect on type checking. >--------------------------------------------------------------- d61c7e8d418331e4db783dace9c7ad75306ce05a compiler/typecheck/TcType.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index f814a5f..5013f47 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -646,23 +646,18 @@ Note [TcLevel assignment] ~~~~~~~~~~~~~~~~~~~~~~~~~ We arrange the TcLevels like this + 0 Level for flatten meta-vars 1 Top level - 2 Flatten-meta-vars of level 3 - 3 First-level implication constraints - 4 Flatten-meta-vars of level 5 - 5 Second-level implication constraints + 2 First-level implication constraints + 3 Second-level implication constraints ...etc... -The even-numbered levels are for the flatten-meta-variables assigned -at the next level in. Eg for a second-level implication constraint -(level 5), the flatten meta-vars are level 4, which makes them untouchable. -The flatten meta-vars could equally well all have level 0, or just NotALevel -since they do not live across implications. +The flatten meta-vars are all at level 0, just to make them untouchable. -} fmvTcLevel :: TcLevel -> TcLevel -- See Note [TcLevel assignment] -fmvTcLevel (TcLevel n) = TcLevel (n-1) +fmvTcLevel _ = TcLevel 0 topTcLevel :: TcLevel -- See Note [TcLevel assignment] @@ -674,7 +669,7 @@ isTopTcLevel _ = False pushTcLevel :: TcLevel -> TcLevel -- See Note [TcLevel assignment] -pushTcLevel (TcLevel us) = TcLevel (us + 2) +pushTcLevel (TcLevel us) = TcLevel (us + 1) strictlyDeeperThan :: TcLevel -> TcLevel -> Bool strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl) From git at git.haskell.org Fri Oct 21 16:16:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:35 +0000 (UTC) Subject: [commit: ghc] master: A collection of type-inference refactorings. (3f5673f) Message-ID: <20161021161635.9733E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3f5673f34a2f761423027bf46f64f7499708725f/ghc >--------------------------------------------------------------- commit 3f5673f34a2f761423027bf46f64f7499708725f Author: Simon Peyton Jones Date: Tue Sep 20 23:31:07 2016 +0100 A collection of type-inference refactorings. This patch does a raft of useful tidy-ups in the type checker. I've been meaning to do this for some time, and finally made time to do it en route to ICFP. 1. Modify TcType.ExpType to make a distinct data type, InferResult for the Infer case, and consequential refactoring. 2. Define a new function TcUnify.fillInferResult, to fill in an InferResult. It uses TcMType.promoteTcType to promote the type to the level of the InferResult. See TcMType Note [Promoting a type] This refactoring is in preparation for an improvement to typechecking pattern bindings, coming next. I flirted with an elaborate scheme to give better higher rank inference, but it was just too complicated. See TcMType Note [Promotion and higher rank types] 3. Add to InferResult a new field ir_inst :: Bool to say whether or not the type used to fill in the InferResult should be deeply instantiated. See TcUnify Note [Deep instantiation of InferResult]. 4. Add a TcLevel to SkolemTvs. This will be useful generally - it's a fast way to see if the type variable escapes when floating (not used yet) - it provides a good consistency check when updating a unification variable (TcMType.writeMetaTyVarRef, the level_check_ok check) I originally had another reason (related to the flirting in (2), but I left it in because it seems like a step in the right direction. 5. Reduce and simplify the plethora of uExpType, tcSubType and related functions in TcUnify. It was such an opaque mess and it's still not great, but it's better. 6. Simplify the uo_expected field of TypeEqOrigin. Richard had generatlised it to a ExpType, but it was almost always a Check type. Now it's back to being a plain TcType which is much, much easier. 7. Improve error messages by refraining from skolemisation when it's clear that there's an error: see TcUnify Note [Don't skolemise unnecessarily] 8. Type.isPiTy and isForAllTy seem to be missing a coreView check, so I added it 9. Kill off tcs_used_tcvs. Its purpose is to track the givens used by wanted constraints. For dictionaries etc we do that via the free vars of the /bindings/ in the implication constraint ic_binds. But for coercions we just do update-in-place in the type, rather than generating a binding. So we need something analogous to bindings, to track what coercions we have added. That was the purpose of tcs_used_tcvs. But it only worked for a /single/ iteration, whereas we may have multiple iterations of solving an implication. Look at (the old) 'setImplicationStatus'. If the constraint is unsolved, it just drops the used_tvs on the floor. If it becomes solved next time round, we'll pick up coercions used in that round, but ignore ones used in the first round. There was an outright bug. Result = (potentialy) bogus unused-constraint errors. Constructing a case where this actually happens seems quite trick so I did not do so. Solution: expand EvBindsVar to include the (free vars of the) coercions, so that the coercions are tracked in essentially the same way as the bindings. This turned out to be much simpler. Less code, more correct. 10. Make the ic_binds field in an implication have type ic_binds :: EvBindsVar instead of (as previously) ic_binds :: Maybe EvBindsVar This is notably simpler, and faster to use -- less testing of the Maybe. But in the occaional situation where we don't have anywhere to put the bindings, the belt-and-braces error check is lost. So I put it back as an ASSERT in 'setImplicationStatus' (see the use of 'termEvidenceAllowed') All these changes led to quite bit of error message wibbling >--------------------------------------------------------------- 3f5673f34a2f761423027bf46f64f7499708725f compiler/ghci/RtClosureInspect.hs | 2 +- compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcBinds.hs | 90 +-- compiler/typecheck/TcErrors.hs | 44 +- compiler/typecheck/TcEvidence.hs | 33 +- compiler/typecheck/TcExpr.hs | 24 +- compiler/typecheck/TcHsSyn.hs | 7 +- compiler/typecheck/TcHsType.hs | 21 +- compiler/typecheck/TcInstDcls.hs | 7 +- compiler/typecheck/TcMType.hs | 324 ++++++--- compiler/typecheck/TcMatches.hs | 19 +- compiler/typecheck/TcPat.hs | 22 +- compiler/typecheck/TcPatSyn.hs | 16 +- compiler/typecheck/TcPluginM.hs | 16 +- compiler/typecheck/TcRnDriver.hs | 9 +- compiler/typecheck/TcRnMonad.hs | 28 +- compiler/typecheck/TcRnTypes.hs | 29 +- compiler/typecheck/TcSMonad.hs | 124 ++-- compiler/typecheck/TcSimplify.hs | 58 +- compiler/typecheck/TcType.hs | 78 ++- compiler/typecheck/TcUnify.hs | 731 +++++++++++++++------ compiler/typecheck/TcValidity.hs | 2 +- compiler/types/Type.hs | 2 + compiler/vectorise/Vectorise/Generic/PData.hs | 2 +- testsuite/tests/ado/ado004.stderr | 4 +- .../tests/annotations/should_fail/annfail10.stderr | 12 +- testsuite/tests/driver/T2182.stderr | 32 +- testsuite/tests/gadt/gadt-escape1.stderr | 16 +- testsuite/tests/gadt/gadt13.stderr | 10 +- testsuite/tests/gadt/gadt7.stderr | 18 +- .../tests/ghci.debugger/scripts/break012.stdout | 8 +- .../tests/ghci.debugger/scripts/print022.stdout | 4 +- testsuite/tests/ghci/scripts/T11524a.stdout | 4 +- testsuite/tests/ghci/scripts/T2182ghci.stderr | 10 +- .../tests/indexed-types/should_fail/T12386.hs | 9 + .../tests/indexed-types/should_fail/T12386.stderr | 7 + .../tests/indexed-types/should_fail/T5439.stderr | 16 +- .../tests/indexed-types/should_fail/T7354.stderr | 8 +- .../tests/parser/should_compile/read014.stderr | 2 +- testsuite/tests/parser/should_fail/T7848.stderr | 5 +- .../tests/parser/should_fail/readFail003.stderr | 4 +- .../partial-sigs/should_compile/T10438.stderr | 14 +- .../partial-sigs/should_compile/T11192.stderr | 16 +- .../tests/patsyn/should_compile/T11213.stderr | 2 +- testsuite/tests/patsyn/should_fail/mono.stderr | 4 +- testsuite/tests/polykinds/T7438.stderr | 16 +- testsuite/tests/rebindable/rebindable6.stderr | 12 +- .../tests/rename/should_compile/T12597.stderr | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 5 +- .../simplCore/should_compile/noinline01.stderr | 4 +- testsuite/tests/th/T11452.stderr | 2 +- testsuite/tests/th/T2222.stderr | 2 +- .../typecheck/should_compile/ExPatFail.stderr | 4 +- .../should_compile/T12427.stderr} | 0 .../tests/typecheck/should_compile/T12427a.stderr | 33 + .../tests/typecheck/should_compile/tc141.stderr | 6 +- .../tests/typecheck/should_fail/T10495.stderr | 10 +- .../tests/typecheck/should_fail/T10619.stderr | 4 +- .../tests/typecheck/should_fail/T12177.stderr | 19 +- testsuite/tests/typecheck/should_fail/T3102.hs | 6 +- testsuite/tests/typecheck/should_fail/T3102.stderr | 12 - testsuite/tests/typecheck/should_fail/T7453.stderr | 50 +- testsuite/tests/typecheck/should_fail/T7734.stderr | 12 +- testsuite/tests/typecheck/should_fail/T9109.stderr | 10 +- testsuite/tests/typecheck/should_fail/T9318.stderr | 12 +- .../tests/typecheck/should_fail/VtaFail.stderr | 2 +- testsuite/tests/typecheck/should_fail/all.T | 2 +- .../tests/typecheck/should_fail/tcfail002.stderr | 6 +- .../tests/typecheck/should_fail/tcfail004.stderr | 6 +- .../tests/typecheck/should_fail/tcfail005.stderr | 6 +- .../tests/typecheck/should_fail/tcfail013.stderr | 2 +- .../tests/typecheck/should_fail/tcfail014.stderr | 6 +- .../tests/typecheck/should_fail/tcfail018.stderr | 2 +- .../tests/typecheck/should_fail/tcfail032.stderr | 6 +- .../tests/typecheck/should_fail/tcfail099.stderr | 6 +- .../tests/typecheck/should_fail/tcfail104.stderr | 10 +- .../tests/typecheck/should_fail/tcfail140.stderr | 4 +- .../tests/typecheck/should_fail/tcfail181.stderr | 2 +- .../tests/warnings/should_compile/T12574.stderr | 2 +- 79 files changed, 1321 insertions(+), 859 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 3f5673f34a2f761423027bf46f64f7499708725f From git at git.haskell.org Fri Oct 21 16:16:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:38 +0000 (UTC) Subject: [commit: ghc] master: Accept 20% dedgradation in Trac #5030 compile time (1f09b24) Message-ID: <20161021161638.588EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f09b246d377a0007a953e5a77545d81671d2e36/ghc >--------------------------------------------------------------- commit 1f09b246d377a0007a953e5a77545d81671d2e36 Author: Simon Peyton Jones Date: Mon Oct 17 10:39:25 2016 +0100 Accept 20% dedgradation in Trac #5030 compile time In commit 31621b12 * A collection of type-inference refactorings. I fixed a bug in the on-the-fly unifier. Usually the on-the-fly unifier (TcUnify) defers type function applications to the constraint solver. But in one situation it inconsistently did not defer, so a unification happened without reducing a type function. By a fluke this makes T5030 (specifcially the definition of cnst) much better. It turns out that consistently non-deferring type functions makes the test for #3064 go bad. So somehow the current, inconsistent situation was an accidental sweet spot. But it's a horrible sweet spot, relying on what was essentially a bug. So I've accepted the worsening (it's an exotic case), and opened #12724 to deal with the underlying cause. >--------------------------------------------------------------- 1f09b246d377a0007a953e5a77545d81671d2e36 testsuite/tests/perf/compiler/all.T | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index c93fe02..b7655a1 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -380,7 +380,7 @@ test('T5030', # 2015-07-11: 201882912 reason unknown # 2016-04-06: 345668088 likely TypeInType - (wordsize(64), 653710960, 10)]), + (wordsize(64), 794426536, 10)]), # Previously 530000000 (+/- 10%) # 17/1/13: 602993184 (x86_64/Linux) # (new demand analyser) @@ -398,6 +398,9 @@ test('T5030', # of family-applications leads to less sharing, I think # 2015-03-17 403932600 tweak to solver algorithm # 2015-12-11 653710960 TypeInType (see #11196) + # 2016-10-17 794426536 20% big increase following + # 31621b12 * A collection of type-inference refactorings. + # See ticket for more info only_ways(['normal']) ], From git at git.haskell.org Fri Oct 21 16:16:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:41 +0000 (UTC) Subject: [commit: ghc] master: Refactor occurrence-check logic (9417e57) Message-ID: <20161021161641.161613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9417e57983dbcf7f500cca16163b11d1abb699e6/ghc >--------------------------------------------------------------- commit 9417e57983dbcf7f500cca16163b11d1abb699e6 Author: Simon Peyton Jones Date: Sun Sep 25 03:50:13 2016 +0100 Refactor occurrence-check logic This patch does two related things * Combines the occurrence-check logic in the on-the-fly unifier with that in the constraint solver. They are both doing the same job, after all. The resulting code is now in TcUnify: metaTyVarUpdateOK occCheckExpand occCheckForErrors (called in TcErrors) * In doing this I disovered checking for family-free-ness and foralls can be unnecessarily inefficient, because it expands type synonyms. It's easy just to cache this info in the type syononym TyCon, which I am now doing. >--------------------------------------------------------------- 9417e57983dbcf7f500cca16163b11d1abb699e6 compiler/basicTypes/DataCon.hs | 10 +- compiler/iface/TcIface.hs | 2 +- compiler/prelude/TysPrim.hs | 2 + compiler/prelude/TysWiredIn.hs | 6 +- compiler/typecheck/TcCanonical.hs | 10 +- compiler/typecheck/TcErrors.hs | 7 +- compiler/typecheck/TcFlatten.hs | 49 +++--- compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/typecheck/TcType.hs | 281 +------------------------------ compiler/typecheck/TcUnify.hs | 78 +-------- compiler/types/TyCon.hs | 27 ++- compiler/types/Type.hs | 25 ++- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- 13 files changed, 102 insertions(+), 399 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 9417e57983dbcf7f500cca16163b11d1abb699e6 From git at git.haskell.org Fri Oct 21 16:16:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:43 +0000 (UTC) Subject: [commit: ghc] master: Define emitNewWantedEq, and use it (e1fc5a3) Message-ID: <20161021161643.BEF3B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1fc5a3351bc02dc059db5c2a1079b04db18b401/ghc >--------------------------------------------------------------- commit e1fc5a3351bc02dc059db5c2a1079b04db18b401 Author: Simon Peyton Jones Date: Fri Oct 14 17:35:04 2016 +0100 Define emitNewWantedEq, and use it This is just a minor refactoring >--------------------------------------------------------------- e1fc5a3351bc02dc059db5c2a1079b04db18b401 compiler/typecheck/TcCanonical.hs | 7 +++---- compiler/typecheck/TcInteract.hs | 15 ++++++--------- compiler/typecheck/TcSMonad.hs | 11 ++++++++++- 3 files changed, 19 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 9caef47..1a35bcc 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -1456,11 +1456,10 @@ homogeniseRhsKind ev eq_rel lhs rhs build_ct | otherwise -- Wanted and Derived. See Note [No derived kind equalities] -- evar :: (lhs :: k1) ~ (rhs :: k2) - = do { (kind_ev, kind_co) <- newWantedEq kind_loc Nominal k1 k2 + = do { kind_co <- emitNewWantedEq kind_loc Nominal k1 k2 -- kind_ev :: (k1 :: *) ~ (k2 :: *) ; traceTcS "Hetero equality gives rise to wanted kind equality" $ - ppr (kind_ev) - ; emitWorkNC [kind_ev] + ppr (kind_co) ; let homo_co = mkSymCo kind_co -- homo_co :: k2 ~ k1 rhs' = mkCastTy rhs homo_co @@ -1471,7 +1470,7 @@ homogeniseRhsKind ev eq_rel lhs rhs build_ct where homo_pred = mkTcEqPredLikeEv ev lhs rhs' CtWanted { ctev_dest = dest } -> do { (type_ev, hole_co) <- newWantedEq loc role lhs rhs' - -- type_ev :: (lhs :: k1) ~ (rhs |> sym kind_ev :: k1) + -- type_ev :: (lhs :: k1) ~ (rhs |> sym kind_co :: k1) ; setWantedEq dest (hole_co `mkTransCo` (mkReflCo role rhs diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 05efceb..22556ed 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1416,20 +1416,17 @@ reduce_top_fun_eq old_ev fsk ax_co rhs_ty | otherwise -- We must not assign ufsk := ...ufsk...! = do { alpha_ty <- newFlexiTcSTy (tyVarKind fsk) - ; new_ev <- case old_ev of - CtWanted {} -> do { (ev, _) <- newWantedEq loc Nominal alpha_ty rhs_ty - ; updWorkListTcS $ - extendWorkListEq (mkNonCanonical ev) - ; return ev } + ; new_co <- case old_ev of + CtWanted {} -> emitNewWantedEq loc Nominal alpha_ty rhs_ty CtDerived {} -> do { ev <- newDerivedNC loc pred ; updWorkListTcS (extendWorkListDerived loc ev) - ; return ev } - where pred = mkPrimEqPred alpha_ty rhs_ty + ; return (ctEvCoercion ev) } -- Coercion is bottom + where pred = mkPrimEqPred alpha_ty rhs_ty _ -> pprPanic "reduce_top_fun_eq" (ppr old_ev) -- By emitting this as non-canonical, we deal with all -- flattening, occurs-check, and ufsk := ufsk issues - ; let final_co = ax_co `mkTcTransCo` mkTcSymCo (ctEvCoercion new_ev) + ; let final_co = ax_co `mkTcTransCo` mkTcSymCo new_co -- ax_co :: fam_tc args ~ rhs_ty -- ev :: alpha ~ rhs_ty -- ufsk := alpha @@ -1440,7 +1437,7 @@ reduce_top_fun_eq old_ev fsk ax_co rhs_ty , nest 2 (text ":=") <+> if isDerived old_ev then text "(derived)" else ppr final_co - , text "new_ev:" <+> ppr new_ev ] + , text "new_co:" <+> ppr new_co ] ; stopWith old_ev "Fun/Top (wanted)" } where loc = ctEvLoc old_ev diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 0174b4a..27529e4 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -29,7 +29,7 @@ module TcSMonad ( MaybeNew(..), freshGoals, isFresh, getEvTerm, newTcEvBinds, - newWantedEq, + newWantedEq, emitNewWantedEq, newWanted, newWantedEvVar, newWantedEvVarNC, newDerivedNC, newBoundEvVarId, unifyTyVar, unflattenFmv, reportUnifications, @@ -2995,6 +2995,15 @@ newBoundEvVarId pred rhs newGivenEvVars :: CtLoc -> [(TcPredType, EvTerm)] -> TcS [CtEvidence] newGivenEvVars loc pts = mapM (newGivenEvVar loc) pts +emitNewWantedEq :: CtLoc -> Role -> TcType -> TcType -> TcS Coercion +-- | Emit a new Wanted equality into the work-list +emitNewWantedEq loc role ty1 ty2 + | otherwise + = do { (ev, co) <- newWantedEq loc role ty1 ty2 + ; updWorkListTcS $ + extendWorkListEq (mkNonCanonical ev) + ; return co } + -- | Make a new equality CtEvidence newWantedEq :: CtLoc -> Role -> TcType -> TcType -> TcS (CtEvidence, Coercion) newWantedEq loc role ty1 ty2 From git at git.haskell.org Fri Oct 21 16:16:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 16:16:46 +0000 (UTC) Subject: [commit: ghc] master: Improve TcCanonical.unifyWanted and unifyDerived (6ddba64) Message-ID: <20161021161646.833D13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ddba64287fe07df3b2df1f3db974b03945fc07f/ghc >--------------------------------------------------------------- commit 6ddba64287fe07df3b2df1f3db974b03945fc07f Author: Simon Peyton Jones Date: Fri Oct 14 17:35:38 2016 +0100 Improve TcCanonical.unifyWanted and unifyDerived When debugging something else I noticed that these functions were emitting constraints like [W] a ~ a which is plain stupid. So I fixed it not to do that. Should result in fewer constraints getting generated. >--------------------------------------------------------------- 6ddba64287fe07df3b2df1f3db974b03945fc07f compiler/typecheck/TcCanonical.hs | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 1a35bcc..3419400 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -1823,25 +1823,27 @@ unifyWanted loc role orig_ty1 orig_ty2 = do { cos <- zipWith3M (unifyWanted loc) (tyConRolesX role tc1) tys1 tys2 ; return (mkTyConAppCo role tc1 cos) } - go (TyVarTy tv) ty2 + + go ty1@(TyVarTy tv) ty2 = do { mb_ty <- isFilledMetaTyVar_maybe tv ; case mb_ty of Just ty1' -> go ty1' ty2 - Nothing -> bale_out } - go ty1 (TyVarTy tv) + Nothing -> bale_out ty1 ty2} + go ty1 ty2@(TyVarTy tv) = do { mb_ty <- isFilledMetaTyVar_maybe tv ; case mb_ty of Just ty2' -> go ty1 ty2' - Nothing -> bale_out } + Nothing -> bale_out ty1 ty2 } go ty1@(CoercionTy {}) (CoercionTy {}) = return (mkReflCo role ty1) -- we just don't care about coercions! - go _ _ = bale_out + go ty1 ty2 = bale_out ty1 ty2 - bale_out = do { (new_ev, co) <- newWantedEq loc role orig_ty1 orig_ty2 - ; emitWorkNC [new_ev] - ; return co } + bale_out ty1 ty2 + | ty1 `tcEqType` ty2 = return (mkTcReflCo role ty1) + -- Check for equality; e.g. a ~ a, or (m a) ~ (m a) + | otherwise = emitNewWantedEq loc role orig_ty1 orig_ty2 unifyDeriveds :: CtLoc -> [Role] -> [TcType] -> [TcType] -> TcS () -- See Note [unifyWanted and unifyDerived] @@ -1869,19 +1871,22 @@ unify_derived loc role orig_ty1 orig_ty2 | tc1 == tc2, tys1 `equalLength` tys2 , isInjectiveTyCon tc1 role = unifyDeriveds loc (tyConRolesX role tc1) tys1 tys2 - go (TyVarTy tv) ty2 + go ty1@(TyVarTy tv) ty2 = do { mb_ty <- isFilledMetaTyVar_maybe tv ; case mb_ty of Just ty1' -> go ty1' ty2 - Nothing -> bale_out } - go ty1 (TyVarTy tv) + Nothing -> bale_out ty1 ty2 } + go ty1 ty2@(TyVarTy tv) = do { mb_ty <- isFilledMetaTyVar_maybe tv ; case mb_ty of Just ty2' -> go ty1 ty2' - Nothing -> bale_out } - go _ _ = bale_out + Nothing -> bale_out ty1 ty2 } + go ty1 ty2 = bale_out ty1 ty2 - bale_out = emitNewDerivedEq loc role orig_ty1 orig_ty2 + bale_out ty1 ty2 + | ty1 `tcEqType` ty2 = return () + -- Check for equality; e.g. a ~ a, or (m a) ~ (m a) + | otherwise = emitNewDerivedEq loc role orig_ty1 orig_ty2 maybeSym :: SwapFlag -> TcCoercion -> TcCoercion maybeSym IsSwapped co = mkTcSymCo co From git at git.haskell.org Fri Oct 21 19:15:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Oct 2016 19:15:57 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Fix calculation of res_ty in CoreFVs (d136b6b) Message-ID: <20161021191557.30F153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/d136b6b84fc769e0c34c802b7125f90cf2de6c51/ghc >--------------------------------------------------------------- commit d136b6b84fc769e0c34c802b7125f90cf2de6c51 Author: Joachim Breitner Date: Fri Oct 21 15:13:43 2016 -0400 Fix calculation of res_ty in CoreFVs but should the other code not have worked? Weird. >--------------------------------------------------------------- d136b6b84fc769e0c34c802b7125f90cf2de6c51 compiler/coreSyn/CoreFVs.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index dc46280..12544b8 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -753,9 +753,12 @@ freeVars = go where cargs' = map go cargs args = uncompressArgs exprTypeFV (go . Type) dc_ty cargs' - arg_tys = map (exprToType . deAnnotate) args dc_ty = dataConRepType dc - res_ty = piResultTys dc_ty arg_tys + res_ty = foldl applyTypeToArg dc_ty (map deAnnotate args) + -- Why does this not work? Isn't piResultTys just iterated application + -- of piResultTy, which is what applyTypeToArg uses? + -- arg_tys = map (exprToType . deAnnotate) args + -- res_ty = piResultTys dc_ty arg_tys go (Case scrut bndr ty alts) = ( FVAnn { fva_fvs = (bndr `delBinderFV` alts_fvs) From git at git.haskell.org Sat Oct 22 00:07:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 00:07:38 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Squached ConApp commit (38dbcb1) Message-ID: <20161022000738.DBFBC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/38dbcb17800d21f0b2bb5e76267c81f42c070599/ghc >--------------------------------------------------------------- commit 38dbcb17800d21f0b2bb5e76267c81f42c070599 Author: Joachim Breitner Date: Fri Oct 21 20:07:04 2016 -0400 Squached ConApp commit commit c7e38780308908fcbb3bd17b841bee027c8cc87a Author: Joachim Breitner Date: Wed Oct 19 16:14:27 2016 -0400 Update Test output test T12689 is partially broken for now. And two perf numbers had to be adjusted: They improved! commit 6b35f6643d539e047a2e89124ba11e92a9159a0c Author: Joachim Breitner Date: Tue Oct 18 15:29:20 2016 -0400 Add eta-expanded variants of RULE foldr/id and foldr/app this is annoying. commit f62ba67f44bdbfb18686f15563ff851df391156b Author: Joachim Breitner Date: Tue Oct 18 14:58:22 2016 -0400 specExpr: Reverse ConArg traversal, to reduce diff commit c2189250a803ba73a98d0378d94ae2a3f11a122f Author: Joachim Breitner Date: Tue Oct 18 13:51:58 2016 -0400 Handle ConApp in more points in the Specializer commit fb0ca506618c6e9c93f3c7cdef90ed1b5849f8e3 Author: Joachim Breitner Date: Fri Oct 14 23:20:12 2016 -0400 magictDict built-in rule: Also match ConApp commit 5b1e66568e5d6ca3c43e8f0ae0d7e5b9915bba68 Author: Joachim Breitner Date: Fri Oct 14 15:34:23 2016 -0400 Have SimpleWrapperUnfoldings to keep them apart from compulsory unfoldings for now, to avoid accidential unrelated effects of this patch. commit 03195f67022162318c8fed3d86b188597eb26c6b Author: Joachim Breitner Date: Thu Oct 13 15:20:47 2016 -0400 Try to apply rules that match a data con this is slightly annoying, all the rule matching code so far assumes that rules can only apply to function applications, which is just no longer true. commit 67dbf3a9841e6ffcca9d7c480a06b78c30513c98 Author: Joachim Breitner Date: Thu Oct 13 14:55:34 2016 -0400 Make simple DataCon wrappers complusary unfoldings and make sure they are unfolded in simple_opt_expr, even when they are nullary. For that, start paying attention to the arity field in the unfolding guidance. (This design can be revised later.) commit e6ad487ff9dd77ff4d35b15d671338b02942ac80 Author: Joachim Breitner Date: Thu Oct 13 13:25:49 2016 -0400 Extend test for #12689 with rule matching late on normal data con commit 5ed10e8ea37e3d1d89c6edae5c1a626b483849a3 Author: Joachim Breitner Date: Thu Oct 13 13:11:10 2016 -0400 Use mkSimpleDataConRep in mkDataConRep if nothing fancy goes on as a step towards treating them diffently in the inliner. commit 92b560e6d04e2db290d6e1e8a4fa93c936a5de69 Author: Joachim Breitner Date: Thu Oct 13 13:08:34 2016 -0400 Revert "Make data con wrappers ConLike (and see what happens)" This reverts commit ad72aa0e46d1e58eac3e6ff3c17af080b01e6ff3. commit ad72aa0e46d1e58eac3e6ff3c17af080b01e6ff3 Author: Joachim Breitner Date: Tue Oct 11 19:03:51 2016 -0400 Make data con wrappers ConLike (and see what happens) commit e17608466274b8448bd9d4f1f4f5edaa4894bd63 Author: Joachim Breitner Date: Tue Oct 11 16:50:25 2016 -0400 Add a broken test case for #12689 A rule with a phase specification trying to match on a constructor with a wrapper will fail to match, as the wrapper will be inlined by then. The fact that it works in the other case is also mostly by accident. (Split into two test cases so that regressions with regard what works so far are caught.) commit 6d59834455f8e9c294f030890e96af548079652a Author: Joachim Breitner Date: Tue Oct 11 16:25:05 2016 -0400 Add test case for #12689 which test a few variants of rules involving constructors, including nullary constructors, constructors with wrappers, and unsaturated of constructors. At the moment, all the rules work as expected, despite GHC’s compile time warnings when called with -Wall. commit 0e07dc90aa94673bcc83f10e32b466b7f22ee3ee Author: Joachim Breitner Date: Tue Oct 11 10:57:55 2016 -0400 SpecConstr.isValue: Handle ConApp now all tests pass (here) commit ddbcc7b5cea1fb22697d6d0723e90e0d893a6537 Author: Joachim Breitner Date: Tue Oct 11 10:47:06 2016 -0400 Adjust exprIsCheap commit 54cfb30b0b33246d4e8cb36d659ccbc971e9f094 Author: Joachim Breitner Date: Tue Oct 11 10:11:19 2016 -0400 Fix instance Eq (DeBruijn CoreExpr) for ConApp commit 557166a6b670f3dcd3bed4f79af1119b9a3f4832 Author: Joachim Breitner Date: Mon Oct 10 17:35:36 2016 -0400 Have a compulary unfolding for unboxed tuple wrappers as we have no binding for them. commit 5bdf9d042d812fdfeece8db9037c0175c2b8ed6b Author: Joachim Breitner Date: Mon Oct 10 17:27:19 2016 -0400 sptModuleInitCode: Look for ConApp commit 11b0d182da0b283ab73f3682c195cce452c4a57f Author: Joachim Breitner Date: Mon Oct 10 16:37:54 2016 -0400 Nullary data constructors are trivial commit 09f72a920ba786bf7a0c235a38402d8ff8d6f9a5 Author: Simon Peyton Jones Date: Sat Oct 8 00:03:53 2016 +0100 Move zonking out of tcFamTyPats In tcFamTyPats we were zonking from the TcType world to the Type world, ready to build the results into a CoAxiom (which should have no TcType stuff. But the 'thing_inside' for tcFamTyPats also must be zonked, and that zonking must have the ZonkEnv from the binders zonked tcFamTyPats. Ugh. This caused an assertion failure (with DEBUG on) in RaeBlobPost and TypeLevelVec, both in tests/dependent, as shown in Trac #12682. Why it hasn't shown up before now is obscure to me. So I moved the zonking stuff out of tcFamTyPats to its three call sites, where we can do it all together. Very slightly longer, but much more robust. commit 0a5850dab49cbec07c41dcac6771da4c1584d9cd Author: Joachim Breitner Date: Sun Oct 9 17:54:51 2016 -0400 Update debugger test output Because we desugare to the wrapper, without simplifiation, many expressions that were values before are now thunks, and shown as such in the debugger. commit 32a2826823c67b8ff54224b47ede9017619a7a23 Author: Joachim Breitner Date: Sun Oct 9 15:51:04 2016 -0400 SetLevels: Do not float nullary data constructors commit 0ae46fea877a38b872ba7eb241e9a620d1c2de1d Author: Joachim Breitner Date: Sun Oct 9 14:43:56 2016 -0400 Update some test output commit 891c903b791b67aa4742a8634cfad71bf61a8d2c Author: Joachim Breitner Date: Sun Oct 9 14:23:04 2016 -0400 No lint warning about staticPtr data con worker because of collectStaticPtrSatArgs this may be around. commit 33728e85c73918b2e4549ee92f5350a7accce00a Author: Joachim Breitner Date: Sun Oct 9 13:45:08 2016 -0400 Avoid invalid haddock synatx commit 75e5dd948dc4c3db6830383b5cc83231a71005d6 Author: Joachim Breitner Date: Sun Oct 9 13:44:00 2016 -0400 getIdFromTrivialExpr_maybe: Return dataConWorkId for nullary data cons commit 2fee1279c78e39e7233a9f79b27549b02a74d565 Author: Joachim Breitner Date: Sun Oct 9 13:20:59 2016 -0400 Handle nullary constructors in the byte code generator. commit 4068e403fe104e4226939190bb107a1f3c655d0c Author: Joachim Breitner Date: Sun Oct 9 12:38:14 2016 -0400 Handle nullary Cons in myCollectArgs commit d51996444bfd40eb7588e696078f3f6eedd35442 Author: Joachim Breitner Date: Sun Oct 9 12:07:50 2016 -0400 cpe_ExprIsTrivial: Nullary Constructors are trivial commit 518ed7909a9c81d96480b9ed2fd39a0be2fb8fe3 Author: Joachim Breitner Date: Sat Oct 8 22:55:54 2016 -0400 Handle ConApp in inlineBoringOk commit ab230b9fe7142b1a9dcd62f6af2dce848b0d8f59 Author: Joachim Breitner Date: Sat Oct 8 16:59:00 2016 -0400 coreToStgExpr: add con worker to free variables reported commit 7a6203882ee5af9db0cdc5463f23a60989ab7cee Author: Joachim Breitner Date: Fri Oct 7 21:59:46 2016 -0400 Do not lint the bodz of the data con worker bindings introduced by CorePrep commit c9a3415460ab6361ecdaf396800a3a533d62587e Author: Joachim Breitner Date: Fri Oct 7 21:43:24 2016 -0400 Revert "CorePrep: Stop creating weird bindings for data constructor workers" This reverts commit 36143d401423e7fc427cef6ed71cb9dae3c9d561. commit 5a0b12869b7d9058348a4af42ef016da3d5b83ae Author: Joachim Breitner Date: Fri Oct 7 17:39:42 2016 -0400 maybe_substitute: Detect ConApp commit f0b187303fad8c36df615bc835752b5a16202831 Author: Joachim Breitner Date: Fri Oct 7 15:21:35 2016 -0400 Temporarily disable rule shadowing warnings Until https://ghc.haskell.org/trac/ghc/ticket/12618#comment:25 is resolved. commit 13557d6e3d92315ed034479905aa4a15baff4025 Author: Joachim Breitner Date: Fri Oct 7 09:18:53 2016 -0400 isTrueLHsExpr: Match on data con wrapper now commit cc7e75428218cc02fe7da916fb2ee5a5e3868807 Author: Joachim Breitner Date: Thu Oct 6 23:38:34 2016 -0400 Include constructor in freeNamesIfExpr commit 65ba986828aba20e61ef15b2db09eb40c06259b4 Author: Joachim Breitner Date: Wed Oct 5 23:23:20 2016 -0400 Use ConApp when creating True resp. False commit 70e58e8316a138627274160e2fe6972802084fea Author: Joachim Breitner Date: Wed Oct 5 23:22:48 2016 -0400 New Lint Check: No data con workers any more, please commit ba8341c129bb26e8d92e763dd7de6f0a1e265caf Author: Joachim Breitner Date: Wed Oct 5 23:08:34 2016 -0400 mkCoreConApps: Do not use ConApp for newtypes commit 48877dad6bfd8a7d5cf47da04fde8e2223530146 Author: Joachim Breitner Date: Wed Oct 5 18:21:59 2016 -0400 mkSimpleDataConRep: No wrapper for newtypes commit 3f42e87964b327f4e6b463056727e3de980dfa31 Author: Joachim Breitner Date: Wed Oct 5 18:13:33 2016 -0400 ConApp: More Linting commit 1aa69bff3624beb966136e70e806dd7c7038a795 Author: Joachim Breitner Date: Wed Oct 5 17:50:29 2016 -0400 Use dataConWrapId in unsaturated uses of mkCoreConApps commit d1922185829f5ee2eac8c9797d732aa653b0408d Author: Joachim Breitner Date: Wed Oct 5 17:43:05 2016 -0400 Handle ConApp in "Eliminate Identity Case" commit ef7fc1a15bc64084589d3b63789f2d03f5bf6cf0 Author: Joachim Breitner Date: Wed Oct 5 17:29:53 2016 -0400 Deserialize interface tuples to ConApp commit 395db23544dbde568bfaf71966123b7b8388e971 Author: Joachim Breitner Date: Wed Oct 5 17:16:59 2016 -0400 Create a simple wrapper for built-in types as well (The module structure might need some refactoring here.) commit 5be97a0c7aec64260335581ec8de27792be0467a Author: Joachim Breitner Date: Wed Oct 5 13:21:41 2016 -0400 Desugar: Use Coercible worker, not wrapper commit 36143d401423e7fc427cef6ed71cb9dae3c9d561 Author: Joachim Breitner Date: Wed Oct 5 13:15:40 2016 -0400 CorePrep: Stop creating weird bindings for data constructor workers as these should only occur saturated now. commit 916c15272fffd7d7457c085488051765c6c8146e Author: Joachim Breitner Date: Wed Oct 5 12:50:32 2016 -0400 Reserve a unique for the wrapper of a wired in DataCon commit 32b47198c2f6b365611e144b0730c9dff12ba206 Author: Joachim Breitner Date: Tue Oct 4 15:46:59 2016 -0400 Always use ConApp in CoreSyn commit 39185a4af6d85087f2eb42fb02f74e990bcb142d Author: Joachim Breitner Date: Tue Oct 4 15:14:45 2016 -0400 Always build a wrapper for data types commit 3733c4dfc50d578bef3e6a287f28841ce16f309a Author: Joachim Breitner Date: Tue Oct 4 14:49:40 2016 -0400 Get rid of unitDataConId (use ConApp instead) commit c3e1cb0b94f527d2a488c19b4566a46cd7d780ce Author: Joachim Breitner Date: Tue Oct 4 14:41:54 2016 -0400 knownCon: Use ConApp in unfolding of scrutinee commit 8399e73a44287d5aa6ce6c61620c628f85033392 Author: Joachim Breitner Date: Tue Oct 4 14:35:23 2016 -0400 Use ConApp in tagToEnumRule commit a40b10315ca752652e23c15be0e7a1d48807f62f Author: Joachim Breitner Date: Tue Oct 4 14:29:17 2016 -0400 Lint: Complain about saturated uses of the data con worker to find the spots where ConApp has to be used instead. commit 6c7668e65cc1901414aa14a8e9d555082cc2c9f3 Author: Joachim Breitner Date: Tue Oct 4 14:23:43 2016 -0400 mkCoreConApps: Warn about unsaturated use commit b486662d3c75ef8a1c96d2d29f8e5ca547c23c25 Author: Joachim Breitner Date: Tue Oct 4 14:20:05 2016 -0400 DataCon wrapper: Use ConApp in the body commit f10cbcb7aab88b38ce1dc17568af4454abf624ae Author: Joachim Breitner Date: Tue Oct 4 14:10:09 2016 -0400 mkDataConRep: Do not interleave applying arguments and unboxers in preparation to using ConApp in the data con wrapper (where this is not possible). commit 8fa24208a732b877952ded6e2e98f54f526dde19 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in dffvExpr just to see if this fixes the crashes here. commit 5a7d036452d83c7d456a73b4fc4781aa76c57f62 Author: Joachim Breitner Date: Tue Oct 4 13:33:05 2016 -0400 ConApp: Include dc worker id in free variables just to see if this fixes the crashes here. commit e7d8c5a713218329d52954f99aff60a484e00eed Author: Joachim Breitner Date: Sun Oct 2 21:19:49 2016 -0400 ConApp bytecode: Add more ASSERT commit f17b59ef00616ac15405cf84b30bf202fc239592 Author: Joachim Breitner Date: Fri Sep 30 20:50:42 2016 -0400 Actually desugar to ConApp at least if the constructor is saturated. Fall back to the worker otherwise. commit 67814af6d68758eba6d424a4454cef6bd7235127 Author: Joachim Breitner Date: Thu Sep 29 16:56:56 2016 -0400 Introduce ConApp to Core (dead code as of yet) This is the first step towards #12618: It adds the data constructor and then fixes all problems due to incomplete patterns, essentially preparing the complete compiler for the eventual use of this variant. Because no where a ConApp is created, this should not yet have any effect. Care is taken to not take shortcuts via the data con worker id, as eventually, there will be no data con worker any more. There are a few unclear spots, marked with "TODO #12618". Input is appreciated. These are currently: * CoreLint: Remove a check from the App case that will only be relevant occurring in the ConApp case later * simplExprF1: This case became very easy. I might have overlooked something else happening to arguments, as I read and simplified the code that handled App. Second pairs of eyes welcome. * ruleCheck: There can be no rules attached to data constructors, can there? * scExp: Can a datacon be in scSubstId? * dmdAnal: How to get the idStrictness equivalent of the worker? Or is there never something useful to be said about the strictness signature of an constructor? (Because strictness annotations are taken care of by the wrapper? >--------------------------------------------------------------- 38dbcb17800d21f0b2bb5e76267c81f42c070599 compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/Demand.hs | 17 ++- compiler/basicTypes/MkId.hs | 137 ++++++++++++++------- compiler/basicTypes/MkId.hs-boot | 4 +- compiler/basicTypes/Unique.hs | 22 ++-- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/coreSyn/CoreFVs.hs | 14 +++ compiler/coreSyn/CoreLint.hs | 42 +++++++ compiler/coreSyn/CorePrep.hs | 24 ++++ compiler/coreSyn/CoreSeq.hs | 1 + compiler/coreSyn/CoreStats.hs | 2 + compiler/coreSyn/CoreSubst.hs | 52 +++++--- compiler/coreSyn/CoreSyn.hs | 38 +++++- compiler/coreSyn/CoreTidy.hs | 15 +-- compiler/coreSyn/CoreUnfold.hs | 20 ++- compiler/coreSyn/CoreUtils.hs | 65 ++++++---- compiler/coreSyn/MkCore.hs | 39 +++++- compiler/coreSyn/PprCore.hs | 11 ++ compiler/coreSyn/TrieMap.hs | 80 +++++++----- compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsBinds.hs | 10 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/ByteCodeGen.hs | 42 ++++++- compiler/iface/IfaceSyn.hs | 60 ++++++--- compiler/iface/MkIface.hs | 32 +++-- compiler/iface/TcIface.hs | 13 +- compiler/main/StaticPtrTable.hs | 5 + compiler/main/TidyPgm.hs | 2 + compiler/prelude/PrelNames.hs | 17 ++- compiler/prelude/PrelRules.hs | 16 ++- compiler/prelude/TysWiredIn.hs | 35 +++--- compiler/simplCore/CSE.hs | 1 + compiler/simplCore/CallArity.hs | 26 +++- compiler/simplCore/FloatIn.hs | 19 +++ compiler/simplCore/FloatOut.hs | 8 ++ compiler/simplCore/LiberateCase.hs | 1 + compiler/simplCore/OccurAnal.hs | 8 ++ compiler/simplCore/SAT.hs | 12 ++ compiler/simplCore/SetLevels.hs | 18 ++- compiler/simplCore/SimplUtils.hs | 19 +-- compiler/simplCore/Simplify.hs | 30 ++++- compiler/specialise/Rules.hs | 15 +++ compiler/specialise/SpecConstr.hs | 7 ++ compiler/specialise/Specialise.hs | 3 + compiler/stgSyn/CoreToStg.hs | 20 +++ compiler/stranal/DmdAnal.hs | 33 +++++ compiler/stranal/WorkWrap.hs | 3 + compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 48 +++++--- compiler/vectorise/Vectorise/Exp.hs | 13 ++ compiler/vectorise/Vectorise/Utils.hs | 6 - libraries/base/GHC/Base.hs | 2 + mk/warnings.mk | 2 + .../tests/deSugar/should_compile/T2431.stderr | 48 ++++---- .../tests/ghci.debugger/scripts/print002.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 20 ++- .../tests/ghci.debugger/scripts/print006.stdout | 14 +-- .../tests/ghci.debugger/scripts/print008.stdout | 10 +- .../tests/ghci.debugger/scripts/print010.stdout | 7 +- .../tests/ghci.debugger/scripts/print012.stdout | 9 +- .../tests/ghci.debugger/scripts/print013.stdout | 2 +- .../tests/ghci.debugger/scripts/print014.stdout | 2 +- .../tests/ghci.debugger/scripts/print019.stderr | 12 +- .../tests/ghci.debugger/scripts/print019.stdout | 15 +-- .../tests/ghci.debugger/scripts/print034.stdout | 6 +- testsuite/tests/ghci/scripts/T2976.stdout | 2 +- testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../tests/numeric/should_compile/T7116.stdout | 40 +++--- testsuite/tests/perf/compiler/all.T | 6 +- testsuite/tests/plugins/HomePackagePlugin.hs | 1 + testsuite/tests/quasiquotation/T7918.stdout | 16 +-- testsuite/tests/roles/should_compile/Roles1.stderr | 60 ++++----- .../tests/roles/should_compile/Roles13.stderr | 70 +++++------ .../tests/roles/should_compile/Roles14.stderr | 12 +- testsuite/tests/roles/should_compile/Roles2.stderr | 20 +-- testsuite/tests/roles/should_compile/Roles3.stderr | 36 +++--- testsuite/tests/roles/should_compile/Roles4.stderr | 20 +-- testsuite/tests/roles/should_compile/T8958.stderr | 32 ++--- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T3055.stdout | 2 +- .../tests/simplCore/should_compile/T3234.stderr | 15 ++- .../tests/simplCore/should_compile/T3717.stderr | 20 +-- .../tests/simplCore/should_compile/T3772.stdout | 22 ++-- .../tests/simplCore/should_compile/T3990.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 43 ++++--- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 26 ++-- .../tests/simplCore/should_compile/T5366.stdout | 3 +- .../tests/simplCore/should_compile/T7360.stderr | 114 ++++++++++------- .../tests/simplCore/should_compile/T7865.stdout | 2 +- .../tests/simplCore/should_compile/T8274.stdout | 34 +++-- .../tests/simplCore/should_compile/T8832.stdout | 20 +-- .../tests/simplCore/should_compile/T9400.stderr | 14 +-- .../tests/simplCore/should_compile/par01.stderr | 14 +-- .../simplCore/should_compile/spec-inline.stderr | 40 +++--- testsuite/tests/simplCore/should_run/T12689.hs | 33 +++++ testsuite/tests/simplCore/should_run/T12689.stdout | 8 ++ testsuite/tests/simplCore/should_run/T12689a.hs | 27 ++++ .../tests/simplCore/should_run/T12689a.stdout | 6 + .../tests/simplCore/should_run/T12689broken.hs | 9 ++ .../tests/simplCore/should_run/T12689broken.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 3 + testsuite/tests/th/TH_Roles2.stderr | 8 +- 105 files changed, 1427 insertions(+), 686 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 38dbcb17800d21f0b2bb5e76267c81f42c070599 From git at git.haskell.org Sat Oct 22 00:07:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 00:07:42 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Compress arguments to ConApp (a875ab3) Message-ID: <20161022000742.3B6E43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/a875ab3b4c3bce7e52ffa270f4c82e79f62b3fb8/ghc >--------------------------------------------------------------- commit a875ab3b4c3bce7e52ffa270f4c82e79f62b3fb8 Author: Joachim Breitner Date: Thu Oct 20 19:11:37 2016 -0400 Compress arguments to ConApp I really wish I could use pattern synonyms (with exhaustiveness checks) here, would make the code much nicer. ConApp stores compressed arguments, mkConApp and collectConArgs compress resp. decompress. A promising number of places to not have to decompress the arguments! >--------------------------------------------------------------- a875ab3b4c3bce7e52ffa270f4c82e79f62b3fb8 compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/CoreFVs.hs | 20 ++++--- compiler/coreSyn/CoreLint.hs | 6 +- compiler/coreSyn/CorePrep.hs | 28 ++++----- compiler/coreSyn/CoreSeq.hs | 2 +- compiler/coreSyn/CoreStats.hs | 2 +- compiler/coreSyn/CoreSubst.hs | 11 ++-- compiler/coreSyn/CoreSyn.hs | 9 +-- compiler/coreSyn/CoreTidy.hs | 2 +- compiler/coreSyn/CoreUnfold.hs | 6 +- compiler/coreSyn/CoreUtils.hs | 70 +++++++++++++++++----- compiler/coreSyn/MkCore.hs | 6 +- compiler/coreSyn/PprCore.hs | 13 ++-- compiler/coreSyn/TrieMap.hs | 12 ++-- compiler/deSugar/DsBinds.hs | 3 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsListComp.hs | 8 +-- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghc.cabal.in | 1 + compiler/ghc.mk | 1 + compiler/ghci/ByteCodeGen.hs | 3 +- compiler/iface/MkIface.hs | 6 +- compiler/iface/TcIface.hs | 2 +- compiler/main/StaticPtrTable.hs | 4 +- compiler/main/TidyPgm.hs | 4 +- compiler/prelude/PrelRules.hs | 13 ++-- compiler/simplCore/CSE.hs | 2 +- compiler/simplCore/CallArity.hs | 6 +- compiler/simplCore/FloatOut.hs | 6 +- compiler/simplCore/LiberateCase.hs | 2 +- compiler/simplCore/OccurAnal.hs | 7 ++- compiler/simplCore/SAT.hs | 5 +- compiler/simplCore/SetLevels.hs | 5 +- compiler/simplCore/Simplify.hs | 17 +++--- compiler/specialise/Rules.hs | 6 +- compiler/specialise/SpecConstr.hs | 14 +++-- compiler/specialise/Specialise.hs | 6 +- compiler/stgSyn/CoreToStg.hs | 6 +- compiler/stranal/DmdAnal.hs | 6 +- compiler/stranal/WorkWrap.hs | 4 +- compiler/types/CompressArgs.hs | 46 ++++++++++++++ compiler/types/Type.hs | 7 +++ compiler/vectorise/Vectorise/Exp.hs | 6 +- .../tests/simplCore/should_compile/T7360.stderr | 4 +- .../simplCore/should_compile/spec-inline.stderr | 12 ++-- 45 files changed, 267 insertions(+), 144 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 a875ab3b4c3bce7e52ffa270f4c82e79f62b3fb8 From git at git.haskell.org Sat Oct 22 00:07:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 00:07:45 +0000 (UTC) Subject: [commit: ghc] wip/T12618: Cache the analysis of the data con type (201332e) Message-ID: <20161022000745.127A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12618 Link : http://ghc.haskell.org/trac/ghc/changeset/201332eda995ffe5faee07849e629eea09ec84d4/ghc >--------------------------------------------------------------- commit 201332eda995ffe5faee07849e629eea09ec84d4 Author: Joachim Breitner Date: Fri Oct 21 19:07:51 2016 -0400 Cache the analysis of the data con type for faster compression/decompression. >--------------------------------------------------------------- 201332eda995ffe5faee07849e629eea09ec84d4 compiler/basicTypes/DataCon.hs | 8 +++++ compiler/coreSyn/CoreFVs.hs | 4 +-- compiler/coreSyn/CoreSyn.hs | 2 +- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/types/CompressArgs.hs | 66 +++++++++++++++++++++++++----------------- 5 files changed, 52 insertions(+), 30 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 47b05c9..14795e8 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -28,6 +28,7 @@ module DataCon ( -- ** Type deconstruction dataConRepType, dataConSig, dataConInstSig, dataConFullSig, + dataConCompressScheme, dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConOrigTyCon, dataConUserType, dataConUnivTyVars, dataConUnivTyVarBinders, @@ -66,6 +67,7 @@ import ForeignCall ( CType ) import Coercion import Unify import TyCon +import CompressArgs import FieldLabel import Class import Name @@ -407,6 +409,8 @@ data DataCon -- and use that to check the pattern. Mind you, this is really only -- used in CoreLint. + dcCompressScheme :: CompressScheme, + dcInfix :: Bool, -- True <=> declared infix -- Used for Template Haskell and 'deriving' only @@ -797,6 +801,7 @@ mkDataCon name declared_infix prom_info dcRepTyCon = rep_tycon, dcSrcBangs = arg_stricts, dcFields = fields, dcTag = tag, dcRepType = rep_ty, + dcCompressScheme = genCompressScheme rep_ty, dcWorkId = work_id, dcRep = rep, dcSourceArity = length orig_arg_tys, @@ -882,6 +887,9 @@ dataConOrigTyCon dc dataConRepType :: DataCon -> Type dataConRepType = dcRepType +dataConCompressScheme :: DataCon -> CompressScheme +dataConCompressScheme = dcCompressScheme + -- | Should the 'DataCon' be presented infix? dataConIsInfix :: DataCon -> Bool dataConIsInfix = dcInfix diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index 12544b8..5f1fad2 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -74,7 +74,7 @@ import Type import TyCoRep import TyCon import CompressArgs -import DataCon ( dataConRepType, dataConWorkId ) +import DataCon ( dataConRepType, dataConCompressScheme, dataConWorkId ) import CoAxiom import FamInstEnv import TysPrim( funTyConName ) @@ -752,7 +752,7 @@ freeVars = go , AnnConApp dc cargs' ) where cargs' = map go cargs - args = uncompressArgs exprTypeFV (go . Type) dc_ty cargs' + args = uncompressArgs exprTypeFV (go . Type) (dataConCompressScheme dc) cargs' dc_ty = dataConRepType dc res_ty = foldl applyTypeToArg dc_ty (map deAnnotate args) -- Why does this not work? Isn't piResultTys just iterated application diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 54a62ef..b47b21c 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -1501,7 +1501,7 @@ mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars mkConApp dc args = ASSERT2 ( dataConRepFullArity dc == length args, text "mkConApp: artiy mismatch" $$ ppr dc ) - ConApp dc (compressArgs (dataConRepType dc) args) + ConApp dc (compressArgs (dataConCompressScheme dc) args) mkTyApps f args = foldl (\ e a -> App e (typeOrCoercion a)) f args where diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index e71055b..89499e3 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -212,7 +212,7 @@ applyTypeToArgs e op_ty args -} collectConArgs :: CoreExpr -> [CoreArg] -collectConArgs (ConApp dc cargs) = uncompressArgs exprTypeOrKind Type (dataConRepType dc) cargs +collectConArgs (ConApp dc cargs) = uncompressArgs exprTypeOrKind Type (dataConCompressScheme dc) cargs collectConArgs _ = panic "conAppArgs" diff --git a/compiler/types/CompressArgs.hs b/compiler/types/CompressArgs.hs index 099ce20..ccbc357 100644 --- a/compiler/types/CompressArgs.hs +++ b/compiler/types/CompressArgs.hs @@ -1,44 +1,58 @@ -module CompressArgs (compressArgs, uncompressArgs) where +module CompressArgs ( + CompressScheme, -- abstract + genCompressScheme, + compressArgs, + uncompressArgs + ) where import Type import TyCoRep import Panic -import Data.List ( findIndex ) +import Data.List ( findIndex, dropWhileEnd ) +import Data.Maybe ( isNothing ) -compressArgs :: Type -> [a] -> [a] -uncompressArgs :: (a -> Type) -> (Type -> a) -> Type -> [a] -> [a] +-- We want to analyze the data con type only once. The resulting information +-- is given by a list of offsets. +-- The list may be shorted. +-- Abstract by design. +newtype CompressScheme = CS ([Maybe Int]) -compressArgs funTy args = go pis args +genCompressScheme :: Type -> CompressScheme +genCompressScheme funTy = CS $ shorten $ go pis where (pis,_) = splitPiTys funTy - -- Remove redundant type type arguments - go (Named tyBndr : pis) (_ : args) - | any (isRedundandTyVar (binderVar tyBndr)) pis - = go pis args + shorten = dropWhileEnd isNothing - go (_ : pis) (a : args) = a : go pis args - go [] [] = [] - -- Error conditions below - go [] _ = panic "compressArgs: not enough arrows in type" - go _ [] = panic "compressArgs: not enough args" + go (Named tyBndr : pis) + | Just i <- findIndex (isRedundandTyVar (binderVar tyBndr)) pis + = Just i : go pis + go (_ : pis) + = Nothing : go pis + go [] + = [] -uncompressArgs typeOf mkType funTy args = go pis args - where - (pis,_) = splitPiTys funTy - go (Named tyBndr : pis) args - | Just i <- findIndex (isRedundandTyVar (binderVar tyBndr)) pis - -- This is a type argument we have to recover - = let args' = go pis args - in mkType (typeOf (args' !! i)) : args' +compressArgs :: CompressScheme -> [a] -> [a] +uncompressArgs :: (a -> Type) -> (Type -> a) -> CompressScheme -> [a] -> [a] + +compressArgs (CS cs) args = go cs args + where + go (Just _ : pis) (_ : args) = go pis args + go (Nothing : pis) (a : args) = a : go pis args + go [] args = args + go _ [] = panic "compressArgs: not enough args" - go (_ : pis) (a : args) = a : go pis args - go [] [] = [] +uncompressArgs typeOf mkType (CS cs) args = go cs args + where + go (Just i : pis) args = mkType (typeOf (args' !! i)) : args' + where args' = go pis args + go (Nothing : pis) (a : args) = a : args' + where args' = go pis args + go [] args = args -- Error conditions below - go [] _ = panic "uncompressArgs: not enough arrows in type" - go _ [] = panic "uncompressArgs: not enough args" + go _ [] = panic "uncompressArgs: not enough args" isRedundandTyVar :: TyVar -> TyBinder -> Bool isRedundandTyVar v (Anon t) | Just v' <- getTyVar_maybe t, v == v' = True From git at git.haskell.org Sat Oct 22 00:21:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 00:21:39 +0000 (UTC) Subject: [commit: ghc] master: Add and use a new dynamic-library-dirs field in the ghc-pkg info (f41a8a3) Message-ID: <20161022002139.386723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f41a8a369796985a75dd618b969292e1e7033112/ghc >--------------------------------------------------------------- commit f41a8a369796985a75dd618b969292e1e7033112 Author: Duncan Coutts Date: Fri Oct 21 14:32:02 2016 -0700 Add and use a new dynamic-library-dirs field in the ghc-pkg info Summary: Build systems / package managers want to be able to control the file layout of installed libraries. In general they may want/need to be able to put the static libraries and dynamic libraries in different places. The ghc-pkg library regisrtation needs to be able to handle this. This is already possible in principle by listing both a static lib dir and a dynamic lib dir in the library-dirs field (indeed some previous versions of Cabal did this for shared libs on ELF platforms). The downside of listing both dirs is twofold. There is a lack of precision, if we're not careful with naming then we could end up picking up the wrong library. The more immediate problem however is that if we list both directories then both directories get included into the ELF and Mach-O shared object runtime search paths. On ELF this merely slows down loading of shared libs (affecting prog startup time). On the latest OSX versions this provokes a much more serious problem: that there is a rather low limit on the total size of the section containing the runtime search path (and lib names and related) and thus listing any unnecessary directories wastes the limited space. So the solution in this patch is fairly straightforward: split the static and dynamic library search paths in the ghc-pkg db and its use within ghc. This is a traditional solution: pkg-config has the same static / dynamic split (though it describes in in terms of private and public, but it translates into different behaviour for static and dynamic linking). Indeed it would make perfect sense to also have a static/dynamic split for the list of the libraries to use i.e. to have dynamic variants of the hs-libraries and extra-libraries fields. These are not immediately required so this patch does not add it, but it is a reasonable direction to follow. To handle compatibility, if the new dynamic-library-dirs field is not specified then its value is taken from the library-dirs field. Contains Cabal submodule update. Test Plan: Run ./validate Get christiaanb and carter to test it on OSX Sierra, in combination with Cabal/cabal-install changes to the default file layout for libraries. Reviewers: carter, austin, hvr, christiaanb, bgamari Reviewed By: christiaanb, bgamari Subscribers: ezyang, Phyx, thomie Differential Revision: https://phabricator.haskell.org/D2611 GHC Trac Issues: #12479 >--------------------------------------------------------------- f41a8a369796985a75dd618b969292e1e7033112 compiler/backpack/DriverBkp.hs | 1 + compiler/ghci/Linker.hs | 3 ++- compiler/main/DriverPipeline.hs | 2 +- compiler/main/PackageConfig.hs | 1 + compiler/main/Packages.hs | 33 +++++++++++++++++++++++++++++---- compiler/main/SysTools.hs | 2 +- libraries/Cabal | 2 +- libraries/ghc-boot/GHC/PackageDb.hs | 10 ++++++++-- utils/ghc-cabal/Main.hs | 4 ++++ utils/ghc-pkg/Main.hs | 4 +++- 10 files changed, 51 insertions(+), 11 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 f41a8a369796985a75dd618b969292e1e7033112 From git at git.haskell.org Sat Oct 22 01:37:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 01:37:49 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D2471' deleted Message-ID: <20161022013749.86D1B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/D2471 From git at git.haskell.org Sat Oct 22 09:22:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 09:22:04 +0000 (UTC) Subject: [commit: ghc] branch 'wip/erikd/cpp-undef' created Message-ID: <20161022092204.6C00C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/erikd/cpp-undef Referencing: 767ee632167271475eb40b1c8bc53ac54c7031e4 From git at git.haskell.org Sat Oct 22 09:22:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 09:22:07 +0000 (UTC) Subject: [commit: ghc] wip/erikd/cpp-undef: Add -Wcpp-undef warning flag (767ee63) Message-ID: <20161022092207.BE50E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/cpp-undef Link : http://ghc.haskell.org/trac/ghc/changeset/767ee632167271475eb40b1c8bc53ac54c7031e4/ghc >--------------------------------------------------------------- commit 767ee632167271475eb40b1c8bc53ac54c7031e4 Author: Erik de Castro Lopo Date: Sat Oct 22 19:01:49 2016 +1100 Add -Wcpp-undef warning flag Summary: When enabled, this new warning flag passes `-Wundef` to the C pre-processor which causes the pre-processor to warn on uses of the `#if` directive on undefined identifiers. It is not currently enabled in any of the standard warning groups. Test Plan: Add a test to this commit and make sure the test passes on all major platforms. Reviewers: bgamari, hvr, austin, Phyx, carter Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2626 GHC Trac Issues: #12752 >--------------------------------------------------------------- 767ee632167271475eb40b1c8bc53ac54c7031e4 compiler/main/DynFlags.hs | 2 ++ compiler/main/SysTools.hs | 5 ++--- docs/users_guide/using-warnings.rst | 6 ++++++ testsuite/tests/driver/T12752pass.hs | 9 +++++++++ testsuite/tests/driver/all.T | 2 ++ testsuite/tests/driver/should_fail/T12752.hs | 10 ++++++++++ testsuite/tests/driver/should_fail/all.T | 2 ++ 7 files changed, 33 insertions(+), 3 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7978c03..cd8dc41 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -619,6 +619,7 @@ data WarningFlag = | Opt_WarnMissingPatternSynonymSignatures -- since 8.0 | Opt_WarnUnrecognisedWarningFlags -- since 8.0 | Opt_WarnSimplifiableClassConstraints -- Since 8.2 + | Opt_WarnCPPUndef -- Since 8.2 deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -3287,6 +3288,7 @@ wWarningFlagsDeps = [ "it has no effect", depFlagSpec "auto-orphans" Opt_WarnAutoOrphans "it has no effect", + flagSpec "cpp-undef" Opt_WarnCPPUndef, flagSpec "deferred-type-errors" Opt_WarnDeferredTypeErrors, flagSpec "deferred-out-of-scope-variables" Opt_WarnDeferredOutOfScopeVariables, diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index dd98883..d5fd0c5 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -403,9 +403,8 @@ runCpp :: DynFlags -> [Option] -> IO () runCpp dflags args = do let (p,args0) = pgm_P dflags args1 = map Option (getOpts dflags opt_P) - args2 = if gopt Opt_WarnIsError dflags - then [Option "-Werror"] - else [] + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 runSomethingFiltered dflags id "C pre-processor" p (args0 ++ args1 ++ args2 ++ args) mb_env diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index c07058a..c9216b9 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -1007,6 +1007,12 @@ of ``-W(no-)*``. be inlined before the rule has a chance to fire. See :ref:`rules-inline`. +.. ghc-flag:: -Wcpp-undef + + This flag passes ``-Wundef`` to the C pre-processor (if its being used) + which causes the pre-processor to warn on uses of the `#if` directive on + undefined identifiers. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's sanity, not yours.) diff --git a/testsuite/tests/driver/T12752pass.hs b/testsuite/tests/driver/T12752pass.hs new file mode 100644 index 0000000..5826d48 --- /dev/null +++ b/testsuite/tests/driver/T12752pass.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +#if SHOULD_PASS +message :: String +message = "Hello!" +#endif + +main :: IO () +main = putStrLn message diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index c6283df..8cd5c2f 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -497,3 +497,5 @@ test('T10923', extra_clean(['T10923.o', 'T10923.hi']), run_command, ['$MAKE -s --no-print-directory T10923']) + +test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) diff --git a/testsuite/tests/driver/should_fail/T12752.hs b/testsuite/tests/driver/should_fail/T12752.hs new file mode 100644 index 0000000..3560d00 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T12752.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE CPP #-} + +-- This should fail to compile with "ghc -Wcpp-undef -Werror ...". +#if this_cpp_identifier_does_not_exist +message :: String +message = "This is wrong!" +#endif + +main :: IO () +main = putStrLn "Hello" diff --git a/testsuite/tests/driver/should_fail/all.T b/testsuite/tests/driver/should_fail/all.T index f068d65..3d0708b 100644 --- a/testsuite/tests/driver/should_fail/all.T +++ b/testsuite/tests/driver/should_fail/all.T @@ -1,2 +1,4 @@ # --make -o without Main should be an error, not a warning. test('T10895', normal, multimod_compile_fail, ['T10895.hs', '-v0 -o dummy']) + +test('T12752', expect_fail, compile, ['-Wcpp-undef -Werror']) From git at git.haskell.org Sat Oct 22 19:30:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 19:30:16 +0000 (UTC) Subject: [commit: ghc] master: Fix failure in setnumcapabilities001 (#12728) (acc9851) Message-ID: <20161022193016.8815B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/acc98510c5e32474b0bba9fba54e78df2b11078c/ghc >--------------------------------------------------------------- commit acc98510c5e32474b0bba9fba54e78df2b11078c Author: Simon Marlow Date: Fri Oct 21 12:02:57 2016 -0400 Fix failure in setnumcapabilities001 (#12728) The value of enabled_capabilities can change across a call to requestSync(), and we were erroneously using an old value, causing things to go wrong later. It manifested as an assertion failure, I'm not sure whether there are worse consequences or not, but we should get this fix into 8.0.2 anyway. The failure didn't happen for me because it only shows up on machines with fewer than 4 processors, due to the new logic to enable -qn automatically. I've bumped the test parameter 8 to make it more likely to exercise that code. Test Plan: Ran setnumcapabilities001 many times Reviewers: niteria, austin, erikd, rwbarton, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2617 GHC Trac Issues: #12728 >--------------------------------------------------------------- acc98510c5e32474b0bba9fba54e78df2b11078c rts/Schedule.c | 53 ++++++++++++++--------------- testsuite/tests/concurrent/should_run/all.T | 2 +- 2 files changed, 27 insertions(+), 28 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 3cbfc0e..06db3fe 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1562,35 +1562,14 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, gc_type = SYNC_GC_SEQ; } - // If -qn is not set and we have more capabilities than cores, set the - // number of GC threads to #cores. We do this here rather than in - // normaliseRtsOpts() because here it will work if the program calls - // setNumCapabilities. - n_gc_threads = RtsFlags.ParFlags.parGcThreads; - if (n_gc_threads == 0 && enabled_capabilities > getNumberOfProcessors()) { - n_gc_threads = getNumberOfProcessors(); - } - - if (gc_type == SYNC_GC_PAR && n_gc_threads > 0) { - need_idle = stg_max(0, enabled_capabilities - n_gc_threads); - } else { - need_idle = 0; - } - // In order to GC, there must be no threads running Haskell code. - // Therefore, the GC thread needs to hold *all* the capabilities, - // and release them after the GC has completed. - // - // This seems to be the simplest way: previous attempts involved - // making all the threads with capabilities give up their - // capabilities and sleep except for the *last* one, which - // actually did the GC. But it's quite hard to arrange for all - // the other tasks to sleep and stay asleep. + // Therefore, for single-threaded GC, the GC thread needs to hold *all* the + // capabilities, and release them after the GC has completed. For parallel + // GC, we synchronise all the running threads using requestSync(). // - - /* Other capabilities are prevented from running yet more Haskell - threads if pending_sync is set. Tested inside - yieldCapability() and releaseCapability() in Capability.c */ + // Other capabilities are prevented from running yet more Haskell threads if + // pending_sync is set. Tested inside yieldCapability() and + // releaseCapability() in Capability.c PendingSync sync = { .type = gc_type, @@ -1602,6 +1581,26 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, SyncType prev_sync = 0; rtsBool was_syncing; do { + // If -qn is not set and we have more capabilities than cores, set + // the number of GC threads to #cores. We do this here rather than + // in normaliseRtsOpts() because here it will work if the program + // calls setNumCapabilities. + // + n_gc_threads = RtsFlags.ParFlags.parGcThreads; + if (n_gc_threads == 0 && + enabled_capabilities > getNumberOfProcessors()) { + n_gc_threads = getNumberOfProcessors(); + } + + // This calculation must be inside the loop because + // enabled_capabilities may change if requestSync() below fails and + // we retry. + if (gc_type == SYNC_GC_PAR && n_gc_threads > 0) { + need_idle = stg_max(0, enabled_capabilities - n_gc_threads); + } else { + need_idle = 0; + } + // We need an array of size n_capabilities, but since this may // change each time around the loop we must allocate it afresh. idle_cap = (rtsBool *)stgMallocBytes(n_capabilities * diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 6eda000..e3e053e 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -249,7 +249,7 @@ test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', [ only_ways(['threaded1','threaded2']), - extra_run_opts('4 12 2000'), + extra_run_opts('8 12 2000'), req_smp ], compile_and_run, ['']) From git at git.haskell.org Sat Oct 22 19:30:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 19:30:19 +0000 (UTC) Subject: [commit: ghc] master: rts: configure.ac should populate HAVE_LIBNUMA instead of USE_LIBNUMA (1050e46) Message-ID: <20161022193019.389A13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1050e46b5b1640a475fa2fa67616cda8d31308e2/ghc >--------------------------------------------------------------- commit 1050e46b5b1640a475fa2fa67616cda8d31308e2 Author: Darshan Kapashi Date: Fri Oct 21 12:03:19 2016 -0400 rts: configure.ac should populate HAVE_LIBNUMA instead of USE_LIBNUMA Code in rts/ which deals with numa checks for `#if HAVE_LIBNUMA`, however this macro is not populated during `./configure`. https://phabricator.haskell.org/D2329 changed this code last and we instead set `USE_LIBNUMA` which fails to setup numa correctly. Test Plan: From main directory in ghc, ./configure && make clean && make boot && make cd nofib/parallel/queens ../../../inplace/bin/ghc-stage2 Main.hs -rtsopts -threaded ./Main 15 +RTS -N24 -s -A64m --numa This fails before this patch with Main: --numa: OS reports NUMA is not available After the fix, it works as expected. Run the validation script, ./validate (It fails with an error in `compiler/utils/Util.hs` saying `GHC.Stack.CallStack` not found, once I remove this 1 line from this file , the script works) Reviewers: hvr, austin, bgamari, erikd, simonmar Reviewed By: erikd, simonmar Subscribers: mpickering, thomie, erikd, niteria Differential Revision: https://phabricator.haskell.org/D2620 GHC Trac Issues: #12741 >--------------------------------------------------------------- 1050e46b5b1640a475fa2fa67616cda8d31308e2 configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 629624a..5decd24 100644 --- a/configure.ac +++ b/configure.ac @@ -1070,7 +1070,7 @@ AC_CHECK_HEADERS([numa.h numaif.h]) if test "$ac_cv_header_numa_h$ac_cv_header_numaif_h" = "yesyes" ; then AC_CHECK_LIB(numa, numa_available,HaveLibNuma=1) fi -AC_DEFINE_UNQUOTED([USE_LIBNUMA], [$HaveLibNuma], [Define to 1 if you have libnuma]) +AC_DEFINE_UNQUOTED([HAVE_LIBNUMA], [$HaveLibNuma], [Define to 1 if you have libnuma]) dnl ** Documentation dnl -------------------------------------------------------------- From git at git.haskell.org Sat Oct 22 20:24:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 20:24:23 +0000 (UTC) Subject: [commit: ghc] master: Skip T5611 on OSX as it fails non-deterministically. (a662f46) Message-ID: <20161022202423.179613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a662f46c32ce35bd0769aa1ab224c3dfd39e207c/ghc >--------------------------------------------------------------- commit a662f46c32ce35bd0769aa1ab224c3dfd39e207c Author: Matthew Pickering Date: Sat Oct 22 15:36:42 2016 -0400 Skip T5611 on OSX as it fails non-deterministically. Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2622 GHC Trac Issues: #12751 >--------------------------------------------------------------- a662f46c32ce35bd0769aa1ab224c3dfd39e207c testsuite/tests/concurrent/should_run/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index e3e053e..24ea29d 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -75,7 +75,8 @@ test('T5558', compile_and_run, ['']) test('T5421', normal, compile_and_run, ['']) -test('T5611', normal, compile_and_run, ['']) +# See #12751, the test fails non-deterministically so we skip it. +test('T5611', when ( opsys('darwin'), skip) , compile_and_run, ['']) test('T5238', normal, compile_and_run, ['']) test('T5866', exit_code(1), compile_and_run, ['']) From git at git.haskell.org Sat Oct 22 20:24:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 20:24:26 +0000 (UTC) Subject: [commit: ghc] master: Add -Wcpp-undef warning flag (3cb32d8) Message-ID: <20161022202426.6A7313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3cb32d8b0b51c548ab424139c66cce6b37a2ab1b/ghc >--------------------------------------------------------------- commit 3cb32d8b0b51c548ab424139c66cce6b37a2ab1b Author: Erik de Castro Lopo Date: Sat Oct 22 15:38:41 2016 -0400 Add -Wcpp-undef warning flag When enabled, this new warning flag passes `-Wundef` to the C pre-processor which causes the pre-processor to warn on uses of the `#if` directive on undefined identifiers. It is not currently enabled in any of the standard warning groups. Test Plan: Make sure the two tests pass on all major platforms. Reviewers: hvr, carter, Phyx, bgamari, austin Reviewed By: Phyx Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2626 GHC Trac Issues: #12752 >--------------------------------------------------------------- 3cb32d8b0b51c548ab424139c66cce6b37a2ab1b compiler/main/DynFlags.hs | 2 ++ compiler/main/SysTools.hs | 5 ++--- docs/users_guide/8.2.1-notes.rst | 4 ++++ docs/users_guide/using-warnings.rst | 6 ++++++ testsuite/tests/driver/T12752pass.hs | 9 +++++++++ testsuite/tests/driver/all.T | 2 ++ testsuite/tests/driver/should_fail/T12752.hs | 10 ++++++++++ testsuite/tests/driver/should_fail/all.T | 2 ++ 8 files changed, 37 insertions(+), 3 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7978c03..cd8dc41 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -619,6 +619,7 @@ data WarningFlag = | Opt_WarnMissingPatternSynonymSignatures -- since 8.0 | Opt_WarnUnrecognisedWarningFlags -- since 8.0 | Opt_WarnSimplifiableClassConstraints -- Since 8.2 + | Opt_WarnCPPUndef -- Since 8.2 deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -3287,6 +3288,7 @@ wWarningFlagsDeps = [ "it has no effect", depFlagSpec "auto-orphans" Opt_WarnAutoOrphans "it has no effect", + flagSpec "cpp-undef" Opt_WarnCPPUndef, flagSpec "deferred-type-errors" Opt_WarnDeferredTypeErrors, flagSpec "deferred-out-of-scope-variables" Opt_WarnDeferredOutOfScopeVariables, diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index dd98883..d5fd0c5 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -403,9 +403,8 @@ runCpp :: DynFlags -> [Option] -> IO () runCpp dflags args = do let (p,args0) = pgm_P dflags args1 = map Option (getOpts dflags opt_P) - args2 = if gopt Opt_WarnIsError dflags - then [Option "-Werror"] - else [] + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 runSomethingFiltered dflags id "C pre-processor" p (args0 ++ args1 ++ args2 ++ args) mb_env diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index c176a08..8988630 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -56,6 +56,10 @@ Compiler and the latter code has no restrictions about whether the data constructors of ``T`` are in scope. +- Add warning flag :ghc-flag:`-Wcpp-undef` which passes ``-Wundef`` to the C + pre-processor causing the pre-processor to warn on uses of the ``#if`` + directive on undefined identifiers. + GHCi ~~~~ diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index c07058a..c9216b9 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -1007,6 +1007,12 @@ of ``-W(no-)*``. be inlined before the rule has a chance to fire. See :ref:`rules-inline`. +.. ghc-flag:: -Wcpp-undef + + This flag passes ``-Wundef`` to the C pre-processor (if its being used) + which causes the pre-processor to warn on uses of the `#if` directive on + undefined identifiers. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's sanity, not yours.) diff --git a/testsuite/tests/driver/T12752pass.hs b/testsuite/tests/driver/T12752pass.hs new file mode 100644 index 0000000..5826d48 --- /dev/null +++ b/testsuite/tests/driver/T12752pass.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +#if SHOULD_PASS +message :: String +message = "Hello!" +#endif + +main :: IO () +main = putStrLn message diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index c6283df..8cd5c2f 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -497,3 +497,5 @@ test('T10923', extra_clean(['T10923.o', 'T10923.hi']), run_command, ['$MAKE -s --no-print-directory T10923']) + +test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) diff --git a/testsuite/tests/driver/should_fail/T12752.hs b/testsuite/tests/driver/should_fail/T12752.hs new file mode 100644 index 0000000..3560d00 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T12752.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE CPP #-} + +-- This should fail to compile with "ghc -Wcpp-undef -Werror ...". +#if this_cpp_identifier_does_not_exist +message :: String +message = "This is wrong!" +#endif + +main :: IO () +main = putStrLn "Hello" diff --git a/testsuite/tests/driver/should_fail/all.T b/testsuite/tests/driver/should_fail/all.T index f068d65..3d0708b 100644 --- a/testsuite/tests/driver/should_fail/all.T +++ b/testsuite/tests/driver/should_fail/all.T @@ -1,2 +1,4 @@ # --make -o without Main should be an error, not a warning. test('T10895', normal, multimod_compile_fail, ['T10895.hs', '-v0 -o dummy']) + +test('T12752', expect_fail, compile, ['-Wcpp-undef -Werror']) From git at git.haskell.org Sat Oct 22 20:24:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 20:24:29 +0000 (UTC) Subject: [commit: ghc] master: Refactoring: Delete copied function in backpack/NameShape (6e9a51c) Message-ID: <20161022202429.24CD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e9a51c06642d01b52a35d1e6a29c9aa5798f1e8/ghc >--------------------------------------------------------------- commit 6e9a51c06642d01b52a35d1e6a29c9aa5798f1e8 Author: Matthew Pickering Date: Sat Oct 22 15:40:51 2016 -0400 Refactoring: Delete copied function in backpack/NameShape Also moved a few utility functions which work with Avails into the Avail module to avoid import loops and increase discoverability. Reviewers: austin, bgamari, ezyang Reviewed By: ezyang Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2629 >--------------------------------------------------------------- 6e9a51c06642d01b52a35d1e6a29c9aa5798f1e8 compiler/backpack/NameShape.hs | 27 ++------------- compiler/basicTypes/Avail.hs | 74 +++++++++++++++++++++++++++++++++++++++++- compiler/rename/RnNames.hs | 60 ---------------------------------- 3 files changed, 75 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 6e9a51c06642d01b52a35d1e6a29c9aa5798f1e8 From git at git.haskell.org Sat Oct 22 20:24:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 20:24:31 +0000 (UTC) Subject: [commit: ghc] master: cmm/Hoopl/Dataflow: minor cleanup (b76cf04) Message-ID: <20161022202431.C794D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b76cf04e652161f684fa7dbfe8d637e8f2c34e0c/ghc >--------------------------------------------------------------- commit b76cf04e652161f684fa7dbfe8d637e8f2c34e0c Author: Michal Terepeta Date: Sat Oct 22 15:42:04 2016 -0400 cmm/Hoopl/Dataflow: minor cleanup This doesn't have any functional changes, it simply removes one unnecessary top binding and improves the comments. Signed-off-by: Michal Terepeta Test Plan: ./validate Reviewers: austin, bgamari, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2619 >--------------------------------------------------------------- b76cf04e652161f684fa7dbfe8d637e8f2c34e0c compiler/cmm/Hoopl/Dataflow.hs | 66 +++++++++++++++++++++++++----------------- 1 file changed, 40 insertions(+), 26 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index a7475d2..47142d5 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -45,12 +45,6 @@ noFwdRewrite = FwdRewrite3 (noRewrite, noRewrite, noRewrite) noBwdRewrite :: BwdRewrite UniqSM n f noBwdRewrite = BwdRewrite3 (noRewrite, noRewrite, noRewrite) -forwardBlockList :: (NonLocal n) - => [Label] -> Body n -> [Block n C C] --- This produces a list of blocks in order suitable for forward analysis, --- along with the list of Labels it may depend on for facts. -forwardBlockList entries blks = postorder_dfs_from blks entries - ---------------------------------------------------------------- -- Forward Analysis only ---------------------------------------------------------------- @@ -180,19 +174,6 @@ analyzeBwd BwdPass { bp_lattice = lattice, cat :: forall f1 f2 f3 . (f2 -> f3) -> (f1 -> f2) -> (f1 -> f3) cat ft1 ft2 = \f -> ft1 $! ft2 f -{- - -The forward and backward cases are not dual. In the forward case, the -entry points are known, and one simply traverses the body blocks from -those points. In the backward case, something is known about the exit -points, but this information is essentially useless, because we don't -actually have a dual graph (that is, one with edges reversed) to -compute with. (Even if we did have a dual graph, it would not avail -us---a backward analysis must include reachable blocks that don't -reach the exit, as in a procedure that loops forever and has side -effects.) - --} ----------------------------------------------------------------------------- -- fixpoint @@ -284,13 +265,46 @@ we'll propagate (x=4) to L4, and nuke the otherwise-good rewriting of L4. -- Pieces that are shared by fixpoint and fixpoint_anal ----------------------------------------------------------------------------- --- | Sort the blocks into the right order for analysis. -sortBlocks :: NonLocal n => Direction -> [Label] -> LabelMap (Block n C C) - -> [Block n C C] -sortBlocks direction entries blockmap - = case direction of Fwd -> fwd - Bwd -> reverse fwd - where fwd = forwardBlockList entries blockmap +-- | Sort the blocks into the right order for analysis. This means reverse +-- postorder for a forward analysis. For the backward one, we simply reverse +-- that (see Note [Backward vs forward analysis]). +-- +-- Note: We're using Hoopl's confusingly named `postorder_dfs_from` but AFAICS +-- it returns the *reverse* postorder of the blocks (it visits blocks in the +-- postorder and uses (:) to collect them, which gives the reverse of the +-- visitation order). +sortBlocks + :: NonLocal n + => Direction -> [Label] -> LabelMap (Block n C C) -> [Block n C C] +sortBlocks direction entries blockmap = + case direction of + Fwd -> fwd + Bwd -> reverse fwd + where + fwd = postorder_dfs_from blockmap entries + +-- Note [Backward vs forward analysis] +-- +-- The forward and backward cases are not dual. In the forward case, the entry +-- points are known, and one simply traverses the body blocks from those points. +-- In the backward case, something is known about the exit points, but a +-- backward analysis must also include reachable blocks that don't reach the +-- exit, as in a procedure that loops forever and has side effects.) +-- For instance, let E be the entry and X the exit blocks (arrows indicate +-- control flow) +-- E -> X +-- E -> B +-- B -> C +-- C -> B +-- We do need to include B and C even though they're unreachable in the +-- *reverse* graph (that we could use for backward analysis): +-- E <- X +-- E <- B +-- B <- C +-- C <- B +-- So when sorting the blocks for the backward analysis, we simply take the +-- reverse of what is used for the forward one. + -- | construct a mapping from L -> block indices. If the fact for L -- changes, re-analyse the given blocks. From git at git.haskell.org Sat Oct 22 20:37:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 20:37:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Test for newtype with unboxed argument (4c8aab8) Message-ID: <20161022203743.8D8543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4c8aab8f5663b9f0f1acdcc1afc85d921f2609d6/ghc >--------------------------------------------------------------- commit 4c8aab8f5663b9f0f1acdcc1afc85d921f2609d6 Author: Simon Peyton Jones Date: Wed Oct 19 12:22:11 2016 +0100 Test for newtype with unboxed argument Newtypes cannot (currently) have an unboxed argument type. But Trac #12729 showed that this was only being checked for newtypes in H98 syntax; in GADT snytax they were let through. This patch moves the test to checkValidDataCon, where it properly belongs. (cherry picked from commit 1f09c16c38a2112322d8eab95cd1269daaf5a818) >--------------------------------------------------------------- 4c8aab8f5663b9f0f1acdcc1afc85d921f2609d6 compiler/typecheck/TcHsType.hs | 13 +----- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcTyClsDecls.hs | 47 ++++++++++++---------- testsuite/tests/typecheck/should_fail/T12729.hs | 11 +++++ .../tests/typecheck/should_fail/T12729.stderr | 10 +++++ testsuite/tests/typecheck/should_fail/all.T | 1 + .../tests/typecheck/should_fail/tcfail079.stderr | 9 ++--- 7 files changed, 53 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 4c8aab8f5663b9f0f1acdcc1afc85d921f2609d6 From git at git.haskell.org Sat Oct 22 20:37:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 20:37:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add and use a new dynamic-library-dirs field in the ghc-pkg info (9448e62) Message-ID: <20161022203746.815223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9448e62740ca03aeb915bf0ecf8b16e54a52798a/ghc >--------------------------------------------------------------- commit 9448e62740ca03aeb915bf0ecf8b16e54a52798a Author: Duncan Coutts Date: Sat Oct 22 13:52:40 2016 -0400 Add and use a new dynamic-library-dirs field in the ghc-pkg info Build systems / package managers want to be able to control the file layout of installed libraries. In general they may want/need to be able to put the static libraries and dynamic libraries in different places. The ghc-pkg library regisrtation needs to be able to handle this. This is already possible in principle by listing both a static lib dir and a dynamic lib dir in the library-dirs field (indeed some previous versions of Cabal did this for shared libs on ELF platforms). The downside of listing both dirs is twofold. There is a lack of precision, if we're not careful with naming then we could end up picking up the wrong library. The more immediate problem however is that if we list both directories then both directories get included into the ELF and Mach-O shared object runtime search paths. On ELF this merely slows down loading of shared libs (affecting prog startup time). On the latest OSX versions this provokes a much more serious problem: that there is a rather low limit on the total size of the section containing the runtime search path (and lib names and related) and thus listing any unnecessary directories wastes the limited space. So the solution in this patch is fairly straightforward: split the static and dynamic library search paths in the ghc-pkg db and its use within ghc. This is a traditional solution: pkg-config has the same static / dynamic split (though it describes in in terms of private and public, but it translates into different behaviour for static and dynamic linking). Indeed it would make perfect sense to also have a static/dynamic split for the list of the libraries to use i.e. to have dynamic variants of the hs-libraries and extra-libraries fields. These are not immediately required so this patch does not add it, but it is a reasonable direction to follow. To handle compatibility, if the new dynamic-library-dirs field is not specified then its value is taken from the library-dirs field. Contains Cabal submodule update. Test Plan: Run ./validate Get christiaanb and carter to test it on OSX Sierra, in combination with Cabal/cabal-install changes to the default file layout for libraries. Reviewers: carter, bgamari, hvr, austin, christiaanb Subscribers: thomie, Phyx, ezyang Differential Revision: https://phabricator.haskell.org/D2625 GHC Trac Issues: #12479 >--------------------------------------------------------------- 9448e62740ca03aeb915bf0ecf8b16e54a52798a compiler/ghci/Linker.hs | 3 ++- compiler/main/DriverPipeline.hs | 2 +- compiler/main/PackageConfig.hs | 1 + compiler/main/Packages.hs | 33 +++++++++++++++++++++++++++++---- compiler/main/SysTools.hs | 2 +- libraries/Cabal | 2 +- libraries/ghc-boot/GHC/PackageDb.hs | 10 ++++++++-- utils/ghc-cabal/Main.hs | 4 ++++ utils/ghc-pkg/Main.hs | 4 +++- 9 files changed, 50 insertions(+), 11 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 9448e62740ca03aeb915bf0ecf8b16e54a52798a From git at git.haskell.org Sat Oct 22 21:13:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 21:13:28 +0000 (UTC) Subject: [commit: ghc] branch 'wip/erikd/cpp-undef' deleted Message-ID: <20161022211328.5E8173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/erikd/cpp-undef From git at git.haskell.org Sat Oct 22 23:21:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 23:21:13 +0000 (UTC) Subject: [commit: ghc] master: rts/package.conf.in: Fix CPP usage (aaede1e) Message-ID: <20161022232113.5E9ED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aaede1ec8265f3b4f8effbf33f7fd77eb7f87f99/ghc >--------------------------------------------------------------- commit aaede1ec8265f3b4f8effbf33f7fd77eb7f87f99 Author: Erik de Castro Lopo Date: Sun Oct 23 00:16:10 2016 +0100 rts/package.conf.in: Fix CPP usage Summary: The configure script sets `HAVE_LIBNUMA` to either `0` or `1` but this file had `#ifdef HAVE_LIBNUMA`. This surfaced as a side-effect of 1050e46b5b. CPP is really hard to get right. Test Plan: Validate on harbourmaster Reviewers: simonmar, bgamari, austin, mpickering Reviewed By: mpickering Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2631 >--------------------------------------------------------------- aaede1ec8265f3b4f8effbf33f7fd77eb7f87f99 rts/package.conf.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/package.conf.in b/rts/package.conf.in index 03848c4..5d8ab8b 100644 --- a/rts/package.conf.in +++ b/rts/package.conf.in @@ -37,7 +37,7 @@ extra-libraries: #ifdef HAVE_LIBFFI , "ffi" #endif -#ifdef HAVE_LIBNUMA +#if HAVE_LIBNUMA , "numa" #endif #ifdef mingw32_HOST_OS From git at git.haskell.org Sat Oct 22 23:30:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Oct 2016 23:30:23 +0000 (UTC) Subject: [commit: ghc] master: Refactoring: Replace when (not ...) with unless in ErrUtils (a6bcf87) Message-ID: <20161022233023.0FF833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6bcf8783ff758a82d003ea8f669d7216695fa59/ghc >--------------------------------------------------------------- commit a6bcf8783ff758a82d003ea8f669d7216695fa59 Author: Matthew Pickering Date: Sun Oct 23 00:22:30 2016 +0100 Refactoring: Replace when (not ...) with unless in ErrUtils [skip ci] >--------------------------------------------------------------- a6bcf8783ff758a82d003ea8f669d7216695fa59 compiler/main/ErrUtils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 9a4c7fc..41150a6 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -356,7 +356,7 @@ dumpSDoc dflags print_unqual flag hdr doc gd <- readIORef gdref let append = Set.member fileName gd mode = if append then AppendMode else WriteMode - when (not append) $ + unless append $ writeIORef gdref (Set.insert fileName gd) createDirectoryIfMissing True (takeDirectory fileName) handle <- openFile fileName mode From git at git.haskell.org Sun Oct 23 18:05:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Oct 2016 18:05:30 +0000 (UTC) Subject: [commit: ghc] master: rts: Move path utilities to separate source file (f084e68) Message-ID: <20161023180530.8F93B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f084e6845515fbfb774a09ae5d2af1eea8fdc3f0/ghc >--------------------------------------------------------------- commit f084e6845515fbfb774a09ae5d2af1eea8fdc3f0 Author: Ben Gamari Date: Sun Oct 23 14:03:48 2016 -0400 rts: Move path utilities to separate source file Test Plan: Validate Reviewers: simonmar, austin, erikd Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2614 >--------------------------------------------------------------- f084e6845515fbfb774a09ae5d2af1eea8fdc3f0 rts/Linker.c | 84 +-------------------------------------------------------- rts/PathUtils.c | 68 ++++++++++++++++++++++++++++++++++++++++++++++ rts/PathUtils.h | 43 +++++++++++++++++++++++++++++ 3 files changed, 112 insertions(+), 83 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index 3eeb46e..7600ba8 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -28,6 +28,7 @@ #include "Profiling.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" +#include "PathUtils.h" #if !defined(mingw32_HOST_OS) #include "posix/Signals.h" @@ -45,7 +46,6 @@ #include #include #include -#include #ifdef HAVE_SYS_STAT_H #include @@ -231,81 +231,6 @@ static ObjectCode* mkOc( pathchar *path, char *image, int imageSize, int misalignment ); -// Use wchar_t for pathnames on Windows (#5697) -#if defined(mingw32_HOST_OS) -#define pathcmp wcscmp -#define pathlen wcslen -#define pathopen _wfopen -#define pathstat _wstat -#define struct_stat struct _stat -#define open wopen -#define WSTR(s) L##s -#define pathprintf swprintf -#define pathsize sizeof(wchar_t) -#else -#define pathcmp strcmp -#define pathlen strlen -#define pathopen fopen -#define pathstat stat -#define struct_stat struct stat -#define WSTR(s) s -#define pathprintf snprintf -#define pathsize sizeof(char) -#endif - -static pathchar* pathdup(pathchar *path) -{ - pathchar *ret; -#if defined(mingw32_HOST_OS) - ret = wcsdup(path); -#else - /* sigh, strdup() isn't a POSIX function, so do it the long way */ - ret = stgMallocBytes( strlen(path)+1, "pathdup" ); - strcpy(ret, path); -#endif - return ret; -} - -static pathchar* pathdir(pathchar *path) -{ - pathchar *ret; -#if defined(mingw32_HOST_OS) - pathchar *drive, *dirName; - size_t memberLen = pathlen(path) + 1; - dirName = stgMallocBytes(pathsize * memberLen, "pathdir(path)"); - ret = stgMallocBytes(pathsize * memberLen, "pathdir(path)"); - drive = stgMallocBytes(pathsize * _MAX_DRIVE, "pathdir(path)"); - _wsplitpath_s(path, drive, _MAX_DRIVE, dirName, pathsize * pathlen(path), NULL, 0, NULL, 0); - pathprintf(ret, memberLen, WSTR("%" PATH_FMT "%" PATH_FMT), drive, dirName); - stgFree(drive); - stgFree(dirName); -#else - pathchar* dirName = dirname(path); - size_t memberLen = pathlen(dirName); - ret = stgMallocBytes(pathsize * (memberLen + 2), "pathdir(path)"); - strcpy(ret, dirName); - ret[memberLen ] = '/'; - ret[memberLen+1] = '\0'; -#endif - return ret; -} - -static pathchar* mkPath(char* path) -{ -#if defined(mingw32_HOST_OS) - size_t required = mbstowcs(NULL, path, 0); - pathchar *ret = stgMallocBytes(sizeof(pathchar) * (required + 1), "mkPath"); - if (mbstowcs(ret, path, required) == (size_t)-1) - { - barf("mkPath failed converting char* to wchar_t*"); - } - ret[required] = '\0'; - return ret; -#else - return pathdup(path); -#endif -} - /* Generic wrapper function to try and Resolve and RunInit oc files */ int ocTryLoad( ObjectCode* oc ); @@ -361,13 +286,6 @@ static void machoInitSymbolsWithoutUnderscore( void ); #endif #if defined(OBJFORMAT_PEi386) -/* string utility function */ -static HsBool endsWithPath(pathchar* base, pathchar* str) { - int blen = pathlen(base); - int slen = pathlen(str); - return (blen >= slen) && (0 == pathcmp(base + blen - slen, str)); -} - static int checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, diff --git a/rts/PathUtils.c b/rts/PathUtils.c new file mode 100644 index 0000000..f27e03f --- /dev/null +++ b/rts/PathUtils.c @@ -0,0 +1,68 @@ +#include +#include + +#include +#include "RtsUtils.h" +#include "PathUtils.h" + +#include +#include + +pathchar* pathdup(pathchar *path) +{ + pathchar *ret; +#if defined(mingw32_HOST_OS) + ret = wcsdup(path); +#else + /* sigh, strdup() isn't a POSIX function, so do it the long way */ + ret = stgMallocBytes( strlen(path)+1, "pathdup" ); + strcpy(ret, path); +#endif + return ret; +} + +pathchar* pathdir(pathchar *path) +{ + pathchar *ret; +#if defined(mingw32_HOST_OS) + pathchar *drive, *dirName; + size_t memberLen = pathlen(path) + 1; + dirName = stgMallocBytes(pathsize * memberLen, "pathdir(path)"); + ret = stgMallocBytes(pathsize * memberLen, "pathdir(path)"); + drive = stgMallocBytes(pathsize * _MAX_DRIVE, "pathdir(path)"); + _wsplitpath_s(path, drive, _MAX_DRIVE, dirName, pathsize * pathlen(path), NULL, 0, NULL, 0); + pathprintf(ret, memberLen, WSTR("%" PATH_FMT "%" PATH_FMT), drive, dirName); + stgFree(drive); + stgFree(dirName); +#else + pathchar* dirName = dirname(path); + size_t memberLen = pathlen(dirName); + ret = stgMallocBytes(pathsize * (memberLen + 2), "pathdir(path)"); + strcpy(ret, dirName); + ret[memberLen ] = '/'; + ret[memberLen+1] = '\0'; +#endif + return ret; +} + +pathchar* mkPath(char* path) +{ +#if defined(mingw32_HOST_OS) + size_t required = mbstowcs(NULL, path, 0); + pathchar *ret = stgMallocBytes(sizeof(pathchar) * (required + 1), "mkPath"); + if (mbstowcs(ret, path, required) == (size_t)-1) + { + barf("mkPath failed converting char* to wchar_t*"); + } + ret[required] = '\0'; + return ret; +#else + return pathdup(path); +#endif +} + +HsBool endsWithPath(pathchar* base, pathchar* str) { + int blen = pathlen(base); + int slen = pathlen(str); + return (blen >= slen) && (0 == pathcmp(base + blen - slen, str)); +} diff --git a/rts/PathUtils.h b/rts/PathUtils.h new file mode 100644 index 0000000..4821938 --- /dev/null +++ b/rts/PathUtils.h @@ -0,0 +1,43 @@ +/* --------------------------------------------------------------------------- + * + * (c) The GHC Team, 2001-2016 + * + * Platform-independent path manipulation utilities + * + * --------------------------------------------------------------------------*/ + +#ifndef PATH_UTILS_H +#define PATH_UTILS_H + +#include "BeginPrivate.h" + +// Use wchar_t for pathnames on Windows (#5697) +#if defined(mingw32_HOST_OS) +#define pathcmp wcscmp +#define pathlen wcslen +#define pathopen _wfopen +#define pathstat _wstat +#define struct_stat struct _stat +#define open wopen +#define WSTR(s) L##s +#define pathprintf swprintf +#define pathsize sizeof(wchar_t) +#else +#define pathcmp strcmp +#define pathlen strlen +#define pathopen fopen +#define pathstat stat +#define struct_stat struct stat +#define WSTR(s) s +#define pathprintf snprintf +#define pathsize sizeof(char) +#endif + +pathchar* pathdup(pathchar *path); +pathchar* pathdir(pathchar *path); +pathchar* mkPath(char* path); +HsBool endsWithPath(pathchar* base, pathchar* str); + +#include "EndPrivate.h" + +#endif /* PATH_UTILS_H */ From git at git.haskell.org Mon Oct 24 07:36:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 07:36:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/spj-tc-branch3' created Message-ID: <20161024073642.B070B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/spj-tc-branch3 Referencing: 5cd257c13758da5469fd3044dc48ce5ad12c55e9 From git at git.haskell.org Mon Oct 24 07:36:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 07:36:45 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: Delete bogus comments (1f76501) Message-ID: <20161024073645.674CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/1f7650172e75df640c636282dca4db78d98ca139/ghc >--------------------------------------------------------------- commit 1f7650172e75df640c636282dca4db78d98ca139 Author: Simon Peyton Jones Date: Mon Oct 17 23:41:07 2016 +0100 Delete bogus comments >--------------------------------------------------------------- 1f7650172e75df640c636282dca4db78d98ca139 compiler/typecheck/TcSimplify.hs | 28 ---------------------------- 1 file changed, 28 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index ddf0bce..feb7e65 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1093,11 +1093,6 @@ solveWanteds :: WantedConstraints -> TcS WantedConstraints solveWanteds wc@(WC { wc_simple = simples, wc_insol = insols, wc_impl = implics }) = do { traceTcS "solveWanteds {" (ppr wc) - -- Try the simple bit, including insolubles. Solving insolubles a - -- second time round is a bit of a waste; but the code is simple - -- and the program is wrong anyway, and we don't run the danger - -- of adding Derived insolubles twice; see - -- TcSMonad Note [Do not add duplicate derived insolubles] ; wc1 <- solveSimpleWanteds simples ; (no_new_scs, wc1) <- expandSuperClasses wc1 ; let WC { wc_simple = simples1, wc_insol = insols1, wc_impl = implics1 } = wc1 @@ -1766,29 +1761,6 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: in (g1 '3', g2 undefined) -Note [Solving Family Equations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -After we are done with simplification we may be left with constraints of the form: - [Wanted] F xis ~ beta -If 'beta' is a touchable unification variable not already bound in the TyBinds -then we'd like to create a binding for it, effectively "defaulting" it to be 'F xis'. - -When is it ok to do so? - 1) 'beta' must not already be defaulted to something. Example: - - [Wanted] F Int ~ beta <~ Will default [beta := F Int] - [Wanted] F Char ~ beta <~ Already defaulted, can't default again. We - have to report this as unsolved. - - 2) However, we must still do an occurs check when defaulting (F xis ~ beta), to - set [beta := F xis] only if beta is not among the free variables of xis. - - 3) Notice that 'beta' can't be bound in ty binds already because we rewrite RHS - of type family equations. See Inert Set invariants in TcInteract. - -This solving is now happening during zonking, see Note [Unflattening while zonking] -in TcMType. - ********************************************************************************* * * From git at git.haskell.org Mon Oct 24 07:36:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 07:36:48 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: SPJ work in progress (5cd257c) Message-ID: <20161024073648.26A053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/5cd257c13758da5469fd3044dc48ce5ad12c55e9/ghc >--------------------------------------------------------------- commit 5cd257c13758da5469fd3044dc48ce5ad12c55e9 Author: Simon Peyton Jones Date: Mon Oct 24 08:32:16 2016 +0100 SPJ work in progress The main idea here is to generate Derived constraints only when we've failed to solve the Wanteds. This is much mroe economical; often we don't need to generate any at all. And the code is a lot simpler >--------------------------------------------------------------- 5cd257c13758da5469fd3044dc48ce5ad12c55e9 compiler/typecheck/TcCanonical.hs | 18 ++- compiler/typecheck/TcFlatten.hs | 7 +- compiler/typecheck/TcInteract.hs | 43 ++++-- compiler/typecheck/TcMType.hs | 20 ++- compiler/typecheck/TcRnTypes.hs | 37 +---- compiler/typecheck/TcRules.hs | 11 +- compiler/typecheck/TcSMonad.hs | 172 ++++++++++++--------- compiler/typecheck/TcSimplify.hs | 115 +++++++------- .../indexed-types/should_compile/T3017.stderr | 2 +- .../tests/indexed-types/should_compile/T4338.hs | 35 ++++- .../tests/indexed-types/should_fail/T4174.stderr | 4 +- .../tests/indexed-types/should_fail/T4179.stderr | 6 +- .../tests/typecheck/should_compile/Improvement.hs | 4 + testsuite/tests/typecheck/should_compile/T6018.hs | 13 ++ .../tests/typecheck/should_compile/T6018.stderr | 8 +- testsuite/tests/typecheck/should_fail/Makefile | 5 + testsuite/tests/typecheck/should_fail/T5691.stderr | 10 +- .../tests/typecheck/should_fail/T7748a.stderr | 6 +- 18 files changed, 296 insertions(+), 220 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 5cd257c13758da5469fd3044dc48ce5ad12c55e9 From git at git.haskell.org Mon Oct 24 16:32:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:32:12 +0000 (UTC) Subject: [commit: ghc] master: Prioritise class-level equality costraints (1c4a39d) Message-ID: <20161024163212.55EC23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c4a39d3a8d36803382792ff78b4709794358883/ghc >--------------------------------------------------------------- commit 1c4a39d3a8d36803382792ff78b4709794358883 Author: Simon Peyton Jones Date: Mon Oct 24 16:55:49 2016 +0100 Prioritise class-level equality costraints This patch fixes Trac #12734 by prioritising the class-level variants of equality constraints, namely (a~b) and (a~~b). See comment:10 of Trac #12734 for a description of what went wrong, and Note [Prioritise class equalities] in TcSMonad. The fix is still not great, but it's a definite step forward, and cures the particular problem. Worth merging to 8.0. >--------------------------------------------------------------- 1c4a39d3a8d36803382792ff78b4709794358883 compiler/typecheck/TcSMonad.hs | 31 +++++- testsuite/tests/typecheck/should_compile/T12734.hs | 92 ++++++++++++++++++ .../tests/typecheck/should_compile/T12734a.hs | 104 +++++++++++++++++++++ .../tests/typecheck/should_compile/T12734a.stderr | 9 ++ testsuite/tests/typecheck/should_compile/all.T | 2 + 5 files changed, 237 insertions(+), 1 deletion(-) 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 1c4a39d3a8d36803382792ff78b4709794358883 From git at git.haskell.org Mon Oct 24 16:32:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:32:15 +0000 (UTC) Subject: [commit: ghc] master: Don't instantaite when typechecking a pattern synonym (1221f81) Message-ID: <20161024163215.08C3C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1221f8104bb5123c18bd5b840cde9ab2e71247d5/ghc >--------------------------------------------------------------- commit 1221f8104bb5123c18bd5b840cde9ab2e71247d5 Author: Simon Peyton Jones Date: Mon Oct 24 16:59:03 2016 +0100 Don't instantaite when typechecking a pattern synonym Fixes most of the cases in Trac #12762 >--------------------------------------------------------------- 1221f8104bb5123c18bd5b840cde9ab2e71247d5 compiler/typecheck/TcPatSyn.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 05d98ff..81c5e2c 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -72,7 +72,7 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, ; let (arg_names, rec_fields, is_infix) = collectPatSynArgInfo details ; (tclvl, wanted, ((lpat', args), pat_ty)) <- pushLevelAndCaptureConstraints $ - tcInferInst $ \ exp_ty -> + tcInferNoInst $ \ exp_ty -> tcPat PatSyn lpat exp_ty $ mapM tcLookupId arg_names From git at git.haskell.org Mon Oct 24 16:32:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:32:17 +0000 (UTC) Subject: [commit: ghc] master: Take account of kinds in promoteTcType (08ba691) Message-ID: <20161024163217.CABB83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/08ba691ad55f30e67466628125244392c48ce1ab/ghc >--------------------------------------------------------------- commit 08ba691ad55f30e67466628125244392c48ce1ab Author: Simon Peyton Jones Date: Mon Oct 24 17:01:41 2016 +0100 Take account of kinds in promoteTcType One of the ASSERT failures in Trac #12762, namely the one for T4439, showed that I had not dealt correctly with promoting the kind of a type in promoteTcType. Happily I could fix this by simplifying InferRes (eliminating the ir_kind field), so things get better. And the ASSERT is fixed. >--------------------------------------------------------------- 08ba691ad55f30e67466628125244392c48ce1ab compiler/typecheck/TcExpr.hs | 5 +- compiler/typecheck/TcHsType.hs | 30 ++--- compiler/typecheck/TcMType.hs | 150 ++++----------------- compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcType.hs | 6 +- compiler/typecheck/TcUnify.hs | 148 +++++++++++++++++--- testsuite/tests/gadt/gadt7.stderr | 6 +- .../tests/indexed-types/should_fail/T2664.stderr | 28 ++-- .../tests/indexed-types/should_fail/T9662.stderr | 4 +- testsuite/tests/polykinds/T7438.stderr | 6 +- testsuite/tests/polykinds/T9222.stderr | 2 - 11 files changed, 196 insertions(+), 191 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 08ba691ad55f30e67466628125244392c48ce1ab From git at git.haskell.org Mon Oct 24 16:32:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:32:21 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12174 (03b0b8e) Message-ID: <20161024163221.107133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/03b0b8e43ff43365fc52a92d8ff18558f4ee8202/ghc >--------------------------------------------------------------- commit 03b0b8e43ff43365fc52a92d8ff18558f4ee8202 Author: Simon Peyton Jones Date: Mon Oct 24 17:31:43 2016 +0100 Test Trac #12174 >--------------------------------------------------------------- 03b0b8e43ff43365fc52a92d8ff18558f4ee8202 testsuite/tests/dependent/should_fail/T12174.hs | 9 +++++++++ testsuite/tests/dependent/should_fail/T12174.stderr | 7 +++++++ testsuite/tests/dependent/should_fail/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/dependent/should_fail/T12174.hs b/testsuite/tests/dependent/should_fail/T12174.hs new file mode 100644 index 0000000..29064d6 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T12174.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeInType #-} +module T12174 where + +data V a +data T = forall (a :: S). MkT (V a) +data S = forall (a :: T). MkS (V a) diff --git a/testsuite/tests/dependent/should_fail/T12174.stderr b/testsuite/tests/dependent/should_fail/T12174.stderr new file mode 100644 index 0000000..8680461 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T12174.stderr @@ -0,0 +1,7 @@ + +T12174.hs:9:23: error: + • Type constructor ‘T’ cannot be used here + (it is defined and used in the same recursive group) + • In the kind ‘T’ + In the definition of data constructor ‘MkS’ + In the data declaration for ‘S’ diff --git a/testsuite/tests/dependent/should_fail/all.T b/testsuite/tests/dependent/should_fail/all.T index e2777a4..f1ed340 100644 --- a/testsuite/tests/dependent/should_fail/all.T +++ b/testsuite/tests/dependent/should_fail/all.T @@ -14,3 +14,4 @@ test('InferDependency', normal, compile_fail, ['']) test('KindLevelsB', normal, compile_fail, ['']) test('T11473', normal, compile_fail, ['']) test('T11471', normal, compile_fail, ['']) +test('T12174', normal, compile_fail, ['']) From git at git.haskell.org Mon Oct 24 16:37:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:37:37 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12081 (853cdae) Message-ID: <20161024163737.7478C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/853cdaea7f8724cd071f4fa7ad6c5377a2a8a6e4/ghc >--------------------------------------------------------------- commit 853cdaea7f8724cd071f4fa7ad6c5377a2a8a6e4 Author: Simon Peyton Jones Date: Mon Oct 24 17:37:16 2016 +0100 Test Trac #12081 >--------------------------------------------------------------- 853cdaea7f8724cd071f4fa7ad6c5377a2a8a6e4 testsuite/tests/dependent/should_fail/T12081.hs | 9 +++++++++ testsuite/tests/dependent/should_fail/T12081.stderr | 7 +++++++ testsuite/tests/dependent/should_fail/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/dependent/should_fail/T12081.hs b/testsuite/tests/dependent/should_fail/T12081.hs new file mode 100644 index 0000000..f68de42 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T12081.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeInType #-} + +module T12081 where + +data Nat = Z | S Nat + +class C (n :: Nat) where + type T n :: Nat + f :: (a :: T n) diff --git a/testsuite/tests/dependent/should_fail/T12081.stderr b/testsuite/tests/dependent/should_fail/T12081.stderr new file mode 100644 index 0000000..77d5a40 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T12081.stderr @@ -0,0 +1,7 @@ + +T12081.hs:9:14: error: + • Type constructor ‘T’ cannot be used here + (it is defined and used in the same recursive group) + • In the kind ‘T n’ + In the type signature: f :: (a :: T n) + In the class declaration for ‘C’ diff --git a/testsuite/tests/dependent/should_fail/all.T b/testsuite/tests/dependent/should_fail/all.T index f1ed340..b9c82f1 100644 --- a/testsuite/tests/dependent/should_fail/all.T +++ b/testsuite/tests/dependent/should_fail/all.T @@ -15,3 +15,4 @@ test('KindLevelsB', normal, compile_fail, ['']) test('T11473', normal, compile_fail, ['']) test('T11471', normal, compile_fail, ['']) test('T12174', normal, compile_fail, ['']) +test('T12081', normal, compile_fail, ['']) From git at git.haskell.org Mon Oct 24 16:46:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:46:13 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: Delete bogus comments (ce20685) Message-ID: <20161024164613.3B1583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/ce206851a0ab5136b3551e0a5c6e9a8b1b5002a5/ghc >--------------------------------------------------------------- commit ce206851a0ab5136b3551e0a5c6e9a8b1b5002a5 Author: Simon Peyton Jones Date: Mon Oct 17 23:41:07 2016 +0100 Delete bogus comments >--------------------------------------------------------------- ce206851a0ab5136b3551e0a5c6e9a8b1b5002a5 compiler/typecheck/TcSimplify.hs | 28 ---------------------------- 1 file changed, 28 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index ddf0bce..feb7e65 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1093,11 +1093,6 @@ solveWanteds :: WantedConstraints -> TcS WantedConstraints solveWanteds wc@(WC { wc_simple = simples, wc_insol = insols, wc_impl = implics }) = do { traceTcS "solveWanteds {" (ppr wc) - -- Try the simple bit, including insolubles. Solving insolubles a - -- second time round is a bit of a waste; but the code is simple - -- and the program is wrong anyway, and we don't run the danger - -- of adding Derived insolubles twice; see - -- TcSMonad Note [Do not add duplicate derived insolubles] ; wc1 <- solveSimpleWanteds simples ; (no_new_scs, wc1) <- expandSuperClasses wc1 ; let WC { wc_simple = simples1, wc_insol = insols1, wc_impl = implics1 } = wc1 @@ -1766,29 +1761,6 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: in (g1 '3', g2 undefined) -Note [Solving Family Equations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -After we are done with simplification we may be left with constraints of the form: - [Wanted] F xis ~ beta -If 'beta' is a touchable unification variable not already bound in the TyBinds -then we'd like to create a binding for it, effectively "defaulting" it to be 'F xis'. - -When is it ok to do so? - 1) 'beta' must not already be defaulted to something. Example: - - [Wanted] F Int ~ beta <~ Will default [beta := F Int] - [Wanted] F Char ~ beta <~ Already defaulted, can't default again. We - have to report this as unsolved. - - 2) However, we must still do an occurs check when defaulting (F xis ~ beta), to - set [beta := F xis] only if beta is not among the free variables of xis. - - 3) Notice that 'beta' can't be bound in ty binds already because we rewrite RHS - of type family equations. See Inert Set invariants in TcInteract. - -This solving is now happening during zonking, see Note [Unflattening while zonking] -in TcMType. - ********************************************************************************* * * From git at git.haskell.org Mon Oct 24 16:46:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:46:16 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: SPJ work in progress (d387268) Message-ID: <20161024164616.02CCE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/d38726877c85b686eb27fe99188a29f0f3865003/ghc >--------------------------------------------------------------- commit d38726877c85b686eb27fe99188a29f0f3865003 Author: Simon Peyton Jones Date: Mon Oct 24 08:32:16 2016 +0100 SPJ work in progress The main idea here is to generate Derived constraints only when we've failed to solve the Wanteds. This is much mroe economical; often we don't need to generate any at all. And the code is a lot simpler >--------------------------------------------------------------- d38726877c85b686eb27fe99188a29f0f3865003 compiler/typecheck/TcCanonical.hs | 18 ++- compiler/typecheck/TcFlatten.hs | 7 +- compiler/typecheck/TcInteract.hs | 43 +++-- compiler/typecheck/TcMType.hs | 20 ++- compiler/typecheck/TcRnTypes.hs | 37 +---- compiler/typecheck/TcRules.hs | 11 +- compiler/typecheck/TcSMonad.hs | 174 ++++++++++++--------- compiler/typecheck/TcSimplify.hs | 115 ++++++-------- .../indexed-types/should_compile/T3017.stderr | 2 +- .../tests/indexed-types/should_compile/T4338.hs | 35 ++++- .../tests/indexed-types/should_fail/T4174.stderr | 4 +- .../tests/indexed-types/should_fail/T4179.stderr | 6 +- .../tests/typecheck/should_compile/Improvement.hs | 4 + testsuite/tests/typecheck/should_compile/T6018.hs | 13 ++ .../tests/typecheck/should_compile/T6018.stderr | 8 +- testsuite/tests/typecheck/should_fail/Makefile | 5 + testsuite/tests/typecheck/should_fail/T5691.stderr | 10 +- .../tests/typecheck/should_fail/T7748a.stderr | 6 +- 18 files changed, 297 insertions(+), 221 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 d38726877c85b686eb27fe99188a29f0f3865003 From git at git.haskell.org Mon Oct 24 16:46:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:46:18 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: More work in progress (03c0046) Message-ID: <20161024164618.B128A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/03c00464cc0693287d9ba2629b9e425d8ea3bc39/ghc >--------------------------------------------------------------- commit 03c00464cc0693287d9ba2629b9e425d8ea3bc39 Author: Simon Peyton Jones Date: Mon Oct 24 17:43:45 2016 +0100 More work in progress This patch incorporate wip/spj-solver-branch, which mainly concerns - Putting 'fuv' meta variables on the left, always - Some changes to unflattening This makes indexed-tupes/should_compile/T4338 polykinds/T11249 work again >--------------------------------------------------------------- 03c00464cc0693287d9ba2629b9e425d8ea3bc39 compiler/typecheck/TcFlatten.hs | 143 +++++++++++++-------- compiler/typecheck/TcInteract.hs | 43 ++++--- compiler/typecheck/TcRnTypes.hs | 3 +- compiler/typecheck/TcSMonad.hs | 9 +- compiler/typecheck/TcUnify.hs | 3 + .../tests/indexed-types/should_fail/T1897b.stderr | 2 +- .../tests/indexed-types/should_fail/T2544.stderr | 24 +--- .../tests/indexed-types/should_fail/T2627b.stderr | 4 +- .../tests/indexed-types/should_fail/T3330c.stderr | 6 +- .../tests/indexed-types/should_fail/T6123.stderr | 6 +- testsuite/tests/indexed-types/should_fail/T7786.hs | 16 ++- .../tests/indexed-types/should_fail/T7786.stderr | 43 +++---- .../tests/indexed-types/should_fail/T8227.stderr | 11 +- .../tests/typecheck/should_fail/ContextStack2.hs | 2 + .../typecheck/should_fail/ContextStack2.stderr | 13 -- testsuite/tests/typecheck/should_fail/T5853.stderr | 31 ++--- testsuite/tests/typecheck/should_fail/T8883.stderr | 2 +- testsuite/tests/typecheck/should_fail/T9260.stderr | 11 +- testsuite/tests/typecheck/should_fail/all.T | 2 +- 19 files changed, 207 insertions(+), 167 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 03c00464cc0693287d9ba2629b9e425d8ea3bc39 From git at git.haskell.org Mon Oct 24 16:46:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Oct 2016 16:46:20 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3's head updated: More work in progress (03c0046) Message-ID: <20161024164620.F1E2B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/spj-tc-branch3' now includes: aaede1e rts/package.conf.in: Fix CPP usage a6bcf87 Refactoring: Replace when (not ...) with unless in ErrUtils f084e68 rts: Move path utilities to separate source file ce20685 Delete bogus comments d387268 SPJ work in progress 03c0046 More work in progress From git at git.haskell.org Tue Oct 25 07:24:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Oct 2016 07:24:07 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: More work in progress (d8f3bcf) Message-ID: <20161025072407.4FCA63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/d8f3bcf4122831dc66fdfcc48f01b87a5c35dab1/ghc >--------------------------------------------------------------- commit d8f3bcf4122831dc66fdfcc48f01b87a5c35dab1 Author: Simon Peyton Jones Date: Tue Oct 25 08:19:19 2016 +0100 More work in progress >--------------------------------------------------------------- d8f3bcf4122831dc66fdfcc48f01b87a5c35dab1 compiler/typecheck/TcFlatten.hs | 4 +- compiler/typecheck/TcInteract.hs | 103 ++++++++++++--------- compiler/typecheck/TcSMonad.hs | 6 +- compiler/typecheck/TcSimplify.hs | 8 +- .../tests/indexed-types/should_compile/T12526.hs | 70 ++++++++++++++ .../tests/indexed-types/should_compile/T12538.hs | 40 ++++++++ .../indexed-types/should_compile/T12538.stderr | 11 +++ testsuite/tests/indexed-types/should_compile/all.T | 2 + .../tests/indexed-types/should_fail/T1897b.stderr | 2 +- .../tests/indexed-types/should_fail/T8227.stderr | 11 ++- testsuite/tests/perf/compiler/T5837.hs | 29 ++++-- testsuite/tests/polykinds/T12444.hs | 65 +++++++++++++ testsuite/tests/polykinds/T12444.stderr | 16 ++++ testsuite/tests/polykinds/all.T | 1 + testsuite/tests/typecheck/should_fail/T5853.stderr | 26 +++--- testsuite/tests/typecheck/should_fail/T8883.stderr | 2 +- 16 files changed, 315 insertions(+), 81 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 d8f3bcf4122831dc66fdfcc48f01b87a5c35dab1 From git at git.haskell.org Tue Oct 25 13:51:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Oct 2016 13:51:01 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump peak_megabytes_allocated for T3064 (a182c0e) Message-ID: <20161025135101.74DD93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a182c0e81b59494b4c8b4c03b7b9b68d81ee3381/ghc >--------------------------------------------------------------- commit a182c0e81b59494b4c8b4c03b7b9b68d81ee3381 Author: Ben Gamari Date: Tue Oct 25 09:50:29 2016 -0400 testsuite: Bump peak_megabytes_allocated for T3064 >--------------------------------------------------------------- a182c0e81b59494b4c8b4c03b7b9b68d81ee3381 testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index b7655a1..61abe35 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -282,7 +282,7 @@ test('T3064', # 2014-01-22: 23 (x86/Linux) # 2014-12-22: 23 (x86/Linux) death to silent superclasses # 2015-07-11 28 (x86/Linux, 64-bit machine) use +RTS -G1 - (wordsize(64), 54, 20)]), + (wordsize(64), 66, 20)]), # (amd64/Linux): 18 # (amd64/Linux) 2012-02-07: 26 # (amd64/Linux) 2013-02-12: 23; increased range to 10% @@ -296,6 +296,7 @@ test('T3064', # (amd64/Linux) 2014-12-22: 27: death to silent superclasses # (amd64/Linux) 2015-01-22: 32: Varies from 30 to 34, at least here. # (amd64/Linux) 2015-06-03: 54: use +RTS -G1 + # (amd64/Linux) 2016-10-25: 66: Presumably creep compiler_stats_num_field('bytes allocated', [(wordsize(32), 153261024, 10), From git at git.haskell.org Tue Oct 25 16:42:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Oct 2016 16:42:22 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: Make a panic into an ASSERT (e26f3b7) Message-ID: <20161025164222.255993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/e26f3b7b098ab776e7a80259b840f6c2a89e3cc0/ghc >--------------------------------------------------------------- commit e26f3b7b098ab776e7a80259b840f6c2a89e3cc0 Author: Simon Peyton Jones Date: Tue Oct 25 15:21:31 2016 +0100 Make a panic into an ASSERT >--------------------------------------------------------------- e26f3b7b098ab776e7a80259b840f6c2a89e3cc0 compiler/typecheck/FunDeps.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs index c40be7b..54ac530 100644 --- a/compiler/typecheck/FunDeps.hs +++ b/compiler/typecheck/FunDeps.hs @@ -194,11 +194,9 @@ improveFromInstEnv :: InstEnvs -> [FunDepEqn loc] -- Needs to be a FunDepEqn because -- of quantified variables -- Post: Equations oriented from the template (matching instance) to the workitem! -improveFromInstEnv _inst_env _ pred - | not (isClassPred pred) - = panic "improveFromInstEnv: not a class predicate" improveFromInstEnv inst_env mk_loc pred - | Just (cls, tys) <- getClassPredTys_maybe pred + | Just (cls, tys) <- ASSERT2( isClassPred pred, ppr pred ) + getClassPredTys_maybe pred , tys `lengthAtLeast` 2 , let (cls_tvs, cls_fds) = classTvsFds cls instances = classInstances inst_env cls From git at git.haskell.org Tue Oct 25 16:42:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Oct 2016 16:42:24 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: Fix a bug in mk_superclasses_of (20e7432) Message-ID: <20161025164224.D033E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/20e7432b55f86aad0413bc404668f2bd0033586a/ghc >--------------------------------------------------------------- commit 20e7432b55f86aad0413bc404668f2bd0033586a Author: Simon Peyton Jones Date: Tue Oct 25 15:22:17 2016 +0100 Fix a bug in mk_superclasses_of This bug meant that we were less eager about expanding tuple superclasses than we should have been; i.e. we stopped too soon. That's not fatal, beause we expand more superclasses later, but it's less efficient. >--------------------------------------------------------------- 20e7432b55f86aad0413bc404668f2bd0033586a compiler/typecheck/TcCanonical.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 3419400..209eec9 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -432,15 +432,20 @@ mk_superclasses_of :: NameSet -> CtEvidence -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses mk_superclasses_of rec_clss ev cls tys - | loop_found = return [this_ct] -- cc_pend_sc of this_ct = True - | otherwise = do { sc_cts <- mk_strict_superclasses rec_clss' ev cls tys + | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) + ; return [this_ct] } -- cc_pend_sc of this_ct = True + | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys + , ppr (isCTupleClass cls) + , ppr rec_clss + ]) + ; sc_cts <- mk_strict_superclasses rec_clss' ev cls tys ; return (this_ct : sc_cts) } -- cc_pend_sc of this_ct = False where cls_nm = className cls - loop_found = cls_nm `elemNameSet` rec_clss - rec_clss' | isCTupleClass cls = rec_clss -- Never contribute to recursion - | otherwise = rec_clss `extendNameSet` cls_nm + loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss + -- Tuples neveer contribute to recursion, and can be nested + rec_clss' = rec_clss `extendNameSet` cls_nm this_ct = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys , cc_pend_sc = loop_found } -- NB: If there is a loop, we cut off, so we have not @@ -460,7 +465,8 @@ mk_strict_superclasses rec_clss ev cls tys = return [] -- Wanteds with no variables yield no deriveds. -- See Note [Improvement from Ground Wanteds] - | otherwise -- Wanted/Derived case, just add those SC that can lead to improvement. + | otherwise -- Wanted/Derived case, just add Derived superclasses + -- that can lead to improvement. = do { let loc = ctEvLoc ev ; sc_evs <- mapM (newDerivedNC loc) (immSuperClasses cls tys) ; concatMapM (mk_superclasses rec_clss) sc_evs } From git at git.haskell.org Tue Oct 25 16:42:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Oct 2016 16:42:27 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: Comments only in TcType (fc72e5d) Message-ID: <20161025164227.85DAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/fc72e5d4f0ed75e82e6aed9dd3300102293baffb/ghc >--------------------------------------------------------------- commit fc72e5d4f0ed75e82e6aed9dd3300102293baffb Author: Simon Peyton Jones Date: Tue Oct 25 15:25:03 2016 +0100 Comments only in TcType >--------------------------------------------------------------- fc72e5d4f0ed75e82e6aed9dd3300102293baffb compiler/typecheck/TcType.hs | 72 +++++++++++++++++++++++--------------------- 1 file changed, 38 insertions(+), 34 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index e5c03bf..75ae84c 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1436,7 +1436,13 @@ tcSplitMethodTy ty | otherwise = pprPanic "tcSplitMethodTy" (ppr ty) ------------------------ + +{- ********************************************************************* +* * + Type equalities +* * +********************************************************************* -} + tcEqKind :: TcKind -> TcKind -> Bool tcEqKind = tcEqType @@ -1546,39 +1552,9 @@ pickyEqType ty1 ty2 = isNothing $ tc_eq_type (const Nothing) ty1 ty2 -{- Note [Expanding superclasses] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we expand superclasses, we use the following algorithm: - -expand( so_far, pred ) returns the transitive superclasses of pred, - not including pred itself - 1. If pred is not a class constraint, return empty set - Otherwise pred = C ts - 2. If C is in so_far, return empty set (breaks loops) - 3. Find the immediate superclasses constraints of (C ts) - 4. For each such sc_pred, return (sc_pred : expand( so_far+C, D ss ) - -Notice that - - * With normal Haskell-98 classes, the loop-detector will never bite, - so we'll get all the superclasses. - - * Since there is only a finite number of distinct classes, expansion - must terminate. - - * The loop breaking is a bit conservative. Notably, a tuple class - could contain many times without threatening termination: - (Eq a, (Ord a, Ix a)) - And this is try of any class that we can statically guarantee - as non-recursive (in some sense). For now, we just make a special - case for tuples. Somthing better would be cool. - -See also TcTyDecls.checkClassCycles. - - -************************************************************************ +{- ********************************************************************* * * -\subsection{Predicate types} + Predicate types * * ************************************************************************ @@ -1760,7 +1736,35 @@ isImprovementPred ty ClassPred cls _ -> classHasFds cls IrredPred {} -> True -- Might have equalities after reduction? -{- +{- Note [Expanding superclasses] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we expand superclasses, we use the following algorithm: + +expand( so_far, pred ) returns the transitive superclasses of pred, + not including pred itself + 1. If pred is not a class constraint, return empty set + Otherwise pred = C ts + 2. If C is in so_far, return empty set (breaks loops) + 3. Find the immediate superclasses constraints of (C ts) + 4. For each such sc_pred, return (sc_pred : expand( so_far+C, D ss ) + +Notice that + + * With normal Haskell-98 classes, the loop-detector will never bite, + so we'll get all the superclasses. + + * Since there is only a finite number of distinct classes, expansion + must terminate. + + * The loop breaking is a bit conservative. Notably, a tuple class + could contain many times without threatening termination: + (Eq a, (Ord a, Ix a)) + And this is try of any class that we can statically guarantee + as non-recursive (in some sense). For now, we just make a special + case for tuples. Somthing better would be cool. + +See also TcTyDecls.checkClassCycles. + Note [Inheriting implicit parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this: From git at git.haskell.org Tue Oct 25 16:42:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Oct 2016 16:42:31 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: More constraint-solver refactoring (42d5eb7) Message-ID: <20161025164231.23F3C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/42d5eb7b35d330d44c79088c7bd9440c70f5766d/ghc >--------------------------------------------------------------- commit 42d5eb7b35d330d44c79088c7bd9440c70f5766d Author: Simon Peyton Jones Date: Tue Oct 25 17:41:45 2016 +0100 More constraint-solver refactoring This patch takes further my refactoring of the constraint solver. It fixes a number of tricky bugs including Trac #12526 Trac #12444 Trac #12538 The main changes are these * Flatten unification variables (fmvs/fuvs) appear on the LHS of a tvar/tyvar equality; thus fmv ~ alpha and not alpha ~ fmv See Note [Put flatten unification variables on the left] This is implemented by TcUnify.swapOverTyVars. * Don't reduce a "loopy" CFunEqCan where the fsk appears on the LHS: F t1 .. tn ~ fsk where 'fsk' is free in t1..tn. See Note [FunEq occurs-check principle] in TcInteract This neatly stops some infinite loops that people reported; and it allows us to delete some crufty code in reduce_top_fun_eq. And it appears to be no loss whatsoever. As well as fixing loops, ContextStack2 and T5837 both terminate when they didn't before. * Previously we generated "derived shadow" constraints incrementally; a Wanted might do duty as the shadow, until it couldn't any more. But this was jolly tricky to implement correctly; and it generated Derived constraints even in situations where we didn't need any because the Wanted constraints all got solved anyway. So this patch arranges to add Derived shadows after the first iteration of solving is complete, in TcSimplify. See the call to mkDerivedShadows. It's a lot simpler, and it matches the treatment of (derived) superclasses. See TcSMonad Note [Shadow constraints and improvement] * Rather than have a separate inert_model in the InertCans, I've put the derived equalities back into inert_eqs. We weren't gaining anything from a separate field. * Previously we had a mode for the constraint solver in which it would more aggressively solve Derived constraints; it was used for simplifying the context of a 'deriving' clause, or a 'default' delcaration, for example. But the complexity wasn't worth it; now I just make proper Wanted constraints. See TcMType.cloneWC * Don't generate injectivity improvement for Givens; see Note [No FunEq improvement for Givens] in TcInteract * Don't do reduction for Derived class constraints; see Note [No reduction for Derived class constraints] If we had derived CFunEqCans, we would not reduce those either. This is a free choice really; we get less overhead, but risk missing some eventual injectivity opportunity. * We generate no Derived CFunEqCans at all. When flattening a Derived constraint we generate a Watned CFunEqCan. The main reason is to make the inert_funeqs simple; but I think this really isn't quite right and want to come back to it. See TcSMonad Note [No Derived CFunEqCans]. * solveSimpleWanteds leaves the insolubles in-place rather than returning them. Simpler. I also did lots of work on comments. >--------------------------------------------------------------- 42d5eb7b35d330d44c79088c7bd9440c70f5766d compiler/typecheck/TcFlatten.hs | 161 ++-- compiler/typecheck/TcInteract.hs | 573 +++++++------ compiler/typecheck/TcMType.hs | 20 +- compiler/typecheck/TcRnTypes.hs | 40 +- compiler/typecheck/TcRules.hs | 11 +- compiler/typecheck/TcSMonad.hs | 903 ++++++++++----------- compiler/typecheck/TcSimplify.hs | 148 ++-- compiler/typecheck/TcUnify.hs | 40 +- .../tests/indexed-types/should_compile/T12526.hs | 70 ++ .../tests/indexed-types/should_compile/T12538.hs | 40 + .../indexed-types/should_compile/T12538.stderr | 11 + .../indexed-types/should_compile/T3017.stderr | 2 +- .../indexed-types/should_compile/T3208b.stderr | 11 +- .../tests/indexed-types/should_compile/T4338.hs | 35 +- testsuite/tests/indexed-types/should_compile/all.T | 2 + .../tests/indexed-types/should_fail/T2544.stderr | 24 +- .../tests/indexed-types/should_fail/T2627b.stderr | 4 +- .../tests/indexed-types/should_fail/T3330c.stderr | 6 +- .../tests/indexed-types/should_fail/T4174.stderr | 4 +- .../tests/indexed-types/should_fail/T4179.stderr | 6 +- .../tests/indexed-types/should_fail/T6123.stderr | 6 +- testsuite/tests/indexed-types/should_fail/T7786.hs | 16 +- .../tests/indexed-types/should_fail/T7786.stderr | 43 +- .../tests/indexed-types/should_fail/T8227.stderr | 11 +- testsuite/tests/perf/compiler/T5837.hs | 29 +- testsuite/tests/perf/compiler/T5837.stderr | 91 --- testsuite/tests/perf/compiler/all.T | 7 +- testsuite/tests/polykinds/T12444.hs | 65 ++ testsuite/tests/polykinds/T12444.stderr | 16 + testsuite/tests/polykinds/all.T | 1 + .../tests/typecheck/should_compile/Improvement.hs | 12 +- testsuite/tests/typecheck/should_compile/T6018.hs | 13 + .../tests/typecheck/should_compile/T6018.stderr | 8 +- testsuite/tests/typecheck/should_compile/all.T | 2 +- .../tests/typecheck/should_fail/ContextStack2.hs | 2 + .../typecheck/should_fail/ContextStack2.stderr | 13 - testsuite/tests/typecheck/should_fail/Makefile | 5 + testsuite/tests/typecheck/should_fail/T1899.stderr | 21 +- testsuite/tests/typecheck/should_fail/T5691.stderr | 10 +- testsuite/tests/typecheck/should_fail/T5853.stderr | 31 +- .../tests/typecheck/should_fail/T7748a.stderr | 6 +- testsuite/tests/typecheck/should_fail/T8450.stderr | 10 +- testsuite/tests/typecheck/should_fail/T9260.stderr | 11 +- testsuite/tests/typecheck/should_fail/all.T | 2 +- .../tests/typecheck/should_fail/tcfail201.stderr | 8 +- 45 files changed, 1357 insertions(+), 1193 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 42d5eb7b35d330d44c79088c7bd9440c70f5766d From git at git.haskell.org Tue Oct 25 16:42:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Oct 2016 16:42:33 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3's head updated: More constraint-solver refactoring (42d5eb7) Message-ID: <20161025164233.6FBE33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/spj-tc-branch3' now includes: 1c4a39d Prioritise class-level equality costraints 1221f81 Don't instantaite when typechecking a pattern synonym 08ba691 Take account of kinds in promoteTcType 03b0b8e Test Trac #12174 853cdae Test Trac #12081 e26f3b7 Make a panic into an ASSERT 20e7432 Fix a bug in mk_superclasses_of fc72e5d Comments only in TcType 42d5eb7 More constraint-solver refactoring From git at git.haskell.org Wed Oct 26 10:13:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 10:13:40 +0000 (UTC) Subject: [commit: ghc] master: Fundeps work even for unary type classes (801c263) Message-ID: <20161026101340.6F9773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/801c26372742fc79bd3756bdcb710031c716c402/ghc >--------------------------------------------------------------- commit 801c26372742fc79bd3756bdcb710031c716c402 Author: Simon Peyton Jones Date: Wed Oct 26 10:54:16 2016 +0100 Fundeps work even for unary type classes The functional-dependency improvement functions, improveFromAnother improveFromInstEnv had a side-condition that said the type class has to have at least two arguments. But not so, as Trac #12763 shows: class C a | -> a where ... is perfectly legal, albeit a bit of a corner case. >--------------------------------------------------------------- 801c26372742fc79bd3756bdcb710031c716c402 compiler/typecheck/FunDeps.hs | 3 +- testsuite/tests/typecheck/should_compile/T12763.hs | 13 +++++ .../tests/typecheck/should_compile/T12763.stderr | 14 +++++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T5684.stderr | 60 +++------------------- 5 files changed, 35 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 801c26372742fc79bd3756bdcb710031c716c402 From git at git.haskell.org Wed Oct 26 10:34:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 10:34:16 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch3: Responding to Richard's comments on Phab (3f8e408) Message-ID: <20161026103416.492663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch3 Link : http://ghc.haskell.org/trac/ghc/changeset/3f8e408adb40bd77dafe762cbeacc076b9eef23b/ghc >--------------------------------------------------------------- commit 3f8e408adb40bd77dafe762cbeacc076b9eef23b Author: Simon Peyton Jones Date: Wed Oct 26 11:33:33 2016 +0100 Responding to Richard's comments on Phab >--------------------------------------------------------------- 3f8e408adb40bd77dafe762cbeacc076b9eef23b compiler/typecheck/TcInteract.hs | 13 +-- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcRules.hs | 10 +- compiler/typecheck/TcSMonad.hs | 107 +++------------------ .../tests/indexed-types/should_compile/T10226.hs | 24 +++++ 5 files changed, 53 insertions(+), 108 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 3f8e408adb40bd77dafe762cbeacc076b9eef23b From git at git.haskell.org Wed Oct 26 14:21:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 14:21:37 +0000 (UTC) Subject: [commit: ghc] master: Delete extraneous backtick in users' guide (9f814b2) Message-ID: <20161026142137.6FE953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f814b2f85c9feb9de2b4122a85fccf6cf713693/ghc >--------------------------------------------------------------- commit 9f814b2f85c9feb9de2b4122a85fccf6cf713693 Author: Ryan Scott Date: Wed Oct 26 10:18:49 2016 -0400 Delete extraneous backtick in users' guide [ci skip] >--------------------------------------------------------------- 9f814b2f85c9feb9de2b4122a85fccf6cf713693 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 9f0a755..8809670 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -1615,7 +1615,7 @@ has no non-bottom values. For example: f :: Void -> Int f x = case x of { } -With dependently-typed features it is more useful (see :ghc-ticket:`2431``). For +With dependently-typed features it is more useful (see :ghc-ticket:`2431`). For example, consider these two candidate definitions of ``absurd``: :: From git at git.haskell.org Wed Oct 26 15:50:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 15:50:12 +0000 (UTC) Subject: [commit: ghc] master: Make traceRn behave more like traceTc (925d178) Message-ID: <20161026155012.561063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/925d178e023ec3c481ec8a5a38019797b779f7d7/ghc >--------------------------------------------------------------- commit 925d178e023ec3c481ec8a5a38019797b779f7d7 Author: Matthew Pickering Date: Wed Oct 26 11:18:39 2016 -0400 Make traceRn behave more like traceTc Reviewers: bgamari, austin Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2586 GHC Trac Issues: #12617 >--------------------------------------------------------------- 925d178e023ec3c481ec8a5a38019797b779f7d7 compiler/rename/RnEnv.hs | 32 ++++++++++++++++------------- compiler/rename/RnExpr.hs | 2 +- compiler/rename/RnNames.hs | 13 ++++++------ compiler/rename/RnSource.hs | 28 ++++++++++++------------- compiler/rename/RnSplice.hs | 30 +++++++++++++++------------ compiler/rename/RnTypes.hs | 15 +++++++------- compiler/typecheck/TcRnDriver.hs | 16 +++++++-------- compiler/typecheck/TcRnExports.hs | 11 +++++----- compiler/typecheck/TcRnMonad.hs | 41 +++++++++++++++++++++---------------- testsuite/tests/perf/compiler/all.T | 9 +++++--- 10 files changed, 107 insertions(+), 90 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 925d178e023ec3c481ec8a5a38019797b779f7d7 From git at git.haskell.org Wed Oct 26 15:50:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 15:50:15 +0000 (UTC) Subject: [commit: ghc] master: rts/linker: Move loadArchive to new source file (488a9ed) Message-ID: <20161026155015.B17C43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/488a9ed3440fe882ae043ba7f44fed4e84e679ce/ghc >--------------------------------------------------------------- commit 488a9ed3440fe882ae043ba7f44fed4e84e679ce Author: Ben Gamari Date: Wed Oct 26 11:19:01 2016 -0400 rts/linker: Move loadArchive to new source file Test Plan: Validate Reviewers: erikd, simonmar, austin, DemiMarie Reviewed By: erikd, simonmar, DemiMarie Subscribers: hvr, thomie Differential Revision: https://phabricator.haskell.org/D2615 GHC Trac Issues: #12388 >--------------------------------------------------------------- 488a9ed3440fe882ae043ba7f44fed4e84e679ce rts/Linker.c | 658 +--------------------------------------------- rts/LinkerInternals.h | 7 + rts/linker/LoadArchive.c | 661 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 671 insertions(+), 655 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 488a9ed3440fe882ae043ba7f44fed4e84e679ce From git at git.haskell.org Wed Oct 26 15:50:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 15:50:18 +0000 (UTC) Subject: [commit: ghc] master: Refine ASSERT in buildPatSyn for the nullary case. (23143f6) Message-ID: <20161026155018.D39E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23143f60680f78f80762754fe060a3e8c6dc9a01/ghc >--------------------------------------------------------------- commit 23143f60680f78f80762754fe060a3e8c6dc9a01 Author: Matthew Pickering Date: Wed Oct 26 11:19:48 2016 -0400 Refine ASSERT in buildPatSyn for the nullary case. For a nullary pattern synonym we add an extra void argument to the matcher in order to preserve laziness. The check in buildPatSyn wasn't aware of this special case which was causing the assertion to fail. Reviewers: austin, simonpj, bgamari Reviewed By: simonpj, bgamari Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2624 GHC Trac Issues: #12746 >--------------------------------------------------------------- 23143f60680f78f80762754fe060a3e8c6dc9a01 compiler/iface/BuildTyCl.hs | 13 +++++++++++-- testsuite/tests/patsyn/should_compile/T12746.hs | 7 +++++++ testsuite/tests/patsyn/should_compile/T12746A.hs | 5 +++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 4 files changed, 24 insertions(+), 2 deletions(-) diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs index 023c461..2617f32 100644 --- a/compiler/iface/BuildTyCl.hs +++ b/compiler/iface/BuildTyCl.hs @@ -18,6 +18,7 @@ module BuildTyCl ( import IfaceEnv import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom ) import TysWiredIn( isCTupleTyConName ) +import TysPrim ( voidPrimTy ) import DataCon import PatSyn import Var @@ -247,7 +248,7 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder , pat_ty `eqType` substTy subst pat_ty1 , prov_theta `eqTypes` substTys subst prov_theta1 , req_theta `eqTypes` substTys subst req_theta1 - , arg_tys `eqTypes` substTys subst arg_tys1 + , compareArgTys arg_tys (substTys subst arg_tys1) ]) , (vcat [ ppr univ_tvs <+> twiddle <+> ppr univ_tvs1 , ppr ex_tvs <+> twiddle <+> ppr ex_tvs1 @@ -263,11 +264,19 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id ([pat_ty1, cont_sigma, _], _) = tcSplitFunTys tau (ex_tvs1, prov_theta1, cont_tau) = tcSplitSigmaTy cont_sigma - (arg_tys1, _) = tcSplitFunTys cont_tau + (arg_tys1, _) = (tcSplitFunTys cont_tau) twiddle = char '~' subst = zipTvSubst (univ_tvs1 ++ ex_tvs1) (mkTyVarTys (binderVars (univ_tvs ++ ex_tvs))) + -- For a nullary pattern synonym we add a single void argument to the + -- matcher to preserve laziness in the case of unlifted types. + -- See #12746 + compareArgTys :: [Type] -> [Type] -> Bool + compareArgTys [] [x] = x `eqType` voidPrimTy + compareArgTys arg_tys matcher_arg_tys = arg_tys `eqTypes` matcher_arg_tys + + ------------------------------------------------------ type TcMethInfo -- A temporary intermediate, to communicate -- between tcClassSigs and buildClass. diff --git a/testsuite/tests/patsyn/should_compile/T12746.hs b/testsuite/tests/patsyn/should_compile/T12746.hs new file mode 100644 index 0000000..4c44c0f --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12746.hs @@ -0,0 +1,7 @@ +module T12746 where + +import T12746A + +foo a = case a of + Foo -> True + _ -> False diff --git a/testsuite/tests/patsyn/should_compile/T12746A.hs b/testsuite/tests/patsyn/should_compile/T12746A.hs new file mode 100644 index 0000000..4cf7b07 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12746A.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables, PatternSynonyms #-} +module T12746A where + +pattern Foo :: Int +pattern Foo = 0x00000001 diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 4426c74..1952672 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -61,3 +61,4 @@ test('T12484', normal, compile, ['']) test('T11987', normal, multimod_compile, ['T11987', '-v0']) test('T12615', normal, compile, ['']) test('T12698', normal, compile, ['']) +test('T12746', normal, multi_compile, ['T12746', [('T12746A.hs', '-c')],'-v0']) From git at git.haskell.org Wed Oct 26 15:50:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 15:50:21 +0000 (UTC) Subject: [commit: ghc] master: Remove -dtrace-level (48876ae) Message-ID: <20161026155021.8897B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48876ae04c4963f8d5a60a121ac85d52322faaee/ghc >--------------------------------------------------------------- commit 48876ae04c4963f8d5a60a121ac85d52322faaee Author: Matthew Pickering Date: Wed Oct 26 11:20:06 2016 -0400 Remove -dtrace-level The flag was: 1. Not documented. 2. Only used as a boolean flag. 3. Has overlapping functionality with -dno-debug-output 4. My poll of #ghc concluded that people didn't know it existed. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2627 GHC Trac Issues: #12691 >--------------------------------------------------------------- 48876ae04c4963f8d5a60a121ac85d52322faaee compiler/main/DynFlags.hs | 4 ---- compiler/rename/RnTypes.hs | 3 +++ compiler/typecheck/TcRnMonad.hs | 6 ++---- compiler/typecheck/TcSMonad.hs | 18 +++++++++--------- compiler/vectorise/Vectorise/Monad/Base.hs | 4 +--- 5 files changed, 15 insertions(+), 20 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index cd8dc41..ffebf3b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -856,7 +856,6 @@ data DynFlags = DynFlags { -- Output style options pprUserLength :: Int, pprCols :: Int, - traceLevel :: Int, -- Standard level is 1. Less verbose is 0. useUnicode :: Bool, @@ -1601,7 +1600,6 @@ defaultDynFlags mySettings = pprUserLength = 5, pprCols = 100, useUnicode = False, - traceLevel = 1, profAuto = NoProfAuto, interactivePrint = Nothing, nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum", @@ -2640,8 +2638,6 @@ dynamic_flags_deps = [ d { pprUserLength = n })) , make_ord_flag defFlag "dppr-cols" (intSuffix (\n d -> d { pprCols = n })) - , make_ord_flag defGhcFlag "dtrace-level" (intSuffix (\n d -> - d { traceLevel = n })) -- Suppress all that is suppressable in core dumps. -- Except for uniques, as some simplifier phases introduce new variables that -- have otherwise identical names. diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 870baad..56a0331 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -267,6 +267,9 @@ rnImplicitBndrs no_implicit_if_forall free_vars hs_ty@(L loc _) thing_inside real_rdrs = freeKiTyVarsKindVars free_vars ++ real_tv_rdrs ; traceRn "rnSigType" (ppr hs_ty $$ ppr free_vars $$ ppr real_rdrs) + + ; traceRn "" (text "rnSigType2" <+> ppr hs_ty $$ ppr free_vars $$ + ppr real_rdrs) ; vars <- mapM (newLocalBndrRn . L loc . unLoc) real_rdrs ; bindLocalNamesFV vars $ thing_inside vars } diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index e2c5938..e4fdd9c 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -669,12 +669,10 @@ traceRn :: String -> SDoc -> TcRn () traceRn = guardedTraceOptTcRn Opt_D_dump_rn_trace --- | Do not display a trace if `-dno-debug-output` is on or `-dtrace-level=0`. +-- | Do not display a trace if `-dno-debug-output` is on guardedTraceOptTcRn :: DumpFlag -> String -> SDoc -> TcRn () guardedTraceOptTcRn flag herald doc = do - dflags <- getDynFlags - when ( traceLevel dflags >= 1 - && not opt_NoDebugOutput) + unless opt_NoDebugOutput ( traceOptTcRn flag (formatTraceMsg herald doc) ) formatTraceMsg :: String -> SDoc -> SDoc diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 6e04e2c..a362cef 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -2424,12 +2424,12 @@ bumpStepCountTcS = TcS $ \env -> do { let ref = tcs_count env csTraceTcS :: SDoc -> TcS () csTraceTcS doc - = wrapTcS $ csTraceTcM 1 (return doc) + = wrapTcS $ csTraceTcM (return doc) traceFireTcS :: CtEvidence -> SDoc -> TcS () -- Dump a rule-firing trace traceFireTcS ev doc - = TcS $ \env -> csTraceTcM 1 $ + = TcS $ \env -> csTraceTcM $ do { n <- TcM.readTcRef (tcs_count env) ; tclvl <- TcM.getTcLevel ; return (hang (int n <> brackets (text "U:" <> ppr tclvl @@ -2437,14 +2437,14 @@ traceFireTcS ev doc <+> doc <> colon) 4 (ppr ev)) } -csTraceTcM :: Int -> TcM SDoc -> TcM () +csTraceTcM :: TcM SDoc -> TcM () -- Constraint-solver tracing, -ddump-cs-trace -csTraceTcM trace_level mk_doc +csTraceTcM mk_doc = do { dflags <- getDynFlags - ; when ( (dopt Opt_D_dump_cs_trace dflags || dopt Opt_D_dump_tc_trace dflags) - && trace_level <= traceLevel dflags ) $ - do { msg <- mk_doc - ; TcM.traceTcRn Opt_D_dump_cs_trace msg } } + ; when ( dopt Opt_D_dump_cs_trace dflags + || dopt Opt_D_dump_tc_trace dflags ) + ( do { msg <- mk_doc + ; TcM.traceTcRn Opt_D_dump_cs_trace msg }) } runTcS :: TcS a -- What to run -> TcM (a, EvBindMap) @@ -2489,7 +2489,7 @@ runTcSWithEvBinds solve_deriveds ev_binds_var tcs ; count <- TcM.readTcRef step_count ; when (count > 0) $ - csTraceTcM 0 $ return (text "Constraint solver steps =" <+> int count) + csTraceTcM $ return (text "Constraint solver steps =" <+> int count) #ifdef DEBUG ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var diff --git a/compiler/vectorise/Vectorise/Monad/Base.hs b/compiler/vectorise/Vectorise/Monad/Base.hs index b084da6..a612a9c 100644 --- a/compiler/vectorise/Vectorise/Monad/Base.hs +++ b/compiler/vectorise/Vectorise/Monad/Base.hs @@ -123,9 +123,7 @@ emitVt herald doc -- traceVt :: String -> SDoc -> VM () traceVt herald doc - = do dflags <- getDynFlags - when (1 <= traceLevel dflags) $ - liftDs $ traceOptIf Opt_D_dump_vt_trace $ hang (text herald) 2 doc + = liftDs $ traceOptIf Opt_D_dump_vt_trace $ hang (text herald) 2 doc -- |Dump the given program conditionally. -- From git at git.haskell.org Wed Oct 26 15:50:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Oct 2016 15:50:24 +0000 (UTC) Subject: [commit: ghc] master: CmmUtils: remove the last dataflow functions (b8effa7) Message-ID: <20161026155024.59FEC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b8effa7fad6f29b89215ff17c5aa7c8a83b93b10/ghc >--------------------------------------------------------------- commit b8effa7fad6f29b89215ff17c5aa7c8a83b93b10 Author: Michal Terepeta Date: Wed Oct 26 11:20:33 2016 -0400 CmmUtils: remove the last dataflow functions This commit: - Moves the remaining few methods concerned with dataflow analysis from `CmmUtils` to `Hoopl.Dataflow`. - Refactors the code to not use `FwdPass` and simply pass `FwdTransfer` and `DataflowLattice` directly. Signed-off-by: Michal Terepeta Test Plan: validate Reviewers: austin, simonmar, bgamari Reviewed By: simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2634 >--------------------------------------------------------------- b8effa7fad6f29b89215ff17c5aa7c8a83b93b10 compiler/cmm/CmmBuildInfoTables.hs | 2 +- compiler/cmm/CmmLive.hs | 7 ++-- compiler/cmm/CmmProcPoint.hs | 2 +- compiler/cmm/CmmUtils.hs | 40 ------------------- compiler/cmm/Hoopl.hs | 8 +--- compiler/cmm/Hoopl/Dataflow.hs | 81 ++++++++++++++++++++++++-------------- 6 files changed, 59 insertions(+), 81 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 b8effa7fad6f29b89215ff17c5aa7c8a83b93b10 From git at git.haskell.org Thu Oct 27 07:28:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Oct 2016 07:28:48 +0000 (UTC) Subject: [commit: ghc] master: Simple refactor to remove misleading comment (3562727) Message-ID: <20161027072848.6EAC53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3562727fd8a8bf5bc5aa0474a78f6c14f14f95a0/ghc >--------------------------------------------------------------- commit 3562727fd8a8bf5bc5aa0474a78f6c14f14f95a0 Author: Simon Peyton Jones Date: Wed Oct 26 14:57:57 2016 +0100 Simple refactor to remove misleading comment >--------------------------------------------------------------- 3562727fd8a8bf5bc5aa0474a78f6c14f14f95a0 compiler/typecheck/TcTyClsDecls.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 46784f6..734a3a3 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -742,14 +742,12 @@ tcTyClDecl1 _parent roles_info , tcdATs = ats, tcdATDefs = at_defs }) = ASSERT( isNothing _parent ) do { clas <- fixM $ \ clas -> + -- We need the knot becase 'clas' is passed into tcClassATs tcTyClTyVars class_name $ \ binders res_kind -> do { MASSERT( isConstraintKind res_kind ) - -- This little knot is just so we can get - -- hold of the name of the class TyCon, which we - -- need to look up its recursiveness ; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders) - ; let tycon_name = tyConName (classTyCon clas) - roles = roles_info tycon_name + ; let tycon_name = class_name -- We use the same name + roles = roles_info tycon_name -- for TyCon and Class ; ctxt' <- solveEqualities $ tcHsContext ctxt ; ctxt' <- zonkTcTypeToTypes emptyZonkEnv ctxt' From git at git.haskell.org Thu Oct 27 07:28:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Oct 2016 07:28:51 +0000 (UTC) Subject: [commit: ghc] master: Collect coercion variables, not type variables (f9308c2) Message-ID: <20161027072851.266D13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9308c2a682d45e061eaa169c4f2389009a9177e/ghc >--------------------------------------------------------------- commit f9308c2a682d45e061eaa169c4f2389009a9177e Author: Simon Peyton Jones Date: Wed Oct 26 14:58:59 2016 +0100 Collect coercion variables, not type variables ...when tracking which constraints are used. Previously we were gathering type variables too, which meant that the ics_need field was (stupidly) non-empty, which meant that we kept hold of solved implications for no purpose. Better just to get rid of them, which setImplicationStatus is all ste up to to do. No change in behaviour; a bit more efficient. >--------------------------------------------------------------- f9308c2a682d45e061eaa169c4f2389009a9177e compiler/typecheck/TcEvidence.hs | 4 ++-- compiler/typecheck/TcSMonad.hs | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index ae98d38..e513f93 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -292,8 +292,8 @@ data EvBindsVar -- The main payload: the value-level evidence bindings -- (dictionaries etc) - ebv_tcvs :: IORef TyCoVarSet - -- The free vars of the (rhss of) the coercion bindings + ebv_tcvs :: IORef CoVarSet + -- The free coercion vars of the (rhss of) the coercion bindings -- -- Coercions don't actually have bindings -- because we plug them in-place (via a mutable diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index a362cef..504bc66 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -2960,7 +2960,7 @@ setEvBind ev_bind ; wrapTcS $ TcM.addTcEvBind evb ev_bind } -- | Mark variables as used filling a coercion hole -useVars :: TyCoVarSet -> TcS () +useVars :: CoVarSet -> TcS () useVars vars = do { EvBindsVar { ebv_tcvs = ref } <- getTcEvBindsVar ; wrapTcS $ @@ -2971,7 +2971,7 @@ useVars vars -- | Equalities only setWantedEq :: TcEvDest -> Coercion -> TcS () setWantedEq (HoleDest hole) co - = do { useVars (tyCoVarsOfCo co) + = do { useVars (coVarsOfCo co) ; wrapTcS $ TcM.fillCoercionHole hole co } setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq" (ppr ev) @@ -2984,7 +2984,7 @@ setEqIfWanted _ _ = return () setWantedEvTerm :: TcEvDest -> EvTerm -> TcS () setWantedEvTerm (HoleDest hole) tm = do { let co = evTermCoercion tm - ; useVars (tyCoVarsOfCo co) + ; useVars (coVarsOfCo co) ; wrapTcS $ TcM.fillCoercionHole hole co } setWantedEvTerm (EvVarDest ev) tm = setWantedEvBind ev tm From git at git.haskell.org Thu Oct 27 07:28:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Oct 2016 07:28:54 +0000 (UTC) Subject: [commit: ghc] master: Allow levity-polymorpic arrows (eefe86d) Message-ID: <20161027072854.971E13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eefe86d96d40697707c3ddfb9973a30a1897241f/ghc >--------------------------------------------------------------- commit eefe86d96d40697707c3ddfb9973a30a1897241f Author: Simon Peyton Jones Date: Wed Oct 26 15:34:56 2016 +0100 Allow levity-polymorpic arrows This cures Trac #12668 (and cures the Lint errors you get from Trac #12718). The idea is explained in Note [Levity polymorphism], in Kind.hs >--------------------------------------------------------------- eefe86d96d40697707c3ddfb9973a30a1897241f compiler/types/Kind.hs | 33 +++++++++++++++++++++++++++++++-- testsuite/tests/polykinds/T12668.hs | 15 +++++++++++++++ testsuite/tests/polykinds/T12718.hs | 30 ++++++++++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 2 ++ 4 files changed, 78 insertions(+), 2 deletions(-) diff --git a/compiler/types/Kind.hs b/compiler/types/Kind.hs index c38a533..01a62e2 100644 --- a/compiler/types/Kind.hs +++ b/compiler/types/Kind.hs @@ -25,7 +25,6 @@ import TyCoRep import TyCon import VarSet ( isEmptyVarSet ) import PrelNames -import Util ( (<&&>) ) {- ************************************************************************ @@ -88,9 +87,11 @@ isRuntimeRepPolymorphic k -- Kinding for arrow (->) -- Says when a kind is acceptable on lhs or rhs of an arrow -- arg -> res +-- +-- See Note [Levity polymorphism] okArrowArgKind, okArrowResultKind :: Kind -> Bool -okArrowArgKind = classifiesTypeWithValues <&&> (not . isRuntimeRepPolymorphic) +okArrowArgKind = classifiesTypeWithValues okArrowResultKind = classifiesTypeWithValues ----------------------------------------- @@ -120,3 +121,31 @@ isStarKind _ = False -- | Is the tycon @Constraint@? isStarKindSynonymTyCon :: TyCon -> Bool isStarKindSynonymTyCon tc = tc `hasKey` constraintKindTyConKey + + +{- Note [Levity polymorphism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Is this type legal? + (a :: TYPE rep) -> Int + where 'rep :: RuntimeRep' + +You might think not, because no lambda can have a +runtime-rep-polymorphic binder. So no lambda has the +above type. BUT here's a way it can be useful (taken from +Trac #12708): + + data T rep (a :: TYPE rep) + = MkT (a -> Int) + + x1 :: T LiftedPtrRep Int + x1 = MkT LiftedPtrRep Int (\x::Int -> 3) + + x2 :: T IntRep INt# + x2 = MkT IntRep Int# (\x:Int# -> 3) + +Note that the lambdas are just fine! + +Hence, okArrowArgKind and okArrowResultKind both just +check that the type is of the form (TYPE r) for some +representation type r. +-} diff --git a/testsuite/tests/polykinds/T12668.hs b/testsuite/tests/polykinds/T12668.hs new file mode 100644 index 0000000..4640903 --- /dev/null +++ b/testsuite/tests/polykinds/T12668.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE RankNTypes #-} + +module T12668 where + +import GHC.Exts + +data Some r = Some (TYPE r -> TYPE r) + +doSomething :: forall (r :: RuntimeRep). forall (a :: TYPE r). () + => Int -> (a -> Int) -> a -> a +doSomething n f = + case n of + 1 -> error "hello" + 3 -> error "hello" diff --git a/testsuite/tests/polykinds/T12718.hs b/testsuite/tests/polykinds/T12718.hs new file mode 100644 index 0000000..82d6dcd --- /dev/null +++ b/testsuite/tests/polykinds/T12718.hs @@ -0,0 +1,30 @@ +{-# Language RebindableSyntax, NoImplicitPrelude, MagicHash, RankNTypes, + PolyKinds, ViewPatterns, TypeInType, FlexibleInstances #-} + +module Main where + +import Prelude hiding (Eq (..), Num(..)) +import qualified Prelude as P +import GHC.Prim +import GHC.Types + +class XNum (a :: TYPE rep) where + (+) :: a -> a -> a + fromInteger :: Integer -> a + +instance P.Num a => XNum a where + (+) = (P.+) + fromInteger = P.fromInteger + +instance XNum Int# where + (+) = (+#) + fromInteger i = case fromInteger i of + I# n -> n + +u :: Bool +u = isTrue# v_ + where + v_ :: forall rep (a :: TYPE rep). XNum a => a + v_ = fromInteger 10 + +main = print u diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 6da6ae4..6ec2a43 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -152,3 +152,5 @@ test('T11554', normal, compile_fail, ['']) test('T12055', normal, compile, ['']) test('T12055a', normal, compile_fail, ['']) test('T12593', normal, compile_fail, ['']) +test('T12668', normal, compile, ['']) +test('T12718', normal, compile, ['']) From git at git.haskell.org Thu Oct 27 07:33:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Oct 2016 07:33:19 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in comment (0eb8934) Message-ID: <20161027073319.37D183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0eb893444cd6893e77dbfc5f6828827e02e5e55a/ghc >--------------------------------------------------------------- commit 0eb893444cd6893e77dbfc5f6828827e02e5e55a Author: Simon Peyton Jones Date: Thu Oct 27 08:33:06 2016 +0100 Fix typo in comment >--------------------------------------------------------------- 0eb893444cd6893e77dbfc5f6828827e02e5e55a compiler/types/Kind.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Kind.hs b/compiler/types/Kind.hs index 01a62e2..c31169e 100644 --- a/compiler/types/Kind.hs +++ b/compiler/types/Kind.hs @@ -140,7 +140,7 @@ Trac #12708): x1 :: T LiftedPtrRep Int x1 = MkT LiftedPtrRep Int (\x::Int -> 3) - x2 :: T IntRep INt# + x2 :: T IntRep Int# x2 = MkT IntRep Int# (\x:Int# -> 3) Note that the lambdas are just fine! From git at git.haskell.org Thu Oct 27 08:51:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Oct 2016 08:51:57 +0000 (UTC) Subject: [commit: ghc] master: Revert "rts/linker: Move loadArchive to new source file" (cc29eb5) Message-ID: <20161027085157.A32F53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc29eb54fc85c464e97a87e941231c6b1d114191/ghc >--------------------------------------------------------------- commit cc29eb54fc85c464e97a87e941231c6b1d114191 Author: Matthew Pickering Date: Thu Oct 27 09:47:55 2016 +0100 Revert "rts/linker: Move loadArchive to new source file" This reverts commit 488a9ed3440fe882ae043ba7f44fed4e84e679ce. >--------------------------------------------------------------- cc29eb54fc85c464e97a87e941231c6b1d114191 rts/Linker.c | 658 +++++++++++++++++++++++++++++++++++++++++++++- rts/LinkerInternals.h | 7 - rts/linker/LoadArchive.c | 661 ----------------------------------------------- 3 files changed, 655 insertions(+), 671 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 cc29eb54fc85c464e97a87e941231c6b1d114191 From git at git.haskell.org Fri Oct 28 01:09:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Oct 2016 01:09:50 +0000 (UTC) Subject: [commit: ghc] master: Minor doc addition as requested in #12774. (815b837) Message-ID: <20161028010950.89AE43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/815b837224fe8b7a43acebafcfc7b79a66311363/ghc >--------------------------------------------------------------- commit 815b837224fe8b7a43acebafcfc7b79a66311363 Author: Edward Z. Yang Date: Thu Oct 27 18:09:40 2016 -0700 Minor doc addition as requested in #12774. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 815b837224fe8b7a43acebafcfc7b79a66311363 testsuite/tests/backpack/cabal/bkpcabal02/Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/backpack/cabal/bkpcabal02/Makefile b/testsuite/tests/backpack/cabal/bkpcabal02/Makefile index 780102f..4856c2c 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal02/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal02/Makefile @@ -9,11 +9,14 @@ bkpcabal02: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d '$(TEST_HC)' -v0 --make Setup + # Here is a working signature which this + # package can typecheck with cp p/H.hsig.in1 p/H.hsig # typecheck everything $(CONFIGURE) $(SETUP) build $(SETUP) -v1 build + # This signature doesn't typecheck with the package cp p/H.hsig.in2 p/H.hsig ! $(SETUP) build ifneq "$(CLEANUP)" "" From git at git.haskell.org Fri Oct 28 15:42:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Oct 2016 15:42:00 +0000 (UTC) Subject: [commit: ghc] master: Clarify comments on kinds (Trac #12536) (7187ded) Message-ID: <20161028154200.1B1903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7187dedabec8e01394578c9f40241ca3d644a4f8/ghc >--------------------------------------------------------------- commit 7187dedabec8e01394578c9f40241ca3d644a4f8 Author: Simon Peyton Jones Date: Fri Oct 28 12:08:49 2016 +0100 Clarify comments on kinds (Trac #12536) - Remove misleading comments from TyCoRep. - Remove 'check_lifted' calls (which were no-ops) from TcValidity. >--------------------------------------------------------------- 7187dedabec8e01394578c9f40241ca3d644a4f8 compiler/typecheck/TcValidity.hs | 30 ++---------------------------- compiler/types/TyCoRep.hs | 33 +++------------------------------ 2 files changed, 5 insertions(+), 58 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 31859e1..b316fe2 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -452,24 +452,6 @@ representationPolymorphismForbidden = go go _ = False -- Other cases are caught by zonker ---------------------------------------- --- | Fail with error message if the type is unlifted -check_lifted :: Type -> TcM () -check_lifted _ = return () - -{- ------ Legacy comment --------- -The check_unlifted function seems entirely redundant. The -kind system should check for uses of unlifted types. So I've -removed the check. See Trac #11120 comment:19. - -check_lifted ty - = do { env <- tcInitOpenTidyEnv (tyCoVarsOfTypeList ty) - ; checkTcM (not (isUnliftedType ty)) (unliftedArgErr env ty) } - -unliftedArgErr :: TidyEnv -> Type -> (TidyEnv, SDoc) -unliftedArgErr env ty = (env, sep [text "Illegal unlifted type:", ppr_tidy env ty]) ------- End of legacy comment --------- -} - - check_type :: TidyEnv -> UserTypeCtxt -> Rank -> Type -> TcM () -- The args say what the *type context* requires, independent -- of *flag* settings. You test the flag settings at usage sites. @@ -610,12 +592,7 @@ check_arg_type env ctxt rank ty -- (Ord (forall a.a)) => a -> a -- and so that if it Must be a monotype, we check that it is! - ; check_type env ctxt rank' ty - ; check_lifted ty } - -- NB the isUnliftedType test also checks for - -- T State# - -- where there is an illegal partial application of State# (which has - -- kind * -> #); see Note [The kind invariant] in TyCoRep + ; check_type env ctxt rank' ty } ---------------------------------------- forAllTyErr :: TidyEnv -> Rank -> Type -> (TidyEnv, SDoc) @@ -1628,7 +1605,6 @@ checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs loc -- type instance F Int = Int# -- See Trac #9357 ; checkValidMonoType rhs - ; check_lifted rhs -- We have a decidable instance unless otherwise permitted ; undecidable_ok <- xoptM LangExt.UndecidableInstances @@ -1701,9 +1677,7 @@ checkValidTypePat pat_ty -- Ensure that no type family instances occur a type pattern ; checkTc (isTyFamFree pat_ty) $ - tyFamInstIllegalErr pat_ty - - ; check_lifted pat_ty } + tyFamInstIllegalErr pat_ty } isTyFamFree :: Type -> Bool -- ^ Check that a type does not contain any type family applications. diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index a9dcbcb..62c186c 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -247,7 +247,7 @@ data Type -- See Note [Non-trivial definitional equality] = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable) - | AppTy -- See Note [AppTy rep] + | AppTy Type Type -- ^ Type application to something other than a 'TyCon'. Parameters: -- @@ -256,7 +256,7 @@ data Type -- -- 2) Argument type - | TyConApp -- See Note [AppTy rep] + | TyConApp TyCon [KindOrType] -- ^ Application of a 'TyCon', including newtypes /and/ synonyms. -- Invariant: saturated applications of 'FunTyCon' must @@ -304,34 +304,7 @@ data TyLit | StrTyLit FastString deriving (Eq, Ord, Data.Data) -{- Note [The kind invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The kinds - # UnliftedTypeKind - OpenKind super-kind of *, # - -can never appear under an arrow or type constructor in a kind; they -can only be at the top level of a kind. It follows that primitive TyCons, -which have a naughty pseudo-kind - State# :: * -> # -must always be saturated, so that we can never get a type whose kind -has a UnliftedTypeKind or ArgTypeKind underneath an arrow. - -Nor can we abstract over a type variable with any of these kinds. - - k :: = kk | # | ArgKind | (#) | OpenKind - kk :: = * | kk -> kk | T kk1 ... kkn - -So a type variable can only be abstracted kk. - -Note [AppTy rep] -~~~~~~~~~~~~~~~~ -Types of the form 'f a' must be of kind *, not #, so we are guaranteed -that they are represented by pointers. The reason is that f must have -kind (kk -> kk) and kk cannot be unlifted; see Note [The kind invariant] -in TyCoRep. - -Note [Arguments to type constructors] +{- Note [Arguments to type constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Because of kind polymorphism, in addition to type application we now have kind instantiation. We reuse the same notations to do so. From git at git.haskell.org Fri Oct 28 19:16:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Oct 2016 19:16:33 +0000 (UTC) Subject: [commit: ghc] master: Make it possible to use +RTS -qn without -N (aae2b3d) Message-ID: <20161028191633.E6E663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aae2b3d522aae49311a9f9c52d40fb58c99eed13/ghc >--------------------------------------------------------------- commit aae2b3d522aae49311a9f9c52d40fb58c99eed13 Author: Simon Marlow Date: Fri Oct 28 16:34:44 2016 +0100 Make it possible to use +RTS -qn without -N It's entirely reasonable to set +RTS -qn without setting -N, because the program might later call setNumCapabilities. If we disallow it, there's no way to use -qn on programs that use setNumCapabilities. >--------------------------------------------------------------- aae2b3d522aae49311a9f9c52d40fb58c99eed13 rts/RtsFlags.c | 7 ------- rts/Schedule.c | 6 +++++- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index d86b154..aeb2fe5 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -1487,13 +1487,6 @@ static void normaliseRtsOpts (void) RtsFlags.ParFlags.parGcLoadBalancingGen = 1; } } - -#ifdef THREADED_RTS - if (RtsFlags.ParFlags.parGcThreads > RtsFlags.ParFlags.nCapabilities) { - errorBelch("GC threads (-qn) must be between 1 and the value of -N"); - errorUsage(); - } -#endif } static void errorUsage (void) diff --git a/rts/Schedule.c b/rts/Schedule.c index 06db3fe..a44512b 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1596,7 +1596,11 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, // enabled_capabilities may change if requestSync() below fails and // we retry. if (gc_type == SYNC_GC_PAR && n_gc_threads > 0) { - need_idle = stg_max(0, enabled_capabilities - n_gc_threads); + if (n_gc_threads >= enabled_capabilities) { + need_idle = 0; + } else { + need_idle = enabled_capabilities - n_gc_threads; + } } else { need_idle = 0; } From git at git.haskell.org Fri Oct 28 21:03:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Oct 2016 21:03:10 +0000 (UTC) Subject: [commit: ghc] master: Add test for #12732 (60343a4) Message-ID: <20161028210310.92DDA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60343a419ab44d387cfd11f0dd2b522fd922e63a/ghc >--------------------------------------------------------------- commit 60343a419ab44d387cfd11f0dd2b522fd922e63a Author: Ryan Scott Date: Fri Oct 28 17:00:29 2016 -0400 Add test for #12732 >--------------------------------------------------------------- 60343a419ab44d387cfd11f0dd2b522fd922e63a testsuite/tests/partial-sigs/should_fail/T12732.hs | 6 ++++++ testsuite/tests/partial-sigs/should_fail/T12732.stderr | 6 ++++++ testsuite/tests/partial-sigs/should_fail/all.T | 1 + 3 files changed, 13 insertions(+) diff --git a/testsuite/tests/partial-sigs/should_fail/T12732.hs b/testsuite/tests/partial-sigs/should_fail/T12732.hs new file mode 100644 index 0000000..60bcde6 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T12732.hs @@ -0,0 +1,6 @@ +module T12732 where + +(a ... b) xs + | a == x + , (l, _:r) <- break (== x) xs + = l ++ [x] diff --git a/testsuite/tests/partial-sigs/should_fail/T12732.stderr b/testsuite/tests/partial-sigs/should_fail/T12732.stderr new file mode 100644 index 0000000..5188f62 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T12732.stderr @@ -0,0 +1,6 @@ + +T12732.hs:4:10: error: Variable not in scope: x + +T12732.hs:5:27: error: Variable not in scope: x + +T12732.hs:6:11: error: Variable not in scope: x diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T index dca7f48..42bd088 100644 --- a/testsuite/tests/partial-sigs/should_fail/all.T +++ b/testsuite/tests/partial-sigs/should_fail/all.T @@ -63,3 +63,4 @@ test('T11976', normal, compile_fail, ['']) 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']) From git at git.haskell.org Fri Oct 28 21:50:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Oct 2016 21:50:20 +0000 (UTC) Subject: [commit: ghc] master: Minor refactoring in stg_unpackClosurezh (4b300a3) Message-ID: <20161028215020.23FC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b300a32257c3ed272747f7e75709a26dd2d8407/ghc >--------------------------------------------------------------- commit 4b300a32257c3ed272747f7e75709a26dd2d8407 Author: Ömer Sinan Ağacan Date: Fri Oct 28 15:39:11 2016 -0400 Minor refactoring in stg_unpackClosurezh - Reuse `clos` local variable - Rename labels for clarity >--------------------------------------------------------------- 4b300a32257c3ed272747f7e75709a26dd2d8407 rts/PrimOps.cmm | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 02a7daf..4cc0dcc 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -2119,8 +2119,9 @@ stg_mkApUpd0zh ( P_ bco ) stg_unpackClosurezh ( P_ closure ) { - W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr; - info = %GET_STD_INFO(UNTAG(closure)); + W_ clos, info, ptrs, nptrs, p, ptrs_arr, nptrs_arr; + clos = UNTAG(closure); + info = %GET_STD_INFO(clos); // Some closures have non-standard layout, so we omit those here. W_ type; @@ -2142,8 +2143,8 @@ stg_unpackClosurezh ( P_ closure ) nptrs = TO_W_(%INFO_NPTRS(info)); goto out; }} -out: +out: W_ ptrs_arr_sz, ptrs_arr_cards, nptrs_arr_sz; nptrs_arr_sz = SIZEOF_StgArrBytes + WDS(nptrs); ptrs_arr_cards = mutArrPtrsCardWords(ptrs); @@ -2151,9 +2152,6 @@ out: ALLOC_PRIM_P (ptrs_arr_sz + nptrs_arr_sz, stg_unpackClosurezh, closure); - W_ clos; - clos = UNTAG(closure); - ptrs_arr = Hp - nptrs_arr_sz - ptrs_arr_sz + WDS(1); nptrs_arr = Hp - nptrs_arr_sz + WDS(1); @@ -2162,11 +2160,12 @@ out: StgMutArrPtrs_size(ptrs_arr) = ptrs + ptrs_arr_cards; p = 0; -for: + +write_ptrs: if(p < ptrs) { W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(clos,p); p = p + 1; - goto for; + goto write_ptrs; } /* We can leave the card table uninitialised, since the array is allocated in the nursery. The GC will fill it in if/when the array @@ -2175,12 +2174,14 @@ for: SET_HDR(nptrs_arr, stg_ARR_WORDS_info, CCCS); StgArrBytes_bytes(nptrs_arr) = WDS(nptrs); p = 0; -for2: + +write_nptrs: if(p < nptrs) { W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(clos, p+ptrs); p = p + 1; - goto for2; + goto write_nptrs; } + return (info, ptrs_arr, nptrs_arr); } From git at git.haskell.org Fri Oct 28 21:50:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Oct 2016 21:50:22 +0000 (UTC) Subject: [commit: ghc] master: Document unpackClosure# primop (5ebcb3a) Message-ID: <20161028215022.CA3D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ebcb3acaae63886d55f379d7e48437ac264a169/ghc >--------------------------------------------------------------- commit 5ebcb3acaae63886d55f379d7e48437ac264a169 Author: Ömer Sinan Ağacan Date: Fri Oct 28 15:36:55 2016 -0400 Document unpackClosure# primop >--------------------------------------------------------------- 5ebcb3acaae63886d55f379d7e48437ac264a169 compiler/prelude/primops.txt.pp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index a38dd57..49f78fa 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2631,6 +2631,11 @@ primop NewBCOOp "newBCO#" GenPrimOp primop UnpackClosureOp "unpackClosure#" GenPrimOp a -> (# Addr#, Array# b, ByteArray# #) + { {\tt unpackClosure\# closure} copies non-pointers and pointers in the + payload of the given closure into two new arrays, and returns a pointer to + the first word of the closure's info table, a pointer array for the + pointers in the payload, and a non-pointer array for the non-pointers in + the payload. } with out_of_line = True From git at git.haskell.org Sat Oct 29 01:25:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Oct 2016 01:25:40 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ghc-7.10-with-timings' created Message-ID: <20161029012540.17F9B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ghc-7.10-with-timings Referencing: fb40d415b947805ac33690f63317dd3b8c3e85d6 From git at git.haskell.org Sat Oct 29 01:25:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Oct 2016 01:25:42 +0000 (UTC) Subject: [commit: ghc] wip/ghc-7.10-with-timings: ErrUtils: Add timings to compiler phases (fb40d41) Message-ID: <20161029012542.CD6B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ghc-7.10-with-timings Link : http://ghc.haskell.org/trac/ghc/changeset/fb40d415b947805ac33690f63317dd3b8c3e85d6/ghc >--------------------------------------------------------------- commit fb40d415b947805ac33690f63317dd3b8c3e85d6 Author: Ben Gamari Date: Wed Mar 23 16:11:45 2016 +0100 ErrUtils: Add timings to compiler phases This adds timings and allocation figures to the compiler's output when run with `-v2` in an effort to ease performance analysis. Todo: * Documentation * Where else should we add these? * Perhaps we should remove some of the now-arguably-redundant `showPass` occurrences where they are * Must we force more? * Perhaps we should place this behind a `-ftimings` instead of `-v2` Test Plan: `ghc -v2 Test.hs`, look at the output Reviewers: hvr, goldfire, simonmar, austin Reviewed By: simonmar Subscribers: angerman, michalt, niteria, ezyang, thomie Differential Revision: https://phabricator.haskell.org/D1959 (cherry picked from commit 8048d51be0676627b417c128af0b0c352b75c537) >--------------------------------------------------------------- fb40d415b947805ac33690f63317dd3b8c3e85d6 compiler/cmm/CmmParse.y | 3 +- compiler/coreSyn/CoreLint.hs | 9 +----- compiler/coreSyn/CorePrep.hs | 16 ++++++---- compiler/deSugar/Desugar.hs | 9 +++--- compiler/ghci/ByteCodeGen.hs | 8 +++-- compiler/llvmGen/LlvmCodeGen.hs | 3 +- compiler/llvmGen/LlvmMangler.hs | 7 +++-- compiler/main/CodeOutput.hs | 7 +++-- compiler/main/ErrUtils.hs | 58 +++++++++++++++++++++++++++++++++++- compiler/main/GhcMake.hs | 19 ++++++------ compiler/main/HscMain.hs | 63 +++++++++++++++++++++------------------- compiler/main/TidyPgm.hs | 23 ++++++++++----- compiler/simplCore/SimplCore.hs | 31 +++++++++++--------- compiler/typecheck/TcRnDriver.hs | 12 ++++---- compiler/utils/Outputable.hs | 8 ++++- docs/users_guide/debugging.xml | 10 ++++++- 16 files changed, 189 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 fb40d415b947805ac33690f63317dd3b8c3e85d6 From git at git.haskell.org Sat Oct 29 01:27:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Oct 2016 01:27:42 +0000 (UTC) Subject: [commit: ghc] ghc-7.10's head updated: ErrUtils: Add timings to compiler phases (fb40d41) Message-ID: <20161029012742.2987B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-7.10' now includes: fb40d41 ErrUtils: Add timings to compiler phases From git at git.haskell.org Sat Oct 29 18:34:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Oct 2016 18:34:08 +0000 (UTC) Subject: [commit: ghc] master: Fix a bug in parallel GC synchronisation (4e088b4) Message-ID: <20161029183408.944AC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e088b497edd83f361898fa9d2d62ff310b08945/ghc >--------------------------------------------------------------- commit 4e088b497edd83f361898fa9d2d62ff310b08945 Author: Simon Marlow Date: Fri Oct 28 08:30:14 2016 -0700 Fix a bug in parallel GC synchronisation Summary: The problem boils down to global variables: in particular gc_threads[], which was being modified by a subsequent GC before the previous GC had finished with it. The fix is to not use global variables. This was causing setnumcapabilities001 to fail (again!). It's an old bug though. Test Plan: Ran setnumcapabilities001 in a loop for a couple of hours. Before this patch it had been failing after a few minutes. Not a very scientific test, but it's the best I have. Reviewers: bgamari, austin, fryguybob, niteria, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2654 >--------------------------------------------------------------- 4e088b497edd83f361898fa9d2d62ff310b08945 rts/Schedule.c | 30 ++++++++++++++++-------------- rts/sm/GC.c | 39 +++++++++++++++++++++------------------ rts/sm/GC.h | 6 +++--- rts/sm/GCThread.h | 2 -- 4 files changed, 40 insertions(+), 37 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 4e088b497edd83f361898fa9d2d62ff310b08945 From git at git.haskell.org Sun Oct 30 21:49:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 30 Oct 2016 21:49:14 +0000 (UTC) Subject: [commit: ghc] master: Zap redundant imports (7ddbdfd) Message-ID: <20161030214914.CF8243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ddbdfd399a91eed410f3bd5a7caff2fd4bcce92/ghc >--------------------------------------------------------------- commit 7ddbdfd399a91eed410f3bd5a7caff2fd4bcce92 Author: Gabor Greif Date: Sun Oct 30 19:02:33 2016 +0100 Zap redundant imports >--------------------------------------------------------------- 7ddbdfd399a91eed410f3bd5a7caff2fd4bcce92 compiler/backpack/NameShape.hs | 2 -- compiler/codeGen/StgCmmEnv.hs | 1 - compiler/main/GhcMake.hs | 1 - 3 files changed, 4 deletions(-) diff --git a/compiler/backpack/NameShape.hs b/compiler/backpack/NameShape.hs index da1b5ea..ea6e193 100644 --- a/compiler/backpack/NameShape.hs +++ b/compiler/backpack/NameShape.hs @@ -24,8 +24,6 @@ import TcRnMonad import Util import IfaceEnv -import Avail ( plusAvail ) - import Control.Monad -- Note [NameShape] diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs index 30307a2..01c99ec 100644 --- a/compiler/codeGen/StgCmmEnv.hs +++ b/compiler/codeGen/StgCmmEnv.hs @@ -28,7 +28,6 @@ import TyCon import StgCmmMonad import StgCmmUtils import StgCmmClosure -import StgSyn (StgArg) import CLabel diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index cd9fb15..2340f3f 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -69,7 +69,6 @@ import UniqSet import Util import qualified GHC.LanguageExtensions as LangExt import NameEnv -import TcRnDriver (findExtraSigImports, implicitRequirements) import Data.Either ( rights, partitionEithers ) import qualified Data.Map as Map From git at git.haskell.org Mon Oct 31 16:43:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 31 Oct 2016 16:43:33 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (80d4a03) Message-ID: <20161031164333.9FB473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80d4a03332e09064e5542924f2897d7eb573f19e/ghc >--------------------------------------------------------------- commit 80d4a03332e09064e5542924f2897d7eb573f19e Author: Gabor Greif Date: Mon Oct 31 12:08:50 2016 +0100 Typos in comments >--------------------------------------------------------------- 80d4a03332e09064e5542924f2897d7eb573f19e compiler/iface/MkIface.hs | 2 +- compiler/rename/RnEnv.hs | 2 +- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/typecheck/TcType.hs | 2 +- compiler/vectorise/Vectorise/Monad/Naming.hs | 2 +- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- libraries/base/System/Console/GetOpt.hs | 2 +- testsuite/tests/ffi/should_run/ffi005.hs | 2 +- testsuite/tests/polykinds/T7332.hs | 4 ++-- testsuite/tests/typecheck/should_compile/tc080.hs | 12 ++++++------ 12 files changed, 18 insertions(+), 18 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 80d4a03332e09064e5542924f2897d7eb573f19e From git at git.haskell.org Mon Oct 31 21:03:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 31 Oct 2016 21:03:41 +0000 (UTC) Subject: [commit: ghc] master: Align GHCi's library search order more closely with LDs (795be0e) Message-ID: <20161031210341.095173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/795be0ea60fc81aefdaf6ecb1dc9b03c4a5c9f86/ghc >--------------------------------------------------------------- commit 795be0ea60fc81aefdaf6ecb1dc9b03c4a5c9f86 Author: Tamar Christina Date: Mon Oct 31 21:03:14 2016 +0000 Align GHCi's library search order more closely with LDs Summary: Given a static library and an import library in the same folder. e.g. ``` libfoo.a libfoo.dll.a ``` running `ghci -lfoo` we should prefer the import library `libfoo.dll.a` over `libfoo.a` because we prefer having to just load the DLL. And not having to do any linking. This also more closely emulated the behaviour of LD, which has a search order of ``` libxxx.dll.a xxx.dll.a libxxx.a cygxxx.dll (*) libxxx.dll xxx.dll ``` Test Plan: ./validate Reviewers: RyanGlScott, austin, hvr, bgamari, erikd, simonmar Reviewed By: RyanGlScott Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2651 GHC Trac Issues: #12771 >--------------------------------------------------------------- 795be0ea60fc81aefdaf6ecb1dc9b03c4a5c9f86 compiler/ghci/Linker.hs | 7 ++++--- testsuite/tests/rts/T12771/Makefile | 10 ++++++++++ .../should_run/bkprun02.stdout => rts/T12771/T12771.stdout} | 0 testsuite/tests/rts/T12771/all.T | 5 +++++ testsuite/tests/rts/T12771/foo.c | 6 ++++++ testsuite/tests/rts/T12771/foo_dll.c | 4 ++++ testsuite/tests/rts/T12771/main.hs | 5 +++++ 7 files changed, 34 insertions(+), 3 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index a2ca1b5..73d0fac 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -1281,7 +1281,8 @@ loadFrameworks hsc_env platform pkg -- If it isn't present, we assume that addDLL in the RTS can find it, -- which generally means that it should be a dynamic library in the -- standard system search path. - +-- For GHCi we tend to prefer dynamic libraries over static ones as +-- they are easier to load and manage, have less overhead. locateLib :: HscEnv -> Bool -> [FilePath] -> String -> IO LibrarySpec locateLib hsc_env is_hs dirs lib | not is_hs @@ -1290,16 +1291,16 @@ locateLib hsc_env is_hs dirs 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 "gcc --print-file-name" to search gcc's search path -- then try looking for import libraries on Windows (.dll.a, .lib) + -- then try "gcc --print-file-name" to search gcc's search path -- then look in library-dirs and inplace GCC for a static library (libfoo.a) -- for a dynamic library (#5289) -- otherwise, assume loadDLL can find it -- = findDll `orElse` findSysDll `orElse` - tryGcc `orElse` tryImpLib `orElse` + tryGcc `orElse` findArchive `orElse` assumeDll diff --git a/testsuite/tests/rts/T12771/Makefile b/testsuite/tests/rts/T12771/Makefile new file mode 100644 index 0000000..d6960a0 --- /dev/null +++ b/testsuite/tests/rts/T12771/Makefile @@ -0,0 +1,10 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T12771: + '$(TEST_CC)' -c foo.c -o foo.o + '$(AR)' rsc libfoo.a foo.o + '$(TEST_HC)' -shared foo_dll.c -o libfoo-1.dll + mv libfoo-1.dll.a libfoo.dll.a + echo main | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) main.hs -lfoo -L"$(PWD)" diff --git a/testsuite/tests/backpack/should_run/bkprun02.stdout b/testsuite/tests/rts/T12771/T12771.stdout similarity index 100% copy from testsuite/tests/backpack/should_run/bkprun02.stdout copy to testsuite/tests/rts/T12771/T12771.stdout diff --git a/testsuite/tests/rts/T12771/all.T b/testsuite/tests/rts/T12771/all.T new file mode 100644 index 0000000..50933d5 --- /dev/null +++ b/testsuite/tests/rts/T12771/all.T @@ -0,0 +1,5 @@ +test('T12771', [ extra_clean(['libfoo.a', 'libfoo-1.dll', 'foo.o', 'main.o']) + , extra_files(['foo.c', 'main.hs', 'foo_dll.c']) + , unless(opsys('mingw32'), skip) + ], + run_command, ['$MAKE -s --no-print-directory T12771']) diff --git a/testsuite/tests/rts/T12771/foo.c b/testsuite/tests/rts/T12771/foo.c new file mode 100644 index 0000000..af8ad9c --- /dev/null +++ b/testsuite/tests/rts/T12771/foo.c @@ -0,0 +1,6 @@ +extern int bar(); + +int foo () +{ + return bar(); +} diff --git a/testsuite/tests/rts/T12771/foo_dll.c b/testsuite/tests/rts/T12771/foo_dll.c new file mode 100644 index 0000000..8ea6c22 --- /dev/null +++ b/testsuite/tests/rts/T12771/foo_dll.c @@ -0,0 +1,4 @@ +int foo() +{ + return 1; +} diff --git a/testsuite/tests/rts/T12771/main.hs b/testsuite/tests/rts/T12771/main.hs new file mode 100644 index 0000000..fbc8f56 --- /dev/null +++ b/testsuite/tests/rts/T12771/main.hs @@ -0,0 +1,5 @@ +module Main where + +foreign import ccall "foo" c_foo :: Int + +main = print c_foo