From git at git.haskell.org Tue Sep 1 05:41:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Sep 2015 05:41:23 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Non-GADT PmPat type and pmTraverse (31e5c00) Message-ID: <20150901054123.4A5F73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/31e5c00db2682625c92f16560dd6511355260688/ghc >--------------------------------------------------------------- commit 31e5c00db2682625c92f16560dd6511355260688 Author: George Karachalias Date: Mon Aug 31 17:10:52 2015 +0200 Non-GADT PmPat type and pmTraverse >--------------------------------------------------------------- 31e5c00db2682625c92f16560dd6511355260688 compiler/deSugar/Check.hs | 676 +++++++++++++++++++------------------------ compiler/deSugar/TmOracle.hs | 14 +- 2 files changed, 302 insertions(+), 388 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 31e5c00db2682625c92f16560dd6511355260688 From git at git.haskell.org Tue Sep 1 05:42:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Sep 2015 05:42:25 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Added incremental interface for the term oracle (84b478a) Message-ID: <20150901054225.633F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/84b478af2c6fdcd03f81e78203fae1d54a63f336/ghc >--------------------------------------------------------------- commit 84b478af2c6fdcd03f81e78203fae1d54a63f336 Author: George Karachalias Date: Tue Sep 1 07:44:03 2015 +0200 Added incremental interface for the term oracle >--------------------------------------------------------------- 84b478af2c6fdcd03f81e78203fae1d54a63f336 compiler/deSugar/TmOracle.hs | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/compiler/deSugar/TmOracle.hs b/compiler/deSugar/TmOracle.hs index dd57704..372c30f 100644 --- a/compiler/deSugar/TmOracle.hs +++ b/compiler/deSugar/TmOracle.hs @@ -21,6 +21,9 @@ module TmOracle , filterComplex , runPmPprM , pprPmExprWithParens + +-- Incremental version +, solveSimplesIncr, initialIncrState ) where #include "HsVersions.h" @@ -710,3 +713,24 @@ instance Outputable PmLit where instance Outputable PmExpr where ppr e = fst $ runPmPprM (pprPmExpr e) [] + +-- ---------------------------------------------------------------------------- + +initialIncrState :: ([ComplexEq], TmOracleEnv) +initialIncrState = ([], ([], Map.empty)) + +solveSimplesIncr :: ([ComplexEq], TmOracleEnv) -- residual & previous state + -> [SimpleEq] -- what to solve + -> Either Failure ([ComplexEq], TmOracleEnv) +solveSimplesIncr (residual, (unhandled, mapping)) simples + = runExcept (runStateT result (unhandled, mapping)) + where + complex = map (applySubstSimpleEq mapping) simples ++ residual + result = prepComplexEqM complex >>= iterateComplex + +applySubstSimpleEq :: PmVarEnv -> SimpleEq -> ComplexEq +applySubstSimpleEq env (x,e2) + = case Map.lookup x env of + Just e1 -> (e1, getValuePmExpr env e2) + Nothing -> (PmExprVar x, getValuePmExpr env e2) + From git at git.haskell.org Wed Sep 2 10:31:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 10:31:01 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: refactoring only (ad26c54) Message-ID: <20150902103101.4429D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad26c54b86a868567d324d5de6fd0b4c2ed28022/ghc >--------------------------------------------------------------- commit ad26c54b86a868567d324d5de6fd0b4c2ed28022 Author: Thomas Miedema Date: Fri Aug 28 12:03:30 2015 +0200 Testsuite: refactoring only * Rename `platform_wordsize_qualify` to `find_expected_file`, and make it return a filename instead of an (absolute) filepath. * Replace most usages of `qualify` by `in_testdir`. Others usage sites will be deleted in a later commit. These changes will be useful in a later commit, when we'll distinguish between files in the source directory and those in a (newly created) test directory. Reviewed by: austin, bgamari Differential Revision: https://phabricator.haskell.org/D1186 >--------------------------------------------------------------- ad26c54b86a868567d324d5de6fd0b4c2ed28022 testsuite/driver/testlib.py | 111 +++++++++++++++++++++++--------------------- 1 file changed, 58 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ad26c54b86a868567d324d5de6fd0b4c2ed28022 From git at git.haskell.org Wed Sep 2 11:15:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 11:15:00 +0000 (UTC) Subject: [commit: packages/array] master: update output for tests/T2120 (2f5b772) Message-ID: <20150902111500.A90423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/2f5b772f4475d70a68c6f9d10390ac9812afdb7d >--------------------------------------------------------------- commit 2f5b772f4475d70a68c6f9d10390ac9812afdb7d Author: Eric Seidel Date: Thu Jul 9 14:06:28 2015 -0700 update output for tests/T2120 >--------------------------------------------------------------- 2f5b772f4475d70a68c6f9d10390ac9812afdb7d tests/T2120.stdout | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/T2120.stdout b/tests/T2120.stdout index 518a3e8..89c73bc 100644 --- a/tests/T2120.stdout +++ b/tests/T2120.stdout @@ -1,2 +1,6 @@ Ix{Int}.index: Index (5) out of range ((1,4)) +CallStack: + error, called at libraries/base/GHC/Arr.hs:176:5 in base:GHC.Arr Error in array index +CallStack: + error, called at libraries/base/GHC/Arr.hs:182:22 in base:GHC.Arr From git at git.haskell.org Wed Sep 2 11:22:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 11:22:46 +0000 (UTC) Subject: [commit: ghc] master: Use IP based CallStack in error and undefined (6740d70) Message-ID: <20150902112246.C93EC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6740d70d95cb81cea3859ff847afc61ec439db4f/ghc >--------------------------------------------------------------- commit 6740d70d95cb81cea3859ff847afc61ec439db4f Author: Eric Seidel Date: Wed Sep 2 10:22:01 2015 +0200 Use IP based CallStack in error and undefined This patch modifies `error`, `undefined`, and `assertError` to use implicit call-stacks to provide better error messages to users. There are a few knock-on effects: - `GHC.Classes.IP` is now wired-in so it can be used in the wired-in types for `error` and `undefined`. - `TysPrim.tyVarList` has been replaced with a new function `TysPrim.mkTemplateTyVars`. `tyVarList` made it easy to introduce subtle bugs when you need tyvars of different kinds. The naive ``` tv1 = head $ tyVarList kind1 tv2 = head $ tyVarList kind2 ``` would result in `tv1` and `tv2` sharing a `Unique`, thus substitutions would be applied incorrectly, treating `tv1` and `tv2` as the same tyvar. `mkTemplateTyVars` avoids this pitfall by taking a list of kinds and producing a single tyvar of each kind. - The types `GHC.SrcLoc.SrcLoc` and `GHC.Stack.CallStack` now live in ghc-prim. - The type `GHC.Exception.ErrorCall` has a new constructor `ErrorCallWithLocation` that takes two `String`s instead of one, the 2nd one being arbitrary metadata about the error (but usually the call-stack). A bi-directional pattern synonym `ErrorCall` continues to provide the old API. Updates Cabal, array, and haddock submodules. Reviewers: nh2, goldfire, simonpj, hvr, rwbarton, austin, bgamari Reviewed By: simonpj Subscribers: rwbarton, rodlogic, goldfire, maoe, simonmar, carter, liyang, bgamari, thomie Differential Revision: https://phabricator.haskell.org/D861 GHC Trac Issues: #5273 >--------------------------------------------------------------- 6740d70d95cb81cea3859ff847afc61ec439db4f compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/MkCore.hs | 28 +++++--- compiler/iface/IfaceType.hs | 4 +- compiler/prelude/PrelNames.hs | 27 ++++---- compiler/prelude/TysPrim.hs | 29 +++++---- compiler/prelude/TysWiredIn.hs | 74 ++++++++++++++++++++-- compiler/typecheck/TcBinds.hs | 6 +- compiler/typecheck/TcExpr.hs | 32 +++------- compiler/typecheck/TcHsType.hs | 3 +- compiler/typecheck/TcInteract.hs | 8 +-- compiler/typecheck/TcTypeNats.hs | 10 +-- compiler/types/Type.hs | 6 +- compiler/types/TypeRep.hs | 2 +- docs/users_guide/7.12.1-notes.xml | 41 ++++++++---- docs/users_guide/glasgow_exts.xml | 4 +- libraries/Cabal | 2 +- libraries/array | 2 +- libraries/base/Control/Exception.hs | 3 +- libraries/base/Control/Exception/Base.hs | 3 +- libraries/base/GHC/Err.hs | 10 +-- libraries/base/GHC/Exception.hs | 57 +++++++++++++++-- libraries/base/GHC/Exception.hs-boot | 5 +- libraries/base/GHC/IO/Exception.hs | 10 +-- libraries/base/GHC/SrcLoc.hs | 40 ------------ libraries/base/GHC/Stack.hsc | 62 +----------------- libraries/base/base.cabal | 1 - libraries/base/tests/assert.stderr | 4 +- libraries/ghc-prim/GHC/Types.hs | 51 ++++++++++++++- .../tests/annotations/should_fail/annfail12.stderr | 4 +- testsuite/tests/cabal/cabal07/cabal07.stderr | 5 +- testsuite/tests/deriving/should_run/T9576.stderr | 2 +- testsuite/tests/driver/T1372/T1372.stderr | 1 + .../tests/ghci.debugger/scripts/break009.stdout | 2 + .../tests/ghci.debugger/scripts/break011.stdout | 26 ++++++-- .../tests/ghci.debugger/scripts/break017.stdout | 3 + testsuite/tests/ghci/scripts/T10501.stderr | 5 ++ testsuite/tests/ghci/scripts/T5557.stdout | 6 ++ testsuite/tests/ghci/scripts/ghci055.stdout | 5 +- testsuite/tests/perf/compiler/all.T | 10 ++- .../tests/simplCore/should_compile/EvalTest.stdout | 2 +- testsuite/tests/simplCore/should_compile/T4930.hs | 2 +- .../tests/simplCore/should_compile/T4930.stderr | 48 +++++++------- testsuite/tests/th/T5358.stderr | 2 + testsuite/tests/th/T5976.stderr | 6 +- testsuite/tests/th/T7276a.stdout | 6 +- testsuite/tests/th/T8987.stderr | 5 +- testsuite/tests/th/TH_exn2.stderr | 8 ++- utils/haddock | 2 +- 48 files changed, 408 insertions(+), 268 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 6740d70d95cb81cea3859ff847afc61ec439db4f From git at git.haskell.org Wed Sep 2 11:49:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 11:49:25 +0000 (UTC) Subject: [commit: ghc] master: Fix trac #10413 (010e187) Message-ID: <20150902114925.525313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/010e1878c9c851a638211a03fd58bfa6bdd93081/ghc >--------------------------------------------------------------- commit 010e1878c9c851a638211a03fd58bfa6bdd93081 Author: Ben Gamari Date: Wed Sep 2 13:26:22 2015 +0200 Fix trac #10413 Test Plan: Validate. Reviewers: austin, tibbe, bgamari Reviewed By: tibbe, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1194 GHC Trac Issues: #10413 >--------------------------------------------------------------- 010e1878c9c851a638211a03fd58bfa6bdd93081 compiler/codeGen/StgCmmPrim.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 7188c05..e7b709f 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -417,7 +417,9 @@ emitPrimOp _ [] WriteSmallArrayOp [obj,ix,v] = doWriteSmallPtrArrayOp obj -- Getting the size of pointer arrays emitPrimOp dflags [res] SizeofArrayOp [arg] - = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags + oFFSET_StgMutArrPtrs_ptrs dflags) (bWord dflags)) + = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg + (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgMutArrPtrs_ptrs dflags)) + (bWord dflags)) emitPrimOp dflags [res] SizeofMutableArrayOp [arg] = emitPrimOp dflags [res] SizeofArrayOp [arg] emitPrimOp dflags [res] SizeofArrayArrayOp [arg] @@ -428,7 +430,8 @@ emitPrimOp dflags [res] SizeofMutableArrayArrayOp [arg] emitPrimOp dflags [res] SizeofSmallArrayOp [arg] = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg - (fixedHdrSizeW dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags) (bWord dflags)) + (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgSmallMutArrPtrs_ptrs dflags)) + (bWord dflags)) emitPrimOp dflags [res] SizeofSmallMutableArrayOp [arg] = emitPrimOp dflags [res] SizeofSmallArrayOp [arg] From git at git.haskell.org Wed Sep 2 11:49:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 11:49:28 +0000 (UTC) Subject: [commit: ghc] master: Add test for updating a record with existentially quantified fields. (ff9432f) Message-ID: <20150902114928.BF1C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff9432f600ca294fb747b0288dc10659d035d45e/ghc >--------------------------------------------------------------- commit ff9432f600ca294fb747b0288dc10659d035d45e Author: Matthew Pickering Date: Wed Sep 2 13:28:34 2015 +0200 Add test for updating a record with existentially quantified fields. Test Plan: ./validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1193 >--------------------------------------------------------------- ff9432f600ca294fb747b0288dc10659d035d45e testsuite/tests/typecheck/should_compile/all.T | 1 + .../typecheck/should_compile/update-existential.hs | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index d9f2bd8..b469689 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -469,3 +469,4 @@ test('T10564', normal, compile, ['']) test('T10632', normal, compile, ['']) test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) +test('update-existential', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_compile/update-existential.hs b/testsuite/tests/typecheck/should_compile/update-existential.hs new file mode 100644 index 0000000..e216d1d --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/update-existential.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE + NoImplicitPrelude + , ExistentialQuantification + #-} + +module Test where + +hGetContents handle_ = handle_{ haType=SemiClosedHandle} + +data HandleType = SemiClosedHandle + +class Show a where + show :: a -> a + +-- they have to check whether the handle has indeed been closed. +data Handle__ + = forall dev . (Show dev) => + Handle__ { + haDevice :: !dev, + haType :: HandleType -- type (read/write/append etc.) +} From git at git.haskell.org Wed Sep 2 11:49:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 11:49:31 +0000 (UTC) Subject: [commit: ghc] master: Use a response file for linker command line arguments #10777 (296bc70) Message-ID: <20150902114931.AA2643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/296bc70b5ff6c853f2782e9ec5aa47a52110345e/ghc >--------------------------------------------------------------- commit 296bc70b5ff6c853f2782e9ec5aa47a52110345e Author: Michael Snoyman Date: Wed Sep 2 13:31:25 2015 +0200 Use a response file for linker command line arguments #10777 On Windows, we're constrained to 32k bytes total for command line arguments. When building large projects, this limit can be exceeded. This patch changes GHC to always use response files for linker arguments, a feature first used by Microsoft compilers and added to GCC (over a decade ago). Alternatives here include: * Only use this method on Windows systems * Check the length of the command line arguments and use that to decide whether to use this method I did not pursue either of these, as I believe it would make the patch more likely to break in less tested situations. Test Plan: Confirm that linking still works in general. Ideally: compile a very large project on Windows with this patch. (I am attempting to do that myself now, but having trouble getting the Windows build tool chain up and running.) Reviewers: goldfire, hvr, rwbarton, austin, thomie, bgamari, Phyx Reviewed By: thomie, bgamari, Phyx Subscribers: erikd, awson, #ghc_windows_task_force, thomie Differential Revision: https://phabricator.haskell.org/D1158 GHC Trac Issues: #8596, #10777 >--------------------------------------------------------------- 296bc70b5ff6c853f2782e9ec5aa47a52110345e compiler/main/SysTools.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 54 insertions(+), 2 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index af1f546..b624862 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -412,7 +412,7 @@ runCc dflags args = do args1 = map Option (getOpts dflags opt_c) args2 = args0 ++ args1 ++ args mb_env <- getGccEnv args2 - runSomethingFiltered dflags cc_filter "C Compiler" p args2 mb_env + runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env where -- discard some harmless warnings from gcc that we can't turn off cc_filter = unlines . doFilter . lines @@ -926,7 +926,7 @@ runLink dflags args = do args1 = map Option (getOpts dflags opt_l) args2 = args0 ++ linkargs ++ args1 ++ args mb_env <- getGccEnv args2 - runSomethingFiltered dflags ld_filter "Linker" p args2 mb_env + runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env where ld_filter = case (platformOS (targetPlatform dflags)) of OSSolaris2 -> sunos_ld_filter @@ -1254,6 +1254,58 @@ runSomething :: DynFlags runSomething dflags phase_name pgm args = runSomethingFiltered dflags id phase_name pgm args Nothing +-- | Run a command, placing the arguments in an external response file. +-- +-- This command is used in order to avoid overlong command line arguments on +-- Windows. The command line arguments are first written to an external, +-- temporary response file, and then passed to the linker via @filepath. +-- response files for passing them in. See: +-- +-- https://gcc.gnu.org/wiki/Response_Files +-- https://ghc.haskell.org/trac/ghc/ticket/10777 +runSomethingResponseFile + :: DynFlags -> (String->String) -> String -> String -> [Option] + -> Maybe [(String,String)] -> IO () + +runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env = + runSomethingWith dflags phase_name pgm args $ \real_args -> do + fp <- getResponseFile real_args + let args = ['@':fp] + r <- builderMainLoop dflags filter_fn pgm args mb_env + return (r,()) + where + getResponseFile args = do + fp <- newTempName dflags "rsp" + withFile fp WriteMode $ \h -> do + hSetEncoding h utf8 + hPutStr h $ unlines $ map escape args + return fp + + -- Note: Response files have backslash-escaping, double quoting, and are + -- whitespace separated (some implementations use newline, others any + -- whitespace character). Therefore, escape any backslashes, newlines, and + -- double quotes in the argument, and surround the content with double + -- quotes. + -- + -- Another possibility that could be considered would be to convert + -- backslashes in the argument to forward slashes. This would generally do + -- the right thing, since backslashes in general only appear in arguments + -- as part of file paths on Windows, and the forward slash is accepted for + -- those. However, escaping is more reliable, in case somehow a backslash + -- appears in a non-file. + escape x = concat + [ "\"" + , concatMap + (\c -> + case c of + '\\' -> "\\\\" + '\n' -> "\\n" + '\"' -> "\\\"" + _ -> [c]) + x + , "\"" + ] + runSomethingFiltered :: DynFlags -> (String->String) -> String -> String -> [Option] -> Maybe [(String,String)] -> IO () From git at git.haskell.org Wed Sep 2 11:55:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 11:55:35 +0000 (UTC) Subject: [commit: ghc] master: Allow annotations though addTopDecls (#10486) (ba5554e) Message-ID: <20150902115535.4DB3D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba5554ec2753cc41f5e087a91f23e1f612a9eb29/ghc >--------------------------------------------------------------- commit ba5554ec2753cc41f5e087a91f23e1f612a9eb29 Author: Michael Smith Date: Wed Sep 2 13:56:27 2015 +0200 Allow annotations though addTopDecls (#10486) addTopDecls restricts what declarations it can be used to add. Adding annotations via this method works fine with no special changes apart from adding AnnD to the declaration whitelist. Test Plan: validate Reviewers: austin, goldfire, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1201 GHC Trac Issues: #10486 >--------------------------------------------------------------- ba5554ec2753cc41f5e087a91f23e1f612a9eb29 compiler/typecheck/TcSplice.hs | 4 +++- docs/users_guide/7.12.1-notes.xml | 6 ++++++ testsuite/tests/annotations/should_compile/th/TestModuleTH.hs | 10 ++++++++++ .../tests/annotations/should_compile/th/annth_compunits.stdout | 8 ++++---- .../tests/annotations/should_compile/th/annth_make.stdout | 8 ++++---- 5 files changed, 27 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 7c9882b..a018e4a 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -817,10 +817,12 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where = mapM_ bindName (collectHsBindBinders binds) checkTopDecl (SigD _) = return () + checkTopDecl (AnnD _) + = return () checkTopDecl (ForD (ForeignImport (L _ name) _ _ _)) = bindName name checkTopDecl _ - = addErr $ text "Only function, value, and foreign import declarations may be added with addTopDecl" + = addErr $ text "Only function, value, annotation, and foreign import declarations may be added with addTopDecl" bindName :: RdrName -> TcM () bindName (Exact n) diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index 5829666..3916e71 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -188,6 +188,12 @@ char literals. + + + addTopDecls now accepts annotation + pragmas. + + diff --git a/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs index f21b137..715cc25 100644 --- a/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs +++ b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs @@ -3,16 +3,26 @@ module TestModuleTH where import Language.Haskell.TH +import Language.Haskell.TH.Syntax (addTopDecls) $(do modAnn <- pragAnnD ModuleAnnotation (stringE "TH module annotation") + modAnn' <- pragAnnD ModuleAnnotation + (stringE "addTopDecls module annotation") [typ] <- [d| data TestTypeTH = TestTypeTH |] conAnn <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH") (stringE "TH Constructor annotation") + conAnn' <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH") + (stringE "addTopDecls Constructor annotation") typAnn <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH") (stringE "TH Type annotation") + typAnn' <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH") + (stringE "addTopDecls Type annotation") valAnn <- pragAnnD (ValueAnnotation $ mkName "testValueTH") (stringE "TH Value annotation") + valAnn' <- pragAnnD (ValueAnnotation $ mkName "testValueTH") + (stringE "addTopDecls value annotation") [val] <- [d| testValueTH = (42 :: Int) |] + addTopDecls [modAnn', conAnn', typAnn', valAnn'] return [modAnn, conAnn, typAnn, typ, valAnn, val] ) diff --git a/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout index 96e4642..51fa405 100644 --- a/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout +++ b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout @@ -1,7 +1,7 @@ -["TH module annotation","Module annotation"] +["TH module annotation","addTopDecls module annotation","Module annotation"] ["Value annotation"] -["TH Value annotation"] +["TH Value annotation","addTopDecls value annotation"] ["Type annotation"] -["TH Type annotation"] +["TH Type annotation","addTopDecls Type annotation"] ["Constructor annotation"] -["TH Constructor annotation"] +["TH Constructor annotation","addTopDecls Constructor annotation"] diff --git a/testsuite/tests/annotations/should_compile/th/annth_make.stdout b/testsuite/tests/annotations/should_compile/th/annth_make.stdout index 96e4642..51fa405 100644 --- a/testsuite/tests/annotations/should_compile/th/annth_make.stdout +++ b/testsuite/tests/annotations/should_compile/th/annth_make.stdout @@ -1,7 +1,7 @@ -["TH module annotation","Module annotation"] +["TH module annotation","addTopDecls module annotation","Module annotation"] ["Value annotation"] -["TH Value annotation"] +["TH Value annotation","addTopDecls value annotation"] ["Type annotation"] -["TH Type annotation"] +["TH Type annotation","addTopDecls Type annotation"] ["Constructor annotation"] -["TH Constructor annotation"] +["TH Constructor annotation","addTopDecls Constructor annotation"] From git at git.haskell.org Wed Sep 2 13:38:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 13:38:41 +0000 (UTC) Subject: [commit: packages/stm] master: stm: Fix test case (826ad99) Message-ID: <20150902133841.B5A4D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/826ad990713c5ba57b93a51e2514e48b40dff224 >--------------------------------------------------------------- commit 826ad990713c5ba57b93a51e2514e48b40dff224 Author: Ben Gamari Date: Wed Sep 2 09:34:00 2015 -0400 stm: Fix test case >--------------------------------------------------------------- 826ad990713c5ba57b93a51e2514e48b40dff224 tests/stm060.stdout | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/stm060.stdout b/tests/stm060.stdout index b476708..947395b 100644 --- a/tests/stm060.stdout +++ b/tests/stm060.stdout @@ -24,6 +24,8 @@ Caught: Exn raised in invariant Adding a trivially false invariant (no TVar access) Caught: Transactional invariant violation +CallStack: + error, called at libraries/base/GHC/Conc/Sync.hs:767:61 in base:GHC.Conc.Sync Adding a trivially false invariant (with TVar access) Caught: Exn raised in invariant From git at git.haskell.org Wed Sep 2 13:39:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 13:39:31 +0000 (UTC) Subject: [commit: ghc] master: Expand declaration QQs first (#10047) (c8f623e) Message-ID: <20150902133931.F24483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c8f623e305ec0a51ac2406a1f754d244e05b96f5/ghc >--------------------------------------------------------------- commit c8f623e305ec0a51ac2406a1f754d244e05b96f5 Author: Michael Smith Date: Wed Sep 2 13:57:44 2015 +0200 Expand declaration QQs first (#10047) Declaration QuasiQuoters do not cause a group split like $(...) splices, and are run and expanded before other declarations in the group. Resolves the lingering issue with #10047, and fixes broken tests qq007 and qq008. Test Plan: validate Reviewers: goldfire, austin, bgamari Reviewed By: bgamari Subscribers: goldfire, simonpj, thomie, spinda Differential Revision: https://phabricator.haskell.org/D1199 GHC Trac Issues: #10047 >--------------------------------------------------------------- c8f623e305ec0a51ac2406a1f754d244e05b96f5 compiler/rename/RnSource.hs | 9 ++++- compiler/rename/RnSplice.hs-boot | 2 + docs/users_guide/7.12.1-notes.xml | 47 +++++++++++----------- docs/users_guide/glasgow_exts.xml | 39 +++++++++++++++++- testsuite/tests/quasiquotation/qq007/test.T | 1 - testsuite/tests/quasiquotation/qq008/test.T | 1 - .../tests/quasiquotation/{qq007 => qq009}/Makefile | 1 - testsuite/tests/quasiquotation/qq009/QQ.hs | 14 +++++++ testsuite/tests/quasiquotation/qq009/Test.hs | 9 +++++ .../tests/quasiquotation/{qq008 => qq009}/test.T | 3 +- 10 files changed, 94 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 c8f623e305ec0a51ac2406a1f754d244e05b96f5 From git at git.haskell.org Wed Sep 2 13:39:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 13:39:34 +0000 (UTC) Subject: [commit: ghc] master: Improve the error messages for class instance errors (28ac9d3) Message-ID: <20150902133934.F15B13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28ac9d31bcabeb44496c0e1750563f3091c62da9/ghc >--------------------------------------------------------------- commit 28ac9d31bcabeb44496c0e1750563f3091c62da9 Author: Simon Peyton Jones Date: Wed Sep 2 14:05:36 2015 +0200 Improve the error messages for class instance errors Summary: See Note [Displaying potential instances]. Reviewers: austin Subscribers: KaneTW, thomie Differential Revision: https://phabricator.haskell.org/D1176 >--------------------------------------------------------------- 28ac9d31bcabeb44496c0e1750563f3091c62da9 compiler/main/DynFlags.hs | 2 + compiler/typecheck/TcErrors.hs | 106 +++++++++++++++++---- docs/users_guide/flags.xml | 6 ++ docs/users_guide/using.xml | 10 ++ .../tests/annotations/should_fail/annfail10.stderr | 10 +- .../tests/ghci.debugger/scripts/break006.stderr | 10 +- .../tests/ghci.debugger/scripts/print019.stderr | 5 +- testsuite/tests/ghci/scripts/Defer02.stderr | 75 ++++++++------- .../tests/indexed-types/should_fail/T4485.stderr | 6 +- .../should_fail/overloadedlistsfail01.stderr | 14 +-- testsuite/tests/quotes/TH_localname.stderr | 3 +- testsuite/tests/rebindable/rebindable6.stderr | 6 +- testsuite/tests/rename/should_fail/mc14.stderr | 3 +- .../tests/typecheck/should_compile/holes2.stderr | 3 +- testsuite/tests/typecheck/should_fail/T4921.stderr | 8 +- testsuite/tests/typecheck/should_fail/T5095.stderr | 78 +-------------- testsuite/tests/typecheck/should_fail/T5858.stderr | 4 +- testsuite/tests/typecheck/should_fail/T7857.stderr | 4 +- .../tests/typecheck/should_fail/tcfail008.stderr | 7 +- .../tests/typecheck/should_fail/tcfail040.stderr | 4 +- .../tests/typecheck/should_fail/tcfail043.stderr | 8 +- .../tests/typecheck/should_fail/tcfail072.stderr | 12 ++- .../tests/typecheck/should_fail/tcfail128.stderr | 4 +- .../tests/typecheck/should_fail/tcfail133.stderr | 9 +- .../tests/typecheck/should_fail/tcfail181.stderr | 5 +- 25 files changed, 219 insertions(+), 183 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 28ac9d31bcabeb44496c0e1750563f3091c62da9 From git at git.haskell.org Wed Sep 2 13:39:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 13:39:37 +0000 (UTC) Subject: [commit: ghc] master: stm: Fix test case (3cc8f07) Message-ID: <20150902133937.C861E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3cc8f075313a4f7e934ba69250a167a62f3005af/ghc >--------------------------------------------------------------- commit 3cc8f075313a4f7e934ba69250a167a62f3005af Author: Ben Gamari Date: Wed Sep 2 09:34:56 2015 -0400 stm: Fix test case Updates stm submodule. >--------------------------------------------------------------- 3cc8f075313a4f7e934ba69250a167a62f3005af libraries/stm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/stm b/libraries/stm index b5cb4c4..826ad99 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit b5cb4c462e008c666631c14435df0dd90fb20517 +Subproject commit 826ad990713c5ba57b93a51e2514e48b40dff224 From git at git.haskell.org Wed Sep 2 15:40:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 15:40:17 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: don't warn about missing specialisations (5d7a873) Message-ID: <20150902154017.864483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d7a873a6bae4e2be70252dbc585d766e129e9f9/ghc >--------------------------------------------------------------- commit 5d7a873a6bae4e2be70252dbc585d766e129e9f9 Author: Thomas Miedema Date: Wed Sep 2 15:45:57 2015 +0200 Testsuite: don't warn about missing specialisations They can only occur with `-O`, but we want tests to produce the same output for all test ways. This brings us closer to passing the complete testsuite. Differential Revision: https://phabricator.haskell.org/D1203 >--------------------------------------------------------------- 5d7a873a6bae4e2be70252dbc585d766e129e9f9 compiler/specialise/Specialise.hs | 1 + testsuite/mk/test.mk | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index b68191f..e3501df 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -738,6 +738,7 @@ warnMissingSpecs :: DynFlags -> [Id] -> Bool -- See Note [Warning about missed specialisations] warnMissingSpecs dflags callers | wopt Opt_WarnAllMissedSpecs dflags = True + | not (wopt Opt_WarnMissedSpecs dflags) = False | null callers = False | otherwise = all has_inline_prag callers where diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 7a4e4f1..920d634 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -44,6 +44,10 @@ TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user- # TEST_HC_OPTS += -fno-warn-tabs +# Don't warn about missing specialisations. They can only occur with `-O`, but +# we want tests to produce the same output for all test ways. +TEST_HC_OPTS += -fno-warn-missed-specialisations + RUNTEST_OPTS = ifeq "$(filter $(TargetOS_CPP), cygwin32 mingw32)" "" From git at git.haskell.org Wed Sep 2 16:30:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 16:30:09 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: update expected output (e0b3ff0) Message-ID: <20150902163009.B3C013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0b3ff0f21f046c14f753182d3ec5c64dd9ecab4/ghc >--------------------------------------------------------------- commit e0b3ff0f21f046c14f753182d3ec5c64dd9ecab4 Author: Thomas Miedema Date: Wed Sep 2 18:30:07 2015 +0200 Testsuite: update expected output >--------------------------------------------------------------- e0b3ff0f21f046c14f753182d3ec5c64dd9ecab4 testsuite/tests/ghci/scripts/T9293.stdout | 4 ++++ testsuite/tests/ghci/scripts/ghci024.stdout | 1 + testsuite/tests/ghci/scripts/ghci057.stdout | 4 ++++ 3 files changed, 9 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout index 67fc630..1dc12f1 100644 --- a/testsuite/tests/ghci/scripts/T9293.stdout +++ b/testsuite/tests/ghci/scripts/T9293.stdout @@ -8,6 +8,7 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should fail, GADTs is not enabled options currently set: none. base language is: Haskell2010 @@ -22,6 +23,7 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should work, GADTs is in force from :set options currently set: none. base language is: Haskell2010 @@ -35,6 +37,7 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should fail, GADTs is now disabled base language is: Haskell2010 with the following modifiers: @@ -50,5 +53,6 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should fail, GADTs is only enabled at the prompt C :: T Int diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout index 1624322..084f1ff 100644 --- a/testsuite/tests/ghci/scripts/ghci024.stdout +++ b/testsuite/tests/ghci/scripts/ghci024.stdout @@ -9,6 +9,7 @@ other dynamic, non-language, flag settings: -fforce-recomp -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations -fno-warn-tabs ~~~~~~~~~~ Testing :set -a options currently set: none. diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout index 67fc630..1dc12f1 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stdout +++ b/testsuite/tests/ghci/scripts/ghci057.stdout @@ -8,6 +8,7 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should fail, GADTs is not enabled options currently set: none. base language is: Haskell2010 @@ -22,6 +23,7 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should work, GADTs is in force from :set options currently set: none. base language is: Haskell2010 @@ -35,6 +37,7 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should fail, GADTs is now disabled base language is: Haskell2010 with the following modifiers: @@ -50,5 +53,6 @@ other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified warning settings: + -fno-warn-missed-specialisations Should fail, GADTs is only enabled at the prompt C :: T Int From git at git.haskell.org Wed Sep 2 16:49:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 16:49:13 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: mark 4 tests expect_broken_for(#10712, opt_ways) (3b23379) Message-ID: <20150902164913.DC3123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3b233793b2131c1c77be3b2d81f48e569c422439/ghc >--------------------------------------------------------------- commit 3b233793b2131c1c77be3b2d81f48e569c422439 Author: Thomas Miedema Date: Wed Sep 2 18:49:25 2015 +0200 Testsuite: mark 4 tests expect_broken_for(#10712, opt_ways) Please revert when #10712 is fixed. >--------------------------------------------------------------- 3b233793b2131c1c77be3b2d81f48e569c422439 libraries/base/tests/all.T | 2 +- testsuite/tests/concurrent/should_run/all.T | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index d77db30..7021c2d 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -81,7 +81,7 @@ test('enum01', when(fast(), skip), compile_and_run, ['']) test('enum02', when(fast(), skip), compile_and_run, ['']) test('enum03', when(fast(), skip), compile_and_run, ['']) test('enum04', normal, compile_and_run, ['']) -test('exceptionsrun001', normal, compile_and_run, ['']) +test('exceptionsrun001', expect_broken_for(10712, opt_ways), compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) test('foldableArray', normal, compile_and_run, ['']) test('list001' , when(fast(), skip), compile_and_run, ['']) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 80734ad..f4bd781 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -32,7 +32,7 @@ test('T367_letnoescape', test('T1980', normal, compile_and_run, ['']) test('T2910', normal, compile_and_run, ['']) test('T2910a', normal, compile_and_run, ['']) -test('T3279', normal, compile_and_run, ['']) +test('T3279', expect_broken_for(10712, opt_ways), compile_and_run, ['']) # This test takes a long time with the default context switch interval test('T3429', extra_run_opts('+RTS -C0.001 -RTS'), compile_and_run, ['']) @@ -129,11 +129,12 @@ test('conc009', exit_code(1), compile_and_run, ['']) test('conc010', normal, compile_and_run, ['']) # conc012(ghci) needs a smaller stack, or it takes forever -test('conc012', extra_run_opts('+RTS -K8m -RTS'), compile_and_run, ['']) +test('conc012', + [extra_run_opts('+RTS -K8m -RTS'), expect_broken_for(10712, opt_ways)], + compile_and_run, ['']) test('conc013', normal, compile_and_run, ['']) - -test('conc014', normal, compile_and_run, ['']) +test('conc014', expect_broken_for(10712, opt_ways), compile_and_run, ['']) test('conc015', normal, compile_and_run, ['']) test('conc015a', normal, compile_and_run, ['']) test('conc016', omit_ways(['threaded2']), # see comment in conc016.hs From git at git.haskell.org Wed Sep 2 18:14:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 18:14:42 +0000 (UTC) Subject: [commit: packages/hpc] master: fix tests broken by D861 (da5928c) Message-ID: <20150902181442.2874B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/da5928ccf4e369f6985ef291351d074918b88019 >--------------------------------------------------------------- commit da5928ccf4e369f6985ef291351d074918b88019 Author: Eric Seidel Date: Wed Sep 2 10:38:12 2015 -0700 fix tests broken by D861 >--------------------------------------------------------------- da5928ccf4e369f6985ef291351d074918b88019 tests/function/tough.stdout | 4 ++++ tests/function2/tough2.stdout | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/tests/function/tough.stdout b/tests/function/tough.stdout index aed0fd2..22adc34 100644 --- a/tests/function/tough.stdout +++ b/tests/function/tough.stdout @@ -1,7 +1,11 @@ "Hello" "Hello" badCase +CallStack: + error, called at tough.hs:39:14 in main:Main badCase +CallStack: + error, called at tough.hs:39:14 in main:Main "Bark" "Hello" (1,2,3) diff --git a/tests/function2/tough2.stdout b/tests/function2/tough2.stdout index 2594091..690f386 100644 --- a/tests/function2/tough2.stdout +++ b/tests/function2/tough2.stdout @@ -1,7 +1,11 @@ "Hello" "Hello" badCase +CallStack: + error, called at subdir/tough2.lhs:40:14 in main:Main badCase +CallStack: + error, called at subdir/tough2.lhs:40:14 in main:Main "Bark" "Hello" (1,2,3) From git at git.haskell.org Wed Sep 2 18:29:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 18:29:14 +0000 (UTC) Subject: [commit: ghc] master: Fix some tests that were broken by D861 (32a9ead) Message-ID: <20150902182914.97BDD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/32a9eada8dc4f61a2fb801edf1fda822cb56e0dd/ghc >--------------------------------------------------------------- commit 32a9eada8dc4f61a2fb801edf1fda822cb56e0dd Author: Eric Seidel Date: Wed Sep 2 20:17:01 2015 +0200 Fix some tests that were broken by D861 I didn't realize that `./validate` does not run every test :( Test Plan: ./validate --slow Update submodule hpc. Differential Revision: https://phabricator.haskell.org/D1204 >--------------------------------------------------------------- 32a9eada8dc4f61a2fb801edf1fda822cb56e0dd libraries/hpc | 2 +- testsuite/.gitignore | 1 + testsuite/tests/typecheck/should_run/IPLocation.hs | 3 +- .../tests/typecheck/should_run/IPLocation.stdout | 56 +++++++++++----------- 4 files changed, 32 insertions(+), 30 deletions(-) diff --git a/libraries/hpc b/libraries/hpc index a9ecba1..da5928c 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit a9ecba162ae307acf12a1a783dbe1cf6ebb5729d +Subproject commit da5928ccf4e369f6985ef291351d074918b88019 diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 7496958..10abec4 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1481,6 +1481,7 @@ mk/ghcconfig*_bin_ghc*.exe.mk /tests/typecheck/should_fail/tcfail149 /tests/typecheck/should_run/Defer01 /tests/typecheck/should_run/IPRun +/tests/typecheck/should_run/IPLocation /tests/typecheck/should_run/T1624 /tests/typecheck/should_run/T1735 /tests/typecheck/should_run/T2722 diff --git a/testsuite/tests/typecheck/should_run/IPLocation.hs b/testsuite/tests/typecheck/should_run/IPLocation.hs index ffc377b..63f73d2 100644 --- a/testsuite/tests/typecheck/should_run/IPLocation.hs +++ b/testsuite/tests/typecheck/should_run/IPLocation.hs @@ -2,7 +2,8 @@ {-# OPTIONS_GHC -dcore-lint #-} module Main where -import GHC.Stack +import GHC.Exception +import GHC.Types f0 = putStrLn $ showCallStack ?loc -- should just show the location of ?loc diff --git a/testsuite/tests/typecheck/should_run/IPLocation.stdout b/testsuite/tests/typecheck/should_run/IPLocation.stdout index 6dca721..47de194 100644 --- a/testsuite/tests/typecheck/should_run/IPLocation.stdout +++ b/testsuite/tests/typecheck/should_run/IPLocation.stdout @@ -1,28 +1,28 @@ -?loc, called at IPLocation.hs:7:31 in main:Main - -?loc, called at IPLocation.hs:11:31 in main:Main - f1, called at IPLocation.hs:39:11 in main:Main - -?loc, called at IPLocation.hs:15:34 in main:Main - f2, called at IPLocation.hs:40:11 in main:Main - -?loc, called at IPLocation.hs:16:34 in main:Main - f2, called at IPLocation.hs:40:11 in main:Main - -?loc, called at IPLocation.hs:41:48 in main:Main - x, called at IPLocation.hs:21:8 in main:Main - -?loc, called at IPLocation.hs:42:48 in main:Main - x, called at IPLocation.hs:26:8 in main:Main - f4, called at IPLocation.hs:42:11 in main:Main - -?loc3, called at IPLocation.hs:43:48 in main:Main - -?loc, called at IPLocation.hs:34:33 in main:Main - f6, called at IPLocation.hs:35:8 in main:Main - f6, called at IPLocation.hs:35:8 in main:Main - f6, called at IPLocation.hs:35:8 in main:Main - f6, called at IPLocation.hs:35:8 in main:Main - f6, called at IPLocation.hs:35:8 in main:Main - f6, called at IPLocation.hs:44:11 in main:Main - +CallStack: + ?loc, called at IPLocation.hs:8:31 in main:Main +CallStack: + ?loc, called at IPLocation.hs:12:31 in main:Main + f1, called at IPLocation.hs:40:11 in main:Main +CallStack: + ?loc, called at IPLocation.hs:16:34 in main:Main + f2, called at IPLocation.hs:41:11 in main:Main +CallStack: + ?loc, called at IPLocation.hs:17:34 in main:Main + f2, called at IPLocation.hs:41:11 in main:Main +CallStack: + ?loc, called at IPLocation.hs:42:48 in main:Main + x, called at IPLocation.hs:22:8 in main:Main +CallStack: + ?loc, called at IPLocation.hs:43:48 in main:Main + x, called at IPLocation.hs:27:8 in main:Main + f4, called at IPLocation.hs:43:11 in main:Main +CallStack: + ?loc3, called at IPLocation.hs:44:48 in main:Main +CallStack: + ?loc, called at IPLocation.hs:35:33 in main:Main + f6, called at IPLocation.hs:36:8 in main:Main + f6, called at IPLocation.hs:36:8 in main:Main + f6, called at IPLocation.hs:36:8 in main:Main + f6, called at IPLocation.hs:36:8 in main:Main + f6, called at IPLocation.hs:36:8 in main:Main + f6, called at IPLocation.hs:45:11 in main:Main From git at git.haskell.org Wed Sep 2 18:29:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 18:29:17 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: by default run all tests for a single way (c43c8e2) Message-ID: <20150902182917.7EACD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c43c8e2c8a6780737b476ada871387a73c43ee68/ghc >--------------------------------------------------------------- commit c43c8e2c8a6780737b476ada871387a73c43ee68 Author: Thomas Miedema Date: Thu Aug 27 12:44:15 2015 +0200 Testsuite: by default run all tests for a single way `make test` now runs all tests for a single way only. Use `make slowtest` to get the previous behaviour (i.e. run all tests for all ways). The intention is to use this new `make test` setting for Phabricator, as a reasonable compromise between `make fasttest` (what it previously used) and a fullblown `make slowtest` (which runs all tests for all ways). See Note [validate and testsuite speed] in toplevel Makefile. Differential Revision: https://phabricator.haskell.org/D1178 >--------------------------------------------------------------- c43c8e2c8a6780737b476ada871387a73c43ee68 .travis.yml | 2 ++ Makefile | 31 +++++++++++++++++++++++++++-- testsuite/Makefile | 5 ++++- testsuite/driver/testglobals.py | 4 ++-- testsuite/driver/testlib.py | 9 +++++---- testsuite/mk/test.mk | 20 +++++++++++++------ testsuite/tests/concurrent/should_run/all.T | 6 +----- testsuite/tests/gadt/all.T | 2 +- testsuite/tests/typecheck/should_run/all.T | 5 +---- validate | 10 +++++----- 10 files changed, 64 insertions(+), 30 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 c43c8e2c8a6780737b476ada871387a73c43ee68 From git at git.haskell.org Wed Sep 2 18:29:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 18:29:20 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete dead code (bd16e0b) Message-ID: <20150902182920.598243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd16e0bc6af13f1347235782935f7dcd40b260e2/ghc >--------------------------------------------------------------- commit bd16e0bc6af13f1347235782935f7dcd40b260e2 Author: Thomas Miedema Date: Fri Aug 28 01:00:31 2015 +0200 Testsuite: delete dead code >--------------------------------------------------------------- bd16e0bc6af13f1347235782935f7dcd40b260e2 testsuite/driver/testlib.py | 3 --- 1 file changed, 3 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 68a9208..5a587a7 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1407,11 +1407,8 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ): stdin_file = qualify(name, 'stdin') if os.path.exists(stdin_file): - stdin = open(stdin_file, 'r') os.system('cat ' + stdin_file + ' >>' + qscriptname) - script.close() - flags = ' '.join(get_compiler_flags(override_flags=None, noforce=False) + config.way_flags(name)[way]) From git at git.haskell.org Wed Sep 2 23:50:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 23:50:02 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T10830' created Message-ID: <20150902235002.6B0113A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T10830 Referencing: 6066e1fa6770f2cae3114ab4d4dbde04176863cb From git at git.haskell.org Wed Sep 2 23:50:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Sep 2015 23:50:05 +0000 (UTC) Subject: [commit: ghc] wip/T10830: Make Data.List.foldr1 inline (6066e1f) Message-ID: <20150902235005.AF7553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10830 Link : http://ghc.haskell.org/trac/ghc/changeset/6066e1fa6770f2cae3114ab4d4dbde04176863cb/ghc >--------------------------------------------------------------- commit 6066e1fa6770f2cae3114ab4d4dbde04176863cb Author: Joachim Breitner Date: Wed Sep 2 15:58:38 2015 -0700 Make Data.List.foldr1 inline Previously, foldr1 would be defiend recursively and thus not inline. This is bad, for example, when maximumBy has a strict comparison function: Before the BBP, it was implemented via foldl1, which inlined and yielded good code. With BBP, it goes via foldr1, so we better inline this as well. Fixes #10830. >--------------------------------------------------------------- 6066e1fa6770f2cae3114ab4d4dbde04176863cb libraries/base/GHC/List.hs | 8 +++++--- testsuite/tests/simplCore/should_run/T10830.hs | 3 +++ testsuite/tests/simplCore/should_run/all.T | 1 + 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index fcc89d3..ca3fb75 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -355,9 +355,11 @@ match on everything past the :, which is just the tail of scanl. -- and thus must be applied to non-empty lists. foldr1 :: (a -> a -> a) -> [a] -> a -foldr1 _ [x] = x -foldr1 f (x:xs) = f x (foldr1 f xs) -foldr1 _ [] = errorEmptyList "foldr1" +foldr1 f = go + where go [x] = x + go (x:xs) = f x (go xs) + go [] = errorEmptyList "foldr1" +{-# INLINE [0] foldr1 #-} -- | 'scanr' is the right-to-left dual of 'scanl'. -- Note that diff --git a/testsuite/tests/simplCore/should_run/T10830.hs b/testsuite/tests/simplCore/should_run/T10830.hs new file mode 100644 index 0000000..354f0f5 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T10830.hs @@ -0,0 +1,3 @@ +import GHC.OldList +main :: IO () +main = maximumBy compare [1..10000] `seq` return () diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 364dfd6..ba775b7 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -69,3 +69,4 @@ test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, test('T9128', normal, compile_and_run, ['']) test('T9390', normal, compile_and_run, ['']) +test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, ['']) From git at git.haskell.org Thu Sep 3 03:54:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Sep 2015 03:54:20 +0000 (UTC) Subject: [commit: ghc] master: Injective type families (3744578) Message-ID: <20150903035420.5B4123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/374457809de343f409fbeea0a885877947a133a2/ghc >--------------------------------------------------------------- commit 374457809de343f409fbeea0a885877947a133a2 Author: Jan Stolarek Date: Fri Jul 11 13:54:45 2014 +0200 Injective type families For details see #6018, Phab:D202 and the wiki page: https://ghc.haskell.org/trac/ghc/wiki/InjectiveTypeFamilies This patch also wires-in Maybe data type and updates haddock submodule. Test Plan: ./validate Reviewers: simonpj, goldfire, austin, bgamari Subscribers: mpickering, bgamari, alanz, thomie, goldfire, simonmar, carter Differential Revision: https://phabricator.haskell.org/D202 GHC Trac Issues: #6018 >--------------------------------------------------------------- 374457809de343f409fbeea0a885877947a133a2 compiler/basicTypes/MkId.hs | 8 +- compiler/basicTypes/VarSet.hs | 5 +- compiler/coreSyn/MkCore.hs | 21 ++ compiler/deSugar/DsMeta.hs | 180 +++++++---- compiler/hsSyn/Convert.hs | 56 +++- compiler/hsSyn/HsDecls.hs | 335 +++++++++++++++------ compiler/hsSyn/HsTypes.hs | 2 +- compiler/hsSyn/PlaceHolder.hs | 2 +- compiler/iface/BuildTyCl.hs | 22 +- compiler/iface/IfaceSyn.hs | 35 ++- compiler/iface/MkIface.hs | 9 +- compiler/iface/TcIface.hs | 11 +- compiler/main/GHC.hs | 4 +- compiler/parser/ApiAnnotation.hs | 2 +- compiler/parser/Parser.y | 79 +++-- compiler/parser/RdrHsSyn.hs | 29 +- compiler/prelude/PrelNames.hs | 26 +- compiler/prelude/THNames.hs | 196 ++++++------ compiler/prelude/TysPrim.hs | 3 +- compiler/prelude/TysWiredIn.hs | 38 ++- compiler/rename/RnSource.hs | 164 +++++++++- compiler/rename/RnTypes.hs | 58 ++-- compiler/typecheck/FamInst.hs | 187 ++++++++++-- compiler/typecheck/TcCanonical.hs | 6 +- compiler/typecheck/TcEnv.hs | 3 +- compiler/typecheck/TcEvidence.hs | 4 +- compiler/typecheck/TcHsType.hs | 18 +- compiler/typecheck/TcInstDcls.hs | 16 +- compiler/typecheck/TcInteract.hs | 318 +++++++++++++------ compiler/typecheck/TcMType.hs | 27 +- compiler/typecheck/TcRnDriver.hs | 6 +- compiler/typecheck/TcRnMonad.hs | 13 + compiler/typecheck/TcSMonad.hs | 166 ++++++---- compiler/typecheck/TcSplice.hs | 78 +++-- compiler/typecheck/TcTyClsDecls.hs | 182 ++++++----- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcValidity.hs | 72 ++++- compiler/types/CoAxiom.hs | 18 +- compiler/types/Coercion.hs | 3 +- compiler/types/FamInstEnv.hs | 335 ++++++++++++++++++--- compiler/types/Kind.hs | 11 +- compiler/types/OptCoercion.hs | 4 +- compiler/types/TyCon.hs | 81 ++++- compiler/types/TypeRep.hs | 11 +- compiler/types/TypeRep.hs-boot | 3 + compiler/types/Unify.hs | 61 +++- compiler/utils/Outputable.hs | 22 +- compiler/utils/UniqFM.hs | 3 + docs/users_guide/7.12.1-notes.xml | 10 + docs/users_guide/glasgow_exts.xml | 105 +++++++ libraries/template-haskell/Language/Haskell/TH.hs | 13 +- .../template-haskell/Language/Haskell/TH/Lib.hs | 86 ++++-- .../template-haskell/Language/Haskell/TH/Ppr.hs | 61 ++-- .../template-haskell/Language/Haskell/TH/PprLib.hs | 4 +- .../template-haskell/Language/Haskell/TH/Syntax.hs | 29 +- .../tests/ghci.debugger/scripts/print019.stderr | 2 +- testsuite/tests/ghci/scripts/T6018ghci.script | 22 ++ .../tests/ghci/scripts/T6018ghci.stdout | 0 testsuite/tests/ghci/scripts/T6018ghcifail.script | 114 +++++++ testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 111 +++++++ .../tests/ghci/scripts/T6018ghcirnfail.script | 42 +++ .../tests/ghci/scripts/T6018ghcirnfail.stderr | 63 ++++ testsuite/tests/ghci/scripts/all.T | 3 + .../indexed-types/should_compile/T9085.stderr | 2 +- testsuite/tests/indexed-types/should_fail/T9160.hs | 3 +- .../should_fail/overloadedlistsfail01.stderr | 2 +- testsuite/tests/quotes/TH_localname.stderr | 3 +- testsuite/tests/rename/should_fail/T6018rnfail.hs | 54 ++++ .../tests/rename/should_fail/T6018rnfail.stderr | 71 +++++ testsuite/tests/rename/should_fail/all.T | 1 + testsuite/tests/rename/should_fail/mc14.stderr | 3 +- testsuite/tests/th/ClosedFam2TH.hs | 22 +- testsuite/tests/th/T10306.hs | 4 +- testsuite/tests/th/T6018th.hs | 120 ++++++++ testsuite/tests/th/T6018th.stderr | 6 + testsuite/tests/th/T8028.hs | 4 +- testsuite/tests/th/T8028a.hs | 2 +- testsuite/tests/th/T8884.hs | 13 +- testsuite/tests/th/T8884.stderr | 7 +- testsuite/tests/th/TH_RichKinds2.hs | 4 +- testsuite/tests/th/TH_reifyDecl1.hs | 2 - testsuite/tests/th/all.T | 1 + testsuite/tests/typecheck/should_compile/T6018.hs | 254 ++++++++++++++++ .../tests/typecheck/should_compile/T6018.hs-boot | 7 + .../tests/typecheck/should_compile/T6018.stderr | 11 + testsuite/tests/typecheck/should_compile/T6018a.hs | 11 + testsuite/tests/typecheck/should_compile/all.T | 4 + .../tests/typecheck/should_compile/holes2.stderr | 2 +- testsuite/tests/typecheck/should_compile/tc265.hs | 8 + .../tests/typecheck/should_compile/tc265.stderr | 4 + .../tests/typecheck/should_fail/T6018Afail.hs | 7 + .../tests/typecheck/should_fail/T6018Bfail.hs | 5 + .../tests/typecheck/should_fail/T6018Cfail.hs | 8 + .../tests/typecheck/should_fail/T6018Dfail.hs | 7 + testsuite/tests/typecheck/should_fail/T6018fail.hs | 134 +++++++++ .../tests/typecheck/should_fail/T6018fail.stderr | 149 +++++++++ .../typecheck/should_fail/T6018failclosed1.hs | 11 + .../typecheck/should_fail/T6018failclosed1.stderr | 7 + .../typecheck/should_fail/T6018failclosed10.hs | 17 ++ .../typecheck/should_fail/T6018failclosed10.stderr | 9 + .../typecheck/should_fail/T6018failclosed11.hs | 15 + .../typecheck/should_fail/T6018failclosed11.stderr | 7 + .../typecheck/should_fail/T6018failclosed12.hs | 7 + .../typecheck/should_fail/T6018failclosed12.stderr | 8 + .../typecheck/should_fail/T6018failclosed2.hs | 12 + .../typecheck/should_fail/T6018failclosed2.stderr | 16 + .../typecheck/should_fail/T6018failclosed3.hs | 8 + .../typecheck/should_fail/T6018failclosed3.stderr | 8 + .../typecheck/should_fail/T6018failclosed4.hs | 10 + .../typecheck/should_fail/T6018failclosed4.stderr | 8 + .../typecheck/should_fail/T6018failclosed5.hs | 12 + .../typecheck/should_fail/T6018failclosed5.stderr | 8 + .../typecheck/should_fail/T6018failclosed6.hs | 7 + .../typecheck/should_fail/T6018failclosed6.stderr | 9 + .../typecheck/should_fail/T6018failclosed7.hs | 8 + .../typecheck/should_fail/T6018failclosed7.stderr | 7 + .../typecheck/should_fail/T6018failclosed8.hs | 8 + .../typecheck/should_fail/T6018failclosed8.stderr | 7 + .../typecheck/should_fail/T6018failclosed9.hs | 8 + .../typecheck/should_fail/T6018failclosed9.stderr | 8 + testsuite/tests/typecheck/should_fail/T9201.stderr | 2 +- testsuite/tests/typecheck/should_fail/T9260.stderr | 5 +- testsuite/tests/typecheck/should_fail/all.T | 18 ++ .../tests/typecheck/should_fail/tcfail072.stderr | 2 +- .../tests/typecheck/should_fail/tcfail133.stderr | 3 +- .../tests/typecheck/should_fail/tcfail181.stderr | 2 +- utils/haddock | 2 +- 127 files changed, 3962 insertions(+), 842 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 374457809de343f409fbeea0a885877947a133a2 From git at git.haskell.org Thu Sep 3 17:27:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Sep 2015 17:27:21 +0000 (UTC) Subject: [commit: ghc] master: Add test for T10836 (expected broken) (5dc88b7) Message-ID: <20150903172721.6DECC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5dc88b72e4c3cc066e19ea5ece98ce152cd0ca25/ghc >--------------------------------------------------------------- commit 5dc88b72e4c3cc066e19ea5ece98ce152cd0ca25 Author: Jan Stolarek Date: Thu Sep 3 19:28:44 2015 +0200 Add test for T10836 (expected broken) >--------------------------------------------------------------- 5dc88b72e4c3cc066e19ea5ece98ce152cd0ca25 testsuite/tests/typecheck/should_fail/T10836.hs | 10 ++++++++++ testsuite/tests/typecheck/should_fail/T10836.stderr | 14 ++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 25 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T10836.hs b/testsuite/tests/typecheck/should_fail/T10836.hs new file mode 100644 index 0000000..00c5c6a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T10836.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +module T10836 where + +type family Foo a = r | r -> a where + Foo Int = Int + Foo Bool = Int + +type family Bar a = r | r -> a where + Bar Int = Int + Bar Bool = Int diff --git a/testsuite/tests/typecheck/should_fail/T10836.stderr b/testsuite/tests/typecheck/should_fail/T10836.stderr new file mode 100644 index 0000000..b96d371 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T10836.stderr @@ -0,0 +1,14 @@ + +T10836.hs:5:5: error: + Type family equations violate injectivity annotation: + Foo Int = Int + Foo Bool = Int + In the equations for closed type family ?Foo? + In the type family declaration for ?Foo? + +T10836.hs:9:5: error: + Type family equations violate injectivity annotation: + Bar Int = Int + Bar Bool = Int + In the equations for closed type family ?Bar? + In the type family declaration for ?Bar? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 85532de..66b8a86 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -395,3 +395,4 @@ test('ExpandSynsFail2', normal, compile_fail, ['-fprint-expanded-synonyms']) test('ExpandSynsFail3', normal, compile_fail, ['-fprint-expanded-synonyms']) test('ExpandSynsFail4', normal, compile_fail, ['-fprint-expanded-synonyms']) test('T10698', expect_broken(10698), compile_fail, ['']) +test('T10836', expect_broken(10836), compile_fail, ['']) From git at git.haskell.org Thu Sep 3 21:14:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Sep 2015 21:14:20 +0000 (UTC) Subject: [commit: ghc] master: Accept underscores in the module parser. (Thanks spinda for the fix.) (34b106f) Message-ID: <20150903211420.B72273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34b106f65325d7642ad37ac49d2b9b90dd7684e6/ghc >--------------------------------------------------------------- commit 34b106f65325d7642ad37ac49d2b9b90dd7684e6 Author: Edward Z. Yang Date: Thu Sep 3 14:16:03 2015 -0700 Accept underscores in the module parser. (Thanks spinda for the fix.) Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 34b106f65325d7642ad37ac49d2b9b90dd7684e6 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 0dacb0c..6b44e16 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3718,7 +3718,7 @@ clearPkgConf = upd $ \s -> s { extraPkgConfs = const [] } parseModuleName :: ReadP ModuleName parseModuleName = fmap mkModuleName - $ munch1 (\c -> isAlphaNum c || c `elem` ".") + $ munch1 (\c -> isAlphaNum c || c `elem` "_.") parsePackageFlag :: (String -> PackageArg) -- type of argument -> String -- string to parse From git at git.haskell.org Thu Sep 3 22:05:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Sep 2015 22:05:06 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: ignore line number differences in call stacks (#10834) (79cdb25) Message-ID: <20150903220506.11D7D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/79cdb2544d2c68050dbd147936a31e8eb06a4c67/ghc >--------------------------------------------------------------- commit 79cdb2544d2c68050dbd147936a31e8eb06a4c67 Author: Thomas Miedema Date: Thu Sep 3 14:56:50 2015 +0200 Testsuite: ignore line number differences in call stacks (#10834) Differential Revision: https://phabricator.haskell.org/D1206 >--------------------------------------------------------------- 79cdb2544d2c68050dbd147936a31e8eb06a4c67 testsuite/driver/testlib.py | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index ee6f631..6b3426e 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1680,11 +1680,18 @@ def normalise_whitespace( str ): str = re.sub('[ \t\n]+', ' ', str) return str.strip() +def normalise_callstacks(str): + # Ignore line number differences in call stacks (#10834). + return re.sub(', called at (.+):[\\d]+:[\\d]+ in', + ', called at \\1:: in', + str) + def normalise_errmsg( str ): # remove " error:" and lower-case " Warning:" to make patch for # trac issue #10021 smaller str = modify_lines(str, lambda l: re.sub(' error:', '', l)) str = modify_lines(str, lambda l: re.sub(' Warning:', ' warning:', l)) + str = normalise_callstacks(str) # If somefile ends in ".exe" or ".exe:", zap ".exe" (for Windows) # the colon is there because it appears in error messages; this @@ -1748,6 +1755,7 @@ def normalise_output( str ): # Remove a .exe extension (for Windows) # This can occur in error messages generated by the program. str = re.sub('([^\\s])\\.exe', '\\1', str) + str = normalise_callstacks(str) return str def normalise_asm( str ): From git at git.haskell.org Thu Sep 3 22:05:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Sep 2015 22:05:08 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: only print msg when timeout kills process unexpectedly (e1293bb) Message-ID: <20150903220508.DE4BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1293bbfb1fa1fdeb56446a7b957d6f628042e71/ghc >--------------------------------------------------------------- commit e1293bbfb1fa1fdeb56446a7b957d6f628042e71 Author: Thomas Miedema Date: Thu Sep 3 16:13:42 2015 +0200 Testsuite: only print msg when timeout kills process unexpectedly Differential Revision: https://phabricator.haskell.org/D1207 >--------------------------------------------------------------- e1293bbfb1fa1fdeb56446a7b957d6f628042e71 testsuite/driver/testlib.py | 4 ++++ testsuite/timeout/timeout.py | 2 -- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 5a587a7..ee6f631 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1798,6 +1798,10 @@ def rawSystemWithTimeout(cmd_and_args): if r == 98: # The python timeout program uses 98 to signal that ^C was pressed stopNow() + if r == 99 and getTestOpts().exit_code != 99: + # Only print a message when timeout killed the process unexpectedly. + cmd = cmd_and_args[-1] + if_verbose(1, 'Timeout happened...killed process "{}"...\n'.format(cmd)) return r # cmd is a complex command in Bourne-shell syntax diff --git a/testsuite/timeout/timeout.py b/testsuite/timeout/timeout.py index 1016e2d..51fb63c 100644 --- a/testsuite/timeout/timeout.py +++ b/testsuite/timeout/timeout.py @@ -35,8 +35,6 @@ try: else: # parent def handler(signum, frame): - msg = 'Timeout happened...killing process %s...\n' % cmd - sys.stderr.write(msg) killProcess(pid) sys.exit(99) old = signal.signal(signal.SIGALRM, handler) From git at git.haskell.org Thu Sep 3 22:05:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Sep 2015 22:05:11 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: fix tcfail220 - Maybe is wired-in now (b639c97) Message-ID: <20150903220511.C1BFE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b639c977fda47dd0088b0cf1c970018f032188a2/ghc >--------------------------------------------------------------- commit b639c977fda47dd0088b0cf1c970018f032188a2 Author: Thomas Miedema Date: Thu Sep 3 17:01:10 2015 +0200 Testsuite: fix tcfail220 - Maybe is wired-in now This fixes validate. 374457809de343f409fbeea0a885877947a133a2 (D202) mentions: "This patch also wires-in Maybe data type". A conflicting definition of a wired-in type in a .hsig file doesn't seem to cause compilation to fail. This is probably a bug, but a small one. Since SPJ in ffc21506894c7887d3620423aaf86bc6113a1071 swept this under the rug, by removing `data Bool a b c d = False` from tcfail220.hsig, I'm going to do the same here. D1098 touches these files, so ezyang can decide whether this problem warrants fixing when doing a rebase. Differential Revision: https://phabricator.haskell.org/D1208 >--------------------------------------------------------------- b639c977fda47dd0088b0cf1c970018f032188a2 testsuite/tests/typecheck/should_fail/tcfail220.hsig | 2 +- testsuite/tests/typecheck/should_fail/tcfail220.stderr | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/tcfail220.hsig b/testsuite/tests/typecheck/should_fail/tcfail220.hsig index 560fc31..c9e80e3 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail220.hsig +++ b/testsuite/tests/typecheck/should_fail/tcfail220.hsig @@ -1,4 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-} module ShouldFail where -data Maybe a b = Nothing +data Either a b c = Left a diff --git a/testsuite/tests/typecheck/should_fail/tcfail220.stderr b/testsuite/tests/typecheck/should_fail/tcfail220.stderr index 432dc4c..d78fa6d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail220.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail220.stderr @@ -1,9 +1,9 @@ [1 of 1] Compiling ShouldFail[sig of Prelude] ( tcfail220.hsig, nothing ) tcfail220.hsig:4:1: error: - Type constructor ?Maybe? has conflicting definitions in the module + Type constructor ?Either? has conflicting definitions in the module and its hsig file - Main module: data Maybe a = Nothing | Just a - Hsig file: type role Maybe phantom phantom - data Maybe a b = Nothing + Main module: data Either a b = Left a | Right b + Hsig file: type role Either representational phantom phantom + data Either a b c = Left a The types have different kinds From git at git.haskell.org Fri Sep 4 00:12:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Sep 2015 00:12:32 +0000 (UTC) Subject: [commit: ghc] master: Make Data.List.foldr1 inline (85915e9) Message-ID: <20150904001232.280863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/85915e9b73a662f3cc474323ec370d4f61817474/ghc >--------------------------------------------------------------- commit 85915e9b73a662f3cc474323ec370d4f61817474 Author: Joachim Breitner Date: Wed Sep 2 15:58:38 2015 -0700 Make Data.List.foldr1 inline Previously, foldr1 would be defiend recursively and thus not inline. This is bad, for example, when maximumBy has a strict comparison function: Before the BBP, it was implemented via foldl1, which inlined and yielded good code. With BBP, it goes via foldr1, so we better inline this as well. Fixes #10830. Differential Revision: https://phabricator.haskell.org/D1205 >--------------------------------------------------------------- 85915e9b73a662f3cc474323ec370d4f61817474 libraries/base/GHC/List.hs | 8 +++++--- testsuite/tests/simplCore/should_run/T10830.hs | 3 +++ testsuite/tests/simplCore/should_run/all.T | 1 + 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index fcc89d3..ca3fb75 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -355,9 +355,11 @@ match on everything past the :, which is just the tail of scanl. -- and thus must be applied to non-empty lists. foldr1 :: (a -> a -> a) -> [a] -> a -foldr1 _ [x] = x -foldr1 f (x:xs) = f x (foldr1 f xs) -foldr1 _ [] = errorEmptyList "foldr1" +foldr1 f = go + where go [x] = x + go (x:xs) = f x (go xs) + go [] = errorEmptyList "foldr1" +{-# INLINE [0] foldr1 #-} -- | 'scanr' is the right-to-left dual of 'scanl'. -- Note that diff --git a/testsuite/tests/simplCore/should_run/T10830.hs b/testsuite/tests/simplCore/should_run/T10830.hs new file mode 100644 index 0000000..354f0f5 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T10830.hs @@ -0,0 +1,3 @@ +import GHC.OldList +main :: IO () +main = maximumBy compare [1..10000] `seq` return () diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 364dfd6..ba775b7 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -69,3 +69,4 @@ test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, test('T9128', normal, compile_and_run, ['']) test('T9390', normal, compile_and_run, ['']) +test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, ['']) From git at git.haskell.org Fri Sep 4 00:13:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Sep 2015 00:13:14 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T10830' deleted Message-ID: <20150904001314.2B6833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T10830 From git at git.haskell.org Fri Sep 4 03:15:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Sep 2015 03:15:23 +0000 (UTC) Subject: [commit: ghc] master: Fix T6018th test failure (19c6049) Message-ID: <20150904031523.DDF343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/19c6049a3d718a3200feab644d6bbbc6b5f2e74b/ghc >--------------------------------------------------------------- commit 19c6049a3d718a3200feab644d6bbbc6b5f2e74b Author: Jan Stolarek Date: Fri Sep 4 05:15:06 2015 +0200 Fix T6018th test failure >--------------------------------------------------------------- 19c6049a3d718a3200feab644d6bbbc6b5f2e74b testsuite/tests/th/T6018th.hs | 1 - testsuite/tests/th/T6018th.stderr | 3 +-- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/testsuite/tests/th/T6018th.hs b/testsuite/tests/th/T6018th.hs index 3205363..91438c8 100644 --- a/testsuite/tests/th/T6018th.hs +++ b/testsuite/tests/th/T6018th.hs @@ -84,7 +84,6 @@ $( do { decl@([ClosedTypeFamilyD _ _ _ (Just inj) _]) <- Bak Int = Char Bak Char = Int Bak a = a |] - ; runIO $ putStrLn (pprint inj) ; return decl } ) diff --git a/testsuite/tests/th/T6018th.stderr b/testsuite/tests/th/T6018th.stderr index 98c318b..4579ea5 100644 --- a/testsuite/tests/th/T6018th.stderr +++ b/testsuite/tests/th/T6018th.stderr @@ -1,6 +1,5 @@ -| r_0 -> a_1 -T6018th.hs:98:4: +T6018th.hs:97:4: Type family equations violate injectivity annotation: H Int Int Int = Bool H Int Char Bool = Bool From git at git.haskell.org Fri Sep 4 13:59:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Sep 2015 13:59:36 +0000 (UTC) Subject: [commit: ghc] master: Build system: implement `make install-strip` (#1851) (64761ce) Message-ID: <20150904135936.1A7A53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64761ce9a899954a12d8e3ae8b400c5ad9648137/ghc >--------------------------------------------------------------- commit 64761ce9a899954a12d8e3ae8b400c5ad9648137 Author: Thomas Miedema Date: Sat Aug 15 17:45:57 2015 +0200 Build system: implement `make install-strip` (#1851) Reviewed by: bgamari Differential Revision: https://phabricator.haskell.org/D1209 >--------------------------------------------------------------- 64761ce9a899954a12d8e3ae8b400c5ad9648137 MAKEHELP.md | 17 +++++++++-------- Makefile | 22 ++++++++++++++++++++++ ghc.mk | 21 +++++++++++++++++---- rules/build-perl.mk | 7 +++++-- rules/build-prog.mk | 2 +- 5 files changed, 54 insertions(+), 15 deletions(-) diff --git a/MAKEHELP.md b/MAKEHELP.md index 3b58292..8537cf9 100644 --- a/MAKEHELP.md +++ b/MAKEHELP.md @@ -24,8 +24,10 @@ Common commands: Shows the targets available in - make install + - make install-strip - Installs GHC, libraries and tools under $(prefix) + Installs GHC, libraries and tools under $(prefix). The install-strip + variant strips executable files while installing them. - make sdist - make binary-dist @@ -33,13 +35,10 @@ Common commands: Builds a source or binary distribution respectively - `make show VALUE=` - - Displays the value of make variable - - `make show! VALUE=` - Same as `make show`, but works right after ./configure (it skips reading - package-data.mk files). + Show the value of make variable . The show! variant works right after + ./configure (it skips reading package-data.mk files). - make clean - make distclean @@ -76,9 +75,11 @@ Using `make` in subdirectories Make documentation in this directory (if any) - - `make show VALUE=var` + - `make show VALUE=` + - `make show! VALUE=` - Show the value of $(var) + Show the value of make variable . The show! variant works right after + ./configure (it skips reading package-data.mk files). - `make ` diff --git a/Makefile b/Makefile index e6a1bc5..217205c 100644 --- a/Makefile +++ b/Makefile @@ -31,6 +31,22 @@ default: install show: $(MAKE) --no-print-directory -f ghc.mk $@ BINDIST=YES NO_INCLUDE_DEPS=YES +# Note [install-strip] +# +# install-strip is like install, but it strips the executable files while +# installing them. +# +# From http://www.gnu.org/prep/standards/html_node/Standard-Targets.html: +# +# "install-strip should not strip the executables in the build directory +# which are being copied for installation. It should only strip the copies +# that are installed. " + +.PHONY: install-strip +install-strip: + # See Note [install-strip]. + $(MAKE) --no-print-directory -f ghc.mk INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install + else .PHONY: default @@ -65,6 +81,7 @@ endif REALGOALS=$(filter-out \ binary-dist \ binary-dist-prep \ + install-strip \ sdist sdist-ghc \ sdist-ghc-prep \ sdist-windows-tarballs \ @@ -125,6 +142,11 @@ else $(MAKE) --no-print-directory -f ghc.mk unix-binary-dist-prep endif +.PHONY: install-strip +install-strip: + # See Note [install-strip]. + $(MAKE) --no-print-directory -f ghc.mk INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install + .PHONY: sdist sdist-ghc sdist-ghc-prep sdist-windows-tarballs sdist-windows-tarballs-prep sdist-testsuite sdist-testsuite-prep # Just running `./boot && ./configure && make sdist` should work, so skip # phase 0 and 1 and don't build any dependency files. diff --git a/ghc.mk b/ghc.mk index e51eb94..b146d5a 100644 --- a/ghc.mk +++ b/ghc.mk @@ -807,6 +807,11 @@ endif define installLibsTo # $1 = libraries to install # $2 = directory to install to +# +# The .dll case calls STRIP_CMD explicitly, instead of `install -s`, because +# on Win64, "install -s" calls a strip that doesn't understand 64bit binaries. +# For some reason, this means the DLLs end up non-executable, which means +# executables that use them just segfault. $(INSTALL_DIR) $2 for i in $1; do \ case $$i in \ @@ -826,11 +831,14 @@ define installLibsTo done endef -install_bins: $(INSTALL_BINS) +install_bins: $(INSTALL_BINS) $(INSTALL_SCRIPTS) $(INSTALL_DIR) "$(DESTDIR)$(bindir)" for i in $(INSTALL_BINS); do \ $(INSTALL_PROGRAM) $(INSTALL_BIN_OPTS) $$i "$(DESTDIR)$(bindir)" ; \ done + for i in $(INSTALL_SCRIPTS); do \ + $(INSTALL_SCRIPT) $(INSTALL_OPTS) $$i "$(DESTDIR)$(bindir)" ; \ + done install_libs: $(INSTALL_LIBS) $(call installLibsTo, $(INSTALL_LIBS), "$(DESTDIR)$(ghclibdir)") @@ -848,11 +856,14 @@ else "$(MV)" "$(DESTDIR)$(ghclibexecdir)/bin/ghc-stage$(INSTALL_GHC_STAGE)" "$(DESTDIR)$(ghclibexecdir)/bin/ghc" endif -install_topdirs: $(INSTALL_TOPDIRS) +install_topdirs: $(INSTALL_TOPDIR_BINS) $(INSTALL_TOPDIR_SCRIPTS) $(INSTALL_DIR) "$(DESTDIR)$(topdir)" - for i in $(INSTALL_TOPDIRS); do \ + for i in $(INSTALL_TOPDIR_BINS); do \ $(INSTALL_PROGRAM) $(INSTALL_BIN_OPTS) $$i "$(DESTDIR)$(topdir)"; \ done + for i in $(INSTALL_TOPDIR_SCRIPTS); do \ + $(INSTALL_SCRIPT) $(INSTALL_OPTS) $$i "$(DESTDIR)$(topdir)"; \ + done install_docs: $(INSTALL_DOCS) $(INSTALL_DIR) "$(DESTDIR)$(docdir)" @@ -963,8 +974,10 @@ $(eval $(call bindist-list,.,\ $(libffi_HEADERS) \ $(INSTALL_LIBEXECS) \ $(INSTALL_LIBEXEC_SCRIPTS) \ - $(INSTALL_TOPDIRS) \ + $(INSTALL_TOPDIR_BINS) \ + $(INSTALL_TOPDIR_SCRIPTS) \ $(INSTALL_BINS) \ + $(INSTALL_SCRIPTS) \ $(INSTALL_MANPAGES) \ $(INSTALL_DOCS) \ $(INSTALL_LIBRARY_DOCS) \ diff --git a/rules/build-perl.mk b/rules/build-perl.mk index b943e16..5a1660c 100644 --- a/rules/build-perl.mk +++ b/rules/build-perl.mk @@ -66,10 +66,13 @@ $$($1_$2_INPLACE): $1/$2/$$($1_$2_PROG) | $$$$(dir $$$$@)/. endif ifeq "$$($1_$2_INSTALL)" "YES" +# Don't add to INSTALL_BINS or INSTAL_TOPDIR_BINS, because they will get +# stripped when calling 'make install-strip', and stripping a Perl script +# doesn't work. ifeq "$$($1_$2_TOPDIR)" "YES" -INSTALL_TOPDIRS += $$($1_$2_INPLACE) +INSTALL_TOPDIR_SCRIPTS += $$($1_$2_INPLACE) else -INSTALL_BINS += $$($1_$2_INPLACE) +INSTALL_SCRIPTS += $$($1_$2_INPLACE) endif endif diff --git a/rules/build-prog.mk b/rules/build-prog.mk index 1029fdd..f09a8c1 100644 --- a/rules/build-prog.mk +++ b/rules/build-prog.mk @@ -302,7 +302,7 @@ endif ifeq "$$($1_$2_WANT_INSTALLED_WRAPPER)" "YES" INSTALL_LIBEXECS += $1/$2/build/tmp/$$($1_$2_PROG) else ifeq "$$($1_$2_TOPDIR)" "YES" -INSTALL_TOPDIRS += $1/$2/build/tmp/$$($1_$2_PROG) +INSTALL_TOPDIR_BINS += $1/$2/build/tmp/$$($1_$2_PROG) else INSTALL_BINS += $1/$2/build/tmp/$$($1_$2_PROG) endif From git at git.haskell.org Fri Sep 4 16:19:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Sep 2015 16:19:53 +0000 (UTC) Subject: [commit: ghc] master: ghc-pkg: don't print ignored errors when verbosity=0 (5c372fe) Message-ID: <20150904161953.811303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5c372fe50412b8d2606b98ad953d3b0a121f9d9b/ghc >--------------------------------------------------------------- commit 5c372fe50412b8d2606b98ad953d3b0a121f9d9b Author: Thomas Miedema Date: Fri Sep 4 16:59:44 2015 +0200 ghc-pkg: don't print ignored errors when verbosity=0 Lines like the following are filling up the build logs: binary-0.7.5.0: cannot find any of ["Data/Binary.hi","Data/Binary.p_hi","Data/Binary.dyn_hi"] (ignoring) >--------------------------------------------------------------- 5c372fe50412b8d2606b98ad953d3b0a121f9d9b utils/ghc-pkg/Main.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index fbd7dae..4ee0d01 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -973,7 +973,7 @@ registerPackage input verbosity my_flags multi_instance infoLn "done." -- report any warnings from the parse phase - _ <- reportValidateErrors [] ws + _ <- reportValidateErrors verbosity [] ws (display (sourcePackageId pkg) ++ ": Warning: ") Nothing -- validate the expanded pkg, but register the unexpanded @@ -1465,13 +1465,13 @@ checkConsistency verbosity my_flags = do True True if null es then do when (not simple_output) $ do - _ <- reportValidateErrors [] ws "" Nothing + _ <- reportValidateErrors verbosity [] ws "" Nothing return () return [] else do when (not simple_output) $ do reportError ("There are problems in package " ++ display (sourcePackageId p) ++ ":") - _ <- reportValidateErrors es ws " " Nothing + _ <- reportValidateErrors verbosity es ws " " Nothing return () return [p] @@ -1550,9 +1550,9 @@ liftIO :: IO a -> Validate a liftIO k = V (k >>= \a -> return (a,[],[])) -- returns False if we should die -reportValidateErrors :: [ValidateError] -> [ValidateWarning] +reportValidateErrors :: Verbosity -> [ValidateError] -> [ValidateWarning] -> String -> Maybe Force -> IO Bool -reportValidateErrors es ws prefix mb_force = do +reportValidateErrors verbosity es ws prefix mb_force = do mapM_ (warn . (prefix++)) ws oks <- mapM report es return (and oks) @@ -1560,7 +1560,8 @@ reportValidateErrors es ws prefix mb_force = do report (f,s) | Just force <- mb_force = if (force >= f) - then do reportError (prefix ++ s ++ " (ignoring)") + then do when (verbosity >= Normal) $ + reportError (prefix ++ s ++ " (ignoring)") return True else if f < CannotForce then do reportError (prefix ++ s ++ " (use --force to override)") @@ -1584,7 +1585,8 @@ validatePackageConfig pkg verbosity db_stack (_,es,ws) <- runValidate $ checkPackageConfig pkg verbosity db_stack multi_instance update - ok <- reportValidateErrors es ws (display (sourcePackageId pkg) ++ ": ") (Just force) + ok <- reportValidateErrors verbosity es ws + (display (sourcePackageId pkg) ++ ": ") (Just force) when (not ok) $ exitWith (ExitFailure 1) checkPackageConfig :: InstalledPackageInfo From git at git.haskell.org Sat Sep 5 08:54:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 5 Sep 2015 08:54:06 +0000 (UTC) Subject: [commit: ghc] master: user-guide: Add missing tags around body (c60c462) Message-ID: <20150905085406.748353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c60c462f4cf4c25274e4fe13c313deb52f092c47/ghc >--------------------------------------------------------------- commit c60c462f4cf4c25274e4fe13c313deb52f092c47 Author: Ben Gamari Date: Fri Sep 4 18:49:23 2015 +0200 user-guide: Add missing tags around body Otherwise this is ill-formed DocBook >--------------------------------------------------------------- c60c462f4cf4c25274e4fe13c313deb52f092c47 docs/users_guide/codegens.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/codegens.xml b/docs/users_guide/codegens.xml index d2a805a..d9c4859 100644 --- a/docs/users_guide/codegens.xml +++ b/docs/users_guide/codegens.xml @@ -46,9 +46,9 @@ To install LLVM and Clang: - Linux: Use your package management tool. + Linux: Use your package management tool. - Mac OS X: Clang is included by + Mac OS X: Clang is included by default on recent OS X machines when XCode is installed (from 10.6 and later). LLVM is not included. In order to use the LLVM based code generator, you should install @@ -56,12 +56,12 @@ url="http://mxcl.github.com/homebrew/">Homebrew package manager for OS X. Alternatively you can download binaries for LLVM and Clang from here. + url="http://llvm.org/releases/download.html">here. - Windows: You should download binaries for + Windows: You should download binaries for LLVM and clang from - here. + here. From git at git.haskell.org Sat Sep 5 08:54:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 5 Sep 2015 08:54:09 +0000 (UTC) Subject: [commit: ghc] master: EventLog: Factor out ensureRoomFor*Event (96b986b) Message-ID: <20150905085409.41D343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/96b986b669410cf4b6945d1039f9e16e54f4e53f/ghc >--------------------------------------------------------------- commit 96b986b669410cf4b6945d1039f9e16e54f4e53f Author: Ben Gamari Date: Mon Aug 31 22:00:10 2015 +0200 EventLog: Factor out ensureRoomFor*Event >--------------------------------------------------------------- 96b986b669410cf4b6945d1039f9e16e54f4e53f rts/eventlog/EventLog.c | 124 ++++++++++++++++-------------------------------- 1 file changed, 41 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 96b986b669410cf4b6945d1039f9e16e54f4e53f From git at git.haskell.org Sat Sep 5 08:54:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 5 Sep 2015 08:54:12 +0000 (UTC) Subject: [commit: ghc] master: tracing: Kill EVENT_STARTUP (062feee) Message-ID: <20150905085412.2B3153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/062feee4e7408ad5b9d882e5fed2c700e337db72/ghc >--------------------------------------------------------------- commit 062feee4e7408ad5b9d882e5fed2c700e337db72 Author: Ben Gamari Date: Mon Aug 31 22:39:13 2015 +0200 tracing: Kill EVENT_STARTUP This has been unnecessary for quite some time due to the create/delete capability events. >--------------------------------------------------------------- 062feee4e7408ad5b9d882e5fed2c700e337db72 includes/rts/EventLogFormat.h | 4 ++-- rts/RtsStartup.c | 3 --- rts/Trace.c | 7 ------- rts/Trace.h | 24 ------------------------ rts/eventlog/EventLog.c | 14 -------------- rts/eventlog/EventLog.h | 2 -- 6 files changed, 2 insertions(+), 52 deletions(-) diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h index a1e038f..68d0d08 100644 --- a/includes/rts/EventLogFormat.h +++ b/includes/rts/EventLogFormat.h @@ -113,8 +113,7 @@ /* 13, 14 deprecated */ #define EVENT_CREATE_SPARK_THREAD 15 /* (spark_thread) */ #define EVENT_LOG_MSG 16 /* (message ...) */ -/* EVENT_STARTUP should be deprecated at some point */ -#define EVENT_STARTUP 17 /* (num_capabilities) */ +/* 17 deprecated */ #define EVENT_BLOCK_MARKER 18 /* (size, end_time, capability) */ #define EVENT_USER_MSG 19 /* (message ...) */ #define EVENT_GC_IDLE 20 /* () */ @@ -190,6 +189,7 @@ /* ghc changed how it handles sparks so these are no longer applicable */ #define EVENT_CREATE_SPARK 13 /* (cap, thread) */ #define EVENT_SPARK_TO_THREAD 14 /* (cap, thread, spark_thread) */ +#define EVENT_STARTUP 17 /* (num_capabilities) */ /* these are used by eden but are replaced by new alternatives for ghc */ #define EVENT_VERSION 23 /* (version_string) */ #define EVENT_PROGRAM_INVOCATION 24 /* (commandline_string) */ diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index f6544b6..584c31e 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -176,9 +176,6 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) #ifdef TRACING initTracing(); #endif - /* Trace the startup event - */ - traceEventStartup(); /* initialise scheduler data structures (needs to be done before * initStorage()). diff --git a/rts/Trace.c b/rts/Trace.c index dab7347..0ab636a 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -759,13 +759,6 @@ void traceThreadStatus_ (StgTSO *tso USED_IF_DEBUG) } } -void traceEventStartup_(int nocaps) -{ - if (eventlog_enabled) { - postEventStartup(nocaps); - } -} - #ifdef DEBUG void traceBegin (const char *str, ...) { diff --git a/rts/Trace.h b/rts/Trace.h index 31aefcb..c85167c 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -242,8 +242,6 @@ void traceThreadLabel_(Capability *cap, void traceThreadStatus_ (StgTSO *tso); -void traceEventStartup_ (int n_caps); - /* * Events for describing capabilities and capability sets in the eventlog * @@ -298,7 +296,6 @@ void traceTaskDelete_ (Task *task); #define debugTraceCap(class, cap, str, ...) /* nothing */ #define traceThreadStatus(class, tso) /* nothing */ #define traceThreadLabel_(cap, tso, label) /* nothing */ -INLINE_HEADER void traceEventStartup_ (int n_caps STG_UNUSED) {}; #define traceCapEvent(cap, tag) /* nothing */ #define traceCapsetEvent(tag, capset, info) /* nothing */ #define traceWallClockTime_() /* nothing */ @@ -350,9 +347,6 @@ void dtraceUserMarkerWrapper(Capability *cap, char *msg); HASKELLEVENT_CREATE_SPARK_THREAD(cap, spark_tid) #define dtraceThreadLabel(cap, tso, label) \ HASKELLEVENT_THREAD_LABEL(cap, tso, label) -INLINE_HEADER void dtraceStartup (int num_caps) { - HASKELLEVENT_STARTUP(num_caps); -} #define dtraceCapCreate(cap) \ HASKELLEVENT_CAP_CREATE(cap) #define dtraceCapDelete(cap) \ @@ -442,7 +436,6 @@ INLINE_HEADER void dtraceStartup (int num_caps) { #define dtraceRequestParGc(cap) /* nothing */ #define dtraceCreateSparkThread(cap, spark_tid) /* nothing */ #define dtraceThreadLabel(cap, tso, label) /* nothing */ -INLINE_HEADER void dtraceStartup (int num_caps STG_UNUSED) {}; #define dtraceUserMsg(cap, msg) /* nothing */ #define dtraceUserMarker(cap, msg) /* nothing */ #define dtraceGcIdle(cap) /* nothing */ @@ -710,23 +703,6 @@ INLINE_HEADER void traceEventHeapLive(Capability *cap STG_UNUSED, dtraceEventHeapLive(heap_capset, heap_live); } -/* TODO: at some point we should remove this event, it's covered by - * the cap create/delete events. - */ -INLINE_HEADER void traceEventStartup(void) -{ - int n_caps; -#ifdef THREADED_RTS - // XXX n_capabilities hasn't been initialised yet - n_caps = RtsFlags.ParFlags.nNodes; -#else - n_caps = 1; -#endif - - traceEventStartup_(n_caps); - dtraceStartup(n_caps); -} - INLINE_HEADER void traceCapsetCreate(CapsetID capset STG_UNUSED, CapsetType capset_type STG_UNUSED) { diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c index c55ac2c..2153942 100644 --- a/rts/eventlog/EventLog.c +++ b/rts/eventlog/EventLog.c @@ -62,7 +62,6 @@ char *EventDesc[] = { [EVENT_MIGRATE_THREAD] = "Migrate thread", [EVENT_THREAD_WAKEUP] = "Wakeup thread", [EVENT_THREAD_LABEL] = "Thread label", - [EVENT_STARTUP] = "Create capabilities", [EVENT_CAP_CREATE] = "Create capability", [EVENT_CAP_DELETE] = "Delete capability", [EVENT_CAP_DISABLE] = "Disable capability", @@ -312,7 +311,6 @@ initEventLogging(void) + sizeof(EventThreadID); break; - case EVENT_STARTUP: // (cap_count) case EVENT_CAP_CREATE: // (cap) case EVENT_CAP_DELETE: // (cap) case EVENT_CAP_ENABLE: // (cap) @@ -1022,18 +1020,6 @@ void postCapMsg(Capability *cap, char *msg, va_list ap) postLogMsg(&capEventBuf[cap->no], EVENT_LOG_MSG, msg, ap); } -void postEventStartup(EventCapNo n_caps) -{ - ACQUIRE_LOCK(&eventBufMutex); - ensureRoomForEvent(&eventBuf, EVENT_STARTUP); - - // Post a STARTUP event with the number of capabilities - postEventHeader(&eventBuf, EVENT_STARTUP); - postCapNo(&eventBuf, n_caps); - - RELEASE_LOCK(&eventBufMutex); -} - void postUserEvent(Capability *cap, EventTypeNum type, char *msg) { EventsBuf *eb; diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h index 9c2f265..abe7880 100644 --- a/rts/eventlog/EventLog.h +++ b/rts/eventlog/EventLog.h @@ -49,8 +49,6 @@ void postUserEvent(Capability *cap, EventTypeNum type, char *msg); void postCapMsg(Capability *cap, char *msg, va_list ap); -void postEventStartup(EventCapNo n_caps); - /* * Post an event relating to a capability itself (create/delete/etc) */ From git at git.haskell.org Sun Sep 6 17:02:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 6 Sep 2015 17:02:43 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Use a response file for linker command line arguments #10777 (6b08e42) Message-ID: <20150906170243.EE1853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/6b08e42ad99bb7857b631f28db869def046bff35/ghc >--------------------------------------------------------------- commit 6b08e42ad99bb7857b631f28db869def046bff35 Author: Michael Snoyman Date: Wed Sep 2 13:31:25 2015 +0200 Use a response file for linker command line arguments #10777 On Windows, we're constrained to 32k bytes total for command line arguments. When building large projects, this limit can be exceeded. This patch changes GHC to always use response files for linker arguments, a feature first used by Microsoft compilers and added to GCC (over a decade ago). Alternatives here include: * Only use this method on Windows systems * Check the length of the command line arguments and use that to decide whether to use this method I did not pursue either of these, as I believe it would make the patch more likely to break in less tested situations. Test Plan: Confirm that linking still works in general. Ideally: compile a very large project on Windows with this patch. (I am attempting to do that myself now, but having trouble getting the Windows build tool chain up and running.) Reviewers: goldfire, hvr, rwbarton, austin, thomie, bgamari, Phyx Reviewed By: thomie, bgamari, Phyx Subscribers: erikd, awson, #ghc_windows_task_force, thomie Differential Revision: https://phabricator.haskell.org/D1158 GHC Trac Issues: #8596, #10777 >--------------------------------------------------------------- 6b08e42ad99bb7857b631f28db869def046bff35 compiler/main/SysTools.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 54 insertions(+), 2 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 811b930..f84974b 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -407,7 +407,7 @@ runCc dflags args = do args1 = map Option (getOpts dflags opt_c) args2 = args0 ++ args1 ++ args mb_env <- getGccEnv args2 - runSomethingFiltered dflags cc_filter "C Compiler" p args2 mb_env + runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env where -- discard some harmless warnings from gcc that we can't turn off cc_filter = unlines . doFilter . lines @@ -895,7 +895,7 @@ runLink dflags args = do args1 = map Option (getOpts dflags opt_l) args2 = args0 ++ linkargs ++ args1 ++ args mb_env <- getGccEnv args2 - runSomethingFiltered dflags ld_filter "Linker" p args2 mb_env + runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env where ld_filter = case (platformOS (targetPlatform dflags)) of OSSolaris2 -> sunos_ld_filter @@ -1223,6 +1223,58 @@ runSomething :: DynFlags runSomething dflags phase_name pgm args = runSomethingFiltered dflags id phase_name pgm args Nothing +-- | Run a command, placing the arguments in an external response file. +-- +-- This command is used in order to avoid overlong command line arguments on +-- Windows. The command line arguments are first written to an external, +-- temporary response file, and then passed to the linker via @filepath. +-- response files for passing them in. See: +-- +-- https://gcc.gnu.org/wiki/Response_Files +-- https://ghc.haskell.org/trac/ghc/ticket/10777 +runSomethingResponseFile + :: DynFlags -> (String->String) -> String -> String -> [Option] + -> Maybe [(String,String)] -> IO () + +runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env = + runSomethingWith dflags phase_name pgm args $ \real_args -> do + fp <- getResponseFile real_args + let args = ['@':fp] + r <- builderMainLoop dflags filter_fn pgm args mb_env + return (r,()) + where + getResponseFile args = do + fp <- newTempName dflags "rsp" + withFile fp WriteMode $ \h -> do + hSetEncoding h utf8 + hPutStr h $ unlines $ map escape args + return fp + + -- Note: Response files have backslash-escaping, double quoting, and are + -- whitespace separated (some implementations use newline, others any + -- whitespace character). Therefore, escape any backslashes, newlines, and + -- double quotes in the argument, and surround the content with double + -- quotes. + -- + -- Another possibility that could be considered would be to convert + -- backslashes in the argument to forward slashes. This would generally do + -- the right thing, since backslashes in general only appear in arguments + -- as part of file paths on Windows, and the forward slash is accepted for + -- those. However, escaping is more reliable, in case somehow a backslash + -- appears in a non-file. + escape x = concat + [ "\"" + , concatMap + (\c -> + case c of + '\\' -> "\\\\" + '\n' -> "\\n" + '\"' -> "\\\"" + _ -> [c]) + x + , "\"" + ] + runSomethingFiltered :: DynFlags -> (String->String) -> String -> String -> [Option] -> Maybe [(String,String)] -> IO () From git at git.haskell.org Sun Sep 6 17:02:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 6 Sep 2015 17:02:46 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Respect GHC_CHARENC environment variable #10762 (108e35f) Message-ID: <20150906170246.B71643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/108e35ff67586ffd570ca18d84a4f5fbf79727cc/ghc >--------------------------------------------------------------- commit 108e35ff67586ffd570ca18d84a4f5fbf79727cc Author: Michael Snoyman Date: Sat Aug 29 12:23:48 2015 +0200 Respect GHC_CHARENC environment variable #10762 Only supports UTF-8 as a value right now. I expect some discussion to go on around the naming of this variable and whether it's valid to backport it to GHC 7.10 (which would be my preference). The motivation here is that, when capturing the output of GHC to a file, we often want to ensure that the output is UTF-8, regardless of the actual character encoding of the terminal/console. On the other hand, we don't want to necessary change the terminal/console encoding. The reason being: * On Windows, this requires a global-esque change to the console codepage, which adversely affects other processes in the same console * On all OSes, this can break features like smart quote auto-detection. Test Plan: Set LANG to C, GHC_CHARENC to UTF-8, and compile a Haskell source file with a non-ASCII warning produced. The output who include the UTF-8 sequence instead of replacing it with ?. Reviewers: austin, rwbarton, bgamari Reviewed By: bgamari Subscribers: hsyl20, thomie Differential Revision: https://phabricator.haskell.org/D1167 GHC Trac Issues: #10762 >--------------------------------------------------------------- 108e35ff67586ffd570ca18d84a4f5fbf79727cc ghc/Main.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 7b1c244..2a42c06 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -80,8 +80,18 @@ main = do initGCStatistics -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering - hSetTranslit stdout - hSetTranslit stderr + + -- Handle GHC-specific character encoding flags, allowing us to control how + -- GHC produces output regardless of OS. + env <- getEnvironment + case lookup "GHC_CHARENC" env of + Just "UTF-8" -> do + hSetEncoding stdout utf8 + hSetEncoding stderr utf8 + _ -> do + -- Avoid GHC erroring out when trying to display unhandled characters + hSetTranslit stdout + hSetTranslit stderr GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do -- 1. extract the -B flag from the args From git at git.haskell.org Mon Sep 7 09:59:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 09:59:22 +0000 (UTC) Subject: [commit: ghc] master: Build system: put each BuildFlavour in a separate file (#10223) (2c24fd7) Message-ID: <20150907095922.B0E683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c24fd707f8650205bb574ffac5f376239af3723/ghc >--------------------------------------------------------------- commit 2c24fd707f8650205bb574ffac5f376239af3723 Author: Thomas Miedema Date: Mon Aug 31 14:39:47 2015 +0200 Build system: put each BuildFlavour in a separate file (#10223) This allows easier diffing of different BuildFlavours, including `mk/flavours/validate.mk`. Reviewed By: bgamari, austin Differential Revision: https://phabricator.haskell.org/D1050 >--------------------------------------------------------------- 2c24fd707f8650205bb574ffac5f376239af3723 mk/build.mk.sample | 266 ++------------------------------------------- mk/custom-settings.mk | 2 +- mk/flavours/bench-cross.mk | 15 +++ mk/flavours/bench-llvm.mk | 10 ++ mk/flavours/bench.mk | 10 ++ mk/flavours/devel1.mk | 12 ++ mk/flavours/devel2.mk | 12 ++ mk/flavours/perf-cross.mk | 15 +++ mk/flavours/perf-llvm.mk | 10 ++ mk/flavours/perf.mk | 10 ++ mk/flavours/prof.mk | 12 ++ mk/flavours/quick-cross.mk | 15 +++ mk/flavours/quick-llvm.mk | 10 ++ mk/flavours/quick.mk | 10 ++ mk/flavours/quickest.mk | 10 ++ mk/flavours/validate.mk | 44 ++++++++ mk/validate-settings.mk | 38 ------- 17 files changed, 207 insertions(+), 294 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 2c24fd707f8650205bb574ffac5f376239af3723 From git at git.haskell.org Mon Sep 7 09:59:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 09:59:25 +0000 (UTC) Subject: [commit: ghc] master: Build system: simplify *-llvm BuildFlavours (#10223) (b40e559) Message-ID: <20150907095925.9A6FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b40e55954ecdab650d35349cbb93e53df952310e/ghc >--------------------------------------------------------------- commit b40e55954ecdab650d35349cbb93e53df952310e Author: Thomas Miedema Date: Tue Aug 25 17:49:32 2015 +0200 Build system: simplify *-llvm BuildFlavours (#10223) Note that SRC_HC_OPTS are added to every Haskell compilation. So there isn't any need to also add `-fllvm` to GhcStage1HcOpts, GhcStage2HcOpts and GhcLibHcOpts. Small bug fix: make sure we test for -fllvm in SRC_HC_OPTS, to check whether the bootstrap compiler is affected by bug #9439. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1188 >--------------------------------------------------------------- b40e55954ecdab650d35349cbb93e53df952310e Makefile | 2 +- mk/flavours/bench-llvm.mk | 8 ++++---- mk/flavours/perf-llvm.mk | 4 ++-- mk/flavours/quick-llvm.mk | 6 +++--- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/Makefile b/Makefile index 217205c..38c7eb9 100644 --- a/Makefile +++ b/Makefile @@ -71,7 +71,7 @@ include mk/custom-settings.mk # Verify that stage 0 LLVM backend isn't affected by Bug #9439 if needed ifeq "$(GHC_LLVM_AFFECTED_BY_9439)" "1" -ifneq "$(findstring -fllvm,$(GhcHcOpts) $(GhcStage1HcOpts))" "" +ifneq "$(findstring -fllvm,$(SRC_HC_OPTS) $(GhcHcOpts) $(GhcStage1HcOpts))" "" $(error Stage 0 compiler is affected by Bug #9439. Refusing to bootstrap with -fllvm) endif endif diff --git a/mk/flavours/bench-llvm.mk b/mk/flavours/bench-llvm.mk index 99957b9..816d7c7 100644 --- a/mk/flavours/bench-llvm.mk +++ b/mk/flavours/bench-llvm.mk @@ -1,7 +1,7 @@ -SRC_HC_OPTS = -O -H64m -GhcStage1HcOpts = -O -fllvm -GhcStage2HcOpts = -O0 -fllvm -GhcLibHcOpts = -O2 -fllvm +SRC_HC_OPTS = -O -H64m -fllvm +GhcStage1HcOpts = -O +GhcStage2HcOpts = -O0 +GhcLibHcOpts = -O2 BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO diff --git a/mk/flavours/perf-llvm.mk b/mk/flavours/perf-llvm.mk index 581037f..c49849f 100644 --- a/mk/flavours/perf-llvm.mk +++ b/mk/flavours/perf-llvm.mk @@ -1,6 +1,6 @@ SRC_HC_OPTS = -O -H64m -fllvm -GhcStage1HcOpts = -O -fllvm -GhcStage2HcOpts = -O2 -fllvm +GhcStage1HcOpts = -O +GhcStage2HcOpts = -O2 GhcLibHcOpts = -O2 BUILD_PROF_LIBS = YES #SplitObjs diff --git a/mk/flavours/quick-llvm.mk b/mk/flavours/quick-llvm.mk index 90ccb7a..e565327 100644 --- a/mk/flavours/quick-llvm.mk +++ b/mk/flavours/quick-llvm.mk @@ -1,7 +1,7 @@ SRC_HC_OPTS = -O0 -H64m -fllvm -GhcStage1HcOpts = -O -fllvm -GhcStage2HcOpts = -O0 -fllvm -GhcLibHcOpts = -O -fllvm +GhcStage1HcOpts = -O +GhcStage2HcOpts = -O0 +GhcLibHcOpts = -O BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO From git at git.haskell.org Mon Sep 7 09:59:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 09:59:28 +0000 (UTC) Subject: [commit: ghc] master: Build system: cleanup utils/ghc-pkg/ghc.mk (1abbacd) Message-ID: <20150907095928.644DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1abbacd606c7fbbb5a948cf9fa3817f5ed20c37a/ghc >--------------------------------------------------------------- commit 1abbacd606c7fbbb5a948cf9fa3817f5ed20c37a Author: Thomas Miedema Date: Fri Jul 10 01:02:31 2015 +0200 Build system: cleanup utils/ghc-pkg/ghc.mk There used to be a lot of custom make code to build ghc-pkg with the stage0 compiler. Commit ac5a314504554ddef0e855ef9e2fcf51e961f4a6 thankfully cleaned this up, by using the build settings from the ghc-pkg.cabal file. This commit removes some remains of the old way of installing ghc-pkg when Stage1Only=YES. Notably, we called both `build-prog` as `shell-wrapper`. This is surely wrong, because `build-prog` already calls `shell-wrapper`. It isn't needed to set WANT_INSTALLED_WRAPPER either; build-prog does that for us. This prevents the following warnings when Stage1Only=YES: utils/ghc-pkg/ghc.mk:46: warning: overriding commands for target `install_utils/ghc-pkg_dist_wrapper' utils/ghc-pkg/ghc.mk:37: warning: ignoring old commands for target `install_utils/ghc-pkg_dist_wrapper' Also add more comments and restructure a bit. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1063 >--------------------------------------------------------------- 1abbacd606c7fbbb5a948cf9fa3817f5ed20c37a utils/ghc-pkg/ghc.mk | 48 +++++++++++++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 17 deletions(-) diff --git a/utils/ghc-pkg/ghc.mk b/utils/ghc-pkg/ghc.mk index 1bd44c9..c5f0b62 100644 --- a/utils/ghc-pkg/ghc.mk +++ b/utils/ghc-pkg/ghc.mk @@ -24,25 +24,38 @@ utils/ghc-pkg/dist-install/build/Version.hs: mk/project.mk | $$(dir $$@)/. utils/ghc-pkg_PACKAGE = ghc-pkg +# Note [Why build certain utils twice?] +# +# We build certain utils twice: once with stage0, and once with stage1. +# Examples are ghc-pkg and hsc2hs. +# +# These tools are needed during the bootstrapping process, so we have to use +# stage0 to build them at first (stage1 doesn't exist yet). (side note: they're +# also used later in the build process). We install them inplace. +# +# But we can't install these copies when you run 'make install'. The reason is +# that when DYNAMIC_GHC_PROGRAMS=YES, we want to install copies that are +# dynamically linked. But the stage0 copies are either statically linked, or +# linked against libraries on the build machine. +# +# Therefore we build fresh copies, using the stage1 compiler, and install them +# when you run 'make install'. They are not used for any other purpose. + # ----------------------------------------------------------------------------- -# Cross-compile case: install our dist version +# Build ghc-pkg with the stage0 compiler in the dist directory, and install +# inplace. This is the copy we use during in-tree development. +utils/ghc-pkg_dist_USES_CABAL = YES +utils/ghc-pkg_dist_PROGNAME = ghc-pkg +utils/ghc-pkg_dist_SHELL_WRAPPER = YES +utils/ghc-pkg_dist_INSTALL_INPLACE = YES ifeq "$(Stage1Only)" "YES" - +# Install the copy of ghc-pkg from the dist directory when running 'make +# install' (it's the only copy we have at this stage). utils/ghc-pkg_dist_INSTALL = YES -utils/ghc-pkg_dist_SHELL_WRAPPER = YES utils/ghc-pkg_dist_INSTALL_SHELL_WRAPPER_NAME = ghc-pkg-$(ProjectVersion) -utils/ghc-pkg_dist_WANT_INSTALLED_WRAPPER = YES - -$(eval $(call shell-wrapper,utils/ghc-pkg,dist)) - endif -utils/ghc-pkg_dist_USES_CABAL = YES -utils/ghc-pkg_dist_PROGNAME = ghc-pkg -utils/ghc-pkg_dist_SHELL_WRAPPER = YES -utils/ghc-pkg_dist_INSTALL_INPLACE = YES - $(eval $(call build-prog,utils/ghc-pkg,dist,0)) $(ghc-pkg_INPLACE) : | $(INPLACE_PACKAGE_CONF)/. @@ -51,23 +64,24 @@ utils/ghc-pkg/dist/package-data.mk: \ utils/ghc-pkg/dist/build/Version.hs # ----------------------------------------------------------------------------- -# Normal case: Build ghc-pkg with stage 1 and install it +# Build another copy of ghc-pkg with the stage1 compiler in the dist-install +# directory. Don't install it inplace (we use the dist copy there), but do +# install it when running 'make install'. +# +# See Note [Why build certain utils twice?]. ifneq "$(Stage1Only)" "YES" - utils/ghc-pkg_dist-install_USES_CABAL = YES - utils/ghc-pkg_dist-install_PROGNAME = ghc-pkg utils/ghc-pkg_dist-install_SHELL_WRAPPER = YES +utils/ghc-pkg_dist-install_INSTALL_INPLACE = NO utils/ghc-pkg_dist-install_INSTALL = YES utils/ghc-pkg_dist-install_INSTALL_SHELL_WRAPPER_NAME = ghc-pkg-$(ProjectVersion) -utils/ghc-pkg_dist-install_INSTALL_INPLACE = NO $(eval $(call build-prog,utils/ghc-pkg,dist-install,1)) utils/ghc-pkg/dist-install/package-data.mk: \ utils/ghc-pkg/dist-install/build/Version.hs - endif # ----------------------------------------------------------------------------- From git at git.haskell.org Mon Sep 7 11:20:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 11:20:51 +0000 (UTC) Subject: [commit: ghc] master: SPECIALIZE strictMinimum for Int and Integer (dc671a1) Message-ID: <20150907112051.D50403A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dc671a1c06736b192e4a53f580e17356ffa7224e/ghc >--------------------------------------------------------------- commit dc671a1c06736b192e4a53f580e17356ffa7224e Author: Joachim Breitner Date: Mon Sep 7 13:19:50 2015 +0200 SPECIALIZE strictMinimum for Int and Integer This fixes a regression reported in #10788, where due to less inlining compared to earlier versions, we?d get worse code. With the SPECIALIZE, we get the good code, and moreover, the good code is in List.hs and _not_ inlined to the use site, so smaller code size and less compilation time. >--------------------------------------------------------------- dc671a1c06736b192e4a53f580e17356ffa7224e libraries/base/GHC/List.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index ca3fb75..86ff868 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -415,6 +415,8 @@ maximum xs = foldl1 max xs strictMaximum :: (Ord a) => [a] -> a strictMaximum [] = errorEmptyList "maximum" strictMaximum xs = foldl1' max xs +{-# SPECIALIZE strictMaximum :: [Int] -> Int #-} +{-# SPECIALIZE strictMaximum :: [Integer] -> Integer #-} -- | 'minimum' returns the minimum value from a list, -- which must be non-empty, finite, and of an ordered type. @@ -433,6 +435,8 @@ minimum xs = foldl1 min xs strictMinimum :: (Ord a) => [a] -> a strictMinimum [] = errorEmptyList "minimum" strictMinimum xs = foldl1' min xs +{-# SPECIALIZE strictMinimum :: [Int] -> Int #-} +{-# SPECIALIZE strictMinimum :: [Integer] -> Integer #-} -- | 'iterate' @f x@ returns an infinite list of repeated applications From git at git.haskell.org Mon Sep 7 11:52:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 11:52:52 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D1229' created Message-ID: <20150907115252.2AD553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D1229 Referencing: c6b82e99f41e03d4b101b3a32312defad711f56a From git at git.haskell.org Mon Sep 7 11:52:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 11:52:55 +0000 (UTC) Subject: [commit: ghc] wip/D1229: Further simplify the story around minimum/maximum (c6b82e9) Message-ID: <20150907115255.0DFBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D1229 Link : http://ghc.haskell.org/trac/ghc/changeset/c6b82e99f41e03d4b101b3a32312defad711f56a/ghc >--------------------------------------------------------------- commit c6b82e99f41e03d4b101b3a32312defad711f56a Author: Joachim Breitner Date: Mon Sep 7 13:48:10 2015 +0200 Further simplify the story around minimum/maximum After I have found out that I should look at -ddump-prep and not -ddump-core, I noticed that these days, GHC is perfectly capeable of turning (the equivalent) of foldl to (the equivalent) of foldl' if the operation in question is strict. So instead of using rewrite rules to rewrite maximum to a strictMaximum for certain types, we simply use SPECIALIZE. This also marks maximum/minimum as INLINEABLE, so that client code can get similar specializations, hopefully even automatically. And inded, minimum applied to [Double] produces good code (although due to inlineing, not due to specialization, it seems). I checked (by looking at the core) that this still fixes #10788. Differential revision: https://phabricator.haskell.org/D1229 >--------------------------------------------------------------- c6b82e99f41e03d4b101b3a32312defad711f56a libraries/base/GHC/List.hs | 34 +++++++++------------------------- 1 file changed, 9 insertions(+), 25 deletions(-) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index 86ff868..bbaa0a2 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -400,43 +400,27 @@ scanr1 f (x:xs) = f x q : qs -- It is a special case of 'Data.List.maximumBy', which allows the -- programmer to supply their own comparison function. maximum :: (Ord a) => [a] -> a -{-# INLINE [1] maximum #-} +{-# INLINEABLE maximum #-} maximum [] = errorEmptyList "maximum" maximum xs = foldl1 max xs -{-# RULES - "maximumInt" maximum = (strictMaximum :: [Int] -> Int); - "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer) - #-} - --- We can't make the overloaded version of maximum strict without --- changing its semantics (max might not be strict), but we can for --- the version specialised to 'Int'. -strictMaximum :: (Ord a) => [a] -> a -strictMaximum [] = errorEmptyList "maximum" -strictMaximum xs = foldl1' max xs -{-# SPECIALIZE strictMaximum :: [Int] -> Int #-} -{-# SPECIALIZE strictMaximum :: [Integer] -> Integer #-} +-- We want this to be specialized so that with a strict max function, GHC +-- produces good code. Note that to see if this is happending, one has to +-- look at -ddump-prep, not -ddump-core! +{-# SPECIALIZE maximum :: [Int] -> Int #-} +{-# SPECIALIZE maximum :: [Integer] -> Integer #-} -- | 'minimum' returns the minimum value from a list, -- which must be non-empty, finite, and of an ordered type. -- It is a special case of 'Data.List.minimumBy', which allows the -- programmer to supply their own comparison function. minimum :: (Ord a) => [a] -> a -{-# INLINE [1] minimum #-} +{-# INLINEABLE minimum #-} minimum [] = errorEmptyList "minimum" minimum xs = foldl1 min xs -{-# RULES - "minimumInt" minimum = (strictMinimum :: [Int] -> Int); - "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer) - #-} - -strictMinimum :: (Ord a) => [a] -> a -strictMinimum [] = errorEmptyList "minimum" -strictMinimum xs = foldl1' min xs -{-# SPECIALIZE strictMinimum :: [Int] -> Int #-} -{-# SPECIALIZE strictMinimum :: [Integer] -> Integer #-} +{-# SPECIALIZE minimum :: [Int] -> Int #-} +{-# SPECIALIZE minimum :: [Integer] -> Integer #-} -- | 'iterate' @f x@ returns an infinite list of repeated applications From git at git.haskell.org Mon Sep 7 19:33:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 19:33:13 +0000 (UTC) Subject: [commit: ghc] master's head updated: Further simplify the story around minimum/maximum (c6b82e9) Message-ID: <20150907193313.3F4643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: c6b82e9 Further simplify the story around minimum/maximum From git at git.haskell.org Mon Sep 7 19:33:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Sep 2015 19:33:33 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D1229' deleted Message-ID: <20150907193333.CE1F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/D1229 From git at git.haskell.org Tue Sep 8 08:03:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 08:03:38 +0000 (UTC) Subject: [commit: ghc] master: Build system: detect when user cloned from GitHub (554be5e) Message-ID: <20150908080338.9EBBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/554be5e7959da47ba28fe36b403b9af3210448c1/ghc >--------------------------------------------------------------- commit 554be5e7959da47ba28fe36b403b9af3210448c1 Author: Thomas Miedema Date: Mon Sep 7 15:28:30 2015 +0200 Build system: detect when user cloned from GitHub Cloning the ghc repository from GitHub doesn't work out of the box. It requires installing some special url rewrites into ~/.gitconfig. The build fails mysteriously if you forget. This patch tries to detect when you cloned from GitHub, and warns you if you didn't set those url rewrites. This hopefully lowers to barrier to contribute to GHC by a tiny bit. At least one /r/haskell user ran into this recently. Test Plan: cloned from github, ran ./boot, saw the message. Installed url rewrites, and ran ./boot again, didn't see the message. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1230 >--------------------------------------------------------------- 554be5e7959da47ba28fe36b403b9af3210448c1 boot | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/boot b/boot index 7bcc7a1..2ce7acb 100755 --- a/boot +++ b/boot @@ -53,6 +53,40 @@ sub sanity_check_tree { my $tag; my $dir; + if (-d ".git" && + system("git config remote.origin.url | grep github.com > /dev/null") == 0 && + system("git config --get-regexp '^url.*github.com/.*/packages-.insteadOf' > /dev/null") != 0) { + # If we cloned from github, make sure the url rewrites are set. + # Otherwise 'git submodule update --init' prints confusing errors. + die <) { From git at git.haskell.org Tue Sep 8 08:03:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 08:03:41 +0000 (UTC) Subject: [commit: ghc] master: Build system: delete the InstallExtraPackages variable (a158607) Message-ID: <20150908080341.746B83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a15860749ae5353d58cc8907b291ac15d430fc8e/ghc >--------------------------------------------------------------- commit a15860749ae5353d58cc8907b291ac15d430fc8e Author: Thomas Miedema Date: Tue Aug 25 17:30:18 2015 +0200 Build system: delete the InstallExtraPackages variable Just install all packages that are built. Don't make an exception for the dph and extra packages. You can control whether the dph and extra packages should be build using the variables BUILD_DPH and BUILD_EXTRA_PKGS. These variables didn't exist before. But now that they do, InstallExtraPackages isn't really needed anymore. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1227 >--------------------------------------------------------------- a15860749ae5353d58cc8907b291ac15d430fc8e ghc.mk | 21 ++++----------------- mk/config.mk.in | 10 ++-------- mk/flavours/validate.mk | 9 ++++++--- validate | 5 ----- 4 files changed, 12 insertions(+), 33 deletions(-) diff --git a/ghc.mk b/ghc.mk index b146d5a..7337c27 100644 --- a/ghc.mk +++ b/ghc.mk @@ -423,13 +423,6 @@ endif endif PACKAGES_STAGE1 += haskeline -# We normally install only the packages down to this point -REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) -ifneq "$(Stage1Only)" "YES" -REGULAR_INSTALL_PACKAGES += compiler -endif -REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) - ifneq "$(CrossCompiling)" "YES" define addExtraPackage ifeq "$2" "-" @@ -450,18 +443,12 @@ endef $(eval $(call foreachLibrary,addExtraPackage)) endif -# If we want to just install everything, then we want all the packages -SUPERSIZE_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) +# We install all packages that we build. +INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) ifneq "$(Stage1Only)" "YES" -SUPERSIZE_INSTALL_PACKAGES += compiler -endif -SUPERSIZE_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) - -ifeq "$(InstallExtraPackages)" "NO" -INSTALL_PACKAGES := $(REGULAR_INSTALL_PACKAGES) -else -INSTALL_PACKAGES := $(SUPERSIZE_INSTALL_PACKAGES) +INSTALL_PACKAGES += compiler endif +INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) endif # CLEANING diff --git a/mk/config.mk.in b/mk/config.mk.in index 66301c9..9caa2b1 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -302,12 +302,6 @@ SupportsSplitObjs := $(strip \ SplitObjs=$(SupportsSplitObjs) # ---------------------------------------------------------------------------- -# Package-related things - -# Whether to install the extra packages -InstallExtraPackages = NO - -# ---------------------------------------------------------------------------- # There are a number of things which technically depend on GHC (e.g. if # ghc changes then Haskell files may be compiled differently, or Cabal @@ -768,9 +762,9 @@ else HSCOLOUR_SRCS = YES endif -# Build DPH? +# Build and install DPH? BUILD_DPH = NO -# Build the "extra" packages (see ./packages)? +# Build and install the "extra" packages (see ./packages)? BUILD_EXTRA_PKGS = NO ################################################################################ diff --git a/mk/flavours/validate.mk b/mk/flavours/validate.mk index 6c92914..7f74356 100644 --- a/mk/flavours/validate.mk +++ b/mk/flavours/validate.mk @@ -12,11 +12,14 @@ BUILD_DOCBOOK_PDF = NO ifeq "$(ValidateHpc)" "YES" GhcStage2HcOpts += -fhpc -hpcdir $(TOP)/testsuite/hpc_output/ endif + ifeq "$(ValidateSpeed)" "SLOW" GhcStage2HcOpts += -DDEBUG endif -InstallExtraPackages = YES +ifneq "$(ValidateSpeed)" "FAST" +BUILD_EXTRA_PKGS=YES +endif WERROR = -Werror @@ -40,5 +43,5 @@ WERROR = -Werror # markup is correct, so we turn off PS and PDF doc building when # validating. # -# We set InstallExtraPackages=YES, because we want to install the "extra" -# packages, so that we can test them. +# We set BUILD_EXTRA_PKGS=YES to build the "extra" packages (see ./packages), +# so that we can test them. diff --git a/validate b/validate index 188605d..4c123fe 100755 --- a/validate +++ b/validate @@ -193,11 +193,6 @@ if [ $be_quiet -eq 1 ]; then echo "V=0" >> mk/are-validating.mk # Less gunk fi -if [ $speed != "FAST" ]; then - # Build the "extra" packages (see ./packages), to enable more tests. - echo "BUILD_EXTRA_PKGS=YES" >> mk/are-validating.mk -fi - if [ $use_dph -eq 1 ]; then echo "BUILD_DPH=YES" >> mk/are-validating.mk else From git at git.haskell.org Tue Sep 8 08:03:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 08:03:44 +0000 (UTC) Subject: [commit: ghc] master: Build system: remove hack for Mac OSX in configure.ac (#10476) (864a9c4) Message-ID: <20150908080344.5D7F13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/864a9c4f83156caacae5777b3ad6b93b4da9c242/ghc >--------------------------------------------------------------- commit 864a9c4f83156caacae5777b3ad6b93b4da9c242 Author: Thomas Miedema Date: Mon Sep 7 15:58:33 2015 +0200 Build system: remove hack for Mac OSX in configure.ac (#10476) Cross-compilation on Mac OSX currently doesn't work. While building stage 1, the build system uses the `ar` for the target architecture instead of the `ar` for build/host architecture. The cause is a hack added in 24746fe78024a1edab843bc710c79c55998ab134 (2010), to supporting bootstrap compilers built with older versions of Xcode. Xcode 4.3 started installing command line tools in a different location. Assuming this all behind us now, and the paths didn't change again (you never now), we can delete the hack. Deleting the hack fixes the cross compilation issue. Tested by Trac user jakzale. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1231 >--------------------------------------------------------------- 864a9c4f83156caacae5777b3ad6b93b4da9c242 configure.ac | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/configure.ac b/configure.ac index 793ec0f..47b07dd 100644 --- a/configure.ac +++ b/configure.ac @@ -121,20 +121,13 @@ if test "$WithGhc" != ""; then GhcMinVersion2=`echo "$GhcMinVersion" | sed 's/^\\(.\\)$/0\\1/'` GhcCanonVersion="$GhcMajVersion$GhcMinVersion2" - BOOTSTRAPPING_GHC_INFO_FIELD([OS_STAGE0],[target os]) BOOTSTRAPPING_GHC_INFO_FIELD([CC_STAGE0],[C compiler command]) dnl ToDo, once "ld command" is reliably available. dnl Then, we can remove the LD_STAGE0 hack in mk/build-package-date.mk dnl BOOTSTRAPPING_GHC_INFO_FIELD([LD_STAGE0],[ld command]) - if test "x$OS_STAGE0" != "xOSDarwin"; then - BOOTSTRAPPING_GHC_INFO_FIELD([AR_STAGE0],[ar command]) - BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags]) - BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file]) - else - AR_STAGE0='$(AR)' - AR_OPTS_STAGE0='$(AR_OPTS)' - ArSupportsAtFile_STAGE0='$(ArSupportsAtFile)' - fi + BOOTSTRAPPING_GHC_INFO_FIELD([AR_STAGE0],[ar command]) + BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags]) + BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file]) fi dnl ** Must have GHC to build GHC From git at git.haskell.org Tue Sep 8 08:03:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 08:03:47 +0000 (UTC) Subject: [commit: ghc] master: Build system: make *-cross BuildFlavours consistent (#10223) (330fbbd) Message-ID: <20150908080347.345283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/330fbbdacc71a7bb465195e24e268a947fe97412/ghc >--------------------------------------------------------------- commit 330fbbdacc71a7bb465195e24e268a947fe97412 Author: Thomas Miedema Date: Tue Aug 25 19:20:39 2015 +0200 Build system: make *-cross BuildFlavours consistent (#10223) This is a follow up to 841924c9587c10488a18e307b573720977bf4f13, where `-fllvm` was explicitly removed from GhcStage1HcOpts for perf-cross. After removing -fllvm from GhcStage1HcOpts, it should be removed from SRC_HC_OPTS as well, because SRC_HC_OPTS are added to every Haskell compilation. That's what this patch does. BuildFlavour bench-cross (added in ddf79ebf69fe4a6e69d69d451a6040a53b1ea12c), is probably never used. But for consistency, also use -fllvm here, for building stage2 and the libraries. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1228 >--------------------------------------------------------------- 330fbbdacc71a7bb465195e24e268a947fe97412 mk/flavours/bench-cross.mk | 4 ++-- mk/flavours/perf-cross.mk | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/mk/flavours/bench-cross.mk b/mk/flavours/bench-cross.mk index 9c3b68c..496d38a 100644 --- a/mk/flavours/bench-cross.mk +++ b/mk/flavours/bench-cross.mk @@ -1,7 +1,7 @@ SRC_HC_OPTS = -O -H64m GhcStage1HcOpts = -O -GhcStage2HcOpts = -O0 -GhcLibHcOpts = -O2 +GhcStage2HcOpts = -O0 -fllvm +GhcLibHcOpts = -O2 -fllvm BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO diff --git a/mk/flavours/perf-cross.mk b/mk/flavours/perf-cross.mk index 3fcc199..0dd9c33 100644 --- a/mk/flavours/perf-cross.mk +++ b/mk/flavours/perf-cross.mk @@ -1,7 +1,7 @@ -SRC_HC_OPTS = -O -H64m -fllvm +SRC_HC_OPTS = -O -H64m GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O2 -fllvm -GhcLibHcOpts = -O2 +GhcLibHcOpts = -O2 -fllvm BUILD_PROF_LIBS = YES #SplitObjs HADDOCK_DOCS = NO From git at git.haskell.org Tue Sep 8 11:05:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 11:05:44 +0000 (UTC) Subject: [commit: ghc] master: Build system: cleanup BUILD_DIRS + add lots of Notes (8be43dd) Message-ID: <20150908110544.B13CF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8be43dd966c9c56e530eab266d6bf2710f9b07f4/ghc >--------------------------------------------------------------- commit 8be43dd966c9c56e530eab266d6bf2710f9b07f4 Author: Thomas Miedema Date: Sat Jul 11 00:50:58 2015 +0200 Build system: cleanup BUILD_DIRS + add lots of Notes Summary: See Note [CrossCompiling vs Stage1Only] in mk/config.mk.in. See Note [Stage1Only vs stage=1] in mk/config.mk.in. See Note [No stage2 packages when CrossCompiling or Stage1Only]. Also: * use stage2 to build mkUserGuidePart, as was probably intended. Now the following represent the same set of packages: - packages that we build with ghc-stage2 - packages that depend on the ghc library Those packages are: haddock, mkUserGuidePart and ghctags. * don't let utils that don't depend on the ghc library depend on its package-data.mk file. Instead, let those utils directly depend on the package-data.mk files of the stage1 packages. Not sure if it improves anything, but I found it easier to explain what's going on this way. (partially) reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1218 >--------------------------------------------------------------- 8be43dd966c9c56e530eab266d6bf2710f9b07f4 compiler/ghc.mk | 1 + ghc.mk | 174 +++++++++++++++++++++++++++++-------------- ghc/ghc.mk | 2 + mk/config.mk.in | 54 +++++++++++++- utils/ghc-pkg/ghc.mk | 2 + utils/mkUserGuidePart/ghc.mk | 2 +- 6 files changed, 176 insertions(+), 59 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 8be43dd966c9c56e530eab266d6bf2710f9b07f4 From git at git.haskell.org Tue Sep 8 13:42:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 13:42:47 +0000 (UTC) Subject: [commit: ghc] master: Move GeneralCategory et al to GHC.Unicode (e4a73f4) Message-ID: <20150908134247.CD70E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e4a73f4fa1cc9681aee3ce13ee15073deed54635/ghc >--------------------------------------------------------------- commit e4a73f4fa1cc9681aee3ce13ee15073deed54635 Author: Ben Gamari Date: Tue Sep 8 08:38:40 2015 -0500 Move GeneralCategory et al to GHC.Unicode This allows these to be used from Text.Read.Lex import cycles. Reviewed By: thomie, austin Differential Revision: https://phabricator.haskell.org/D1121 GHC Trac Issues: #10444 >--------------------------------------------------------------- e4a73f4fa1cc9681aee3ce13ee15073deed54635 libraries/base/Data/Char.hs | 209 +--------------------------------------- libraries/base/GHC/Read.hs | 4 +- libraries/base/GHC/Show.hs | 2 +- libraries/base/GHC/Unicode.hs | 215 +++++++++++++++++++++++++++++++++++++++++- 4 files changed, 219 insertions(+), 211 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e4a73f4fa1cc9681aee3ce13ee15073deed54635 From git at git.haskell.org Tue Sep 8 16:23:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 16:23:20 +0000 (UTC) Subject: [commit: ghc] master: Build system: check for inconsistent settings (#10157) (1b8eca1) Message-ID: <20150908162320.1B5F13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1b8eca18fc2bb9ccb4fd3246ac48318975574722/ghc >--------------------------------------------------------------- commit 1b8eca18fc2bb9ccb4fd3246ac48318975574722 Author: Thomas Miedema Date: Tue Sep 8 13:51:44 2015 +0200 Build system: check for inconsistent settings (#10157) `configure` currently detects when the docbook and hscolour tools aren't available, and instead of failing outright (as it does for missing alex and happy), sets some variables in mk/config.mk to tell `make` not to build the documentation. Sometimes, however, you want to really make sure all documentation gets built, fully colourized. For example when making a release. To do so, you can override the mentioned variables from mk/config.mk in mk/build.mk (e.g. set HSCOLOUR_SRCS=YES). This patch adds some error checking to make sure that doing so will not result in weird build failures when those tools are still missing. Test Plan: ran `make` a couple of times, with different mk/config.mk settings. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1232 >--------------------------------------------------------------- 1b8eca18fc2bb9ccb4fd3246ac48318975574722 configure.ac | 6 +++--- ghc.mk | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+), 3 deletions(-) diff --git a/configure.ac b/configure.ac index 47b07dd..406a4a6 100644 --- a/configure.ac +++ b/configure.ac @@ -1199,9 +1199,9 @@ echo ["\ fi echo ["\ - Building DocBook HTML documentation : $BUILD_DOCBOOK_HTML - Building DocBook PS documentation : $BUILD_DOCBOOK_PS - Building DocBook PDF documentation : $BUILD_DOCBOOK_PDF"] + Can build DocBook HTML documentation : $BUILD_DOCBOOK_HTML + Can build DocBook PS documentation : $BUILD_DOCBOOK_PS + Can build DocBook PDF documentation : $BUILD_DOCBOOK_PDF"] echo ["---------------------------------------------------------------------- "] diff --git a/ghc.mk b/ghc.mk index f933ce7..cc19501 100644 --- a/ghc.mk +++ b/ghc.mk @@ -147,7 +147,13 @@ include mk/custom-settings.mk SRC_CC_OPTS += $(WERROR) SRC_HC_OPTS += $(WERROR) +# ----------------------------------------------------------------------------- +# Check for inconsistent settings, after reading mk/build.mk. +# Although mk/config.mk should always contain consistent settings (set by +# configure), mk/build.mk can contain pretty much anything. + ifneq "$(CLEANING)" "YES" + ifeq "$(DYNAMIC_GHC_PROGRAMS)" "YES" ifeq "$(findstring dyn,$(GhcLibWays))" "" $(error dyn is not in $$(GhcLibWays), but $$(DYNAMIC_GHC_PROGRAMS) is YES) @@ -157,12 +163,45 @@ ifeq "$(findstring v,$(GhcLibWays))" "" $(error v is not in $$(GhcLibWays), and $$(DYNAMIC_GHC_PROGRAMS) is not YES) endif endif + ifeq "$(GhcProfiled)" "YES" ifeq "$(findstring p,$(GhcLibWays))" "" $(error p is not in $$(GhcLibWays), and $$(GhcProfiled) is YES) endif endif + +ifeq "$(BUILD_DOCBOOK_HTML)" "YES" +ifeq "$(XSLTPROC)" "" +$(error BUILD_DOCBOOK_HTML=YES, but `xsltproc` was not found. \ + Install `xsltproc`, then rerun `./configure`. \ + See https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation) +endif +ifeq "$(HAVE_DOCBOOK_XSL)" "NO" +$(error BUILD_DOCBOOK_HTML=YES, but DocBook XSL stylesheets were not found. \ + Install `docbook-xsl`, then rerun `./configure`. \ + See https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation) +endif +endif + +ifneq "$(BUILD_DOCBOOK_PS) $(BUILD_DOCBOOK_PDF)" "NO NO" +ifeq "$(DBLATEX)" "" +$(error BUILD_DOCBOOK_PS or BUILD_DOCBOOK_PDF=YES, but `dblatex` was not found. \ + Install `dblatex`, then rerun `./configure`. \ + See https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation) endif +endif + +ifeq "$(HSCOLOUR_SRCS)" "YES" +ifeq "$(HSCOLOUR_CMD)" "" +$(error HSCOLOUR_SRCS=YES, but HSCOLOUR_CMD is empty. \ + Run `cabal install hscolour`, then rerun `./configure`. \ + See https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation) +endif +endif + +endif # CLEANING + +# ----------------------------------------------------------------------------- ifeq "$(phase)" "" phase = final From git at git.haskell.org Tue Sep 8 16:29:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 16:29:16 +0000 (UTC) Subject: [commit: ghc] master: HeapStackCheck: Small refactoring (dbb4e41) Message-ID: <20150908162916.416983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbb4e415126aceb603da0fbf657372389a47e466/ghc >--------------------------------------------------------------- commit dbb4e415126aceb603da0fbf657372389a47e466 Author: Ben Gamari Date: Tue Sep 8 11:30:43 2015 -0500 HeapStackCheck: Small refactoring Use modern Cmm argument syntax in stg_block_blackhole definition. Reviewed By: simonmar, austin Differential Revision: https://phabricator.haskell.org/D1210 >--------------------------------------------------------------- dbb4e415126aceb603da0fbf657372389a47e466 rts/HeapStackCheck.cmm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm index 9430a09..825eaef 100644 --- a/rts/HeapStackCheck.cmm +++ b/rts/HeapStackCheck.cmm @@ -610,10 +610,10 @@ stg_block_putmvar (P_ mvar, P_ val) } } -stg_block_blackhole +stg_block_blackhole (P_ node) { Sp_adj(-2); - Sp(1) = R1; + Sp(1) = node; Sp(0) = stg_enter_info; BLOCK_GENERIC; } From git at git.haskell.org Tue Sep 8 16:34:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 16:34:33 +0000 (UTC) Subject: [commit: ghc] master: Forbid annotations when Safe Haskell safe mode is enabled. (4356dac) Message-ID: <20150908163433.23A023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4356dacb4a2ae29dfbd7126b25b72d89bb9db1b0/ghc >--------------------------------------------------------------- commit 4356dacb4a2ae29dfbd7126b25b72d89bb9db1b0 Author: David Kraeutmann Date: Tue Sep 8 11:35:33 2015 -0500 Forbid annotations when Safe Haskell safe mode is enabled. For now, this fails compliation immediately with an error. If desired, this can be a warning that annotations in Safe Haskell are ignored. Signed-off-by: David Kraeutmann Reviewed By: goldfire, austin Differential Revision: https://phabricator.haskell.org/D1226 GHC Trac Issues: #10826 >--------------------------------------------------------------- 4356dacb4a2ae29dfbd7126b25b72d89bb9db1b0 compiler/typecheck/TcAnnotations.hs | 11 ++++++++++- docs/users_guide/7.12.1-notes.xml | 9 +++++++++ docs/users_guide/safe_haskell.xml | 6 ++++++ testsuite/tests/annotations/should_fail/T10826.hs | 7 +++++++ testsuite/tests/annotations/should_fail/T10826.stderr | 6 ++++++ testsuite/tests/annotations/should_fail/all.T | 2 +- 6 files changed, 39 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs index 474630b..688a1e9 100644 --- a/compiler/typecheck/TcAnnotations.hs +++ b/compiler/typecheck/TcAnnotations.hs @@ -12,6 +12,8 @@ module TcAnnotations ( tcAnnotations, annCtxt ) where #ifdef GHCI import {-# SOURCE #-} TcSplice ( runAnnotation ) import Module +import DynFlags +import Control.Monad ( when ) #endif import HsSyn @@ -47,7 +49,14 @@ tcAnnotation (L loc ann@(HsAnnotation _ provenance expr)) = do let target = annProvenanceToTarget mod provenance -- Run that annotation and construct the full Annotation data structure - setSrcSpan loc $ addErrCtxt (annCtxt ann) $ runAnnotation target expr + setSrcSpan loc $ addErrCtxt (annCtxt ann) $ do + -- See #10826 -- Annotations allow one to bypass Safe Haskell. + dflags <- getDynFlags + when (safeLanguageOn dflags) $ failWithTc safeHsErr + runAnnotation target expr + where + safeHsErr = vcat [ ptext (sLit "Annotations are not compatible with Safe Haskell.") + , ptext (sLit "See https://ghc.haskell.org/trac/ghc/ticket/10826") ] annProvenanceToTarget :: Module -> AnnProvenance Name -> AnnTarget Name annProvenanceToTarget _ (ValueAnnProvenance (L _ name)) = NamedTarget name diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index 5a6670d..bc5c7af 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -100,6 +100,15 @@ See for details. + + + + Due to a + security issue + , Safe Haskell now forbids annotations in programs marked as + -XSafe + + diff --git a/docs/users_guide/safe_haskell.xml b/docs/users_guide/safe_haskell.xml index 814f5c9..f9bcf54 100644 --- a/docs/users_guide/safe_haskell.xml +++ b/docs/users_guide/safe_haskell.xml @@ -946,6 +946,12 @@ Wiki. + + Additionally, the use of annotations + is forbidden, as that would allow bypassing Safe Haskell restrictions. + See ticket #10826. + + diff --git a/testsuite/tests/annotations/should_fail/T10826.hs b/testsuite/tests/annotations/should_fail/T10826.hs new file mode 100644 index 0000000..cddf33c --- /dev/null +++ b/testsuite/tests/annotations/should_fail/T10826.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE Safe #-} +module Test (hook) where + +import System.IO.Unsafe + +{-# ANN hook (unsafePerformIO (putStrLn "Woops.")) #-} +hook = undefined diff --git a/testsuite/tests/annotations/should_fail/T10826.stderr b/testsuite/tests/annotations/should_fail/T10826.stderr new file mode 100644 index 0000000..0e2bed5 --- /dev/null +++ b/testsuite/tests/annotations/should_fail/T10826.stderr @@ -0,0 +1,6 @@ + +T10826.hs:6:1: error: + Annotations are not compatible with Safe Haskell. + See https://ghc.haskell.org/trac/ghc/ticket/10826 + In the annotation: + {-# ANN hook (unsafePerformIO (putStrLn "Woops.")) #-} diff --git a/testsuite/tests/annotations/should_fail/all.T b/testsuite/tests/annotations/should_fail/all.T index 21eaa76..0b10d83 100644 --- a/testsuite/tests/annotations/should_fail/all.T +++ b/testsuite/tests/annotations/should_fail/all.T @@ -18,7 +18,7 @@ test('annfail10', req_interp, compile_fail, ['']) test('annfail11', normal, compile_fail, ['']) test('annfail12', req_interp, compile_fail, ['-v0']) test('annfail13', normal, compile_fail, ['']) - +test('T10826', normal, compile_fail, ['']) """" Helpful things to C+P: From git at git.haskell.org Tue Sep 8 20:37:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 20:37:01 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T10858' created Message-ID: <20150908203701.8DBA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T10858 Referencing: 7ee0019015179b87d35f0506abedd0761e745848 From git at git.haskell.org Tue Sep 8 20:37:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 20:37:04 +0000 (UTC) Subject: [commit: ghc] wip/T10858: deriving Ord: Less case expressions (7ee0019) Message-ID: <20150908203704.89A413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10858 Link : http://ghc.haskell.org/trac/ghc/changeset/7ee0019015179b87d35f0506abedd0761e745848/ghc >--------------------------------------------------------------- commit 7ee0019015179b87d35f0506abedd0761e745848 Author: Joachim Breitner Date: Tue Sep 8 22:37:13 2015 +0200 deriving Ord: Less case expressions and implement each operator using the corresponding operator on the fields, instead of going via `compare` for all but the last field. By using the appropriate combiator, the generated code is smaller, which, I hope, will lead to quicker compilation. This is part of my suggestion from #10858. >--------------------------------------------------------------- 7ee0019015179b87d35f0506abedd0761e745848 compiler/prelude/PrelNames.hs | 6 ++++-- compiler/typecheck/TcGenDeriv.hs | 37 +++++++++++++++++-------------------- 2 files changed, 21 insertions(+), 22 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 1684a2f..339ea74 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -611,9 +611,10 @@ compose_RDR :: RdrName compose_RDR = varQual_RDR gHC_BASE (fsLit ".") not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, - and_RDR, range_RDR, inRange_RDR, index_RDR, + and_RDR, or_RDR, range_RDR, inRange_RDR, index_RDR, unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") +or_RDR = varQual_RDR gHC_CLASSES (fsLit "||") not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag") succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") @@ -724,7 +725,7 @@ notAssocDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "NotAssociative") fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, foldMap_RDR, - traverse_RDR, mempty_RDR, mappend_RDR :: RdrName + traverse_RDR, mempty_RDR, mappend_RDR, mappend_diamond_RDR :: RdrName fmap_RDR = varQual_RDR gHC_BASE (fsLit "fmap") pure_RDR = nameRdrName pureAName ap_RDR = nameRdrName apAName @@ -733,6 +734,7 @@ foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") mempty_RDR = varQual_RDR gHC_BASE (fsLit "mempty") mappend_RDR = varQual_RDR gHC_BASE (fsLit "mappend") +mappend_diamond_RDR = varQual_RDR gHC_BASE (fsLit "<>") ---------------------- varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 4a1ce4f..e281a00 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -372,6 +372,16 @@ gtResult OrdGE = true_Expr gtResult OrdGT = true_Expr ------------ +combineResult :: OrdOp -> RdrName +-- Knowing a1 ? b2 and a2 ? b2?, +-- how do we combine that to obtain (a1,a2) ? (b1,b2) +combineResult OrdCompare = mappend_diamond_RDR +combineResult OrdLT = or_RDR +combineResult OrdLE = and_RDR +combineResult OrdGE = and_RDR +combineResult OrdGT = or_RDR + +------------ gen_Ord_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff) gen_Ord_binds loc tycon | null tycon_data_cons -- No data-cons => invoke bale-out case @@ -491,31 +501,18 @@ mkCompareFields :: TyCon -> OrdOp -> [Type] -> LHsExpr RdrName mkCompareFields tycon op tys = go tys as_RDRs bs_RDRs where + -- Build a chain of calls to the current operator for each field, combined + -- with the appropriate combinator from combineResult. go [] _ _ = eqResult op - go [ty] (a:_) (b:_) - | isUnLiftedType ty = unliftedOrdOp tycon ty op a b - | otherwise = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b) - go (ty:tys) (a:as) (b:bs) = mk_compare ty a b - (ltResult op) - (go tys as bs) - (gtResult op) + go [ty] (a:_) (b:_) = mk_compare ty a b + go (ty:tys) (a:as) (b:bs) = genOpApp (mk_compare ty a b) (combineResult op) (go tys as bs) go _ _ _ = panic "mkCompareFields" - -- (mk_compare ty a b) generates - -- (case (compare a b) of { LT -> ; EQ -> ; GT -> }) - -- but with suitable special cases for - mk_compare ty a b lt eq gt + mk_compare ty a b | isUnLiftedType ty - = unliftedCompare lt_op eq_op a_expr b_expr lt eq gt + = unliftedOrdOp tycon ty op a b | otherwise - = nlHsCase (nlHsPar (nlHsApp (nlHsApp (nlHsVar compare_RDR) a_expr) b_expr)) - [mkSimpleHsAlt (nlNullaryConPat ltTag_RDR) lt, - mkSimpleHsAlt (nlNullaryConPat eqTag_RDR) eq, - mkSimpleHsAlt (nlNullaryConPat gtTag_RDR) gt] - where - a_expr = nlHsVar a - b_expr = nlHsVar b - (lt_op, _, eq_op, _, _) = primOrdOps "Ord" tycon ty + = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b) unliftedOrdOp :: TyCon -> Type -> OrdOp -> RdrName -> RdrName -> LHsExpr RdrName unliftedOrdOp tycon ty op a b From git at git.haskell.org Tue Sep 8 20:58:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 20:58:31 +0000 (UTC) Subject: [commit: ghc] wip/T10858: deriving Ord: Less case expressions (bcefd2a) Message-ID: <20150908205831.40B633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10858 Link : http://ghc.haskell.org/trac/ghc/changeset/bcefd2af2beaa887aac483c3d830abb222dc26be/ghc >--------------------------------------------------------------- commit bcefd2af2beaa887aac483c3d830abb222dc26be Author: Joachim Breitner Date: Tue Sep 8 22:37:13 2015 +0200 deriving Ord: Less case expressions and implement each operator using the corresponding operator on the fields, instead of going via `compare` for all but the last field. By using the appropriate combiator, the generated code is smaller, which, I hope, will lead to quicker compilation. This is part of my suggestion from #10858. >--------------------------------------------------------------- bcefd2af2beaa887aac483c3d830abb222dc26be compiler/prelude/PrelNames.hs | 6 ++++-- compiler/typecheck/TcGenDeriv.hs | 37 +++++++++++++++++-------------------- 2 files changed, 21 insertions(+), 22 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 1684a2f..f4a0529 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -611,9 +611,10 @@ compose_RDR :: RdrName compose_RDR = varQual_RDR gHC_BASE (fsLit ".") not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, - and_RDR, range_RDR, inRange_RDR, index_RDR, + and_RDR, or_RDR, range_RDR, inRange_RDR, index_RDR, unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") +or_RDR = varQual_RDR gHC_CLASSES (fsLit "||") not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag") succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") @@ -724,7 +725,7 @@ notAssocDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "NotAssociative") fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, foldMap_RDR, - traverse_RDR, mempty_RDR, mappend_RDR :: RdrName + traverse_RDR, mempty_RDR, mappend_RDR, mappend_diamond_RDR :: RdrName fmap_RDR = varQual_RDR gHC_BASE (fsLit "fmap") pure_RDR = nameRdrName pureAName ap_RDR = nameRdrName apAName @@ -733,6 +734,7 @@ foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") mempty_RDR = varQual_RDR gHC_BASE (fsLit "mempty") mappend_RDR = varQual_RDR gHC_BASE (fsLit "mappend") +mappend_diamond_RDR = varQual_RDR dATA_MONOID (fsLit "<>") ---------------------- varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 4a1ce4f..e281a00 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -372,6 +372,16 @@ gtResult OrdGE = true_Expr gtResult OrdGT = true_Expr ------------ +combineResult :: OrdOp -> RdrName +-- Knowing a1 ? b2 and a2 ? b2?, +-- how do we combine that to obtain (a1,a2) ? (b1,b2) +combineResult OrdCompare = mappend_diamond_RDR +combineResult OrdLT = or_RDR +combineResult OrdLE = and_RDR +combineResult OrdGE = and_RDR +combineResult OrdGT = or_RDR + +------------ gen_Ord_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff) gen_Ord_binds loc tycon | null tycon_data_cons -- No data-cons => invoke bale-out case @@ -491,31 +501,18 @@ mkCompareFields :: TyCon -> OrdOp -> [Type] -> LHsExpr RdrName mkCompareFields tycon op tys = go tys as_RDRs bs_RDRs where + -- Build a chain of calls to the current operator for each field, combined + -- with the appropriate combinator from combineResult. go [] _ _ = eqResult op - go [ty] (a:_) (b:_) - | isUnLiftedType ty = unliftedOrdOp tycon ty op a b - | otherwise = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b) - go (ty:tys) (a:as) (b:bs) = mk_compare ty a b - (ltResult op) - (go tys as bs) - (gtResult op) + go [ty] (a:_) (b:_) = mk_compare ty a b + go (ty:tys) (a:as) (b:bs) = genOpApp (mk_compare ty a b) (combineResult op) (go tys as bs) go _ _ _ = panic "mkCompareFields" - -- (mk_compare ty a b) generates - -- (case (compare a b) of { LT -> ; EQ -> ; GT -> }) - -- but with suitable special cases for - mk_compare ty a b lt eq gt + mk_compare ty a b | isUnLiftedType ty - = unliftedCompare lt_op eq_op a_expr b_expr lt eq gt + = unliftedOrdOp tycon ty op a b | otherwise - = nlHsCase (nlHsPar (nlHsApp (nlHsApp (nlHsVar compare_RDR) a_expr) b_expr)) - [mkSimpleHsAlt (nlNullaryConPat ltTag_RDR) lt, - mkSimpleHsAlt (nlNullaryConPat eqTag_RDR) eq, - mkSimpleHsAlt (nlNullaryConPat gtTag_RDR) gt] - where - a_expr = nlHsVar a - b_expr = nlHsVar b - (lt_op, _, eq_op, _, _) = primOrdOps "Ord" tycon ty + = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b) unliftedOrdOp :: TyCon -> Type -> OrdOp -> RdrName -> RdrName -> LHsExpr RdrName unliftedOrdOp tycon ty op a b From git at git.haskell.org Tue Sep 8 21:35:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Sep 2015 21:35:56 +0000 (UTC) Subject: [commit: ghc] wip/T10858: Export thenComp in GHC.Base as a monomorphic function (98d1fd0) Message-ID: <20150908213556.359DB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10858 Link : http://ghc.haskell.org/trac/ghc/changeset/98d1fd01b43071b474faf3d6b0be455efde9b6a8/ghc >--------------------------------------------------------------- commit 98d1fd01b43071b474faf3d6b0be455efde9b6a8 Author: Joachim Breitner Date: Tue Sep 8 23:36:42 2015 +0200 Export thenComp in GHC.Base as a monomorphic function to avoid generating calls to the overloaded (<>) in generated Ord instances. >--------------------------------------------------------------- 98d1fd01b43071b474faf3d6b0be455efde9b6a8 compiler/prelude/PrelNames.hs | 4 ++-- compiler/typecheck/TcGenDeriv.hs | 2 +- libraries/base/GHC/Base.hs | 12 ++++++++---- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index f4a0529..597ef17 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -725,7 +725,7 @@ notAssocDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "NotAssociative") fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, foldMap_RDR, - traverse_RDR, mempty_RDR, mappend_RDR, mappend_diamond_RDR :: RdrName + traverse_RDR, mempty_RDR, mappend_RDR, thenCmp_RDR :: RdrName fmap_RDR = varQual_RDR gHC_BASE (fsLit "fmap") pure_RDR = nameRdrName pureAName ap_RDR = nameRdrName apAName @@ -734,7 +734,7 @@ foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") mempty_RDR = varQual_RDR gHC_BASE (fsLit "mempty") mappend_RDR = varQual_RDR gHC_BASE (fsLit "mappend") -mappend_diamond_RDR = varQual_RDR dATA_MONOID (fsLit "<>") +thenCmp_RDR = varQual_RDR gHC_BASE (fsLit "thenCmp") ---------------------- varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index e281a00..5e694a9 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -375,7 +375,7 @@ gtResult OrdGT = true_Expr combineResult :: OrdOp -> RdrName -- Knowing a1 ? b2 and a2 ? b2?, -- how do we combine that to obtain (a1,a2) ? (b1,b2) -combineResult OrdCompare = mappend_diamond_RDR +combineResult OrdCompare = thenCmp_RDR combineResult OrdLT = or_RDR combineResult OrdLE = and_RDR combineResult OrdGE = and_RDR diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 9bd6124..5d48d52 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -287,10 +287,14 @@ instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => -- lexicographical ordering instance Monoid Ordering where - mempty = EQ - LT `mappend` _ = LT - EQ `mappend` y = y - GT `mappend` _ = GT + mempty = EQ + mappend = thenCmp + +-- The monomorphic version is used by the autogenerated Ord instances +thenCmp :: Ordering -> Ordering -> Ordering +LT `thenCmp` _ = LT +EQ `thenCmp` y = y +GT `thenCmp` _ = GT -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to -- : \"Any semigroup @S@ may be From git at git.haskell.org Wed Sep 9 07:46:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Sep 2015 07:46:57 +0000 (UTC) Subject: [commit: ghc] wip/T10858: Fix my horribly broken “improved” Ord deriving code (c07fd1d) Message-ID: <20150909074657.B0E683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10858 Link : http://ghc.haskell.org/trac/ghc/changeset/c07fd1dc37aae27a118fafd482dab52ba4946cb3/ghc >--------------------------------------------------------------- commit c07fd1dc37aae27a118fafd482dab52ba4946cb3 Author: Joachim Breitner Date: Wed Sep 9 09:47:41 2015 +0200 Fix my horribly broken ?improved? Ord deriving code but still do something smaller than previously, using the thenCmp operator. (JFTR: This is a commit on a wip/ branch, so do not worry about the unpolished commit messages :-)) >--------------------------------------------------------------- c07fd1dc37aae27a118fafd482dab52ba4946cb3 compiler/typecheck/TcGenDeriv.hs | 48 +++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 5e694a9..4d7c48b 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -372,16 +372,6 @@ gtResult OrdGE = true_Expr gtResult OrdGT = true_Expr ------------ -combineResult :: OrdOp -> RdrName --- Knowing a1 ? b2 and a2 ? b2?, --- how do we combine that to obtain (a1,a2) ? (b1,b2) -combineResult OrdCompare = thenCmp_RDR -combineResult OrdLT = or_RDR -combineResult OrdLE = and_RDR -combineResult OrdGE = and_RDR -combineResult OrdGT = or_RDR - ------------- gen_Ord_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff) gen_Ord_binds loc tycon | null tycon_data_cons -- No data-cons => invoke bale-out case @@ -499,20 +489,32 @@ mkCompareFields :: TyCon -> OrdOp -> [Type] -> LHsExpr RdrName -- Generates nested comparisons for (a1,a2...) against (b1,b2,...) -- where the ai,bi have the given types mkCompareFields tycon op tys - = go tys as_RDRs bs_RDRs + = go (zip3 tys as_RDRs bs_RDRs) where - -- Build a chain of calls to the current operator for each field, combined - -- with the appropriate combinator from combineResult. - go [] _ _ = eqResult op - go [ty] (a:_) (b:_) = mk_compare ty a b - go (ty:tys) (a:as) (b:bs) = genOpApp (mk_compare ty a b) (combineResult op) (go tys as bs) - go _ _ _ = panic "mkCompareFields" - - mk_compare ty a b - | isUnLiftedType ty - = unliftedOrdOp tycon ty op a b - | otherwise - = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b) + -- With one field, we can simply use the current operator. + -- With two fields, we have use `compare` on the first. + -- With more than two fields, we use `compare` on all but the first, and + -- combine the result with thenCmp. + go [] = eqResult op + go [arg] = mk_op arg + go args + | OrdCompare <- op + = mk_compares args + | otherwise + = nlHsCase (nlHsPar (mk_compares (init args))) + [mkSimpleHsAlt (nlNullaryConPat ltTag_RDR) (ltResult op), + mkSimpleHsAlt (nlNullaryConPat eqTag_RDR) (mk_op (last args)), + mkSimpleHsAlt (nlNullaryConPat gtTag_RDR) (gtResult op)] + + mk_op (ty, a, b) + | isUnLiftedType ty = unliftedOrdOp tycon ty op a b + | otherwise = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b) + + mk_compares args = foldr1 (`genOpApp` thenCmp_RDR) (map mk_compare args) + + mk_compare (ty, a, b) + | isUnLiftedType ty = unliftedOrdOp tycon ty (OrdCompare) a b + | otherwise = genOpApp (nlHsVar a) (compare_RDR) (nlHsVar b) unliftedOrdOp :: TyCon -> Type -> OrdOp -> RdrName -> RdrName -> LHsExpr RdrName unliftedOrdOp tycon ty op a b From git at git.haskell.org Wed Sep 9 08:18:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Sep 2015 08:18:02 +0000 (UTC) Subject: [commit: ghc] wip/T10858: Move thenCmp to GHC.Classes (25d72fb) Message-ID: <20150909081802.5317A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10858 Link : http://ghc.haskell.org/trac/ghc/changeset/25d72fbf45903da0b65fccfd3853c7a7ecc06b57/ghc >--------------------------------------------------------------- commit 25d72fbf45903da0b65fccfd3853c7a7ecc06b57 Author: Joachim Breitner Date: Wed Sep 9 10:18:18 2015 +0200 Move thenCmp to GHC.Classes as we need to derive code already that, and that happens before GHC.Base. >--------------------------------------------------------------- 25d72fbf45903da0b65fccfd3853c7a7ecc06b57 compiler/prelude/PrelNames.hs | 7 +++---- libraries/base/GHC/Base.hs | 6 ------ libraries/ghc-prim/GHC/Classes.hs | 9 ++++++++- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 597ef17..1515a2f 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -611,11 +611,11 @@ compose_RDR :: RdrName compose_RDR = varQual_RDR gHC_BASE (fsLit ".") not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, - and_RDR, or_RDR, range_RDR, inRange_RDR, index_RDR, + and_RDR, thenCmp_RDR, range_RDR, inRange_RDR, index_RDR, unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") -or_RDR = varQual_RDR gHC_CLASSES (fsLit "||") not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") +thenCmp_RDR = varQual_RDR gHC_CLASSES (fsLit "thenCmp") getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag") succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred") @@ -725,7 +725,7 @@ notAssocDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "NotAssociative") fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, foldMap_RDR, - traverse_RDR, mempty_RDR, mappend_RDR, thenCmp_RDR :: RdrName + traverse_RDR, mempty_RDR, mappend_RDR :: RdrName fmap_RDR = varQual_RDR gHC_BASE (fsLit "fmap") pure_RDR = nameRdrName pureAName ap_RDR = nameRdrName apAName @@ -734,7 +734,6 @@ foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") mempty_RDR = varQual_RDR gHC_BASE (fsLit "mempty") mappend_RDR = varQual_RDR gHC_BASE (fsLit "mappend") -thenCmp_RDR = varQual_RDR gHC_BASE (fsLit "thenCmp") ---------------------- varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 5d48d52..816c8d6 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -290,12 +290,6 @@ instance Monoid Ordering where mempty = EQ mappend = thenCmp --- The monomorphic version is used by the autogenerated Ord instances -thenCmp :: Ordering -> Ordering -> Ordering -LT `thenCmp` _ = LT -EQ `thenCmp` y = y -GT `thenCmp` _ = GT - -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to -- : \"Any semigroup @S@ may be -- turned into a monoid simply by adjoining an element @e@ not in @S@ diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs index 18662ad..299a872 100644 --- a/libraries/ghc-prim/GHC/Classes.hs +++ b/libraries/ghc-prim/GHC/Classes.hs @@ -32,7 +32,8 @@ module GHC.Classes( Eq(..), eqInt, neInt, Ord(..), gtInt, geInt, leInt, ltInt, compareInt, compareInt#, (&&), (||), not, - divInt#, modInt# + divInt#, modInt#, + thenCmp ) where -- GHC.Magic is used in some derived instances @@ -296,6 +297,12 @@ not :: Bool -> Bool not True = False not False = True +-- This is used by the derived code for Ord, so put it here +thenCmp :: Ordering -> Ordering -> Ordering +LT `thenCmp` _ = LT +EQ `thenCmp` y = y +GT `thenCmp` _ = GT + ------------------------------------------------------------------------ -- These don't really belong here, but we don't have a better place to From git at git.haskell.org Wed Sep 9 11:59:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Sep 2015 11:59:05 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: comment out `setnumcapabilities001` (#10860) (23a301a) Message-ID: <20150909115905.A0F2B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23a301ac36bb7e62bcf91bbcf0eb9e0e37498664/ghc >--------------------------------------------------------------- commit 23a301ac36bb7e62bcf91bbcf0eb9e0e37498664 Author: Thomas Miedema Date: Wed Sep 9 13:56:53 2015 +0200 Testsuite: comment out `setnumcapabilities001` (#10860) Don't mark it expect_broken, because it fails only sometimes. >--------------------------------------------------------------- 23a301ac36bb7e62bcf91bbcf0eb9e0e37498664 testsuite/tests/concurrent/should_run/all.T | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 58c3bd1..1ef566d 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -249,12 +249,14 @@ if (ghc_with_smp == 0): else: skip_if_not_smp = normal -test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2']), - extra_run_opts('4 12 2000'), - reqlib('parallel'), - skip_if_not_smp ], - compile_and_run, ['']) +# Commented out, instead of marked expect_broken, because it fails only +# sometimes. See #10860. +#test('setnumcapabilities001', +# [ only_ways(['threaded1','threaded2']), +# extra_run_opts('4 12 2000'), +# reqlib('parallel'), +# skip_if_not_smp ], +# compile_and_run, ['']) # omit ghci, which can't handle unboxed tuples: test('compareAndSwap', [omit_ways(['ghci','hpc']), reqlib('primitive')], compile_and_run, ['']) From git at git.haskell.org Thu Sep 10 05:00:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Sep 2015 05:00:58 +0000 (UTC) Subject: [commit: ghc] master: Don't check in autogenerated hs files for recomp013. (cdca31e) Message-ID: <20150910050058.3CD793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cdca31ebf7744dcae66a6715500395a63bcc3ee2/ghc >--------------------------------------------------------------- commit cdca31ebf7744dcae66a6715500395a63bcc3ee2 Author: Edward Z. Yang Date: Wed Sep 9 22:02:48 2015 -0700 Don't check in autogenerated hs files for recomp013. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- cdca31ebf7744dcae66a6715500395a63bcc3ee2 testsuite/.gitignore | 3 +++ testsuite/tests/driver/recomp013/A.hs | 1 - testsuite/tests/driver/recomp013/B.hs | 1 - testsuite/tests/driver/recomp013/C.hs | 1 - 4 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 10abec4..8a0796d 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -613,6 +613,9 @@ mk/ghcconfig*_bin_ghc*.exe.mk /tests/driver/recomp012/Main /tests/driver/recomp012/Main.hs /tests/driver/recomp012/MyBool.hs +/tests/driver/recomp013/A.hs +/tests/driver/recomp013/B.hs +/tests/driver/recomp013/C.hs /tests/driver/recomp014/A.hs /tests/driver/recomp014/A1.hs /tests/driver/recomp014/B.hsig diff --git a/testsuite/tests/driver/recomp013/A.hs b/testsuite/tests/driver/recomp013/A.hs deleted file mode 100644 index 01599b3..0000000 --- a/testsuite/tests/driver/recomp013/A.hs +++ /dev/null @@ -1 +0,0 @@ -module A where a1 = 5; a2 = 42; a3 = 113 diff --git a/testsuite/tests/driver/recomp013/B.hs b/testsuite/tests/driver/recomp013/B.hs deleted file mode 100644 index 5737299..0000000 --- a/testsuite/tests/driver/recomp013/B.hs +++ /dev/null @@ -1 +0,0 @@ -module B (module A) where import A hiding (a1, a2) diff --git a/testsuite/tests/driver/recomp013/C.hs b/testsuite/tests/driver/recomp013/C.hs deleted file mode 100644 index da2c02f..0000000 --- a/testsuite/tests/driver/recomp013/C.hs +++ /dev/null @@ -1 +0,0 @@ -module C where import B; a2 = 142 From git at git.haskell.org Fri Sep 11 16:17:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 16:17:13 +0000 (UTC) Subject: [commit: ghc] master: Comments on oneShot (3a71d78) Message-ID: <20150911161713.95AAC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3a71d78156ed9422b7642bfbd665978ea3de7f89/ghc >--------------------------------------------------------------- commit 3a71d78156ed9422b7642bfbd665978ea3de7f89 Author: Simon Peyton Jones Date: Thu Aug 27 16:23:46 2015 +0100 Comments on oneShot >--------------------------------------------------------------- 3a71d78156ed9422b7642bfbd665978ea3de7f89 compiler/basicTypes/MkId.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 36d0794..698c865 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1326,6 +1326,10 @@ and Note [Left folds via right fold]) it was determined that it would be useful if library authors could explicitly tell the compiler that a certain lambda is called at most once. The oneShot function allows that. +'oneShot' is open kinded, i.e. the type variables can refer to unlifted +types as well (Trac #10744); e.g. + oneShot (\x:Int# -> x +# 1#) + Like most magic functions it has a compulsary unfolding, so there is no need for a real definition somewhere. We have one in GHC.Magic for the convenience of putting the documentation there. From git at git.haskell.org Fri Sep 11 16:17:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 16:17:16 +0000 (UTC) Subject: [commit: ghc] master: Add a test for Trac #10806 (487c90e) Message-ID: <20150911161716.E9EFA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/487c90edd3c36406bdc020afd79a6696ae52c19b/ghc >--------------------------------------------------------------- commit 487c90edd3c36406bdc020afd79a6696ae52c19b Author: Simon Peyton Jones Date: Fri Sep 11 15:55:29 2015 +0100 Add a test for Trac #10806 >--------------------------------------------------------------- 487c90edd3c36406bdc020afd79a6696ae52c19b testsuite/tests/indexed-types/should_compile/T10806.hs | 11 +++++++++++ testsuite/tests/indexed-types/should_compile/T10806.stderr | 9 +++++++++ testsuite/tests/indexed-types/should_compile/all.T | 2 +- 3 files changed, 21 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/indexed-types/should_compile/T10806.hs b/testsuite/tests/indexed-types/should_compile/T10806.hs new file mode 100644 index 0000000..149cd0f --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10806.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs, ExplicitNamespaces, TypeOperators, DataKinds #-} + +module T10806 where + +import GHC.TypeLits (Nat, type (<=)) + +data Q a where + Q :: (a <= b, b <= c) => proxy a -> proxy b -> Q c + +triggersLoop :: Q b -> Q b -> Bool +triggersLoop (Q _ _) (Q _ _) = print 'x' 'y' diff --git a/testsuite/tests/indexed-types/should_compile/T10806.stderr b/testsuite/tests/indexed-types/should_compile/T10806.stderr new file mode 100644 index 0000000..3503105 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10806.stderr @@ -0,0 +1,9 @@ + +T10806.hs:11:32: error: + Couldn't match expected type ?Char -> Bool? + with actual type ?IO ()? + The function ?print? is applied to two arguments, + but its type ?Char -> IO ()? has only one + In the expression: print 'x' 'y' + In an equation for ?triggersLoop?: + triggersLoop (Q _ _) (Q _ _) = print 'x' 'y' diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 7bbb04b..5e7e468 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -262,4 +262,4 @@ test('T10507', normal, compile, ['']) test('T10634', normal, compile, ['']) test('T10713', normal, compile, ['']) test('T10753', normal, compile, ['']) - +test('T10806', normal, compile_fail, ['']) From git at git.haskell.org Fri Sep 11 16:17:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 16:17:19 +0000 (UTC) Subject: [commit: ghc] master: Improve rejigConRes (again) (a870738) Message-ID: <20150911161719.C071A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a870738a3b34d264c63656783e84168a230d7da4/ghc >--------------------------------------------------------------- commit a870738a3b34d264c63656783e84168a230d7da4 Author: Simon Peyton Jones Date: Fri Sep 11 15:54:39 2015 +0100 Improve rejigConRes (again) I think this patch finally works around the delicacy in the strictness of TcTyClsDecls.rejigConRes. See the notes with that function and Note [Checking GADT return types]. As a result, we fix Trac #10836, and improve Trac #7175 >--------------------------------------------------------------- a870738a3b34d264c63656783e84168a230d7da4 compiler/typecheck/TcTyClsDecls.hs | 67 +++++++++++++--------- testsuite/tests/typecheck/should_fail/T7175.stderr | 6 ++ testsuite/tests/typecheck/should_fail/all.T | 2 +- 3 files changed, 46 insertions(+), 29 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 19af9f0..11dc141 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -162,10 +162,8 @@ tcTyClGroup tyclds -- expects well-formed TyCons ; tcExtendGlobalEnv tyclss $ do { traceTc "Starting validity check" (ppr tyclss) - ; checkNoErrs $ - mapM_ (recoverM (return ()) . checkValidTyCl) tyclss + ; mapM_ (recoverM (return ()) . checkValidTyCl) tyclss -- We recover, which allows us to report multiple validity errors - -- the checkNoErrs is necessary to fix #7175. ; mapM_ (recoverM (return ()) . checkValidRoleAnnots role_annots) tyclss -- See Note [Check role annotations in a second pass] @@ -1285,6 +1283,9 @@ tcConDecl new_or_data rep_tycon tmpl_tvs res_tmpl -- Data types ResTyGADT ls ty -> ResTyGADT ls <$> zonkTcTypeToType ze ty ; let (univ_tvs, ex_tvs, eq_preds, res_ty') = rejigConRes tmpl_tvs res_tmpl qtkvs res_ty + -- NB: this is a /lazy/ binding, so we pass four thunks to buildDataCon + -- without yet forcing the guards in rejigConRes + -- See Note [Checking GADT return types] ; fam_envs <- tcGetFamInstEnvs ; let @@ -1375,7 +1376,7 @@ There is a delicacy around checking the return types of a datacon. The central problem is dealing with a declaration like data T a where - MkT :: a -> Q a + MkT :: T a -> Q a Note that the return type of MkT is totally bogus. When creating the T tycon, we also need to create the MkT datacon, which must have a "rejigged" @@ -1383,14 +1384,17 @@ return type. That is, the MkT datacon's type must be transformed to have a uniform return type with explicit coercions for GADT-like type parameters. This rejigging is what rejigConRes does. The problem is, though, that checking that the return type is appropriate is much easier when done over *Type*, -not *HsType*. - -So, we want to make rejigConRes lazy and then check the validity of the return -type in checkValidDataCon. But, if the return type is bogus, rejigConRes can't -work -- it will have a failed pattern match. Luckily, if we run -checkValidDataCon before ever looking at the rejigged return type -(checkValidDataCon checks the dataConUserType, which is not rejigged!), we -catch the error before forcing the rejigged type and panicking. +not *HsType*, and doing a call to tcMatchTy will loop because T isn't fully +defined yet. + +So, we want to make rejigConRes lazy and then check the validity of +the return type in checkValidDataCon. To do this we /always/ return a +4-tuple from rejigConRes (so that we can extract ret_ty from it, which +checkValidDataCon needs), but the first three fields may be bogus if +the return type isn't valid (the last equation for rejigConRes). + +This is better than an earlier solution which reduced the number of +errors reported in one pass. See Trac #7175, and #10836. -} -- Example @@ -1432,20 +1436,27 @@ rejigConRes tmpl_tvs res_tmpl dc_tvs (ResTyGADT _ res_ty) -- z -- Existentials are the leftover type vars: [x,y] -- So we return ([a,b,z], [x,y], [a~(x,y),b~z], T [(x,y)] z z) + | Just subst <- tcMatchTy (mkVarSet tmpl_tvs) res_tmpl res_ty + , (univ_tvs, eq_spec) <- foldr (choose subst) ([], []) tmpl_tvs + , let ex_tvs = dc_tvs `minusList` univ_tvs = (univ_tvs, ex_tvs, eq_spec, res_ty) + + | otherwise + -- If the return type of the data constructor doesn't match the parent + -- type constructor, or the arity is wrong, the tcMatchTy will fail + -- e.g data T a b where + -- T1 :: Maybe a -- Wrong tycon + -- T2 :: T [a] -- Wrong arity + -- We are detect that later, in checkValidDataCon, but meanwhile + -- we must do *something*, not just crash. So we do something simple + -- albeit bogus, relying on checkValidDataCon to check the + -- bad-result-type error before seeing that the other fields look odd + -- See Note [Checking GADT return types] + = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, [], res_ty) where - Just subst = tcMatchTy (mkVarSet tmpl_tvs) res_tmpl res_ty - -- This 'Just' pattern is sure to match, because if not - -- checkValidDataCon will complain first. - -- But care: this only works if the result of rejigConRes - -- is not demanded until checkValidDataCon has - -- first succeeded - -- See Note [Checking GADT return types] - - -- /Lazily/ figure out the univ_tvs etc - -- Each univ_tv is either a dc_tv or a tmpl_tv - (univ_tvs, eq_spec) = foldr choose ([], []) tmpl_tvs - choose tmpl (univs, eqs) + -- Figure out the univ_tvs etc + -- Each univ_tv is either a dc_tv or a tmpl_tv + choose subst tmpl (univs, eqs) | Just ty <- lookupTyVar subst tmpl = case tcGetTyVar_maybe ty of Just tv | not (tv `elem` univs) @@ -1454,7 +1465,6 @@ rejigConRes tmpl_tvs res_tmpl dc_tvs (ResTyGADT _ res_ty) where -- see Note [Substitution in template variables kinds] new_tmpl = updateTyVarKind (substTy subst) tmpl | otherwise = pprPanic "tcResultType" (ppr res_ty) - ex_tvs = dc_tvs `minusList` univ_tvs {- Note [Substitution in template variables kinds] @@ -1633,9 +1643,10 @@ checkValidDataCon dflags existential_ok tc con do { -- Check that the return type of the data constructor -- matches the type constructor; eg reject this: -- data T a where { MkT :: Bogus a } - -- c.f. Note [Check role annotations in a second pass] - -- and Note [Checking GADT return types] - let tc_tvs = tyConTyVars tc + -- It's important to do this first: + -- see Note [Checking GADT return types] + -- and c.f. Note [Check role annotations in a second pass] + let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) orig_res_ty = dataConOrigResTy con ; traceTc "checkValidDataCon" (vcat diff --git a/testsuite/tests/typecheck/should_fail/T7175.stderr b/testsuite/tests/typecheck/should_fail/T7175.stderr index 25e9365..57d798f 100644 --- a/testsuite/tests/typecheck/should_fail/T7175.stderr +++ b/testsuite/tests/typecheck/should_fail/T7175.stderr @@ -4,3 +4,9 @@ T7175.hs:8:4: error: instead of an instance of its parent type ?G1 a? In the definition of data constructor ?G1C? In the data type declaration for ?G1? + +T7175.hs:11:4: error: + Data constructor ?G2C? returns type ?F Int? + instead of an instance of its parent type ?G2 a? + In the definition of data constructor ?G2C? + In the data type declaration for ?G2? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 66b8a86..31646d6 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -395,4 +395,4 @@ test('ExpandSynsFail2', normal, compile_fail, ['-fprint-expanded-synonyms']) test('ExpandSynsFail3', normal, compile_fail, ['-fprint-expanded-synonyms']) test('ExpandSynsFail4', normal, compile_fail, ['-fprint-expanded-synonyms']) test('T10698', expect_broken(10698), compile_fail, ['']) -test('T10836', expect_broken(10836), compile_fail, ['']) +test('T10836', normal, compile_fail, ['']) From git at git.haskell.org Fri Sep 11 16:17:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 16:17:22 +0000 (UTC) Subject: [commit: ghc] master: A CFunEqCan can be Derived (a7f6909) Message-ID: <20150911161722.90E883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a7f690972629672510c71149d7d7c6ffe6217201/ghc >--------------------------------------------------------------- commit a7f690972629672510c71149d7d7c6ffe6217201 Author: Simon Peyton Jones Date: Fri Sep 11 16:23:06 2015 +0100 A CFunEqCan can be Derived This fixes the ASSERTION failures in indexed-types/should_fail/T5439 typecheck/should_fail/T5490 when GHC is compiled with -DDEBUG See Phab:D202 attached to Trac #6018 >--------------------------------------------------------------- a7f690972629672510c71149d7d7c6ffe6217201 compiler/typecheck/TcInteract.hs | 18 ++++++++++++++---- compiler/typecheck/TcRnTypes.hs | 1 - compiler/typecheck/TcSMonad.hs | 12 +++++++----- 3 files changed, 21 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 261d9af..773f2ae 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1378,8 +1378,7 @@ reduce_top_fun_eq old_ev fsk ax_co rhs_ty = shortCutReduction old_ev fsk ax_co tc tc_args -- Try shortcut; see Note [Short cut for top-level reaction] - | ASSERT( not (isDerived old_ev) ) -- CFunEqCan is never Derived - isGiven old_ev -- Not shortcut + | isGiven old_ev -- Not shortcut = do { let final_co = mkTcSymCo (ctEvCoercion old_ev) `mkTcTransCo` ax_co -- final_co :: fsk ~ rhs_ty ; new_ev <- newGivenEvVar deeper_loc (mkTcEqPred (mkTyVarTy fsk) rhs_ty, @@ -1387,6 +1386,7 @@ reduce_top_fun_eq old_ev fsk ax_co rhs_ty ; emitWorkNC [new_ev] -- Non-cannonical; that will mean we flatten rhs_ty ; stopWith old_ev "Fun/Top (given)" } + -- So old_ev is Wanted or Derived | not (fsk `elemVarSet` tyVarsOfType rhs_ty) = do { dischargeFmv old_ev fsk ax_co rhs_ty ; traceTcS "doTopReactFunEq" $ @@ -1396,8 +1396,16 @@ 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 <- newWantedEvVarNC loc (mkTcEqPred alpha_ty rhs_ty) - ; emitWorkNC [new_ev] + ; let pred = mkTcEqPred alpha_ty rhs_ty + ; new_ev <- case old_ev of + CtWanted {} -> do { ev <- newWantedEvVarNC loc pred + ; updWorkListTcS (extendWorkListEq (mkNonCanonical ev)) + ; return ev } + CtDerived {} -> do { ev <- newDerivedNC loc pred + ; updWorkListTcS (extendWorkListDerived loc ev) + ; return ev } + _ -> 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) @@ -1536,6 +1544,8 @@ dischargeFmv :: CtEvidence -> TcTyVar -> TcCoercion -> TcType -> TcS () -- Then set fmv := xi, -- set ev := co -- kick out any inert things that are now rewritable +-- +-- Does not evaluate 'co' if 'ev' is Derived dischargeFmv ev fmv co xi = ASSERT2( not (fmv `elemVarSet` tyVarsOfType xi), ppr ev $$ ppr fmv $$ ppr xi ) do { setEvBindIfWanted ev (EvCoercion co) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 83dc81b..c4de91d 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1146,7 +1146,6 @@ data Ct -- * isTypeFamilyTyCon cc_fun -- * typeKind (F xis) = tyVarKind fsk -- * always Nominal role - -- * always Given or Wanted, never Derived cc_ev :: CtEvidence, -- See Note [Ct/evidence invariant] cc_fun :: TyCon, -- A type function diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 80437ff..b782a20 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -6,7 +6,7 @@ module TcSMonad ( -- The work list WorkList(..), isEmptyWorkList, emptyWorkList, extendWorkListNonEq, extendWorkListCt, extendWorkListDerived, - extendWorkListCts, appendWorkList, + extendWorkListCts, extendWorkListEq, appendWorkList, selectNextWorkItem, workListSize, workListWantedCount, updWorkListTcS, @@ -25,7 +25,7 @@ module TcSMonad ( -- Evidence creation and transformation Freshness(..), freshGoals, isFresh, - newTcEvBinds, newWantedEvVar, newWantedEvVarNC, + newTcEvBinds, newWantedEvVar, newWantedEvVarNC, newDerivedNC, unifyTyVar, unflattenFmv, reportUnifications, setEvBind, setWantedEvBind, setEvBindIfWanted, newEvVar, newGivenEvVar, newGivenEvVars, @@ -539,8 +539,10 @@ data InertCans -- See Note [Detailed InertCans Invariants] for more , inert_funeqs :: FunEqMap Ct -- All CFunEqCans; index is the whole family head type. - -- Hence (by CFunEqCan invariants), - -- all Nominal, and all Given/Wanted (no Derived) + -- All Nominal (that's an invarint of all CFunEqCans) + -- We can get Derived ones from e.g. + -- (a) flattening derived equalities + -- (b) emitDerivedShadows , inert_dicts :: DictMap Ct -- Dictionaries only, index is the class @@ -1560,7 +1562,7 @@ After solving the Givens we take two things out of the inert set We get [D] 1 <= n, and we must remove it! Otherwise we unflatten it more then once, and assign to its fmv more than once...disaster. - It's ok to remove them because they turned ont not to + It's ok to remove them because they turned not not to yield an insoluble, and hence have now done their work. -} From git at git.haskell.org Fri Sep 11 16:17:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 16:17:25 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation for transform list-comps (377395e) Message-ID: <20150911161725.66DF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/377395e5ddeb634f0f2bb2385c6c1f23fb7578f5/ghc >--------------------------------------------------------------- commit 377395e5ddeb634f0f2bb2385c6c1f23fb7578f5 Author: Simon Peyton Jones Date: Fri Sep 11 16:23:35 2015 +0100 Improve documentation for transform list-comps Thanks to Jeremy Gibbons for spotting the infelictity >--------------------------------------------------------------- 377395e5ddeb634f0f2bb2385c6c1f23fb7578f5 docs/users_guide/glasgow_exts.xml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 931706b..dbf67c6 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -1887,7 +1887,12 @@ guard Control.Monad t1 -> m t2 fmap GHC.Base forall a b. (a->b) -> n a -> n b mzip Control.Monad.Zip forall a b. m a -> m b -> m (a,b) -The comprehension should typecheck when its desugaring would typecheck. +The comprehension should typecheck when its desugaring would typecheck, +except that (as discussed in ) +in the "then f" and "then group using f" clauses, +when the "by b" qualifier is omitted, argument f should have a polymorphic type. +In particular, "then Data.List.sort" and +"then group using Data.List.group" are insufficiently polymorphic. Monad comprehensions support rebindable syntax (). From git at git.haskell.org Fri Sep 11 16:17:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 16:17:28 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation of comprehensions (413fa95) Message-ID: <20150911161728.3835C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/413fa952eff61ada987e965949df8b09aa342b39/ghc >--------------------------------------------------------------- commit 413fa952eff61ada987e965949df8b09aa342b39 Author: Simon Peyton Jones Date: Fri Sep 11 17:02:58 2015 +0100 Improve documentation of comprehensions Suggestion from Jeremy Gibbons >--------------------------------------------------------------- 413fa952eff61ada987e965949df8b09aa342b39 docs/users_guide/glasgow_exts.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index dbf67c6..0295b13 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -1888,7 +1888,7 @@ fmap GHC.Base forall a b. (a->b) -> n a -> n b mzip Control.Monad.Zip forall a b. m a -> m b -> m (a,b) The comprehension should typecheck when its desugaring would typecheck, -except that (as discussed in ) +except that (as discussed in ) in the "then f" and "then group using f" clauses, when the "by b" qualifier is omitted, argument f should have a polymorphic type. In particular, "then Data.List.sort" and From git at git.haskell.org Fri Sep 11 16:17:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 16:17:31 +0000 (UTC) Subject: [commit: ghc] master: Fix broken links in documentation (50d1c72) Message-ID: <20150911161731.0DB003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/50d1c72588aefd79dcf5c81f56add41d81beb12f/ghc >--------------------------------------------------------------- commit 50d1c72588aefd79dcf5c81f56add41d81beb12f Author: Simon Peyton Jones Date: Fri Sep 11 17:01:33 2015 +0100 Fix broken links in documentation >--------------------------------------------------------------- 50d1c72588aefd79dcf5c81f56add41d81beb12f docs/users_guide/7.12.1-notes.xml | 2 +- docs/users_guide/safe_haskell.xml | 2 +- docs/users_guide/using.xml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index bc5c7af..d131086 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -222,7 +222,7 @@ groups, unlike splices of the form $(...). This behavior has been preserved under the new implementation, and is now - recognized and documented in . + recognized and documented in . diff --git a/docs/users_guide/safe_haskell.xml b/docs/users_guide/safe_haskell.xml index f9bcf54..02182d3 100644 --- a/docs/users_guide/safe_haskell.xml +++ b/docs/users_guide/safe_haskell.xml @@ -947,7 +947,7 @@ - Additionally, the use of annotations + Additionally, the use of annotations is forbidden, as that would allow bypassing Safe Haskell restrictions. See ticket #10826. diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 71d3467..797e784 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -3043,7 +3043,7 @@ foldl f z (Stream step s _) = foldl_loop SPEC z s On by default. - Specialise INLINABLE () + Specialise INLINABLE () type-class-overloaded functions imported from other modules for the types at which they are called in this module. Note that specialisation must be enabled (by -fspecialise) for this to have any effect. From git at git.haskell.org Fri Sep 11 23:22:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 23:22:37 +0000 (UTC) Subject: [commit: ghc] master: Testsuite cleanup (f30a492) Message-ID: <20150911232237.C6F543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f30a49250a0c96e9fb1b86d541657029a9aa8d51/ghc >--------------------------------------------------------------- commit f30a49250a0c96e9fb1b86d541657029a9aa8d51 Author: Jan Stolarek Date: Fri Sep 11 22:02:35 2015 +0200 Testsuite cleanup As a result of fixing #10836 it is now possible to merge 11 different tests for #6018 into one >--------------------------------------------------------------- f30a49250a0c96e9fb1b86d541657029a9aa8d51 .../tests/typecheck/should_fail/T6018failclosed.hs | 66 +++++++++++++++++ .../typecheck/should_fail/T6018failclosed.stderr | 84 ++++++++++++++++++++++ .../typecheck/should_fail/T6018failclosed1.hs | 11 --- .../typecheck/should_fail/T6018failclosed1.stderr | 7 -- .../typecheck/should_fail/T6018failclosed10.hs | 17 ----- .../typecheck/should_fail/T6018failclosed10.stderr | 9 --- .../typecheck/should_fail/T6018failclosed11.hs | 15 ---- .../typecheck/should_fail/T6018failclosed11.stderr | 7 -- .../typecheck/should_fail/T6018failclosed12.hs | 7 -- .../typecheck/should_fail/T6018failclosed12.stderr | 8 --- .../typecheck/should_fail/T6018failclosed2.hs | 21 +++--- .../typecheck/should_fail/T6018failclosed2.stderr | 21 ++---- .../typecheck/should_fail/T6018failclosed3.hs | 8 --- .../typecheck/should_fail/T6018failclosed3.stderr | 8 --- .../typecheck/should_fail/T6018failclosed4.hs | 10 --- .../typecheck/should_fail/T6018failclosed4.stderr | 8 --- .../typecheck/should_fail/T6018failclosed5.hs | 12 ---- .../typecheck/should_fail/T6018failclosed5.stderr | 8 --- .../typecheck/should_fail/T6018failclosed6.hs | 7 -- .../typecheck/should_fail/T6018failclosed6.stderr | 9 --- .../typecheck/should_fail/T6018failclosed7.hs | 8 --- .../typecheck/should_fail/T6018failclosed7.stderr | 7 -- .../typecheck/should_fail/T6018failclosed8.hs | 8 --- .../typecheck/should_fail/T6018failclosed8.stderr | 7 -- .../typecheck/should_fail/T6018failclosed9.hs | 8 --- .../typecheck/should_fail/T6018failclosed9.stderr | 8 --- testsuite/tests/typecheck/should_fail/all.T | 12 +--- 27 files changed, 170 insertions(+), 231 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 f30a49250a0c96e9fb1b86d541657029a9aa8d51 From git at git.haskell.org Fri Sep 11 23:22:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 23:22:40 +0000 (UTC) Subject: [commit: ghc] master: Add assertions (8c0eca3) Message-ID: <20150911232240.A06F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c0eca3dccd58b41b226d3f3aad9a02a18bef6de/ghc >--------------------------------------------------------------- commit 8c0eca3dccd58b41b226d3f3aad9a02a18bef6de Author: Jan Stolarek Date: Fri Sep 11 22:29:02 2015 +0200 Add assertions >--------------------------------------------------------------- 8c0eca3dccd58b41b226d3f3aad9a02a18bef6de compiler/typecheck/FamInst.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 49fc5fe..978e92e 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -423,7 +423,8 @@ makeInjectivityErrors -> [CoAxBranch] -- ^ List of injectivity conflicts -> [(SDoc, SrcSpan)] makeInjectivityErrors tycon axiom inj conflicts - = let lhs = coAxBranchLHS axiom + = ASSERT2( any id inj, text "No injective type variables" ) + let lhs = coAxBranchLHS axiom rhs = coAxBranchRHS axiom are_conflicts = not $ null conflicts From git at git.haskell.org Fri Sep 11 23:22:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 23:22:43 +0000 (UTC) Subject: [commit: ghc] master: Code movement (4275028) Message-ID: <20150911232243.702083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4275028c744ef8ee6bbc26c3a301ef2e3e8708a0/ghc >--------------------------------------------------------------- commit 4275028c744ef8ee6bbc26c3a301ef2e3e8708a0 Author: Jan Stolarek Date: Sat Sep 12 00:07:17 2015 +0200 Code movement >--------------------------------------------------------------- 4275028c744ef8ee6bbc26c3a301ef2e3e8708a0 compiler/typecheck/FamInst.hs | 75 ++++++++++++++++++++++++++++++++++++++++++- compiler/types/FamInstEnv.hs | 72 +---------------------------------------- 2 files changed, 75 insertions(+), 72 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 4275028c744ef8ee6bbc26c3a301ef2e3e8708a0 From git at git.haskell.org Fri Sep 11 23:22:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 23:22:46 +0000 (UTC) Subject: [commit: ghc] master: Remove redundant language extensions (18759cc) Message-ID: <20150911232246.6CD3A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18759cc42636628f136d43d545bd21f26064179e/ghc >--------------------------------------------------------------- commit 18759cc42636628f136d43d545bd21f26064179e Author: Jan Stolarek Date: Fri Sep 11 23:44:42 2015 +0200 Remove redundant language extensions >--------------------------------------------------------------- 18759cc42636628f136d43d545bd21f26064179e compiler/basicTypes/MkId.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/FamInst.hs | 2 +- compiler/types/TypeRep.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 698c865..6f812de 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -12,7 +12,7 @@ have a standard form, namely: - primitive operations -} -{-# LANGUAGE CPP, DataKinds #-} +{-# LANGUAGE CPP #-} module MkId ( mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs, diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index b601dc6..5189b3c 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -6,7 +6,7 @@ Type checking of type signatures in interface files -} -{-# LANGUAGE CPP, DataKinds #-} +{-# LANGUAGE CPP #-} module TcIface ( tcLookupImported_maybe, diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 978e92e..b598f2a 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -1,6 +1,6 @@ -- The @FamInst@ type: family instance heads -{-# LANGUAGE CPP, GADTs, DataKinds #-} +{-# LANGUAGE CPP, GADTs #-} module FamInst ( FamInstEnvs, tcGetFamInstEnvs, diff --git a/compiler/types/TypeRep.hs b/compiler/types/TypeRep.hs index b732247..9a4bccf 100644 --- a/compiler/types/TypeRep.hs +++ b/compiler/types/TypeRep.hs @@ -16,7 +16,7 @@ Note [The Type-related module hierarchy] -} {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, - DeriveTraversable, DataKinds #-} + DeriveTraversable #-} {-# OPTIONS_HADDOCK hide #-} -- We expose the relevant stuff from this module via the Type module From git at git.haskell.org Fri Sep 11 23:22:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 23:22:49 +0000 (UTC) Subject: [commit: ghc] master: Dead code removal, export cleanup (195af2d) Message-ID: <20150911232249.2BBC83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/195af2d5222e667f9b423ef43286540e6b4bc252/ghc >--------------------------------------------------------------- commit 195af2d5222e667f9b423ef43286540e6b4bc252 Author: Jan Stolarek Date: Fri Sep 11 23:55:52 2015 +0200 Dead code removal, export cleanup >--------------------------------------------------------------- 195af2d5222e667f9b423ef43286540e6b4bc252 compiler/rename/RnTypes.hs | 14 +------------- compiler/typecheck/FamInst.hs | 4 +--- compiler/typecheck/TcValidity.hs | 1 - compiler/utils/Outputable.hs | 23 +---------------------- 4 files changed, 3 insertions(+), 39 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 090ed64..8b709de 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -22,7 +22,7 @@ module RnTypes ( -- Binding related stuff warnContextQuantification, warnUnusedForAlls, bindSigTyVarsFV, bindHsTyVars, rnHsBndrSig, rnLHsTyVarBndr, - extractHsTyRdrTyVars, extractHsTysRdrTyVars, extractTyVarBndrNames, + extractHsTyRdrTyVars, extractHsTysRdrTyVars, extractRdrKindSigVars, extractDataDefnKindVars, filterInScope ) where @@ -48,7 +48,6 @@ import Outputable import FastString import Maybes import Data.List ( nub, nubBy, deleteFirstsBy ) -import qualified Data.Set as Set import Control.Monad ( unless, when ) #if __GLASGOW_HASKELL__ < 709 @@ -1123,17 +1122,6 @@ extractHsTysRdrTyVars ty = case extract_ltys ty ([],[]) of (kvs, tvs) -> (nub kvs, nub tvs) --- Extracts variable names used in a type variable binder. Note that HsType --- represents data and type constructors as type variables and so this function --- will also return data and type constructors. -extractTyVarBndrNames :: LHsTyVarBndr RdrName -> Set.Set RdrName -extractTyVarBndrNames (L _ (UserTyVar name)) - = Set.singleton name -extractTyVarBndrNames (L _ (KindedTyVar (L _ name) k)) - = Set.singleton name `Set.union` (Set.fromList tvs) - `Set.union` (Set.fromList kvs) - where (kvs, tvs) = extractHsTyRdrTyVars k - extractRdrKindSigVars :: LFamilyResultSig RdrName -> [RdrName] extractRdrKindSigVars (L _ resultSig) | KindSig k <- resultSig = kindRdrNameFromSig k diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index b598f2a..b7285a6 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -11,9 +11,7 @@ module FamInst ( newFamInst, -- * Injectivity - makeInjectivityErrors, - - tfHeadedErr, bareVariableInRHSErr + makeInjectivityErrors ) where import HscTypes diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index c1b8a09..f9d9bf7 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -12,7 +12,6 @@ module TcValidity ( checkValidInstance, validDerivPred, checkInstTermination, checkValidCoAxiom, checkValidCoAxBranch, - checkTyFamFreeness, checkConsistentFamInst, arityErr, badATErr ) where diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index cb42d75..a4893b9 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -32,8 +32,7 @@ module Outputable ( sep, cat, fsep, fcat, hang, punctuate, ppWhen, ppUnless, - speakNth, speakNTimes, speakN, speakNOf, plural, - thirdPerson, isOrAre, doOrDoes, + speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes, coloured, PprColour, colType, colCoerc, colDataCon, colBinder, bold, keyword, @@ -976,16 +975,6 @@ speakNOf 0 d = ptext (sLit "no") <+> d <> char 's' speakNOf 1 d = ptext (sLit "one") <+> d -- E.g. "one argument" speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments" --- | Converts a strictly positive integer into a number of times: --- --- > speakNTimes 1 = text "once" --- > speakNTimes 2 = text "twice" --- > speakNTimes 4 = text "4 times" -speakNTimes :: Int {- >=1 -} -> SDoc -speakNTimes t | t == 1 = ptext (sLit "once") - | t == 2 = ptext (sLit "twice") - | otherwise = speakN t <+> ptext (sLit "times") - -- | Determines the pluralisation suffix appropriate for the length of a list: -- -- > plural [] = char 's' @@ -995,16 +984,6 @@ plural :: [a] -> SDoc plural [_] = empty -- a bit frightening, but there you are plural _ = char 's' --- | Determines the suffix to use in 3rd person singular depending on the length --- of a list: --- --- > thirdPerson [] = empty --- > thirdPerson ["Hello"] = char 's' --- > thirdPerson ["Hello", "World"] = empty -thirdPerson :: [a] -> SDoc -thirdPerson [_] = char 's' -thirdPerson _ = empty - -- | Determines the form of to be appropriate for the length of a list: -- -- > isOrAre [] = ptext (sLit "are") From git at git.haskell.org Fri Sep 11 23:32:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Sep 2015 23:32:44 +0000 (UTC) Subject: [commit: ghc] master: s/StgArrWords/StgArrBytes/ (7ad4b3c) Message-ID: <20150911233244.588193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ad4b3c1419fefbb01fd4643f374150abd1d11e2/ghc >--------------------------------------------------------------- commit 7ad4b3c1419fefbb01fd4643f374150abd1d11e2 Author: Siddhanathan Shanmugam Date: Fri Sep 11 16:10:41 2015 -0500 s/StgArrWords/StgArrBytes/ Rename StgArrWords to StgArrBytes (see Trac #8552) Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D1233 GHC Trac Issues: #8552 >--------------------------------------------------------------- 7ad4b3c1419fefbb01fd4643f374150abd1d11e2 compiler/cmm/SMRep.hs | 4 +-- compiler/codeGen/StgCmmPrim.hs | 8 +++--- includes/Cmm.h | 4 +-- includes/rts/storage/ClosureMacros.h | 12 ++++----- includes/rts/storage/Closures.h | 13 +++------- rts/Adjustor.c | 6 ++--- rts/CheckUnload.c | 2 +- rts/Disassembler.c | 2 +- rts/Interpreter.c | 4 +-- rts/PrimOps.cmm | 42 ++++++++++++++++---------------- rts/Printer.c | 4 +-- rts/ProfHeap.c | 2 +- rts/sm/Compact.c | 2 +- rts/sm/Evac.c | 2 +- rts/sm/Sanity.c | 2 +- rts/sm/Scav.c | 2 +- utils/deriveConstants/DeriveConstants.hs | 6 ++--- 17 files changed, 55 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 7ad4b3c1419fefbb01fd4643f374150abd1d11e2 From git at git.haskell.org Sat Sep 12 13:26:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Sep 2015 13:26:19 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: normalise slashes in callstack output (89324b8) Message-ID: <20150912132619.17BEA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89324b82edaf5e02807617bffb5cf24c1d7a37af/ghc >--------------------------------------------------------------- commit 89324b82edaf5e02807617bffb5cf24c1d7a37af Author: Thomas Miedema Date: Sat Sep 12 15:23:12 2015 +0200 Testsuite: normalise slashes in callstack output This fixes some tests on Windows, for example T2120. >--------------------------------------------------------------- 89324b82edaf5e02807617bffb5cf24c1d7a37af testsuite/driver/testlib.py | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 6b3426e..1700392 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1681,10 +1681,12 @@ def normalise_whitespace( str ): return str.strip() def normalise_callstacks(str): + def repl(matches): + location = matches.group(1) + location = normalise_slashes_(location) + return ', called at {}:: in'.format(location) # Ignore line number differences in call stacks (#10834). - return re.sub(', called at (.+):[\\d]+:[\\d]+ in', - ', called at \\1:: in', - str) + return re.sub(', called at (.+):[\\d]+:[\\d]+ in', repl, str) def normalise_errmsg( str ): # remove " error:" and lower-case " Warning:" to make patch for From git at git.haskell.org Sat Sep 12 18:38:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Sep 2015 18:38:23 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: mark enum01-enum03 expect_broken(#9399) on Windows (37081ac) Message-ID: <20150912183823.A5F4C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37081acc74b9820b284161c95b16ff878fc5830f/ghc >--------------------------------------------------------------- commit 37081acc74b9820b284161c95b16ff878fc5830f Author: Thomas Miedema Date: Sat Sep 12 19:34:16 2015 +0200 Testsuite: mark enum01-enum03 expect_broken(#9399) on Windows >--------------------------------------------------------------- 37081acc74b9820b284161c95b16ff878fc5830f libraries/base/tests/all.T | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 7021c2d..96cb551 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -77,10 +77,13 @@ test('dynamic002', normal, compile_and_run, ['']) test('dynamic003', extra_run_opts('+RTS -K32m -RTS'), compile_and_run, ['']) test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_run, ['']) test('dynamic005', normal, compile_and_run, ['']) -test('enum01', when(fast(), skip), compile_and_run, ['']) -test('enum02', when(fast(), skip), compile_and_run, ['']) -test('enum03', when(fast(), skip), compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) + +enum_setups = [when(fast(), skip), when(opsys('mingw32'), expect_broken(9399))] +test('enum01', enum_setups, compile_and_run, ['']) +test('enum02', enum_setups, compile_and_run, ['']) +test('enum03', enum_setups, compile_and_run, ['']) +test('enum04', normal, compile_and_run, ['']) + test('exceptionsrun001', expect_broken_for(10712, opt_ways), compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) test('foldableArray', normal, compile_and_run, ['']) From git at git.haskell.org Sat Sep 12 18:38:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Sep 2015 18:38:26 +0000 (UTC) Subject: [commit: ghc] master: CodeGen: fix typo in error message (3ec205a) Message-ID: <20150912183826.7CD593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ec205aec45ec13fc7274d6b019cd7f7654191f4/ghc >--------------------------------------------------------------- commit 3ec205aec45ec13fc7274d6b019cd7f7654191f4 Author: Thomas Miedema Date: Sat Sep 12 20:37:20 2015 +0200 CodeGen: fix typo in error message >--------------------------------------------------------------- 3ec205aec45ec13fc7274d6b019cd7f7654191f4 compiler/nativeGen/X86/CodeGen.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 1fe289c..26df11c 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -2082,7 +2082,7 @@ genCCall _ is32Bit target dest_regs args = do MOV format (OpReg rdx) (OpReg reg_h), MOV format (OpReg rax) (OpReg reg_l)] return code - _ -> panic "genCCall: Wrong number of arguments/results for add2" + _ -> panic "genCCall: Wrong number of arguments/results for mul2" _ -> if is32Bit then genCCall32' dflags target dest_regs args From git at git.haskell.org Sat Sep 12 21:40:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Sep 2015 21:40:43 +0000 (UTC) Subject: [commit: packages/hpc] master: Make error messages Windows proof (315b78a) Message-ID: <20150912214043.BC2A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/315b78ac8fe7b42912d2146783b0366f6b0e9503 >--------------------------------------------------------------- commit 315b78ac8fe7b42912d2146783b0366f6b0e9503 Author: Thomas Miedema Date: Sat Sep 12 23:10:23 2015 +0200 Make error messages Windows proof Before, we ended up with too many slashes, which caused a test failure in T10529a. show "foo\\bar" == "\"foo\\\\bar\"" >--------------------------------------------------------------- 315b78ac8fe7b42912d2146783b0366f6b0e9503 Trace/Hpc/Mix.hs | 6 ++++-- tests/simple/tixs/T10529a.stderr | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Trace/Hpc/Mix.hs b/Trace/Hpc/Mix.hs index 0a5f054..2066284 100644 --- a/Trace/Hpc/Mix.hs +++ b/Trace/Hpc/Mix.hs @@ -22,6 +22,7 @@ module Trace.Hpc.Mix ) where +import Data.List import Data.Maybe (catMaybes, fromMaybe) import Data.Time (UTCTime) import Data.Tree @@ -113,9 +114,10 @@ readMix dirNames mod' = do -- Only complain if multiple *different* `Mix` files with the -- same name are found (#9619). error $ "found " ++ show(length xs) ++ " different instances of " - ++ modName ++ " in " ++ show dirNames + ++ modName ++ " in " ++ intercalate ", " dirNames (x:_) -> return x - _ -> error $ "can not find " ++ modName ++ " in " ++ show dirNames + _ -> error $ "can not find " + ++ modName ++ " in " ++ intercalate ", " dirNames mixName :: FilePath -> String -> String mixName dirName name = dirName name <.> "mix" diff --git a/tests/simple/tixs/T10529a.stderr b/tests/simple/tixs/T10529a.stderr index 945c633..5107218 100644 --- a/tests/simple/tixs/T10529a.stderr +++ b/tests/simple/tixs/T10529a.stderr @@ -1 +1 @@ -hpc: can not find NonExistingModule in ["./.hpc"] +hpc: can not find NonExistingModule in ./.hpc From git at git.haskell.org Sat Sep 12 21:41:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Sep 2015 21:41:48 +0000 (UTC) Subject: [commit: ghc] master: hpc: use `takeDirectory` instead of `dropWhileEnd (/= '/')` (08af42f) Message-ID: <20150912214148.370463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/08af42fd0a30516e0a0ec981af5cc3d165f75a5a/ghc >--------------------------------------------------------------- commit 08af42fd0a30516e0a0ec981af5cc3d165f75a5a Author: Thomas Miedema Date: Sat Sep 12 22:41:35 2015 +0200 hpc: use `takeDirectory` instead of `dropWhileEnd (/= '/')` This fixes some hpc tests on Windows. Update submodule hpc. >--------------------------------------------------------------- 08af42fd0a30516e0a0ec981af5cc3d165f75a5a libraries/hpc | 2 +- utils/hpc/HpcMarkup.hs | 5 +---- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/libraries/hpc b/libraries/hpc index da5928c..315b78a 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit da5928ccf4e369f6985ef291351d074918b88019 +Subproject commit 315b78ac8fe7b42912d2146783b0366f6b0e9503 diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index 31327fc..fb68eac 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -479,15 +479,12 @@ instance Monoid ModuleSummary where writeFileUsing :: String -> String -> IO () writeFileUsing filename text = do - let dest_dir = dropWhileEndLE (\ x -> x /= '/') $ filename - -- We need to check for the dest_dir each time, because we use sub-dirs for -- packages, and a single .tix file might contain information about -- many package. -- create the dest_dir if needed - when (not (null dest_dir)) $ - createDirectoryIfMissing True dest_dir + createDirectoryIfMissing True (takeDirectory filename) writeFile filename text From git at git.haskell.org Sat Sep 12 21:41:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Sep 2015 21:41:51 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: mark T6037 expect_fail on Windows (#6037) (c8d438f) Message-ID: <20150912214151.00AE03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c8d438fb027cbefa31941d8397539c481a03a74f/ghc >--------------------------------------------------------------- commit c8d438fb027cbefa31941d8397539c481a03a74f Author: Thomas Miedema Date: Sat Sep 12 23:34:12 2015 +0200 Testsuite: mark T6037 expect_fail on Windows (#6037) >--------------------------------------------------------------- c8d438fb027cbefa31941d8397539c481a03a74f testsuite/tests/driver/Makefile | 4 ++-- testsuite/tests/driver/all.T | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index dc1238c..50696a7 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -551,8 +551,8 @@ T7563: -"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -C T7563.hs # Below we set LC_ALL=C to request standard ASCII output in the resulting error -# messages. Unfortunately, Mac OS X still uses a Unicode encoding even with -# LC_ALL=C, so we expect these tests to fail there. +# messages. Unfortunately, Mac OS X and Windows still use a Unicode encoding +# even with LC_ALL=C, so we expect these tests to fail there. .PHONY: T6037 T6037: diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index a11c0f1..4a4f930 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -382,7 +382,10 @@ test('T7060', test('T7130', normal, compile_fail, ['-fflul-laziness']) test('T7563', when(unregisterised(), skip), run_command, ['$MAKE -s --no-print-directory T7563']) -test('T6037', normal, run_command, +test('T6037', + # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X + [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)], + run_command, ['$MAKE -s --no-print-directory T6037']) test('T2507', # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X From git at git.haskell.org Sun Sep 13 04:19:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:19:50 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9858-typeable-ben2' created Message-ID: <20150913041950.6DD533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9858-typeable-ben2 Referencing: d90b9f37281048a1bdc5f3e959d6243d4275dd37 From git at git.haskell.org Sun Sep 13 04:19:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:19:53 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Include constraint tuples in the known-key names (cbc2c41) Message-ID: <20150913041953.4037B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/cbc2c41c1cd3b3f1e0ab417051febb15effa23fe/ghc >--------------------------------------------------------------- commit cbc2c41c1cd3b3f1e0ab417051febb15effa23fe Author: Simon Peyton Jones Date: Thu Aug 27 17:48:38 2015 +0100 Include constraint tuples in the known-key names >--------------------------------------------------------------- cbc2c41c1cd3b3f1e0ab417051febb15effa23fe compiler/prelude/PrelInfo.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 9cfa78b..16f72e1 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -72,15 +72,26 @@ Notes about wired in things knownKeyNames :: [Name] --- This list is used to ensure that when you say "Prelude.map" in your --- source code, you get a Name with the correct known key +-- 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 = concat [ tycon_kk_names funTyCon , concatMap tycon_kk_names primTyCons + , concatMap tycon_kk_names wiredInTyCons + -- Does not include tuples + , concatMap tycon_kk_names typeNatTyCons + , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk + + , cTupleTyConNames + -- Constraint tuples are known-key but not wired-in + -- They can't show up in source code, but can appear + -- in intreface files + , map idName wiredInIds , map (idName . primOpId) allThePrimOps , basicKnownKeyNames ] From git at git.haskell.org Sun Sep 13 04:19:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:19:56 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Generate Typeable info at definition sites (7dbbcee) Message-ID: <20150913041956.CEB263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/7dbbceee51fa15527a92daad9c06ea431c5e52e3/ghc >--------------------------------------------------------------- commit 7dbbceee51fa15527a92daad9c06ea431c5e52e3 Author: Ben Gamari Date: Wed Aug 26 18:24:34 2015 +0200 Generate Typeable info at definition sites This patch implements the idea floated in Trac #9858, namely that we should generate type-representation information at the data type declaration site, rather than when solving a Typeable constraint. However, this turned out quite a bit harder than I expected. I still think it's the right thing to do, and it's done now, but it was quite a struggle. See particularly * Note [Grand plan for Typeable] in TcTypeable (which is a new module) * Note [The overall promotion story] in DataCon (clarifies existing stuff) The most painful bit was that to generate Typeable instances (ie TyConRepName bindings) for every TyCon is tricky for types in ghc-prim etc: * We need to have enough data types around to *define* a TyCon * Many of these types are wired-in Also, to minimise the code generated for each data type, I wanted to generate pure data, not CAFs with unpackCString# stuff floating about. Performance ~~~~~~~~~~~ Three perf/compiler tests start to allocate quite a bit more. This isn't surprising, because they all allocate zillions of data types, with practically no other code, esp. T1969 * T1969: GHC allocates 30% more * T5642: GHC allocates 14% more * T9872d: GHC allocates 5% more I'm treating this as acceptable. The payoff comes in Typeable-heavy code. Remaining to do ~~~~~~~~~~~~~~~ * I think that "TyCon" and "Module" are over-generic names to use for the runtime type representations used in GHC.Typeable. Better might be "TrTyCon" and "TrModule". But I have not yet done this * Add more info the the "TyCon" e.g. source location where it was defined * Use the new "Module" type to help with Trac Trac #10068 * It would be possible to generate TyConRepName (ie Typeable instances) selectively rather than all the time. We'd need to persist the information in interface files. Lacking a motivating reason I have not done this, but it would not be difficult. Refactoring ~~~~~~~~~~~ As is so often the case, I ended up refactoring more than I intended. In particular * In TyCon, a type *family* (whether type or data) is repesented by a FamilyTyCon * a algebraic data type (including data/newtype instances) is represented by AlgTyCon This wasn't true before; a data family was represented as an AlgTyCon. There are some corresponding changes in IfaceSyn. * Also get rid of the (unhelpfully named) tyConParent. * In TyCon define 'Promoted', isomorphic to Maybe, used when things are optionally promoted; and use it elsewhere in GHC. * Cleanup handling of knownKeyNames * Each TyCon, including promoted TyCons, contains its TyConRepName, if it has one. This is, in effect, the name of its Typeable instance. * Move mkDefaultMethodIds, mkRecSelBinds from TcTyClsDecls to TcTyDecls >--------------------------------------------------------------- 7dbbceee51fa15527a92daad9c06ea431c5e52e3 compiler/basicTypes/DataCon.hs | 225 ++++++++++---- compiler/basicTypes/OccName.hs | 19 +- compiler/basicTypes/Unique.hs | 51 +++- compiler/coreSyn/CorePrep.hs | 2 +- compiler/deSugar/DsBinds.hs | 277 +++++++++-------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsUtils.hs | 6 +- compiler/iface/BuildTyCl.hs | 54 ++-- compiler/iface/IfaceSyn.hs | 91 +++--- compiler/iface/MkIface.hs | 11 +- compiler/iface/TcIface.hs | 93 +++--- compiler/main/HscMain.hs | 12 +- compiler/main/HscTypes.hs | 12 +- compiler/prelude/PrelInfo.hs | 100 +++--- compiler/prelude/PrelNames.hs | 87 ++++-- compiler/prelude/TysPrim.hs | 38 ++- compiler/prelude/TysWiredIn.hs | 54 ++-- compiler/typecheck/TcBinds.hs | 35 ++- compiler/typecheck/TcEvidence.hs | 53 ++-- compiler/typecheck/TcGenGenerics.hs | 38 ++- compiler/typecheck/TcHsSyn.hs | 28 +- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 19 +- compiler/typecheck/TcInteract.hs | 147 +++++---- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 40 +-- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcTyClsDecls.hs | 329 ++++---------------- compiler/typecheck/TcTyDecls.hs | 330 +++++++++++++++----- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcTypeable.hs | 206 +++++++++++++ compiler/types/TyCon.hs | 406 ++++++++++++++----------- compiler/types/Type.hs | 9 + compiler/utils/Binary.hs | 11 +- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/Env.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 +- libraries/base/Data/Typeable.hs | 3 +- libraries/base/Data/Typeable/Internal.hs | 336 ++++++++++++-------- libraries/base/GHC/Show.hs | 10 + libraries/ghc-prim/GHC/Classes.hs | 36 ++- libraries/ghc-prim/GHC/IntWord64.hs | 3 + libraries/ghc-prim/GHC/Magic.hs | 2 + libraries/ghc-prim/GHC/Tuple.hs | 3 + libraries/ghc-prim/GHC/Types.hs | 47 +++ 46 files changed, 1998 insertions(+), 1274 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 7dbbceee51fa15527a92daad9c06ea431c5e52e3 From git at git.haskell.org Sun Sep 13 04:19:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:19:59 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Make the generated GHC.Prim module import GHC.Tuple (fe4e32c) Message-ID: <20150913041959.A10CE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/fe4e32ca7491e49b891fff242b867f5ca176f2aa/ghc >--------------------------------------------------------------- commit fe4e32ca7491e49b891fff242b867f5ca176f2aa Author: Simon Peyton Jones Date: Fri Aug 28 15:24:02 2015 +0100 Make the generated GHC.Prim module import GHC.Tuple See Note [Import GHC.Tuple into GHC.Prim] in genprimopcode/Main.hs I think this has been a lurking bug for ages. Lacking it, Haddock's invocation of GHC for the ghc-prim library says Checking module GHC.Prim... attempting to use module ?GHC.Tuple? (libraries/ghc-prim/./GHC/Tuple.hs) which is not loaded >--------------------------------------------------------------- fe4e32ca7491e49b891fff242b867f5ca176f2aa utils/genprimopcode/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 2a5218e..3ab8ff8 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -262,6 +262,16 @@ gen_hs_source (Info defaults entries) = ++ "-}\n" ++ "import GHC.Types (Coercible)\n" + ++ "import GHC.Tuple ()\n" + -- Note [Import GHC.Tuple into GHC.Prim] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- This expresses a dependency on GHC.Tuple, which we need + -- to ensure that GHC.Tuple is compiled first. The generated + -- code in this module mentions '()', and that in turn tries + -- to ensure that its home module is loaded (for instances I think) + -- So it had better be there, when compiling with --make or Haddock. + -- It's more kosher anyway to be explicit about the dependency. + ++ "default ()" -- If we don't say this then the default type include Integer -- so that runs off and loads modules that are not part of -- pacakge ghc-prim at all. And that in turn somehow ends up From git at git.haskell.org Sun Sep 13 04:20:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:20:02 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Fixes (ce20012) Message-ID: <20150913042002.7E6043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/ce20012c31b11d2f9816317ddbb58b89b27919d0/ghc >--------------------------------------------------------------- commit ce20012c31b11d2f9816317ddbb58b89b27919d0 Author: Ben Gamari Date: Wed Sep 2 16:33:58 2015 +0200 Fixes >--------------------------------------------------------------- ce20012c31b11d2f9816317ddbb58b89b27919d0 compiler/basicTypes/DataCon.hs | 3 +-- compiler/coreSyn/CorePrep.hs | 2 +- compiler/iface/IfaceSyn.hs | 1 - compiler/prelude/PrelNames.hs | 21 +++++++++++---------- libraries/ghc-prim/GHC/IntWord64.hs | 3 --- 5 files changed, 13 insertions(+), 17 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 7b8cfa4..0384ecc 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -17,6 +17,7 @@ module DataCon ( -- ** Type construction mkDataCon, fIRST_TAG, + buildAlgTyCon, -- ** Type deconstruction dataConRepType, dataConSig, dataConInstSig, dataConFullSig, @@ -46,8 +47,6 @@ module DataCon ( promoteDataCon, promoteDataCon_maybe, promoteType, promoteKind, isPromotableType, computeTyConPromotability, - - buildAlgTyCon ) where #include "HsVersions.h" diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 8dc8a79..7b256a4 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -60,7 +60,7 @@ import MonadUtils ( mapAccumLM ) import Data.List ( mapAccumL ) import Control.Monad -#if __GLASGOW_HASKELL__ < 709 +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 4fed18c..d35aa8a 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -694,7 +694,6 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars pp_rhs IfaceBuiltInSynFamTyCon = ppShowIface ss (ptext (sLit "built-in")) - pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs))) = vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs) $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 28bfc33..6dc4b9d 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -320,9 +320,6 @@ basicKnownKeyNames -- Type-level naturals knownNatClassName, knownSymbolClassName, - -- Implicit parameters - ipClassName, - -- Source locations callStackDataConName, callStackTyConName, srcLocDataConName, @@ -1209,10 +1206,6 @@ knownNatClassName = clsQual gHC_TYPELITS (fsLit "KnownNat") knownNatClassNam knownSymbolClassName :: Name knownSymbolClassName = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey --- Implicit parameters -ipClassName :: Name -ipClassName = clsQual gHC_CLASSES (fsLit "IP") ipClassNameKey - -- Source Locations callStackDataConName, callStackTyConName, srcLocDataConName :: Name callStackDataConName @@ -1349,9 +1342,6 @@ knownSymbolClassNameKey = mkPreludeClassUnique 43 ghciIoClassKey :: Unique ghciIoClassKey = mkPreludeClassUnique 44 -ipClassNameKey :: Unique -ipClassNameKey = mkPreludeClassUnique 45 - {- ************************************************************************ * * @@ -1577,6 +1567,14 @@ callStackTyConKey = mkPreludeTyConUnique 182 typeRepTyConKey :: Unique typeRepTyConKey = mkPreludeTyConUnique 183 +-- Implicit Parameters +ipTyConKey :: Unique +ipTyConKey = mkPreludeTyConUnique 184 + +ipCoNameKey :: Unique +ipCoNameKey = mkPreludeTyConUnique 185 + + ---------------- Template Haskell ------------------- -- USES TyConUniques 200-299 ----------------------------------------------------- @@ -1652,6 +1650,9 @@ callStackDataConKey, srcLocDataConKey :: Unique callStackDataConKey = mkPreludeDataConUnique 36 srcLocDataConKey = mkPreludeDataConUnique 37 +ipDataConKey :: Unique +ipDataConKey = mkPreludeDataConUnique 38 + trTyConDataConKey, trModuleDataConKey, trNameSDataConKey :: Unique trTyConDataConKey = mkPreludeTyConUnique 185 trModuleDataConKey = mkPreludeTyConUnique 186 diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index 63989b8..52dc08e 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -23,11 +23,8 @@ module GHC.IntWord64 ( #endif ) where -import GHC.Types () - #if WORD_SIZE_IN_BITS < 64 import GHC.Prim -import GHC.CString () -- So that unpackCString# works foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int# foreign import ccall unsafe "hs_neWord64" neWord64# :: Word64# -> Word64# -> Int# From git at git.haskell.org Sun Sep 13 04:20:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:20:05 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Fix data family constructor (9fbc69b) Message-ID: <20150913042005.710603A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/9fbc69b25f670a2573baf0311658825846c728b6/ghc >--------------------------------------------------------------- commit 9fbc69b25f670a2573baf0311658825846c728b6 Author: Simon Peyton Jones Date: Fri Aug 28 10:47:40 2015 +0100 Fix data family constructor >--------------------------------------------------------------- 9fbc69b25f670a2573baf0311658825846c728b6 compiler/typecheck/TcSplice.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index a018e4a..91f79d4 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1338,10 +1338,9 @@ reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys) reifyFamFlavour :: TyCon -> TcM (Either TH.FamFlavour [TH.TySynEqn]) reifyFamFlavour tc - | isOpenTypeFamilyTyCon tc = return $ Left TH.TypeFam - | isDataFamilyTyCon tc = return $ Left TH.DataFam | Just flav <- famTyConFlav_maybe tc = case flav of OpenSynFamilyTyCon -> return $ Left TH.TypeFam + DataFamilyTyCon {} -> return $ Left TH.TypeFam AbstractClosedSynFamilyTyCon -> return $ Right [] BuiltInSynFamTyCon _ -> return $ Right [] ClosedSynFamilyTyCon Nothing -> return $ Right [] @@ -1349,7 +1348,7 @@ reifyFamFlavour tc -> do { eqns <- brListMapM reifyAxBranch $ coAxiomBranches ax ; return $ Right eqns } | otherwise - = panic "TcSplice.reifyFamFlavour: not a type family" + = pprPanic "TcSplice.reifyFamFlavour: not a type family" (ppr tc) reifyTyVars :: [TyVar] -> TcM [TH.TyVarBndr] From git at git.haskell.org Sun Sep 13 04:20:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:20:08 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Missing import (170d803) Message-ID: <20150913042008.35D783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/170d803e8e16219d9e2f2448328c31cb41fce232/ghc >--------------------------------------------------------------- commit 170d803e8e16219d9e2f2448328c31cb41fce232 Author: Simon Peyton Jones Date: Thu Aug 27 17:48:56 2015 +0100 Missing import >--------------------------------------------------------------- 170d803e8e16219d9e2f2448328c31cb41fce232 compiler/main/HscMain.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 41418fa..a3db501 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -95,6 +95,7 @@ import Type ( Type ) import {- Kind parts of -} Type ( Kind ) import CoreLint ( lintInteractiveExpr ) import VarEnv ( emptyTidyEnv ) +import THNames ( templateHaskellNames ) import Panic import ConLike From git at git.haskell.org Sun Sep 13 04:20:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:20:11 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: More refactoring in matchClass (75383f9) Message-ID: <20150913042011.1C7BF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/75383f947d6d7cec219cf60b8d4a6530fe0678af/ghc >--------------------------------------------------------------- commit 75383f947d6d7cec219cf60b8d4a6530fe0678af Author: Simon Peyton Jones Date: Fri Aug 28 10:48:32 2015 +0100 More refactoring in matchClass This refactoring was unforced, but tidies up the structure so I can see what is happening. >--------------------------------------------------------------- 75383f947d6d7cec219cf60b8d4a6530fe0678af compiler/typecheck/TcInteract.hs | 305 +++++++++++++++++++++------------------ 1 file changed, 168 insertions(+), 137 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 75383f947d6d7cec219cf60b8d4a6530fe0678af From git at git.haskell.org Sun Sep 13 04:20:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 04:20:13 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Fixes (d90b9f3) Message-ID: <20150913042013.D6ADA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/d90b9f37281048a1bdc5f3e959d6243d4275dd37/ghc >--------------------------------------------------------------- commit d90b9f37281048a1bdc5f3e959d6243d4275dd37 Author: Ben Gamari Date: Wed Sep 2 17:39:16 2015 +0200 Fixes >--------------------------------------------------------------- d90b9f37281048a1bdc5f3e959d6243d4275dd37 compiler/prelude/PrelNames.hs | 6 ++---- compiler/prelude/TysWiredIn.hs | 1 + compiler/typecheck/TcInteract.hs | 4 ++-- libraries/ghc-prim/GHC/Types.hs | 4 ++-- utils/haddock | 2 +- 5 files changed, 8 insertions(+), 9 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 6dc4b9d..d7eec94 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -206,11 +206,9 @@ basicKnownKeyNames -- Typeable typeableClassName, typeRepTyConName, - mkTyConName, mkPolyTyConAppName, mkAppTyName, - typeNatTypeRepName, - typeSymbolTypeRepName, + typeLitTypeRepName, -- Dynamic toDynName, @@ -1926,7 +1924,7 @@ mkTyConKey = mkPreludeMiscIdUnique 503 mkPolyTyConAppKey = mkPreludeMiscIdUnique 504 mkAppTyKey = mkPreludeMiscIdUnique 505 typeLitTypeRepKey = mkPreludeMiscIdUnique 506 -typeRepIdKey = mkPreludeMiscIdUnique 508 +typeRepIdKey = mkPreludeMiscIdUnique 508 -- Dynamic toDynIdKey :: Unique diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 4c8a641..cbea073 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -984,6 +984,7 @@ ipCoName = mkWiredInCoAxiomName BuiltInSyntax gHC_CLASSES (fsLit "NTCo:IP") -- See Note [The Implicit Parameter class] ipTyCon :: TyCon ipTyCon = mkClassTyCon ipTyConName kind [ip,a] [] rhs ipClass NonRecursive + (mkPrelTyConRepName ipTyConName) where kind = mkArrowKinds [typeSymbolKind, liftedTypeKind] constraintKind [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind] diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 1d9b737..00c6090 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -23,7 +23,7 @@ import TcType import Name import PrelNames ( knownNatClassName, knownSymbolClassName, callStackTyConKey, typeableClassName ) -import TysWiredIn ( ipClass, typeNatKind, typeSymbolKind ) +import TysWiredIn ( ipClass ) import Id( idType ) import Class import TyCon @@ -771,7 +771,7 @@ interactGivenIP _ wi = pprPanic "interactGivenIP" (ppr wi) -- i.e. (IP "name" CallStack) isCallStackIP :: CtLoc -> Class -> [Type] -> Maybe (EvTerm -> EvCallStack) isCallStackIP loc cls tys - | cls `hasKey` ipClassNameKey + | cls == ipClass , [_ip_name, ty] <- tys , Just (tc, _) <- splitTyConApp_maybe ty , tc `hasKey` callStackTyConKey diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index 9452556..fe76819 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples, - MultiParamTypeClasses, RoleAnnotations #-} + MultiParamTypeClasses, RoleAnnotations, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Types @@ -30,7 +30,7 @@ module GHC.Types ( SPEC(..), Nat, Symbol, Coercible, - SrcLoc(..), CallStack(..) + SrcLoc(..), CallStack(..), TyCon(..), TrName(..), Module(..) ) where diff --git a/utils/haddock b/utils/haddock index 7570ed8..a66185c 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 7570ed8595402bcd354b7b24de1f4b0e3e527a58 +Subproject commit a66185c01b5d7911f0c15eea2434c5e1302fc6be From git at git.haskell.org Sun Sep 13 11:19:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 11:19:47 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T10874' created Message-ID: <20150913111947.0DA3D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T10874 Referencing: b86c566bf4bfc7f1d74c58b42a3e96f19c519258 From git at git.haskell.org Sun Sep 13 11:19:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 11:19:50 +0000 (UTC) Subject: [commit: ghc] wip/T10874: Merge new commands from ghci-ng (re #10874) (b86c566) Message-ID: <20150913111950.9E2283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10874 Link : http://ghc.haskell.org/trac/ghc/changeset/b86c566bf4bfc7f1d74c58b42a3e96f19c519258/ghc >--------------------------------------------------------------- commit b86c566bf4bfc7f1d74c58b42a3e96f19c519258 Author: Herbert Valerio Riedel Date: Sun Sep 13 13:19:13 2015 +0200 Merge new commands from ghci-ng (re #10874) This is *WORK IN PROGRESS* as -- | Get ALL source spans in the source. listifyAllSpans :: Typeable a => TypecheckedSource -> [Located a] is currently disabled as it relies on `syb` to traverse the AST. >--------------------------------------------------------------- b86c566bf4bfc7f1d74c58b42a3e96f19c519258 ghc/GhciFind.hs | 260 +++++++++++++++++++++++++++++++++++++++++++++++++++ ghc/GhciInfo.hs | 191 +++++++++++++++++++++++++++++++++++++ ghc/GhciMonad.hs | 18 ++++ ghc/GhciTypes.hs | 57 +++++++++++ ghc/InteractiveUI.hs | 183 +++++++++++++++++++++++++++++++++++- ghc/ghc-bin.cabal.in | 13 ++- 6 files changed, 715 insertions(+), 7 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 b86c566bf4bfc7f1d74c58b42a3e96f19c519258 From git at git.haskell.org Sun Sep 13 15:15:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Sep 2015 15:15:19 +0000 (UTC) Subject: [commit: ghc] wip/T10874: Merge new commands from ghci-ng (re #10874) (a473868) Message-ID: <20150913151519.AA8323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10874 Link : http://ghc.haskell.org/trac/ghc/changeset/a4738680ab35fb5d844609fc8755c46268ad6800/ghc >--------------------------------------------------------------- commit a4738680ab35fb5d844609fc8755c46268ad6800 Author: Herbert Valerio Riedel Date: Sun Sep 13 13:19:13 2015 +0200 Merge new commands from ghci-ng (re #10874) This was for the major part implemented by Chris Done on https://github.com/chrisdone/ghci-ng and has been in use by Emacs's `haskell-mode` for about a year already. I've squashed the commits, rebased to GHC HEAD, and cleaned up the patch. ----- The new commands this commit adds are (description copied from [1]): * The `:set +c` command: collect information about modules after they've been loaded, and remember it between loads (including failed ones). I recommend adding this line to your `~/.ghci` file. * The `:type-at` command (requires `+c`): show the type at the given position in the module. Example: ``` haskell *X> :type-at X.hs 6 6 6 7 f Int -> Int ``` This can be useful to get the type of a pattern variable or an arbitrary selected expression. The parameters are: `text` is used for when the span is out of date, i.e. the file changed and the code has moved, text can be used to confirm the contents of the span matches, and to fallback to a general :t-like lookup. * The `:loc-at` command (requires `+c`): get the location of the thing at the given position in the module. Example: ``` haskell *X> :loc-at X.hs 6 14 6 16 mu X.hs:(8,7)-(8,9) ``` This is useful for goto-definition features of editors and IDEs. Parameters are the same as for `:type-at`. * The `:uses` command (requires `+c`): gets all module-local uses of the thing at the given position in the module. Example: ``` haskell > :uses /home/chris/Projects/ghci-ng/ghc/GhciFind.hs 53 66 53 70 name /home/chris/Projects/ghci-ng/ghc/GhciFind.hs:(46,25)-(46,29) /home/chris/Projects/ghci-ng/ghc/GhciFind.hs:(47,37)-(47,41) /home/chris/Projects/ghci-ng/ghc/GhciFind.hs:(53,66)-(53,70) /home/chris/Projects/ghci-ng/ghc/GhciFind.hs:(57,62)-(57,66) ``` This is useful for highlighting and navigating all uses of an identifier in editors and IDEs. Parameters are the same as for `:type-at`. * The `:all-types` command (requires `+c`): list *all* types in the project: expressions, bindings top-level and local. Sort of like `:browse` on steroids. ``` haskell > :all-types ghc/GhciTypes.hs:(38,13)-(38,24): Maybe Id ghc/GhciTypes.hs:(45,10)-(45,29): Outputable SpanInfo ghc/GhciTypes.hs:(45,10)-(45,29): (Rational -> SpanInfo -> SDoc) -> Outputable SpanInfo ``` [1]: https://github.com/chrisdone/ghci-ng/blob/master/README.md >--------------------------------------------------------------- a4738680ab35fb5d844609fc8755c46268ad6800 ghc/GhciFind.hs | 260 +++++++++++++++++++++++++++++++++++++++++++++++++++ ghc/GhciInfo.hs | 156 +++++++++++++++++++++++++++++++ ghc/GhciMonad.hs | 18 ++++ ghc/GhciTypes.hs | 57 +++++++++++ ghc/InteractiveUI.hs | 183 +++++++++++++++++++++++++++++++++++- ghc/ghc-bin.cabal.in | 13 ++- 6 files changed, 680 insertions(+), 7 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 a4738680ab35fb5d844609fc8755c46268ad6800 From git at git.haskell.org Mon Sep 14 09:08:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Sep 2015 09:08:35 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: cleaning up + tiny fix for PatSyn (2bf6b25) Message-ID: <20150914090835.607053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/2bf6b2518b639d56ce3afae94ec63e9692f0e13c/ghc >--------------------------------------------------------------- commit 2bf6b2518b639d56ce3afae94ec63e9692f0e13c Author: George Karachalias Date: Mon Sep 14 11:10:21 2015 +0200 cleaning up + tiny fix for PatSyn >--------------------------------------------------------------- 2bf6b2518b639d56ce3afae94ec63e9692f0e13c compiler/deSugar/Check.hs | 334 ++++++++++++++++++++----------------------- compiler/utils/MonadUtils.hs | 5 +- 2 files changed, 160 insertions(+), 179 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2bf6b2518b639d56ce3afae94ec63e9692f0e13c From git at git.haskell.org Mon Sep 14 14:08:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Sep 2015 14:08:18 +0000 (UTC) Subject: [commit: ghc] master: Account for stack allocation in the thread's allocation counter (12b0bb6) Message-ID: <20150914140818.99BEA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12b0bb6f15caa5b4b01d0330a7a8d23e3c10842c/ghc >--------------------------------------------------------------- commit 12b0bb6f15caa5b4b01d0330a7a8d23e3c10842c Author: Simon Marlow Date: Mon Sep 14 13:37:38 2015 +0100 Account for stack allocation in the thread's allocation counter Summary: (see comment for details) Test Plan: validate Reviewers: bgamari, ezyang, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1243 >--------------------------------------------------------------- 12b0bb6f15caa5b4b01d0330a7a8d23e3c10842c rts/Threads.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/rts/Threads.c b/rts/Threads.c index 434e129..203a248 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -602,7 +602,15 @@ threadStackOverflow (Capability *cap, StgTSO *tso) "allocating new stack chunk of size %d bytes", chunk_size * sizeof(W_)); + // Charge the current thread for allocating stack. Stack usage is + // non-deterministic, because the chunk boundaries might vary from + // run to run, but accounting for this is better than not + // accounting for it, since a deep recursion will otherwise not be + // subject to allocation limits. + cap->r.rCurrentTSO = tso; new_stack = (StgStack*) allocate(cap, chunk_size); + cap->r.rCurrentTSO = NULL; + SET_HDR(new_stack, &stg_STACK_info, old_stack->header.prof.ccs); TICK_ALLOC_STACK(chunk_size); From git at git.haskell.org Mon Sep 14 15:13:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Sep 2015 15:13:15 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: cleaning up (moved PmExpr in a separate file) (a364b7d) Message-ID: <20150914151315.072BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/a364b7d347bae03965c06530684b5abbc834134e/ghc >--------------------------------------------------------------- commit a364b7d347bae03965c06530684b5abbc834134e Author: George Karachalias Date: Mon Sep 14 14:38:54 2015 +0200 cleaning up (moved PmExpr in a separate file) >--------------------------------------------------------------- a364b7d347bae03965c06530684b5abbc834134e compiler/deSugar/PmExpr.hs | 438 +++++++++++++++++++++++++++++++++++++++++++ compiler/deSugar/TmOracle.hs | 361 ++--------------------------------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsPat.hs | 43 +---- 4 files changed, 456 insertions(+), 387 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 a364b7d347bae03965c06530684b5abbc834134e From git at git.haskell.org Mon Sep 14 15:13:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Sep 2015 15:13:17 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Pass term constraints inwards (does not compile) (2369bd4) Message-ID: <20150914151317.D6EA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/2369bd40953cea45634d7262137571a5fc21b075/ghc >--------------------------------------------------------------- commit 2369bd40953cea45634d7262137571a5fc21b075 Author: George Karachalias Date: Mon Sep 14 17:14:53 2015 +0200 Pass term constraints inwards (does not compile) >--------------------------------------------------------------- 2369bd40953cea45634d7262137571a5fc21b075 compiler/deSugar/Check.hs | 26 +++++++++++++++++++++++--- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsExpr.hs | 17 +++++++++-------- compiler/deSugar/DsMonad.hs | 16 ++++++++++++---- compiler/deSugar/Match.hs | 16 +++++++++++----- compiler/deSugar/Match.hs-boot | 1 + compiler/deSugar/PmExpr.hs | 10 ++-------- compiler/deSugar/TmOracle.hs | 14 ++++++++++++-- compiler/typecheck/TcRnTypes.hs | 4 +++- 9 files changed, 74 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 2369bd40953cea45634d7262137571a5fc21b075 From git at git.haskell.org Tue Sep 15 14:25:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Sep 2015 14:25:42 +0000 (UTC) Subject: [commit: ghc] master: Pretty: fix unicode arrow operators. (14c4090) Message-ID: <20150915142542.D3E7E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14c4090e384d9ac5bf434a8a77bbf552bf463023/ghc >--------------------------------------------------------------- commit 14c4090e384d9ac5bf434a8a77bbf552bf463023 Author: Sebastian Reu?e Date: Tue Sep 15 14:20:01 2015 +0200 Pretty: fix unicode arrow operators. As per issue #10509, the documentation gave the wrong glyphs for Unicode alternatives to the -< and >- arrow operators (the codepoints were correct, but the glyphs were not). The incorrect glyphs have also made it into the error output. This replaces those characters with the correct versions. GHC Trac Issues: #10883 >--------------------------------------------------------------- 14c4090e384d9ac5bf434a8a77bbf552bf463023 compiler/utils/Outputable.hs | 4 ++-- testsuite/tests/ghci/scripts/T8959.stderr | 2 +- testsuite/tests/ghci/scripts/T8959b.stderr | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index a4893b9..a730cdf 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -524,8 +524,8 @@ dcolon = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit "::")) arrow = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit "->")) larrow = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit "<-")) darrow = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit "=>")) -arrowt = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit ">-")) -larrowt = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit "-<")) +arrowt = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit ">-")) +larrowt = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit "-<")) arrowtt = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit ">>-")) larrowtt = unicodeSyntax (char '?') (docToSDoc $ Pretty.ptext (sLit "-<<")) semi = docToSDoc $ Pretty.semi diff --git a/testsuite/tests/ghci/scripts/T8959.stderr b/testsuite/tests/ghci/scripts/T8959.stderr index 3f5707b..2c1d5e5 100644 --- a/testsuite/tests/ghci/scripts/T8959.stderr +++ b/testsuite/tests/ghci/scripts/T8959.stderr @@ -13,7 +13,7 @@ :1:1: Arrow command found where an expression was expected: - () ? () ? () ? () ? () + () ? () ? () ? () ? () :13:15: Couldn't match expected type ?()? with actual type ?Bool? diff --git a/testsuite/tests/ghci/scripts/T8959b.stderr b/testsuite/tests/ghci/scripts/T8959b.stderr index 4f1ac7a..6a20f07 100644 --- a/testsuite/tests/ghci/scripts/T8959b.stderr +++ b/testsuite/tests/ghci/scripts/T8959b.stderr @@ -6,8 +6,8 @@ T8959b.hs:5:7: T8959b.hs:8:7: Couldn't match expected type ?()? with actual type ?t0 ? m0 t0? - In the expression: proc x -> do { return ? x } - In an equation for ?bar?: bar = proc x -> do { return ? x } + In the expression: proc x -> do { return ? x } + In an equation for ?bar?: bar = proc x -> do { return ? x } T8959b.hs:10:7: Couldn't match expected type ?(? a2. a2 ? a2) ? a1? From git at git.haskell.org Tue Sep 15 14:41:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Sep 2015 14:41:13 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: add PmExpr.hs in ghc.mk (now it compiles) (49b21ae) Message-ID: <20150915144113.501D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/49b21ae740e70f638c485cf907989ac544320d2e/ghc >--------------------------------------------------------------- commit 49b21ae740e70f638c485cf907989ac544320d2e Author: George Karachalias Date: Tue Sep 15 14:07:51 2015 +0200 add PmExpr.hs in ghc.mk (now it compiles) >--------------------------------------------------------------- 49b21ae740e70f638c485cf907989ac544320d2e compiler/ghc.mk | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 97e64ec..2aae74e 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -519,6 +519,7 @@ compiler_stage2_dll0_MODULES = \ HsImpExp \ HsLit \ PlaceHolder \ + PmExpr \ HsPat \ HsSyn \ HsTypes \ From git at git.haskell.org Tue Sep 15 14:41:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Sep 2015 14:41:16 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Propagate (some) term constraints in nested matches (814f007) Message-ID: <20150915144116.2EF2A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/814f0072ad4f1c515dc1518a271f12a47b8c33ae/ghc >--------------------------------------------------------------- commit 814f0072ad4f1c515dc1518a271f12a47b8c33ae Author: George Karachalias Date: Tue Sep 15 16:43:05 2015 +0200 Propagate (some) term constraints in nested matches >--------------------------------------------------------------- 814f0072ad4f1c515dc1518a271f12a47b8c33ae compiler/deSugar/Check.hs | 31 ++++++++++++++++--------------- compiler/deSugar/Match.hs | 27 +++++++++++++++------------ 2 files changed, 31 insertions(+), 27 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 02f0c0d..95d2ded 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -7,7 +7,7 @@ {-# LANGUAGE CPP #-} -module Check ( toTcTypeBag, pprUncovered, checkSingle, checkMatches, PmResult, hsCaseTmCt ) where +module Check ( toTcTypeBag, pprUncovered, checkSingle, checkMatches, PmResult, hsCaseTmCt, hsCaseTmCtOne ) where #include "HsVersions.h" @@ -117,11 +117,11 @@ type PmResult = ( [[LPat Id]] -- redundant clauses -} -- Check a single pattern binding (let) -checkSingle :: Type -> Pat Id -> DsM PmResult -checkSingle ty p = do +checkSingle :: Id -> Pat Id -> DsM PmResult +checkSingle var p = do let lp = [noLoc p] vec <- liftUs (translatePat p) - vsa <- initial_uncovered [ty] + vsa <- initial_uncovered [var] (c,d,us') <- patVectProc (vec,[]) vsa -- no guards us <- pruneValSetAbs us' return $ case (c,d) of @@ -130,11 +130,11 @@ checkSingle ty p = do (False, False) -> ([lp], [], us) -- Check a matchgroup (case, etc) -checkMatches :: [Type] -> [LMatch Id (LHsExpr Id)] -> DsM PmResult -checkMatches tys matches +checkMatches :: [Id] -> [LMatch Id (LHsExpr Id)] -> DsM PmResult +checkMatches vars matches | null matches = return ([],[],[]) | otherwise = do - missing <- initial_uncovered tys + missing <- initial_uncovered vars (rs,is,us) <- go matches missing return (map hsLMatchPats rs, map hsLMatchPats is, us) where @@ -151,14 +151,12 @@ checkMatches tys matches (False, True) -> ( rs, m:is, us') (False, False) -> (m:rs, is, us') --- You should extend this to algo get term-leven constraints from --- case expressions. -initial_uncovered :: [Type] -> DsM ValSetAbs -initial_uncovered tys = do +initial_uncovered :: [Id] -> DsM ValSetAbs +initial_uncovered vars = do us <- getUniqueSupplyM ty_cs <- TyConstraint . bagToList <$> getDictsDs tm_cs <- map (uncurry TmConstraint) . bagToList <$> getTmCsDs - let vsa = zipWith mkValAbsVar (listSplitUniqSupply us) tys + let vsa = map (VA . PmVar) vars -- zipWith mkValAbsVar (listSplitUniqSupply us) tys return $ mkConstraint (ty_cs:tm_cs) (foldr Cons Singleton vsa) {- @@ -1080,14 +1078,17 @@ pprOne (vs,(complex, subst)) = hsCaseTmCt :: Maybe (LHsExpr Id) -- scrutinee -> [Pat Id] -- match (should have length 1) - -> [Type] -- types of patterns (should have length 1) + -> [Id] -- types of patterns (should have length 1) -> DsM (Bag SimpleEq) hsCaseTmCt Nothing _ _ = return emptyBag -hsCaseTmCt (Just scr) [p] [ty] = liftUs $ do +hsCaseTmCt (Just scr) [p] [var] = liftUs $ do [e] <- map valAbsToPmExpr . coercePmPats <$> translatePat p let scr_e = lhsExprToPmExpr scr - var <- mkPmIdSM ty return $ listToBag [(var, e), (var, scr_e)] hsCaseTmCt _ _ _ = panic "hsCaseTmCt: HsCase" +hsCaseTmCtOne :: Maybe (LHsExpr Id) -> [Id] -> Bag SimpleEq +hsCaseTmCtOne Nothing _ = emptyBag +hsCaseTmCtOne (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +hsCaseTmCtOne _ _ = panic "hsCaseTmCtOne: HsCase" diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 5303872..f38531c 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -696,26 +696,29 @@ matchWrapper ctxt mb_scr (MG { mg_alts = matches = do { dflags <- getDynFlags ; locn <- getSrcSpanDs - -- pattern match check warnings - ; unless (isGenerated origin) $ - dsPmWarn dflags (DsMatchContext ctxt locn) (checkMatches arg_tys matches) - - ; eqns_info <- mapM mk_eqn_info matches ; new_vars <- case matches of [] -> mapM newSysLocalDs arg_tys (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m)) + + ; eqns_info <- mapM (mk_eqn_info new_vars) matches + + -- pattern match check warnings + ; let tm_cs = hsCaseTmCtOne mb_scr new_vars + ; unless (isGenerated origin) $ + dsPmWarn dflags (DsMatchContext ctxt locn) (addTmCsDs tm_cs $ checkMatches new_vars matches) + ; result_expr <- handleWarnings $ matchEquations ctxt new_vars eqns_info rhs_ty ; return (new_vars, result_expr) } where - mk_eqn_info (L _ (Match pats _ grhss)) + mk_eqn_info vars (L _ (Match pats _ grhss)) = do { let upats = map unLoc pats - dicts = toTcTypeBag (collectEvVarsPats upats) -- check rhs with constraints from match in scope -- Only TcTyVars + dicts = toTcTypeBag (collectEvVarsPats upats) -- Only TcTyVars - ; tm_cs <- hsCaseTmCt mb_scr upats arg_tys - ; match_result <- addDictsDs dicts $ - addTmCsDs tm_cs $ - dsGRHSs ctxt upats grhss rhs_ty + ; tm_cs <- hsCaseTmCt mb_scr upats vars -- arg_tys + ; match_result <- addDictsDs dicts $ -- pass type constraints inwards + addTmCsDs tm_cs $ -- pass term constraints inwards + dsGRHSs ctxt upats grhss rhs_ty -- THEY SHOULD BE PASSED HERE TOO BECAUSE IT IS GONNA GENERATE AGAIN ; return (EqnInfo { eqn_pats = upats, eqn_rhs = match_result}) } -- not sure if it is needed anymore (does `matchEquations' generate any other warning?) @@ -774,7 +777,7 @@ matchSinglePat (Var var) ctx (L _ pat) ty match_result ; locn <- getSrcSpanDs -- pattern match check warnings - ; dsPmWarn dflags (DsMatchContext ctx locn) (checkSingle (idType var) pat) + ; dsPmWarn dflags (DsMatchContext ctx locn) (checkSingle var pat) ; matchCheck (DsMatchContext ctx locn) [var] ty From git at git.haskell.org Tue Sep 15 21:22:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Sep 2015 21:22:05 +0000 (UTC) Subject: [commit: ghc] master: Fix `hp2ps -i-` (325efac) Message-ID: <20150915212205.DBB813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/325efac29827447402ad93fe99578fd791ffb822/ghc >--------------------------------------------------------------- commit 325efac29827447402ad93fe99578fd791ffb822 Author: Thomas Miedema Date: Tue Sep 15 23:20:10 2015 +0200 Fix `hp2ps -i-` From the help text: -i[+|-] sort by identifier string (-i+ gives greatest on top) Found by David Binderman. >--------------------------------------------------------------- 325efac29827447402ad93fe99578fd791ffb822 utils/hp2ps/Main.c | 1 + 1 file changed, 1 insertion(+) diff --git a/utils/hp2ps/Main.c b/utils/hp2ps/Main.c index 74d1bce..88f9b08 100644 --- a/utils/hp2ps/Main.c +++ b/utils/hp2ps/Main.c @@ -86,6 +86,7 @@ int main(int argc, char *argv[]) switch( *(*argv + 1) ) { case '-': iflag = -1; + break; case '+': default: iflag = 1; From git at git.haskell.org Wed Sep 16 09:16:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Sep 2015 09:16:22 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: remove unused sPgm_sysman (#8689) (e66daec) Message-ID: <20150916091622.41D0C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e66daecafd83216f076a55e3313799f0834dc599/ghc >--------------------------------------------------------------- commit e66daecafd83216f076a55e3313799f0834dc599 Author: Thomas Miedema Date: Wed Sep 16 11:01:37 2015 +0200 DynFlags: remove unused sPgm_sysman (#8689) Something about a long deleted 'system manager' for the 'parallel system'. Also remove confusing comment in SysTools, that supposedly referred to sPgm_sysman. See commit 16d5d1c75c999677783c9c1bda519540fa9a6e58. >--------------------------------------------------------------- e66daecafd83216f076a55e3313799f0834dc599 compiler/main/DynFlags.hs | 5 +---- compiler/main/SysTools.hs | 3 --- 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 6b44e16..01effa8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -71,7 +71,7 @@ module DynFlags ( versionedAppDir, extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, - pgm_sysman, pgm_windres, pgm_libtool, pgm_lo, pgm_lc, + pgm_windres, pgm_libtool, pgm_lo, pgm_lc, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_windres, opt_lo, opt_lc, @@ -974,7 +974,6 @@ data Settings = Settings { sPgm_l :: (String,[Option]), sPgm_dll :: (String,[Option]), sPgm_T :: String, - sPgm_sysman :: String, sPgm_windres :: String, sPgm_libtool :: String, sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser @@ -1031,8 +1030,6 @@ pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = sPgm_dll (settings dflags) pgm_T :: DynFlags -> String pgm_T dflags = sPgm_T (settings dflags) -pgm_sysman :: DynFlags -> String -pgm_sysman dflags = sPgm_sysman (settings dflags) pgm_windres :: DynFlags -> String pgm_windres dflags = sPgm_windres (settings dflags) pgm_libtool :: DynFlags -> String diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index b624862..15baa38 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -343,13 +343,10 @@ initSysTools mbMinusB sPgm_l = (ld_prog, ld_args), sPgm_dll = (mkdll_prog,mkdll_args), sPgm_T = touch_path, - sPgm_sysman = top_dir ++ "/ghc/rts/parallel/SysMan", sPgm_windres = windres_path, sPgm_libtool = libtool_path, sPgm_lo = (lo_prog,[]), sPgm_lc = (lc_prog,[]), - -- Hans: this isn't right in general, but you can - -- elaborate it in the same way as the others sOpt_L = [], sOpt_P = [], sOpt_F = [], From git at git.haskell.org Thu Sep 17 01:24:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 01:24:14 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: add test for #10781 (8d89d80) Message-ID: <20150917012414.84BB23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d89d80d907a7df1d455e87a382b41dc65c42140/ghc >--------------------------------------------------------------- commit 8d89d80d907a7df1d455e87a382b41dc65c42140 Author: Thomas Miedema Date: Thu Sep 17 03:25:11 2015 +0200 Testsuite: add test for #10781 >--------------------------------------------------------------- 8d89d80d907a7df1d455e87a382b41dc65c42140 testsuite/tests/rename/should_fail/T10781.hs | 12 ++++++++++++ testsuite/tests/rename/should_fail/T10781.stderr | 2 ++ testsuite/tests/rename/should_fail/all.T | 1 + 3 files changed, 15 insertions(+) diff --git a/testsuite/tests/rename/should_fail/T10781.hs b/testsuite/tests/rename/should_fail/T10781.hs new file mode 100644 index 0000000..9991c94 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T10781.hs @@ -0,0 +1,12 @@ +module T10781 where +{- ghc-7.10.2 reported: + +T10781.hs:6:5: + Found hole ?_name? with type: t + Where: ?t? is a rigid type variable bound by + the inferred type of f :: t at T10781.hs:6:1 + Relevant bindings include f :: t (bound at T10781.hs:6:1) + In the expression: Foo._name + In an equation for ?f?: f = Foo._name +-} +f = Foo._name diff --git a/testsuite/tests/rename/should_fail/T10781.stderr b/testsuite/tests/rename/should_fail/T10781.stderr new file mode 100644 index 0000000..5d4dc3c --- /dev/null +++ b/testsuite/tests/rename/should_fail/T10781.stderr @@ -0,0 +1,2 @@ + +T10781.hs:12:5: error: Not in scope: ?Foo._name? diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index bd717dd..48814ec 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -137,3 +137,4 @@ test('T9032', test('T10618', normal, compile_fail, ['']) test('T10668', normal, compile_fail, ['']) test('T5001b', normal, compile_fail, ['']) +test('T10781', normal, compile_fail, ['']) From git at git.haskell.org Thu Sep 17 13:01:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 13:01:41 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Some notes (a866ff3) Message-ID: <20150917130141.3A5CE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/a866ff3eb9b1ec34b502b2892305a5a816690873/ghc >--------------------------------------------------------------- commit a866ff3eb9b1ec34b502b2892305a5a816690873 Author: George Karachalias Date: Thu Sep 17 13:58:19 2015 +0200 Some notes >--------------------------------------------------------------- a866ff3eb9b1ec34b502b2892305a5a816690873 compiler/deSugar/Check.hs | 91 ++++++++++++++++++----- compiler/deSugar/Match.hs | 15 ++-- compiler/deSugar/PmExpr.hs | 88 +++++++++++++--------- compiler/deSugar/TmOracle.hs | 169 +++++++++++++++++++------------------------ 4 files changed, 213 insertions(+), 150 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 a866ff3eb9b1ec34b502b2892305a5a816690873 From git at git.haskell.org Thu Sep 17 13:01:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 13:01:44 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: No more need for function matchCheck (d86218d) Message-ID: <20150917130144.0C3023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/d86218d08982f17ed49ec1896a06b3cf3ef25e05/ghc >--------------------------------------------------------------- commit d86218d08982f17ed49ec1896a06b3cf3ef25e05 Author: George Karachalias Date: Thu Sep 17 14:14:10 2015 +0200 No more need for function matchCheck >--------------------------------------------------------------- d86218d08982f17ed49ec1896a06b3cf3ef25e05 compiler/deSugar/Match.hs | 27 ++++----------------------- 1 file changed, 4 insertions(+), 23 deletions(-) diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index f11a0f8..d542613 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -52,23 +52,6 @@ import Control.Monad( when, unless ) import qualified Data.Map as Map {- -This function is a wrapper of @match@, it must be called from all the parts where -it was called match, but only substitutes the first call, .... -if the associated flags are declared, warnings will be issued. -It can not be called matchWrapper because this name already exists :-( - -JJCQ 30-Nov-1997 --} - -matchCheck :: DsMatchContext - -> [Id] -- Vars rep'ing the exprs we're matching with - -> Type -- Type of the case expression - -> [EquationInfo] -- Info about patterns, etc. (type synonym below) - -> DsM MatchResult -- Desugared result! - -matchCheck _ctx vars ty qs = match vars ty qs -- remove this function maybe? - -{- ************************************************************************ * * The main matching function @@ -735,10 +718,9 @@ matchEquations :: HsMatchContext Name -> DsM CoreExpr matchEquations ctxt vars eqns_info rhs_ty = do { locn <- getSrcSpanDs - ; let ds_ctxt = DsMatchContext ctxt locn - error_doc = matchContextErrString ctxt + ; let error_doc = matchContextErrString ctxt - ; match_result <- matchCheck ds_ctxt vars rhs_ty eqns_info + ; match_result <- match vars rhs_ty eqns_info ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc ; extractMatchResult match_result fail_expr } @@ -782,9 +764,8 @@ matchSinglePat (Var var) ctx (L _ pat) ty match_result -- pattern match check warnings ; dsPmWarn dflags (DsMatchContext ctx locn) (checkSingle var pat) - ; matchCheck (DsMatchContext ctx locn) - [var] ty - [EqnInfo { eqn_pats = [pat], eqn_rhs = match_result }] } + ; match [var] ty + [EqnInfo { eqn_pats = [pat], eqn_rhs = match_result }] } matchSinglePat scrut hs_ctx pat ty match_result = do { var <- selectSimpleMatchVarL pat From git at git.haskell.org Thu Sep 17 13:01:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 13:01:46 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: minor stuff (8ea3741) Message-ID: <20150917130146.C6FB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/8ea37413839c010bc743641c74368db4a1a308d6/ghc >--------------------------------------------------------------- commit 8ea37413839c010bc743641c74368db4a1a308d6 Author: George Karachalias Date: Thu Sep 17 15:03:33 2015 +0200 minor stuff >--------------------------------------------------------------- 8ea37413839c010bc743641c74368db4a1a308d6 compiler/deSugar/Check.hs | 6 +----- compiler/deSugar/Match.hs | 4 +--- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 6164b04..6cc9594 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -169,10 +169,9 @@ checkMatches vars matches initial_uncovered :: [Id] -> DsM ValSetAbs initial_uncovered vars = do - us <- getUniqueSupplyM ty_cs <- TyConstraint . bagToList <$> getDictsDs tm_cs <- map (uncurry TmConstraint) . bagToList <$> getTmCsDs - let vsa = map (VA . PmVar) vars -- zipWith mkValAbsVar (listSplitUniqSupply us) tys + let vsa = map (VA . PmVar) vars return $ mkConstraint (ty_cs:tm_cs) (foldr Cons Singleton vsa) {- @@ -635,9 +634,6 @@ mkPatternVarSM ty = flip mkPatternVar ty <$> getUniqueSupplyM mkPatternVarsSM :: [Type] -> UniqSM PatVec mkPatternVarsSM tys = mapM mkPatternVarSM tys -mkPmIdSM :: Type -> UniqSM Id -mkPmIdSM ty = flip mkPmId ty <$> getUniqueSupplyM - mkPmId :: UniqSupply -> Type -> Id mkPmId usupply ty = mkLocalId name ty where diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index d542613..338a73b 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -19,7 +19,6 @@ import HsSyn import TcHsSyn import TcEvidence import TcRnMonad -import PmExpr import Check import CoreSyn import Literal @@ -717,8 +716,7 @@ matchEquations :: HsMatchContext Name -> [Id] -> [EquationInfo] -> Type -> DsM CoreExpr matchEquations ctxt vars eqns_info rhs_ty - = do { locn <- getSrcSpanDs - ; let error_doc = matchContextErrString ctxt + = do { let error_doc = matchContextErrString ctxt ; match_result <- match vars rhs_ty eqns_info From git at git.haskell.org Thu Sep 17 14:00:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 14:00:37 +0000 (UTC) Subject: [commit: ghc] master: Show minimal complete definitions in ghci (#10847) (43eb1dc) Message-ID: <20150917140037.E3F683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43eb1dc52a4d3cbba9617f5a26177b8251d84b6a/ghc >--------------------------------------------------------------- commit 43eb1dc52a4d3cbba9617f5a26177b8251d84b6a Author: Moritz Kiefer Date: Thu Sep 17 16:02:06 2015 +0200 Show minimal complete definitions in ghci (#10847) Show the minimal complete definition on :info in ghci. They are shown like MINIMAL pragmas in code. If the minimal complete definition is empty or only a specific method from a class is requested, nothing is shown. Reviewed By: simonpj, austin, thomie Differential Revision: https://phabricator.haskell.org/D1241 >--------------------------------------------------------------- 43eb1dc52a4d3cbba9617f5a26177b8251d84b6a compiler/iface/IfaceSyn.hs | 30 +++++++++++++++++++--- testsuite/tests/driver/sigof01/sigof01i2.stdout | 1 + testsuite/tests/ghci/prog008/ghci.prog008.stdout | 2 ++ testsuite/tests/ghci/scripts/T9181.stdout | 2 ++ testsuite/tests/ghci/scripts/ghci008.stdout | 3 +++ testsuite/tests/ghci/scripts/ghci025.stdout | 5 ++++ .../indexed-types/should_compile/T3017.stderr | 1 + .../tests/rename/should_fail/rnfail055.stderr | 2 ++ .../tests/roles/should_compile/Roles14.stderr | 1 + testsuite/tests/roles/should_compile/Roles3.stderr | 4 +++ testsuite/tests/roles/should_compile/Roles4.stderr | 2 ++ .../tests/typecheck/should_compile/tc231.stderr | 1 + 12 files changed, 51 insertions(+), 3 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 43eb1dc52a4d3cbba9617f5a26177b8251d84b6a From git at git.haskell.org Thu Sep 17 15:50:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 15:50:07 +0000 (UTC) Subject: [commit: ghc] master: ApplicativeDo transformation (8ecf6d8) Message-ID: <20150917155007.9E7693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ecf6d8f7dfee9e5b1844cd196f83f00f3b6b879/ghc >--------------------------------------------------------------- commit 8ecf6d8f7dfee9e5b1844cd196f83f00f3b6b879 Author: Simon Marlow Date: Fri Mar 13 16:39:58 2015 +0000 ApplicativeDo transformation Summary: This is an implementation of the ApplicativeDo proposal. See the Note [ApplicativeDo] in RnExpr for details on the current implementation, and the wiki page https://ghc.haskell.org/trac/ghc/wiki/ApplicativeDo for design notes. Test Plan: validate Reviewers: simonpj, goldfire, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D729 >--------------------------------------------------------------- 8ecf6d8f7dfee9e5b1844cd196f83f00f3b6b879 compiler/coreSyn/MkCore.hs | 47 +-- compiler/deSugar/Coverage.hs | 31 +- compiler/deSugar/DsArrows.hs | 11 +- compiler/deSugar/DsExpr.hs | 41 +- compiler/deSugar/DsGRHSs.hs | 2 + compiler/deSugar/DsListComp.hs | 27 +- compiler/deSugar/DsMeta.hs | 2 +- compiler/deSugar/DsUtils.hs | 18 +- compiler/hsSyn/HsExpr.hs | 91 ++++- compiler/hsSyn/HsUtils.hs | 76 +++- compiler/main/DynFlags.hs | 2 + compiler/parser/RdrHsSyn.hs | 4 +- compiler/rename/RnBinds.hs | 19 +- compiler/rename/RnExpr.hs | 528 ++++++++++++++++++++++++-- compiler/typecheck/TcArrows.hs | 4 +- compiler/typecheck/TcHsSyn.hs | 27 +- compiler/typecheck/TcMatches.hs | 126 +++++- docs/users_guide/flags.xml | 8 + docs/users_guide/glasgow_exts.xml | 172 +++++++++ testsuite/tests/{annotations => ado}/Makefile | 0 testsuite/tests/ado/ado001.hs | 159 ++++++++ testsuite/tests/ado/ado001.stdout | 10 + testsuite/tests/ado/ado002.hs | 24 ++ testsuite/tests/ado/ado002.stderr | 55 +++ testsuite/tests/ado/ado003.hs | 8 + testsuite/tests/ado/ado003.stderr | 9 + testsuite/tests/ado/ado004.hs | 247 ++++++++++++ testsuite/tests/ado/ado004.stderr | 28 ++ testsuite/tests/ado/ado005.hs | 10 + testsuite/tests/ado/ado005.stderr | 21 + testsuite/tests/ado/ado006.hs | 10 + testsuite/tests/ado/ado007.hs | 16 + testsuite/tests/ado/all.T | 7 + testsuite/tests/driver/T4437.hs | 3 +- 34 files changed, 1684 insertions(+), 159 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 8ecf6d8f7dfee9e5b1844cd196f83f00f3b6b879 From git at git.haskell.org Thu Sep 17 21:14:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 21:14:50 +0000 (UTC) Subject: [commit: ghc] master: Add namePackage function to template-haskell (77662e1) Message-ID: <20150917211450.B1CCB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/77662e13a510ddbc89fea00785e99f5f4d3a2b25/ghc >--------------------------------------------------------------- commit 77662e13a510ddbc89fea00785e99f5f4d3a2b25 Author: RyanGlScott Date: Thu Sep 17 23:15:26 2015 +0200 Add namePackage function to template-haskell Currently there exists a nameBase function (for retrieving a Name's OccName) and a nameModule function (for retrieving a Name's ModName), but there is no counterpart for PkgNames. This would be useful for implementing Template Haskell features which need to have easy access to a Name's package (e.g., automatically derived Lift instances). Reviewed By: goldfire, austin, thomie Differential Revision: https://phabricator.haskell.org/D1237 >--------------------------------------------------------------- 77662e13a510ddbc89fea00785e99f5f4d3a2b25 libraries/template-haskell/Language/Haskell/TH.hs | 1 + .../template-haskell/Language/Haskell/TH/Syntax.hs | 36 ++++++++++++++++++++-- libraries/template-haskell/changelog.md | 2 ++ testsuite/tests/th/TH_namePackage.hs | 23 ++++++++++++++ testsuite/tests/th/TH_namePackage.stdout | 9 ++++++ testsuite/tests/th/all.T | 1 + 6 files changed, 70 insertions(+), 2 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs index 4db92b7..bce8bf5 100644 --- a/libraries/template-haskell/Language/Haskell/TH.hs +++ b/libraries/template-haskell/Language/Haskell/TH.hs @@ -50,6 +50,7 @@ module Language.Haskell.TH( -- ** Deconstructing names nameBase, -- :: Name -> String nameModule, -- :: Name -> Maybe String + namePackage, -- :: Name -> Maybe String -- ** Built-in names tupleTypeName, tupleDataName, -- Int -> Name unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 82e22dd..48f3f96 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -842,16 +842,48 @@ data NameSpace = VarName -- ^ Variables type Uniq = Int --- | The name without its module prefix +-- | The name without its module prefix. +-- +-- ==== __Examples__ +-- +-- >>> nameBase ''Data.Either.Either +-- "Either" +-- >>> nameBase (mkName "foo") +-- "foo" +-- >>> nameBase (mkName "Module.foo") +-- "foo" nameBase :: Name -> String nameBase (Name occ _) = occString occ --- | Module prefix of a name, if it exists +-- | Module prefix of a name, if it exists. +-- +-- ==== __Examples__ +-- +-- >>> nameModule ''Data.Either.Either" +-- Just "Data.Either" +-- >>> nameModule (mkName "foo") +-- Nothing +-- >>> nameModule (mkName "Module.foo") +-- Just "Module" nameModule :: Name -> Maybe String nameModule (Name _ (NameQ m)) = Just (modString m) nameModule (Name _ (NameG _ _ m)) = Just (modString m) nameModule _ = Nothing +-- | A name's package, if it exists. +-- +-- ==== __Examples__ +-- +-- >>> namePackage ''Data.Either.Either" +-- Just "base" +-- >>> namePackage (mkName "foo") +-- Nothing +-- >>> namePackage (mkName "Module.foo") +-- Nothing +namePackage :: Name -> Maybe String +namePackage (Name _ (NameG _ p _)) = Just (pkgString p) +namePackage _ = Nothing + {- | Generate a capturable name. Occurrences of such names will be resolved according to the Haskell scoping rules at the occurrence diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index 3620d22..fb701ab 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -10,6 +10,8 @@ according to the fixities of the operators. The `ParensT` constructor can be used to explicitly group expressions. + * Add `namePackage` + * TODO: document API changes and important bugfixes diff --git a/testsuite/tests/th/TH_namePackage.hs b/testsuite/tests/th/TH_namePackage.hs new file mode 100644 index 0000000..7c4a541 --- /dev/null +++ b/testsuite/tests/th/TH_namePackage.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Language.Haskell.TH + +eitherName, fooName, moduleFooName :: Name +eitherName = ''Either +fooName = mkName "foo" +moduleFooName = mkName "Module.foo" + +main :: IO () +main = do + print $ nameBase eitherName + print $ nameBase fooName + print $ nameBase moduleFooName + + print $ nameModule eitherName + print $ nameModule fooName + print $ nameModule moduleFooName + + print $ namePackage eitherName + print $ namePackage fooName + print $ namePackage moduleFooName diff --git a/testsuite/tests/th/TH_namePackage.stdout b/testsuite/tests/th/TH_namePackage.stdout new file mode 100644 index 0000000..b6890dd --- /dev/null +++ b/testsuite/tests/th/TH_namePackage.stdout @@ -0,0 +1,9 @@ +"Either" +"foo" +"foo" +Just "Data.Either" +Nothing +Just "Module" +Just "base" +Nothing +Nothing diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index dada44a..eea0fa9 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -352,3 +352,4 @@ test('T10704', multimod_compile_and_run, ['T10704', '-v0']) test('T6018th', normal, compile_fail, ['-v0']) +test('TH_namePackage', normal, compile_and_run, ['-v0']) From git at git.haskell.org Thu Sep 17 23:16:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Sep 2015 23:16:06 +0000 (UTC) Subject: [commit: ghc] master: Docs: make sure all libs are included in index.html (#10879) (48746ff) Message-ID: <20150917231606.354333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48746fff87f79a3c7cc128816f9e84bf4e578445/ghc >--------------------------------------------------------------- commit 48746fff87f79a3c7cc128816f9e84bf4e578445 Author: Thomas Miedema Date: Tue Sep 15 21:37:38 2015 +0200 Docs: make sure all libs are included in index.html (#10879) During the build, when HADDOCK_DOCS=YES, the command 'cd libraries && sh gen_contents_index --intree' is run, which calls haddock to generate the haddock index at 'libraries/dist-haddock/index.html'. What it did before was check the ./packages file for all libraries. The problem is that 'base' and 'ghc-prim' were folded into the main repo some time ago, hence don't have an entry in the ./packages file anymore. As a result, 'base' and 'ghc-prim' were missing from the index.html file. It now simply runs haddock on all the all the `.haddock` files in the libraries directory. The only risk is that this could include the extra libraries in the index.html, if you ever built them in the past (with BUILD_EXTRA_PKGS=YES), even though now you want to exclude them (with BUILD_EXTRA_PKGS=NO). gen_contents_index doesn't have access to build system variables though (PACKAGES_STAGE1+PACKAGES_STAGE2), so fixing this would be a little bit fiddly. Test Plan: 'make libraries/dist-haddock/index.html && grep -q base libraries/dist-haddock/index.html && echo ok' Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1247 >--------------------------------------------------------------- 48746fff87f79a3c7cc128816f9e84bf4e578445 libraries/gen_contents_index | 18 ++---------------- 1 file changed, 2 insertions(+), 16 deletions(-) diff --git a/libraries/gen_contents_index b/libraries/gen_contents_index index b583b88..27fa3c7 100644 --- a/libraries/gen_contents_index +++ b/libraries/gen_contents_index @@ -33,22 +33,10 @@ then cd dist-haddock HADDOCK=../../inplace/bin/haddock + HADDOCK_FILES=`find ../ -name *.haddock | sort` HADDOCK_ARGS="-p ../prologue.txt" - for REPO in `grep '^libraries/[^ ]* *- ' ../../packages | sed -e 's#libraries/##' -e 's/ .*//'` + for HADDOCK_FILE in $HADDOCK_FILES do - if [ -f "../$REPO/ghc-packages" ] - then - LIBS="`cat ../$REPO/ghc-packages`" - LIBROOT="../$REPO" - else - LIBS="$REPO" - LIBROOT=".." - fi - for LIB in $LIBS - do - HADDOCK_FILE="$LIBROOT/$LIB/dist-install/doc/html/$LIB/$LIB.haddock" - if [ -f "$HADDOCK_FILE" ] - then LIBPATH=`echo "$HADDOCK_FILE" | sed 's#/dist-install.*##'` NAME=`echo "$HADDOCK_FILE" | sed 's#.*/##' | sed 's#\.haddock$##'` # It's easier to portably remove tabs with tr than to try to get @@ -56,8 +44,6 @@ then VERSION=`grep -i '^version:' $LIBPATH/$NAME.cabal | sed 's/.*://' | tr -d ' \t'` HADDOCK_ARG="--read-interface=${NAME}-${VERSION},$HADDOCK_FILE" HADDOCK_ARGS="$HADDOCK_ARGS $HADDOCK_ARG" - fi - done done else HADDOCK=../../../../../bin/haddock From git at git.haskell.org Fri Sep 18 20:04:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Sep 2015 20:04:47 +0000 (UTC) Subject: [commit: ghc] master: Pass TEST_HC_OPTS in bug1465 and T5792. (a8406f8) Message-ID: <20150918200447.03C2B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8406f81a5da077d1c4b9995654ca9972f39130c/ghc >--------------------------------------------------------------- commit a8406f81a5da077d1c4b9995654ca9972f39130c Author: Edward Z. Yang Date: Thu Sep 17 19:52:01 2015 -0700 Pass TEST_HC_OPTS in bug1465 and T5792. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1250 >--------------------------------------------------------------- a8406f81a5da077d1c4b9995654ca9972f39130c testsuite/tests/typecheck/bug1465/Makefile | 2 +- testsuite/tests/typecheck/should_compile/Makefile | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/typecheck/bug1465/Makefile b/testsuite/tests/typecheck/bug1465/Makefile index 78cdd51..22fa477 100644 --- a/testsuite/tests/typecheck/bug1465/Makefile +++ b/testsuite/tests/typecheck/bug1465/Makefile @@ -28,6 +28,6 @@ prep: prep.%: cd $* && '$(TEST_HC)' -v0 --make -o setup Setup.hs - cd $* && ./setup configure $(CABAL_MINIMAL_BUILD) -v0 --with-compiler='$(TEST_HC)' --with-ghc-pkg='$(GHC_PKG)' --package-db ../$(LOCAL_PKGCONF) + cd $* && ./setup configure $(CABAL_MINIMAL_BUILD) -v0 --with-compiler='$(TEST_HC)' --with-ghc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db ../$(LOCAL_PKGCONF) cd $* && ./setup build -v0 cd $* && ./setup register -v0 --inplace diff --git a/testsuite/tests/typecheck/should_compile/Makefile b/testsuite/tests/typecheck/should_compile/Makefile index e361556..840254d 100644 --- a/testsuite/tests/typecheck/should_compile/Makefile +++ b/testsuite/tests/typecheck/should_compile/Makefile @@ -28,8 +28,8 @@ tc245: # presumably because of the .hi file T5792: $(RM) -f T5792.o T5792.hi - '$(TEST_HC)' -c T5792.hs - '$(TEST_HC)' -c T5792.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c T5792.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c T5792.hs -fforce-recomp T7171: $(RM) -f T7171.hi-boot T7171.o-boot T7171a.hi T7171a.o From git at git.haskell.org Sat Sep 19 02:11:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 02:11:35 +0000 (UTC) Subject: [commit: ghc] branch 'wip/rae-new-coercible' deleted Message-ID: <20150919021135.B747E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/rae-new-coercible From git at git.haskell.org Sat Sep 19 02:13:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 02:13:33 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #10815 by kind-checking type patterns against known kinds. (23a228e) Message-ID: <20150919021333.BAFAD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/23a228e80ec719be1a36793b93de168e5fa0b913/ghc >--------------------------------------------------------------- commit 23a228e80ec719be1a36793b93de168e5fa0b913 Author: Richard Eisenberg Date: Mon Aug 31 10:46:01 2015 -0700 Fix #10815 by kind-checking type patterns against known kinds. tcFamTyPats now must take information about the instantiation of any class variables, when checking the instance of an associated type. Getting this to work out required some unexpected refactoring in TcDeriv. TcDeriv needs to look at class instances because of the possibility of associated datatypes with `deriving` specs. TcDeriv worked over the user-specified instances. But any data family instances were already processed, and TcDeriv had no way of finding the rep tycons. Indeed, TcDeriv *re-type-checked* any data family instances in an attempt to rediscover what GHC already knew. So, this commit introduces better tracking of compiled data families between TcInstDcls and TcDeriv to streamline all of this. >--------------------------------------------------------------- 23a228e80ec719be1a36793b93de168e5fa0b913 compiler/typecheck/TcDeriv.hs | 114 +++++++++++++-------- compiler/typecheck/TcInstDcls.hs | 46 +++++---- compiler/typecheck/TcTyClsDecls.hs | 41 +++++--- compiler/typecheck/TcValidity.hs | 15 +-- compiler/types/TyCon.hs | 16 ++- .../tests/indexed-types/should_compile/T10815.hs | 11 ++ testsuite/tests/indexed-types/should_compile/all.T | 2 +- .../tests/indexed-types/should_fail/T9160.stderr | 7 +- 8 files changed, 151 insertions(+), 101 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 23a228e80ec719be1a36793b93de168e5fa0b913 From git at git.haskell.org Sat Sep 19 02:13:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 02:13:36 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor according to Simon's suggestions (cdbb30b) Message-ID: <20150919021336.75F0D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/cdbb30b6aabce9f915424d155fb6a1037ee63ede/ghc >--------------------------------------------------------------- commit cdbb30b6aabce9f915424d155fb6a1037ee63ede Author: Richard Eisenberg Date: Fri Sep 18 22:08:29 2015 -0400 Refactor according to Simon's suggestions >--------------------------------------------------------------- cdbb30b6aabce9f915424d155fb6a1037ee63ede compiler/typecheck/TcDeriv.hs | 113 +++++++-------------- compiler/typecheck/TcInstDcls.hs | 52 ++++++---- compiler/typecheck/TcRnDriver.hs | 2 +- .../tests/indexed-types/should_compile/T10815.hs | 4 + 4 files changed, 75 insertions(+), 96 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 cdbb30b6aabce9f915424d155fb6a1037ee63ede From git at git.haskell.org Sat Sep 19 02:13:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 02:13:45 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Refactor according to Simon's suggestions (cdbb30b) Message-ID: <20150919021345.C1DD53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 5444560 update containers submodules to 0.5.6.1 release ea788f0 Parser: use 'error' token in error reporting rules 64678e9 Generate .loc/.file directives from source ticks cc481ec Generate DWARF info section edd6d67 Generate DWARF unwind information 78ab79a Update Haddock submodule 0ac059d Update stm submodule to 2.4.4 release 3745f42 Update deepseq submodule to 1.4.0.0 release c9a0228 Typos in comments 75c211e Role problems pervent GND from happening f50d62b Fix the scope-nesting for arrows 082cf13 Improve an ASSERT c436537 Use the new LintFlags to suppress Lint warnings for INLINE loop breakers 67a0cab Fix GHCi/GHC-API tidying and modules (Trac #9424, #9426) 6b11bab Improve TidyPgm.hasCafRefs to account for Integer literals (Trac #8525) 2469f85 Comment in test 517908f Fix egregious bug in the new canonicalisation code for AppTy ea22a8f Wibble error message 922168f Performance enhancements in TcFlatten. ae1f271 Typos in comments 7719b63 Typo in note 9868622 Minor typo in comment 1d4e94d Add a provenance field to universal coercions. a11987a Update Haddock submodule 726ea08 Amend TcPluginM interface 6ec9e95 Fix wrong-kind-of-family error message (Trac #9896) 989831d Update `bytestring` submodule 4c02b6f Update Cabal submodule to 1.22 version f85db75 Some Dwarf generation fixes 7844dd7 Update process and unix submodules cf594fd Relocate bash completion scripts to utils/ 5b8fa46 Add Data.Version.makeVersion & `IsList Version` 02b4845 Consider equality contexts exotic, uninferrable by "deriving" c190b73 Merge some instances from th-orphans. 53599b3 Clarify that declaration splices exist at top level only. (#9880) 3fffd32 Update release notes for recent language and TH changes. dd1b6d4 Add Jan Stolarek's test for Trac #9872 2e28c82 Add instance Lift Natural e080546 Update Cabal submodule to latest 1.22 branch tip 5cf7618 Update directory submodule to latest snapshot c2fd51b Update Cabal submodule to latest 1.22 branch tip 8448635 Update hoopl submodule to 3.10.0.2 rls 68f717c Improved Backpack IR description. [skip ci] 8e2d858 Optimize flattener by trying to reduce a TF before reducing its args. 397048a Change performance numbers for T3064 5326348 Use a new $b prefix for pattern synonym builder names, instead of re-using $W from wrappers e7eef00 add runMeta hook 4523d66 trac #9744, make program name and product version configurable through DynFlags/Settings 3b497dd Check dflags for language extensions when deciding if "foreign " and "deriving " look like prefixes of valid declarations (fixes #9915) 6713f0d Add expected output to T9915 test 707fb3a Strip leading whitespace before checking if a statement looks like a declaration (fixes #9914) 4f80084 Update pretty and random submodules 2ba36b6 Update containers submodule to 0.5.6.2 release cf0a55d For :info, return all matching Names, rather than complaining about ambiguity eb4d96e Comments only 18bf6d5 Bump version to 7.11 41e1cf1 Revert "Bump version to 7.11" 3879bdf Fix typo in GLASGOW_HASKELL_PATCHLEVEL2 macro 8a02c5e Bump GHC version from 7.9 to 7.11 22bb78b Expand notes in TcFlatten c72f61c Groom comments related to StaticPointers. 1da2c0f fix spInfoSrcLoc field name e435a09 docs: create 7.12.1 relnotes 6eb86a5 Fix panic on :kind _ in GHCi (Trac #9879) 089222c Rename NamedWildcards flag to NamedWildCards 30fdf86 dwarf: sync getIdFromTrivialExpr with exprIsTrivial (test break028 and others) 9fc3aeb always use 'mkdir -p' and fix missing dir (fixes #9876) 625dd7b Add a small comment a6f0f5a Eliminate so-called "silent superclass parameters" 3e96d89 Add a couple of missing cases to isTcReflCo and isTcReflCo_maybe c407b5a Comments only 679a661 A bit of refactoring to TcErrors c3394e0 Attempt to improve cleaning edd233a Test earlier for self-import (Trac #9032) 7a2c9dd Fixup edd233acc19d269385 (T9032 test) 878910e Make ghc -e not exit on valid import commands (#9905) cc510b4 Make ghc -e fail on invalid declarations 3e3aa92 Fix linker interaction between Template Haskell and HPC (#9762) add6a30 2nd attempt to fix T9032 test-case 9ae78b0 Copy GHC's config.guess/sub over libffi's versions 1dcef98 Run T9762 only if dynamic libraries are available c0ab767 We do emit a warning for stdcall now. 0899caa Use directory-style database for bootstrapping database bd01af9 Update hsc2hs submodule for de-tabbing c55fefc Avoid redundant-import warning (w/o CPP) 6b9e958 Update hoopl and hpc submodules d6e7f5d Add export lists to some modules. 1fefb59 Update parallel submodule to 3.2.0.6 release 6c86635 Update validate-settings.mk 0cc0cc8 Support pattern synonyms in GHCi (fixes #9900) 58ac9c8 LlvmCodeGen cross-compiling fixes (#9895) 40561cd Fix `heapSizeSuggesionAuto` typo (#9934) b32c227 Fix system linker on Mac OS X 4e1e776 Skip T2276_ghci on Darwin, since stdcall is not supported. 65e3e0b Test case for #9938 9521a58 Refine test case for #9938 8d62f92 Update nofib submodule, unbreak cryptarithm2 a3d6eb7 Improve documentation of -XFlexibleInstances 44b65fd Comments only (mainly about HsWithBndrs) a9dc427 Comments only, mainly on superclasses fd97d2a Eliminate the final two calls to xCtEvidence d8d0031 When solving one Given from another, use the depth to control which way round 633814f Mark T9938 as not broken af4d998 Don't do a half-hearted recompilation check in compileOne 2223e19 Fix #9243 so recompilation avoidance works with -fno-code d84742b Update Cabal submodule to latest 1.22 snapshot 696f2cf submodule update: remove html dependency from nofib. d2b6e76 Make the location in TcLclEnv and CtLoc into a RealSrcSpan f17992a Updaete perf numbers for 32-bit machines 00e1fc1 Modify a couple of error messages slightly 8e2ed2c Replace fixVarSet with transCloVarSet 28299d6 Always generalise a partial type signature d4f460f Use a less fragile method for defaulting da9b2ec Print singleton consraints without parens 32973bf Major patch to add -fwarn-redundant-constraints 39337a6 Remove redundant constraints in the compiler itself, found by -fwarn-redundant-constraints c409b6f Remove redundant constraints from libraries, discovered by -fwarn-redundant-constraints c790fe8 Test Trac #9939 d57f507 Update haddock submodule, and fix haddock input file from genprimopcode b0f8cb8 Another fix to genprimopcode, when generating Prim.hs 8efaff1 Make comments less beautiful in order to pacify Haddock 228902a Fix undefined GHC.Real export with integer-simple 5bc99df Fix stderr for T9939 471891c Mark T9938 as expect_broken again da64ab5 Compress TypeMap TrieMap leaves with singleton constructor. 197f4e5 Generalize TrieMap compression to GenMap. b14dae3 Fix out of date comment. 2d15dc7 Improve documentation of -fwarn-redundant-constraints 43e5a22 Spelling error in comment 9564bb8 Improve HsBang 8adc015 Bump haddock.base according to whats observed on ghcspeed 6d32c93 Recenter T6048 performance numbers ccef014 Add 'DeBruijn' constructor, which generalizes "key modulo alpha-renaming." 0bef02e Apply GenMap to CoreMap and CoercionMap. 327ce1d Return a [HsImplBang] from dataConImplBangs even with NoDataConRep dfe62eb Make TcRnMonad.reportWarning call makeIntoWarning 4425ab9 A little tidying up in ErrUtils 68a5a78 Update syntax of pattern synonym type signature in documentation (fixes #9967) 6f818e0 Pattern synonyms do work in GHCi now (see #9900) ee4ced4 Comments only 3d44911 A little tidying up in the flattener 678df4c Fix up test for T7861 5830fc4 Pattern synonym names need to be in scope before renaming bindings (#9889) dd3e1dd Fix Trac #9973 (buglet in -fwarn-redundant-constraints) c4e1ccb Miscellaneous improvements to TrieMap, from D608 code review. 90dee6e Inline all of the .*[TCE] methods, and then rename .*[TCE]X to vacated name. 944329a Newtype CoreMap and TypeMap so their keys are user-friendly. 4ec7fcc Update pretty submodule to 1.1.2.0 release c506f25 More comments on HsBang fe0d289 inplace: Don't add empty component to LD_LIBRARY_PATH when it is empty a5bc257 Move libffi configuration after basic toolchain setup 8464fa2 Update Cabal submodule to latest 1.22.0.1 snapshot 0234399 Event Manager: Make one-shot a per-registration property 0fa4240 aclocal.m4: fix == bashism in FIND_LLVM_PROG 07ace5c add -th-file which generates a th.hs file 099b767 Package environments 7637810 Trac #9878: Have StaticPointers support dynamic loading. c9532f8 Fix panics of PartialTypeSignatures combined with extensions 36df098 Dwarf generation fixed pt 2 2a103c7 Improve documentation for -N and -qa (#9890) 24bbc3e Allow the linker to run concurrently with the GC adc542d Compile the RTS with -g by default cf8e669 Optimise scavenge_large_srt_bitmap 0afa37a Correct typos in comments to mkDataCon 6b0cf0e Tighten up constraint solve order for RULES e4cb837 Tiny refactoring (shorter, simpler code) 7884132 Refactor handling of SPECIALISE pragmas (Trac #5821) c823b73 Test Trac #5821 c71fb84 Add Eq, Ord, Show, and Read instances for Const fb7c311 Repsect the package name when checking for self-import 854e7b8 Fix a terrible bug in the canonicaliser which led to an infinite loop 6392df0 Don't hardcode the name "ghc" in versionedAppDir fffbf06 Trac #9878: Make the static form illegal in interpreted mode. 11881ec API Annotations tweaks. 2edb4a7 Trac #9384: fix increasing capabilites number for eventlog. 3ea40e3 Fix the 'builder' code for pattern synonyms with type signatures 9a14582 Add missing argument in Match, a merge bug (apologies) ff4733f Update bytestring submodule 1289048 Fix bad '... \\' escape in ghcversion.h generation 8e774ba Improve documentation of pattern synonyms, to reflect conclusion of Trac #9953 4cfd235 Test Trac #9867 e1a4581 Revert "Fix undefined GHC.Real export with integer-simple" f006ed7 Revert "Add export lists to some modules." d839493 Make AutoDeriveTypeable work for associated datatypes (fix #9999) 55199a9 Split stripTicks into expression editing and tick collection 8ce3871 Update directory submodule to latest 1.2.2 snapshot 960e3c9 Add missing test from previous commit (55199a97) 851ed72 API Annotations documentation update, parsing issue, add example test cb65bdb Doc fix (follow up to #9957) d3c08ca Tidy up fix to Trac #9999 1f15951 Respect package visibility when deciding wired in packages. c77eecd Upgrade Cabal submodule to latest HEAD, change to package key calculation. c024af1 Expose source locations via Implicit Parameters of type GHC.Location.Location d82f592 CMM: add a mechanism to import C .data labels 9894f6a comments only 6108d95 Make the linker_unload test less fragile cf0e100 Cosmetic: Fix all uses of the word 'worker' when referring to pattern synonym builders 387f1d1 32-bit performance wibbles 3992a6e Test Trac #9975 bec932e Some simplification and refactoring of FunDeps f3e6271 cmm lex: drop unused 'align' token bef8b79 compiler/parser/cutils: drop unused 'ghc_memcmp_off' helper ca15376 Update Backpack document with examples [skip ci] 79b0d0e Restore invariant in `Data (Ratio a)` instance 22c4d60 Revert "Restore invariant in `Data (Ratio a)` instance" 027acf6 Merge branch 'master' of ssh://git.haskell.org/ghc 8a29493 Update a few performance numbers ccbe2b8 Revert "32-bit performance wibbles" e675664 32-bit performance wibbles (second attempt) 3df429e Restore invariant in `Data (Ratio a)` instance f2867dc Update binary submodule to 0.7.3.0 release 34d68d8 Update Haddock submodule febee92 Revert "Update Haddock submodule" f44bbc8 Revert zipWith strictification (re #9949) b906370 RTS : Fix StgRun for aarch64-linux (#9935). 0af1b73 Add cost semantics for STG profiling. cecf036 Fix #10031 by inverting a critical test in kick_out. cf3e340 update submodule 276da79 Improve error message on typed holes, and user manual (Tradc #10040) 07ee96f Use strict atomicModifyIORef' (added in GHC 7.6). 92c9354 Fix #10017 daed18c Fix a profiling bug 78216e2 fix _FILE_OFFSET_BITS redefined warning on Solaris/i386 platform c88e112 Bring Match m_fun_id_infix through the renamer. d4f25cb GRHS with empty wherebinds gets wrong SrcSpan ae39c5c Add packageName to GHC.Generics.Datatype 7cf87fc Eta-expand argument to foldr in mapM_ for [] 73f976c Make -ddump-splices output to stdout (fixes #8796) 2f13cd8 Comments only da78af3 Comments only 111e587 Put parens around (ty :: kind) when pretty-printing TH syntax dda6528 Fix the nullary-type-class case for associated types 0f75a3f Test Trac #10041 43636e1 Fix Trac #10004: head [] exception when using recursive mdo 9bc13c0 Remove the *o pattern in testsuite/.gitignore a741e69 Provide default implementation of `Monad(return)` 83efb98 Replace .lhs with .hs in compiler comments e22282e Remove deprecated libraries/base/include/Typeable.h de9a836 Clarify the documentation for 'evaluate' a1db53c Add a workaround to allow older cabal-install to use ghc-7.10 d5a80db Add Uniquable instances for InstalledPackageId/SourcePackageId/PackageName 5d5abdc llvmGen: move to LLVM 3.6 exclusively 78833ca Don't overwrite input file by default f46360e Refactor the handling of quasi-quotes 1e651b9 Comments only 12698ff More comments and white space 1e58ed8 Add a couple of tcTraces around reify 1d982ba Do not complain about missing fields in Trac #10047 3568bf3 Do not share T9878.hs between test T9878 and T9878b 6ff3db9 nameIsLocalOrFrom should include interactive modules befe2d7 Fix #10079 by recurring after flattening exposes a TyConApp. d5cd94d Fix egregious typo in checkTauTvUpdate. 849e25c Propagate ReturnTvs in matchExpectedFunTys b45309f Comments and white space; plus structurally avoiding the previously "egregious bug" 6be91dd Tiny refactoring; no change in behaviour b96db75 Refactor decideQuantification 7fdded4 Improve documentation of 'trace' 36f2ad5 Comments only 5ab7518 Improve typechecking of RULEs, to account for type wildcard holes 6fa285d Move comments about evaluating the message to the top of the module 49d99eb Fix typo in error message 555eef1 Remove RAWCPP_FLAGS (Task #9094) 310b636 Add missing va_end to va_start a82364c Don't truncate traceEvents to 512 bytes (#8309) e7fab33 Improve outdated ghc-pkg cache warning (#9606) 08102b3 Delete vestigial external core code (#9402) 1b82619 Add configurable verbosity level to hpc 91d9530 Revert "Eta-expand argument to foldr in mapM_ for []" 9caf71a Do not clobber CPPFLAGS nor LDFLAGS, fixes #10093 6d17125 runghc: be explicit about ghc version (#9054) 32d1a8a Cleanup ghc-pkg 35d464b Typo in function name e9d72ce Fix #10045 ef391f8 Comments only 3f30912 fix T7600 run on bigendian platform 10fab31 Don't report instance constraints with fundeps as redundant 9c78d09 Add a bizarre corner-case to cgExpr (Trac #9964) f3e5c30 Comments only 5f675e5 Comments only 5094719 Comments only 547c40a [ci skip] comment typo d4b6453 Unbreak travis by installing llvm-3.6 1f60d63 {Data,Generic(1),MonadZip} instances for Identity b2be772 fix bus errors on SPARC caused by unalignment access to alloc_limit (fixes #10043) 0fa2072 Error out on `Main` without `main` in GHCi (#7765) bbb57a6 Make top-level "configure" accept and propagate --with-curses-{includes,libraries} to libraries fd581a7 Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors 30dc59e Always ignore user-package-db when running tests a0ef626 Declare some Makefile targets to be PHONY a293925 rts/linker: ignore unknown PE sections 47175e0 Show '#' on unboxed literals 9a1c8d9 docs: add INSTALL.md to root dir (#9926) c3f9eb4 docs: Flatten MAKEHELP/SUBMAKEHELP 266fa70 base: fix broken link (#10088) 9004f0d Fix build bogons due to missing separator 4f467b2 base: Fix (**) implementation for Data.Complex a5a4c25 Provide a faster implementation for the Read Integer instance d1d02e8 testsuite: update .gitignore bb3b71a System.IO.Error: Fix a documentation link to Control.Exception.Exception 26a85bd Comment typo aead019 driver: split -fwarn-unused-binds into 3 flags (fixes #17) 5be8ed4 Emulate GMP 5+ operations for GMP 4.x compat 00c971e Update submodule to Cabal 1.22.1.0 release 7a3d7c0 Fix comments, and a little reformatting ea3b4cf Axe ModFinderCache, folding it into a generalized FinderCache. b7f7889 AllocationLimitExceeded should be a child of SomeAsyncException 1def53f Update process submodule to 1.2.3.0 snapshot c5977c2 Extend the docs for Data.List.transpose 7727371 Comments only 9b3239f Improve comments on coreView/tcView, and combine coreExpandTyCon/tcExpandTyCon 104c0ad Test Trac #10112 52dfa61 Comments only cabe174 Two kind-polymorphism fixes (Trac #10122) d2e6a3b Improve documentation of infinite inlining bug 5692643 Show record construction/update without parens 6cdccb4 fix typos in coreSyn 1dfab7a Fix detection of llvm-x.x ca478ac Fix typecheck tests (--slow) 31d4f2e `make test` in root directory now runs fulltest efbd3eb Removed unused constrained which causes build to fail with -Werror 3197018 Typos in non-code c3eee14 Improve if-then-else tree for cases on literal values 5bdfb9b Small emitCmmSwitch/emitCmmLitSwitch refactoring 1da3bbd Give full-precision time for BEGIN_SAMPLE/END_SAMPLE. f6609b0 Cite the TrieMap idea [skip-ci] 5200bde Replaced SEH handles with VEH handlers which should work uniformly across x86 and x64 89458eb Pretty-print # on unboxed literals in core 4e6bcc2 Add various instances to newtypes in Data.Monoid a0cea7b Don't use deriveUnique *twice* in flattenTys. 6e77d45 Clarify some comments in Packages.hs [skip-ci] e673b84 Fix -Werror build failure in RtsMain ee56dc5 Tidy up and improve comments about one-shot info d058bc9 Some minor refactoring in TcHsType f66e0e6 A raft of small changes associated with -XConstrainedClassMethods ef2c7a7 Comments only 3aa2519 Check for equality before deferring 9dc0d63 Three other test updates following the fix to Trac #7854 e73c0de travis: Get libstdc++ from a more sensible location 8a5d320 Remove unused/undocumented flag `-fhpc-no-auto` 56e0ac9 Add public rnf/hash operations to TypeRep/TyCon 44b6bbd libraries: update deepseq submodule b833bc2 User manual section to document the principles of kind inference 7b486a6 testsuite: accept updated output 48f32a8 Typos in docs [ci skip] 41df51d Update shift/reduce commentary in Parser.y 91c11fe testsuite: format commands using config dict 1965202 Drop redundant LANGUAGE pragmas eb3661f Re-export `<$>` from Prelude (#10113) 479523f Re-export `<$` from Prelude (#10113) b359c88 Custom `Typeable` solver, that keeps track of kinds. 34ba68c Add missed test (uuugh) 504d8a4 Don't assume tools are in same directory as ghc in some cases 76b1e11 Improve core linter so it catches unsafeCoerce problems (T9122) 0fcc454 Dynamically link all loaded packages in new object e642de6 build: fix 'make help' 68d4f47 Store renamings as (ModuleName, ModuleName) pairs. 47b5b5c base: drop redundant Typeable derivings 7a2d65a Define proper `MINIMAL` pragma for `class Ix` e76f866 Add `GHC.OldList` legacy module 8b7534b Update process submodule 2aef320 hsc2hs: update submodule c439af5 Refactor Digraph to use Data.Graph when possible d01844f Remove obsolete comment in cmmOffset f9344f3 Fix `ghc --make -fhpc` with imported lhs modules fe3cf4d Revert "Refactor Digraph to use Data.Graph when possible" 6188d0a Refactor Digraph to use Data.Graph when possible 74625d6 RTS/IOManager: fix trac issue #9722. c4ac3c9 Merge branch 'master' of git://git.haskell.org/ghc c1db477 Changes to Safe Haskell documentation from feedback (#10140). 19440ae ghc-prim : Hide 64 bit primops when the word size is 32 bits (fixes #9886). fdb7283 Update submodule to Cabal 1.22.1.1 release 0281c98 Update array submodule (min ver bump to 0.5.1.0) d2a5ea1 Sync up terminfo/haskeline submodule with ghc-7.10 b03479d Update directory submodule to latest 1.2.2 snapshot 8a91079 Documentation for PackageArg/ModRenaming/PackageFlag 8cbd7f5 Refactor testsuite with normalise_version() 838d804 Update Cabal submodule to latest 1.22 snapshot 5f356f3 Update filepath submodule to filepath-1.4 snapshot 842028b Rename ty{Con,peRep}Hash to ty{Con,peRep}Fingerprint 5258566 Cleanup test framework string formatting 41e8400 Update submodule hpc (includes fix for #9619) ec67f81 testsuite: use same flags for ghci way and scripts 71fcc4c Use the gold linker for linux/ARM and android/ARM targets. cc07a0b Move the function strip_quotes to testutil.py 1b7f597 Link temporary shared objects with `--no-as-needed` 11314b9 We need to import 'cast' on Windows cbc7103 Update Haddock submodule 14b78eb Update Cabal submodule to latest 1.22.1.2 snapshot e935a7f libraries/win32: update submodule 817d2c3 Test Trac #10156 beee618 Fix testsuite driver for a profiling compiler 5166ee9 Dont call unsafeGlobalDynFlags if it is not set 83afcd1 Fix build on amd64/solaris. 9987c66 Fix Windows testsuite driver 9c9e973 Refactor the extra-deps stuff for hs-boot cf6c307 Comments, white space, and small refactoring dbd9299 Move declaration of Rulebase from Rules to CoreSyn 3f3782d Add more MonadZip instances ac14af3 Add release note entry for D716 86eff3d Expose listPackageConfigMap 801f4b9 hpc: use System.FilePath.() instead of (++) 6f40060 Typos in comments fad7bb0 Comments only 3508b68 Remove mention of `-unreg` in error message 6b3a7f4 Update filepath/hpc/process submodules c4aa959 Update Cabal submodule to 1.22 branch tip 9d81980 Remove comments and flag for GranSim c718bd8 Refactor Linker.hs: use System.Directory.findFile d832b6b Refactor: follow hlint suggestions in Linker.hs 3a0019e Improve `Typeable` solver. 48ba1e5 win32/base: Remove redundant import 2ff68c3 libraries: update win32 submodule a07ff3b Merge branch 'master' of git://git.haskell.org/ghc 75ef8b3 Remove unused parameter to `EvTypeableTyCon` e02ef0e testsuite: add a regression test for #10011 c2833d6 Update deepseq submodule to 1.4.1.1 tag 76f385b Modify test th/T10019 to wobble less 9dfdd16 Bump ghc-prim to 0.4.0.0 6da18b8 Try to reconstruct a changelog for TH 2.10 c746f01 Update bytestring submodule to 0.10.6.0 release tag d9e0e16 Update Cabal submodule to Cabal-v1.22.2.0 rls tag 1cc46b1 Correct documentation in `Parser`. 854fd12 testsuite: add test for #10177 899cb3e Update haskeline submodule to 0.7.2.1 release tag 5449b25 Clarify meaning of the RTS `taskCount` variable 29f7c10 New lint check: exprIsHNF = True and alts = [] is bogus 5119e09 Test case for #10176 b4efac5 Trim Call Arity e25ad04 docs: make gen_contents_index --verbose more verbose 12a03c4 fix bus error (misaligned data access) on SPARC in __decodeDouble_Int64 a20cc3d rts: check arguments to flags that don't have any 5ef5a18 Update integer-gmp2's changelog for release cab5b3a Fix integer-gmp source tarball distribution 992040e Minor fix to Note [Trimming arity] f72074e Fix quasiquotation test (#4150) 7035ff8 Minor bump `base` version to 4.8.1.0 1a72886 Update base changelog regarding 4.8.1 changes 0f03a84 Make testsuite driver Python 2.6 compatible again c1edbdf Do proper depth checking in the flattener to avoid looping. 5673bfc exprIsBottom should look through type lambdas a0678f1 New Lint check: no alternatives implies bottoming expression 567db32 New lint check: Check idArity invariants (#10181) 8f08069 Add Note [No alternatives lint check] aef4de4 isEmptyTy: Improve comment 42448e3 Do version specific detection of LLVM tools (#10170). fd17651 Fix bug in hs-libraries field munging. 7062ebe exprIsBottom: Make use of isEmptyTy (#10186) 9cdd2e6 Empty alternative lint check: Explain why there are two checks 484d2b1 Delete DynFlag for NDP way 6cf0c79 Some stress tests for the empty case linter 8eaa70a Improve environment handling in TcBinds 33cfa5f More comments (related to Trac #10180) 9db005a Add Monad instance for `((,) a)` (#10190) 5aa57d0 Fix Git-commit-id detection for RELEASE=YES 90dd11b Remove some unimplemented GranSim primops af45feb Update list of primops that don't get wrappers (#10191) abde5da Rename driver phases C(obj)cpp to C(obj)cplusplus e2f1ffc Rename C(obj)cplusplus to C(obj)cxx a4656eb Doc typofix. e24f638 Renames some files to help with validation cleanup (#10212) de1160b Refactor the story around switches (#10137) c37ee4a Remove an unused include that doesn't exist on OS X (#10211) b1d6a60 Delete unused field `PipeEnv.pe_isHaskellishFile` 5971ad5 Syntax check package-qualified imports (#9225) 1f69f37 Add `integer-gmp` specific hint to build.mk.sample 995e8c1 Drop old integer-gmp-0.5 from GHC source tree a3d0a7a Testsuite: suppress errors when running GS on bad.ps 9e073ce Explicitly check for -C on registerised build (#7563) 6981862 Don't throw exception when start_phase==stop_phase (#10219) da17f99 Don't treat .hcr and .raw_s as haskellish suffixes 8757e2d Testsuite: redirect stderr to /dev/null when running GS on bad.ps 694c4d5 uBackpack: simplified Backpack description. d4cf705 Don't `make accept` output of expect_broken tests 7cec6c7 Change which files --make thinks are 'Haskellish' (#10220) 3749c05 Reformat build flavours in build.mk.sample (#10223) 43351ff Filter out `-Rghc-timing` for V=0 builds (#10223) f15dbc2 Indentation only. 0721e55 Fake (->) fixity declaration (#10145) 9b66a7f Do not set -fasm explicitly in build.mk.sample (#10223) 4c1e1c8 Disable same warnings for normal builds as for validate (#10223) afcfb62 Change 'Tab character' warnings so there is one per file (#9723) 47f821a libffi: backport noexecstack fix for x86/win32.S 48977c8 Fix validate linenumber off-by-one 13a0d5a clarify --no-as-needed is only needed on ELF 78c79e3 docs: remove unused -ddump flags from users guide 59f7a7b Restore unwind information generation 012ea0b parser: allow type-level cons in prefix position 3541f73 Data.Complex: Derive Generic 2255c76 Remove an incorrect statement about -fwarn-tabs fd1099c Don't `make accept` output of `expect_broken_for` tests ab0743f Comments only, mostly typos a0c1c96 testsuite: fix failing amd64/Windows perf tests 54b7dc5 rts/linker: make an error msg a debug msg b0ba054 testsuite: skip T10017 on Windows 89eef44 Whitespace only a1404e8 Update hsc2hs submodule a838d1f CmmSwitch: Do not trip over a case with no (valid) branches 8f07092 Test case for #10246 fef4948 User's guide: .a files can be 2-2.5x larger with -split-objs c81e070 Stop profiling output from running together (#8811) 22eecaf fix '&stg_interp_constr_entry' FFI type to be FunPtr 7209290 fix typo a7ab161 Replace hooks by callbacks in RtsConfig (#8785) 890461e Add +RTS -O to control the minimum old gen size 93f3a64 Add -n to the RTS help output f745b6e Typechecker: refactoring only 0622970 testdriver: delete unused ways b972de0 Suggest how to fix .ghci when it is group writeable (#8248) 9f0f99f Fix a long-standing bug in the demand analyser 547c597 Reduce module qualifiers in pretty-printing c897613 Error msg wibbles from reduced module prefixes 74d2c33 GHC.Prim.Constraint is not built-in syntax cfb6042 Do not quantify over the function itself in a RULE 6ca7b84 Put quotes round a Name in an error message 8b7ceec More aggressive Given/Wanted overlap check 553c518 Look inside synonyms for foralls when unifying 4f8e348 Replace endian test by 64-bit word access in T7600 ab76b09 rts/Linker.c: distinct between DATA and CODE labels when importing cf1d975 Don't repeat package key with -dppr-debug when package info is missing. f1a4e42 The production for `pquals` is incorrect; the specifics are in D803. cf19640 The production for squals is incorrect; see D806 for specifics. eacda92 Test Trac #10148 e6e0415 More error message wibbles a058ad6 Final error message wibble a7524ea Support for multiple signature files in scope. 9e7802f Commit missing T10148 files and ignore the built executable. 1d5c887 Axe one-shot sig-of 3c6448c Ignore temporary ./configure files. 53cc9af Test Trac #8030 6b96eeb Fixes a compiler error with -DDEBUG (#10265) f536d89 Import rand using capi 2d68aa6 Comments about AnyK d9b0be3 Comments in rejigConRes 702fc77 Comments only fa46c59 Make the evidence in a CtGiven into an EvId 9d16808 Typos in error messages and in comments 485dba8 configure : LLVM and LD detections improvements (#10234). edc059a Fix autoconf's check for create_timer() a5745d2 Derive Generic instance for System.Exit.ExitCode c327393 Derive Generic instance for Data.Version.Version 6109b31 use projectVersion from DynFlags rather than cProjectVersion for versionedAppDir 8aefc9b parser: opt_kind_sig has incorrect SrcSpan 9eab6fe parser: API Annotations : guardquals1 does not annotate commas properly 919b511 parser : the API annotation on opt_sig is being discarded d261d4c Zap usage info in CSE (Trac #10218) 25f2d68 Comments only a2ce3af Comments and white space only 7febc2b Add "error:" prefix to error-messages 79bfe27 Remove LlvmCodeGen panic variants. 8dc2944 API Annotations : ExprWithTySig processing discards annotated spans 5fded20 ApiAnnotations : lexer discards comment close in nested comment 6dd2765 Implement -f[no-]print-unicode-syntax flag for unicode syntax output (#8959) 7b042d5 Do not allow Typeable on constraints (Trac #9858) 49d9b00 Fix fundep coverage-condition check for poly-kinds a9ca67f Improve Call Arity performance 9654a7c Call Arity: Trade precision for performance in large mutually recursive groups 1fb4dd3 Add exception for `KnownNat` and `KnownSymbol` in super classes. d8d541d Fixes (hopefully!) T9858 e68e8ca Fix test output. ea579d9 Fix test output 3b90d8c Rename tests so that they have a unique name. 51af102 Better hints when RTS options not available (Trac #9579) 2483644 Documentation for rnImports/rnImportDecl. 2b3766b Comments only. ad6d6a7 Stub out pkgState with non-error, helps with debugging. 619a324 Make T9579 parallel-safe and add build outputs to .gitignore 88b8406 Test case for indirect dependencies in ghci linker (#10322) 4bc925a Update Cabal submodule to 1.22.3.0 release d5773a4 Teach DmdAnal that coercions are value arguments! 3bec1ac Teach DmdAnal about free coercion variables d12c7cb Spelling in comment f2d1b7f Support unboxing for GADT product types 5c7e4db Wibble to DmdAnal b9f20bd GADTs now are CPR-able 1e8c9b8 Enable SMP and GHCi support for Aarch64 0bbc2ac Use the gold linker for aarch64/linux (#9673) 3b932cc Add a blank line 9b9fc4c Fix the boot dfun impedence-matching binding c0b5adb Do not decompose => (Trac #9858) 1bb1ff2 Mark T8743 as passing 1bd1cef Don't use self {-# SOURCE #-} import in test-cases. a2f9fef Fix #10182 by disallowing/avoiding self {-# SOURCE #-} imports 646866f Fix superclass generation in an instance 9d3bd3d Comments only c715166 Improve error reporting for impredicative types 746f086 Better documetation of higher rank types 932f086 Test Trac #9858 comment:101 43d7137 Rename new T9858c to T9858d to avoid test name clash a55bfab Rename new T9858d to T9858e to avoid test name clash 524ddbd Make sure GHC.List.last is memory-efficient 6ab5da9 Rename role annotations w.r.t only local decls. a8d39a7 Fix #10285 by refusing to use NthCo on a newtype. 414e20b Fix the formal operational semantics (#10121) d4cf559 Test #10321 in ghci/scripts/T10321 dc587fe Test case for #10141 72a9272 Change default roles in hs-boot files. (#9204) bbabb71 Updates to Backpack documentation based on recent visit to MSRC. c4e8097 Bump base version to 4.8.2.0 75adc35 Add missing since-annotations for c024af131b9e2538 9a0c179 base: Export GHC.Event(.Internal).Lifetime 5f127fc Flesh out some more Backpack examples in the merging section. d0898ca Backpack docs: explain alternate merging scheme. 541aa7f Full type checking Backpack details. 21a37ca Backpack docs: merge backpack-shaping into algorithm, sigs no longer provide b61562f Seed SpecConstr from local calls 168c883 A little outright bug in canEqTyVar2 d9bb0ee Don't print evidence in TcFlatten a1275a7 Improve improvement in the constraint solver d4a926b Test Trac #10226 54cefbd Typeset Backpack syntax in a figure b83160d Tidy up treatment of FlexibleContexts a3f7517 Typo fixes (mostly in comments) fe5ccbb Typeset Backpack semantic entities in figure, figure-ify all asides. bbfa0ca Comments only f6ab0f2 Refactor TyCon to eliminate TupleTyCon 0d715db Update haddock submodule to track TyCon change b626cb0 Make Derived NomEq rewrite only Derived NomEq de5d022 Kill off the default types in ghc-prim 2f6a0ac Move IP, Symbol, Nat to ghc-prim 4efa421 Permit empty closed type families 63a10bb arm: Force non-executable stack (#10369) f7dfcef Fix safeHaskell test for llvm backend bf4f3e6 Give a hint when a TH splice has a bad package key, partially fixes #10279 cdba973 Documentation for Language.Haskell.TH.Quote. 1a4374c arm: Force non-executable stack (part 2) 341a766 Doc: checkCrossStageLifting, RnSplice/TcExpr is untyped/typed brackets (#10384) f7daf5a Normalise type families in the type of an expression 458a97b Fix typo: identifer -> identifier 03c4893 Retain ic_monad and ic_int_print from external packages after load 477f514 rts: add "-no-rtsopts-suggestions" option fa0474d base: Fix confusing docs typo fb54b2c API Annotations : add Locations in hsSyn were layout occurs caeae1a Correct parsing of lifted empty list constructor 15aafc7 ApiAnnotations : quoted type variables missing leading quote 81030ed ApiAnnotations : Nested forall loses forall annotation f34c072 Revert "ApiAnnotations : Nested forall loses forall annotation" 97d320f Revert "API Annotations : add Locations in hsSyn were layout occurs" d1295da Comments only 931d014 A bit of refactoring RnSplice c3e6b3a Regression test for Trac #10390 5bde9f7 ApiAnnotations : RdrHsSyn.isFunLhs discards parentheses cc9b788 Backpack docs: meditate on AvailTC with four examples. 225df19 ApiAnnotations : AnnComma missing in TupleSection 7136126 ApiAnnotations: misplaced AnnComma for squals production 2601a43 Backpack docs: AvailInfo plan, and why selectors are hard. 28257ca Support stage 1 Template Haskell (non-quasi) quotes, fixes #10382. 21c72e7 Split off quotes/ from th/ for tests that can be done on stage1 compiler. eb0ed40 RnSplice's staging test should be applied for quotes in stage1. 9a43b2c Always do polymorphic typed quote check, c.f. #10384 3c70ae0 Quick fix: drop base bound on template-haskell. 5c459ee Revert stage 1 template-haskell. This is a combination of 5 commits. 811b72a Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. e4032b1 ApiAnnotations : mkGadtDecl discards annotations for HsFunTy 27aa733 IdInfo comment update 2666ba3 haddock: update submodule to fix #10206 cf7573b More accurate allocation stats for :set +s 9736c04 compiler: make sure we reject -O + HscInterpreted 24707d7 ApiAnnotations : BooleanFormula construction discards original f35d621 Fix build breakage from 9736c042 fe38195 ApiAnnotations : pquals production adds AnnVbar in the wrong place ecc3d6b ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. f16ddce Support stage 1 Template Haskell (non-quasi) quotes, fixes #10382. b0784cc Backpack docs: more carefully describe unification versus unioning. b4f6c16 Ignore out and toc files. 53409a7 Backpack docs: proper discourse on ModIface and ModDetails. eecef17 Fix safe haskell bug: instances in safe-inferred 4fffbc3 New handling of overlapping inst in Safe Haskell ef7ed16 Make template-haskell build with GHC 7.6, fixes bootstrap build. c119a80 Use fmap instead of <$> (Fixes #10407) ca7c855 We need an empty boolFormula.stderr f5188f3 Fix weird behavior of -ignore-dot-ghci and -ghci-scipt 6ee4b6f Turn off warnings when compiling boolFormula 1b47692 Backpack docs: Consistently italicize metavariables. 4432863 Update some tests for recent Safe Haskell change. a171cc1 Update Safe Haskell documentation. 4b8b4ce Fix fragile T9579 tests 8764a7e Revert D727 8da785d Delete commented-out line 130e93a Refactor tuple constraints 5910a1b Change in capitalisation of error msg a154944 Two wibbles to fix the build a8493e0 Fix imports in HscMain (stage2) 6e1174d Separate transCloVarSet from fixVarSet 51cbad1 Update haddock submodule ca173aa Add a case to checkValidTyCon eb6ca85 Make the "matchable-given" check happen first c0aae6f Test Trac #10248 a9ccd37 Test Trac #10403 04a484e Test Trac #10359 3cf8ecd Revert multiple commits 3ef7fce Do not check dir perms when .ghci doesn't exist 5972037 Backpack docs: Rewrite type checking section to have a more concrete plan. ab45de1 Failing test for #10420 using plugins. c256357 Speed up elimCommonBlocks by grouping blocks also by outgoing labels 8e4dc8f Greatly speed up nativeCodeGen/seqBlocks 73f836f CmmCommonBlockElim: Improve hash function 3f42de5 Test Trac #10359 f1f265d Test Trac #10403 fa0bdd3 Test Trac #10248 76024fd Delete commented-out line ffc2150 Refactor tuple constraints 228ddb9 Make the "matchable-given" check happen first eaaa38b includes/stg/SMP.h: implement simple load_/store_load_barrier on armv6 and older 85bf9e4 Add regression test for #10110. 5cbac88 user guide: correct documentation for -Wall (fixes #10386) 578d2ba Remove unneeded compatibility with LLVM < 3.6 b03f074 ghci: Allow :back and :forward to take counts b0b11ad In ghci linker, link against all previous temp sos (#10322) b199536 compiler: make sure we reject -O + HscInterpreted 470a949 Revert "In ghci linker, link against all previous temp sos (#10322)" 753b156 Add a TODO FIXME w.r.t. D894 fc8c5e7 Test Trac #8799, #8555 edb8dc5 Revert "compiler: make sure we reject -O + HscInterpreted" (again) 25d1a71 Fix error messages from open(Binary)TempFileWithDefaultPermissions c934914 Backpack docs: Clarifications from today's Skype call. 9f968e9 Fix binary instance for IfaceLitTy c553e98 ApiAnnotations : AST version of nested forall loses forall annotation 0df14b5 ApiAnnotations : parens around a context with wildcard loses annotations c488da8 ApiAnnotatons : AnnDcolon in wrong place for PatBind 369dd0c White space layout only eae703a Reduce magic for seqId c89bd68 Fix quadratic behaviour in tidyOccName 45d9a15 Fix a huge space leak in the mighty Simplifier 7d519da testsuite: commit missing T4945 stdout 4d6c0ee compiler: kill a stray pprTrace in OccName 6694ccf testsuite: handle missing stats files gracefully (#10305) c00f051 Update .mailmap c04571d rts: Fix typo in comment 326989e Add missing name for FFI import (fixes #9950) 70f1ca4 Fix ghci-way tests of -XStaticPointers. 71d1f01 Omit the static form error for variables not in scope. 388448b Build system: don't install haddock .t files (#10410) c591147 ApiAnnotations tweaks ef90466 Testdriver: don't use os.popen in config/ghc ce166a3 Testdriver: do not interfer with MinGW path magic (#10449) 640fe14 Remove unnecessary loadInterface for TH quoted name. e28462d base: fix #10298 & #7695 b0d8ba3 Add liftData function. a138fa1 Testsuite: accept new output for T2507 and T8959a 5ead7d1 Build system: make more targets PHONY 4c7d177 Build system: remove toplevel target `fast` a065a3a Build system: use `mkdir -p` instead of `-mkdir` 51aacde Build system: allow missing config.mk for target clean_% 4de8028 Build system: check $CLEANING instead of $MAKECMDGOALS 47e00ec Build system: don't set CLEANING=NO b0885e4 Build system: whitespace and comments only cd0e2f5 Build system: prevent "--version: Command not found" 0bfd05e Build system: prevent "./Setup: Command not found" a49070e Build system: time's config files have moved 48ed2f1 Build system: always allow me to clean haddock 577d315 Build system: always use `make -r` 0d20d76 Build system: make clean in utils/ghc-pkg should not delete inplace/lib/bin 0a159e3 Build system: don't use supposedly local variable inside macro 018fec0 Build system: also clean the inplace wrapper 508a3a3 Build system: don't build runghc if GhcWithInterpreter=NO (#10261) 7db2dec linker_unload working on Windows, fixes #8292. 5a65da4 Don't run T9330fail on Windows, no clobber occurs. #9930 94fff17 Travis: use validate --quiet to prevent hitting log file limits 4756438 Catch canonicalizePath exceptions, fix #10101 a52f144 In ghci linker, link against all previous temp sos (#10322) f5b43ce compiler/specialise: shut match_co up a bit f6ca695 rts: Fix aarch64 implementation of xchg e00910b ApiAnnotations : rationalise tests 7dd0ea7 Update binary submodule to 0.7.5.0 release e6191d1 ApiAnnotations : strings in warnings do not return SourceText e8a7254 Add constraint creation functions to TcPluginM API 1c38325 Fix dropped event registrations 928f536 Use seq rather than (==) to force the size 5eee6a1 Move seqExpr, seqIdInfo etc to CoreUtils 20d8621 Add some missing seqs to Coercion.seqCo d245787 Use named fields in SimplCont.Select constructor 403cfc9 Comments only 931268a Replace tabs with spaces. 98b0b2e Add information about allowed foreign prim args, see #10460. e5be846 Typofix: missing period. (#10460) a27fb46 Add (failing) test case for #7672. f82e866 Newline after type of allocate(). dfdc50d Don't call DEAD_WEAK finalizer again on shutdown (#7170) 34dcf8a Re-center perf numbers for T5631 2f0011a White space only 11d8f84 Treat pattern-synonym binders more consistently 9b73cb1 Refactor the GlobalRdrEnv, fixing #7672 90fde52 Mark sigof02 tests as expect_broken 1189196 Re-do superclass solving (again); fixes #10423 b095c97 Improve constraint tuples (Trac #10451) dbcdfe2 Set 32-bit perf figure d6c01fa Remove redundant import b1b2b44 Test Trac #10423 8a38348 Test Trac #10451 8e5f8cf Test Trac #10466 b2b69b2 Test Trac #10438 091944e compiler: make sure we reject -O + HscInterpreted e796026 build: make haddock a bit less chatty 3758050 Improve FFI error reporting 5688053 Detabify a programlisting in the User's Guide (#10425) 942a074 testsuite: mark test T9938 (#9938) as passing again 7a82b77 newTempName: Do not include pid in basename 2c4c627 Typofixes 6adfb88 Suggest -H to improve GC productivity, fixes #10474. 7b6800c Remove outdated uBackpack docs. 7ea156a Refactor RdrName.Provenance, to fix #7672 cd9c5c6 Allow Any return in foreign prim, fixes #10460. 08558a3 Move liftData and use it as a default definition for Lift. 942cfa4 typo: 'Ture' / 'True' 21d7c85 Travis: Send notifications to author and commiter c69b69d ghc-pkg support query by package-key, fixes #9507 d8f66f1 Re-center perf numbers for haddock.compiler 75c6e06 Build: make configure and ghc-pkg a bit less chatty 14652b5 ghc-cabal: don't warn about missing cabal fields 092082e Build: ./boot && ./configure && make sdist (#8723) cac68d0 Build: remove unnecessary CLEANING/=YES check 5dd0286 Build: remove more unnecessary CLEANING/=YES checks d0063e8 Make validate more quiet e340f6e Testsuite: add/fix cleanup for certain tests 07feab1 Testsuite: ignore `stdcall attribute ignored` (#1288) 0686d76 Testsuite: don't show compile/link info for some tests 7beb477 Travis: allow user forks 761fb7c Fix #10488 by unwrapping type synonyms. 53c1374 Minor code cleanup 61b96a8 Fix #10489 dcaaa98 docs: Fix #10416 ae83a81 Testsuite: only show output diff when test is expected to pass 328c212 Fix the sdist build 89223ce Fix the build when SplitObjs=YES 19ec6a8 Fix for CAF retention when dynamically loading & unloading code 7944a68 Revert "docs: Fix #10416" 058af6c Refactor wild card renaming a48167e build: Clean testsuite before sdist 3b55659 Always force the exception in enqueued commands bb99671 Revert "The test runner now also works under the msys-native Python." 43ebe24 Testsuite: delete expect_fail setups for hugs 3445947 Testsuite: delete expect_fail setups for ghc < 7.1 4a0b7a1 Build: run autoreconf jobs in parallel 5828457 make sdist: distclean testsuite for real (#10406) ca39b96 docs: Fix #10416 ddbb97d Another major improvement of "improvement" c0dc79f IndTypesPerfMerge no longer seems to requre -M20M a66ef35 Fix DWARF generation for MinGW (#10468) c1dc421 Update submodule process to master da84fd5 Testsuite Windows: fix T8172 (#8172) a765f72 Testsuite: mark tests as expect_broken on win64 506522c Testsuite: mark T4945 as expect_broken (#4945) 6cefeb3 Testsuite: mention the existence of ticket #10510 5e66a69 Testsuite: change some expect_fail tests to expect_broken a4318c6 Travis: use apt-get -q 0db0ac4 Removes all occurrences of __MINGW32__ (#10485) 23582b0 Add failing test for #9562. 28e04de Remove redundant tcg_visible_orphan_mods, it is recorded in imp_orphs. bac927b Revert "Support for multiple signature files in scope." c60704f Revert "Change loadSrcInterface to return a list of ModIface" ce53138 Delete _MSC_VER when not necessary, fix #10511 016bbfd docs: Fix unicode alternatives table (fixes #10509). 0ef7174 Squash typos in comments c14bd01 Testsuite: fix the little known CHECK_FILES_WRITTEN=1 d20031d Add parseExpr and compileParsedExpr and use them in GHC API and GHCi 892c3e9 Do not copy stack after stack overflow, refix #8435 dd5cac7 Fix typo in `traceShowM` haddock comment (#10392) 0a086c8 Docs: it's `gv --orientation=seascape` nowadays (#10497) b07dccc Docs: `-XTypeOperators` (#10175) e02a4f2 Add versioning section to Backpack docs. 5ddd904 Testsuite: diff non-whitespace normalised output (#10152) 6e542a6 Testsuite: add function compile_timeout_multiplier (#10345) a508455 UNREG: fix pprHexVal to emit zeros (#10518) 1cf7fc0 add type annotations to SrcLoc functions dd3080f Increase constraint tuple limit to 62 (Trac #10451) a607011 Test Trac #10348 77e5ec8 Demonstrate that inferring Typeable for type literals works efa136f Remove derived CFunEqCans after solving givens a3f6239 GHCi: fix scoping for record selectors a6cbf41 Spelling in comments 855f56b Improved peak_megabytes_allocated 2613271 Testsuite: fix framework failure 89c7168 Fix #10534 df63736 ghc.mk: Update instances of -auto-all 1ff7f09 Lexer: Suggest adding 'let' on unexpected '=' token 0d6c97b Lexer: Suggest adding 'let' on unexpected '=' token a90712b users_guide: Various spelling fixes d46fdf2 users_guide: Various spelling fixes 681973c Encode alignment in MO_Memcpy and friends a0d158f Encode alignment in MO_Memcpy and friends c772f57 Fix #10494 0de0b14 Fix #10495. ace8d4f Fix #10493. 6644039 Test case for #10428. ff82387 Decompose wanted repr. eqs. when no matchable givens. 93f97be (mostly) Comments only f108003 Testsuite wibble around decomposing newtypes. 7eceffb Refactor handling of decomposition. 9b105c6 Reimplement Unify.typesCantMatch in terms of apartness. 298c424 Treat funTyCon like any other TyCon in can_eq_nc. a6b8b9c Fix typo in comment daf1eee Clarify some comments around injectivity. 65d4b89 Add `Monoid` instance for `IO` f063656 Fix ghc-pkg reports cache out date (#10205) 0760b84 Update foreign export docs, fixes #10467 b98ca17 Make enum01/enum02/enum03 tests clang-compatible 023a0ba Care with impossible-cons in combineIdenticalAlts 5879d5a Report arity errors correctly despite kinds f4370c6 Comments only 4a7a6c3 Rename getCtLoc, setCtLoc 02bac02 Remove some horrible munging of origins for Coercible 760b079 A bit more tracing 0899911 Comments plus tiny refactoring ee64369 Refactor filterAlts into two parts 5d98b68 Trac #4945 is working again 72b21c3 Parser: commas_tup_tail duplicate SrcSpan on "Missing" value ba7c8e5 Test Trac #10503 c45f8ce Elaborate test for Trac #10403 40698fe Spelling in comments e283cec testsuite: mark T4945 as expect_broken 440d1bc docs: Unbreak the PS/PDF builds for the User's Guide (#10509) 7d5a845 should_run/allocLimit4: disable ghci way e491803 Amend tcrun024, tcrun025 after Trac #7854 fix 7c2293a Amend tcrun037 after Trac #7854 fix 2c6a041 Fix a couple of tests for GHCi/-O* (Trac #10052) 5cc08eb Recognise 'hardhloat' as a valid vendor in a host tuple f2ffdc6 Updated output for test ghci024 85d5397 Make GHC install libraries to e.g. xhtml-3000.2.1-0ACfOp3hebWD9jGWE4v4Gh. 0cb1f5c Filter orphan rules based on imports, fixes #10294 and #10420. 29bc13a Fix all.T for T8131/T8131b. 15ef5fc Remove duplicate test. 13ba87f Build system: unset HADDOCK when haddock is not found 4854fce Change `Typeable` instance for type-lis to use the Known* classes. 38f3745 Add parsePattern parser entry point b5a2e87 Documentation: add section on .haskeline file (#2531) e60dbf3 Check KnownSymbol => Typeable deduction f70fb68 Use -package-id to specify libraries on command line. 6c5a66a Fix #10551 by using LIB_NAMES. 01f7e44 Rename $1_$2_$3_LIB_NAME to LIB_FILE. 55843f1 Further elaborate Trac #10403 test c084796 powerpc: add basic support for PLT relocations (#10402) 73a6265 Make $1 in $1_$2_$3_FOO actually be directory. 95d5031 Build system: delete unused variables in config.mk.in ece2c43 Drop prefix from package keys. aa26731 Clean outdated ext-core references in comments. 4d1316a driver: pass '-fPIC' option to all CC invocations 9a34864 Improve kind-checking for 'deriving' clauses c7b6fb5 Test Trac #10562 a2f828a Be aware of overlapping global STG registers in CmmSink (#10521) a7eee0d Comments only 3edc186 White space only 9195927 Improve pretty-printing for CoPat ff8a671 Use a Representaional coercion for data families 0b7e538 Allow recursive unwrapping of data families cc0dba1 Minor fix to free-vars in RnTypes 9014a7e Fix addDataConStrictness b69dc73 Don't float out alpha[sig] ~ Int 97e313c Add module header to test 2f16a3b Get rid of irrlevant result type signature 95fc6d5 Get rid of irrelevant impredicative polymoprhism fb7b692 Treat out-of-scope variables as holes b98ff25 Error message wibbles from out-of-scope changes 0aaea5b Tiny refactor plus comments be0ce87 Fix for crash in setnumcapabilities001 111ba4b Fix deadlock (#10545) 7c8ffd3 GHCi docs: layout rule is respected inside :{ :} cbd9278 Comments only caf9d42 Small doc fixes 0696fc6 Improve CPR behavior for strict constructors 7c07cf1 closeOverKinds *before* oclose in coverage check 614ba3c Kill off sizePred 8e34783 Make fvType ignore kinds a64a26f Better tracing and tiny refactoring ceb3c84 Improve error message for Typeable k (T k) 0e1e798 Test Trac #10524 8d221bb Test #10582 89834d6 Add -fcross-module-specialise flag 302d937 Add -fcross-module-specialise flag bb0e462 Mask to avoid uncaught ^C exceptions 9b5df2a Update performance numbers due to #10482 c6bb2fc Correct BangPat SrcSpan calculation c495c67 Build system: remove unused variable CHECK_PACKAGES 897a46c Testsuite: accept T2592.stderr (minor changes) 6b9fc65 Testsuite: put extra_run_opts last on command line daa5097 Build system: prevent "warning: overriding commands for target..." bbf6078 disable check for .init_array section on OpenBSD 9aa0e4b ghc-pkg: use read/writeUTF8File from Cabal bdd0b71 bin-package-db: copy paste writeFileAtomic from Cabal bdf7f13 Build system: rename bindist to bindist-list... d3c1dda Implement PowerPC 64-bit native code backend for Linux b5e1944 Use `+RTS -G1` for more stable residency measurements (#9675) 1d6ead7 Enable using qualified field of constructor in GHCi f856383 Fix Trac #10519 f07b7a8 Remove unnecessary OrdList from decl parser. 6400c76 users_guide: Describe order-dependence of -f and -O flags e4bf4bf Remove redundant parser entry point 8b55788 Add "since" column for LANGUAGE extensions in user guide 39d83f2 Generalize traceM, traceShowM (fixes #10023) 6b01d3c parser: Allow Lm (MODIFIER LETTER) category in identifiers 889c81c Fix some validation errors. 69beef5 Replace usages of `-w` by `-fno-warn`s b1d1c65 Support MO_{Add,Sub}IntC and MO_Add2 in the LLVM backend 124f399 Testsuite: add -ignore-dot-ghci to some tests ced27de Remove dead code / overlapping pattern (#9723) a4b0342 Lexer: remove -fno-warn-unused-do-bind aa778c8 Comments only [skip ci] c875b08 Use -fno-warn-unused-imports instead of hiding `ord` 8e12a21 Lexer.x and Parser.y: delete dead code 5d48e67 Easy way to defer type errors (implements #8353) 3fabb71 Fix typo [skip ci] (#10605) 75de613 rts: fix incorrect checking start for -x arguments (#9839) edb2c54 Remove Hugs specific test setups (omit_compiler_type) 7a3d85e Remove all *.stderr/stdout-hugs files 4681f55 Specialise: Avoid unnecessary recomputation of free variable information 2765fcf Remove warnings for -fwarn-incomplete-patterns a07898e Spelling in comments 9180df1 Fix offset calculation in __stg_gc_fun aaa0cd2 Don't eagerly blackhole single-entry thunks (#10414) d27e7fd Add more discussion of black-holing logic for #10414 d59cf4e Fix "CPP directive" in comment db530f1 Add Note [Warnings in code generated by Alex] 37de4ad Build system: don't set GhcLibWays explicitly in build.mk.sample (#10536) 62fcf05 Fix word repetitions in comments ebfc2fb Update comments around blackholes f753cf1 Allow deferred type error warnings to be suppressed 31580e2 Fix todo in compiler/nativeGen: Rename Size to Format 9a3e165 Deferred type errors now throw TypeError (#10284) 5857e0a fix EBADF unqueueing in select backend (Trac #10590) 6d69c3a Generalize `Control.Monad.forever` d03bcfa always use -fPIC on OpenBSD/AMD64 platform 00c8d4d Fix #10596 by looking up 'Int' not 'Maybe Int' in the map. 1967a52 Export more types from GHC.RTS.Flags (#9970) 8800a73 Backpack: Flesh out more Cabal details d71b65f holePackageKey and isHoleModule utility functions. 3d5f8e7 Unbreak Windows build: delete unusud throwIOIO 6f9efcb Delete duplicate "Note [Unpack equality predicates]" f3bfa3b Broaden Outputable instance for Termination 85b14a7 Comments only 4f9d600 Fix Trac #10618 (out of scope operator) b29633f Bitmap: Fix thunk explosion 889824d Document RULES and class methods c58dc1a White space only b5aabfb Infer types with flexible contexts 7dcf86f users_guide: Fix errant "a" in RULES/class methods docs a6359f2 Add testcase for #10602 6f1c076 Make mkQualPackage more robust when package key is bad. 0a3c43f Comments only 9e86bf1 Better type wildcard errors 888026d Update .mailmap [skip ci] 2d06a9f Improve error message for fundeps 9b1ebba Delete the WayPar way d69dfba Fix self-contained handling of ASCII encoding ee28a79 T1969: Update max_bytes_used a846088 T876 (32-bit): Update bytes allocated de6597e perf/compiler: Switch to -G1 and update performance metrics b935497 T9872d: Update 32-bit allocations d073c77 Do not optimise RULE lhs in substRule e922847 Add Linting for Rules 7da7b0e Make sure rule LHSs are simplified 875723b Reformat a leading # in a comment d7335f7 Test Trac #10463 02a6b29 Test Trac #10634 946c8b1 Another comment with a leading # (sigh) 2e52057 Build system: comments only [skip ci] ec197d3 Build system: add `make show!` command (#7810) f70f1b6 Build system: delete two unused files 47ebe26 Build system: delete REGULAR_INSTALL_DYNLIBS and INSTALL_DYNLIBS 392ff06 Build system: do not build stm and parallel by default 5764ade Testsuite: delete unused with_namebase 322ae32 Testsuite: delete remaining only_compiler_types(['ghc']) setups 783b79b traivs: Use the new container based travis setup 4dc3877 Testsuite: rename *.stderr-ghc to *.stderr ab5257b Testsuite: delete *.stderr-ghc-7.0 *.stdout-ghc-7.0 4ee658a0 Mark test case for #10294 expect_broken on #10301 0a40278 Flush stdout in test case for #10596 8e6a503 Mark test case for #10294 conditionally expect_broken on #10301 b1063b1 Testsuite: mark T10294 conditionally expect_broken on #10301 348f5ca Build system: delete fingerprint.py [skip ci] a592e9f Remove all references to sync-all 75fd5dc Don't get a new nursery if we exceeded large_alloc_lim 9f978b6 Fix #10642. 74a00bc initGroup: only initialize the first and last blocks of a group 504c2ae Docs: `sortOn = sortBy (comparing f)` [skip ci] 02897c5 Failing test case: idArity invariant check, #10181 e29c2ac CoreUtils: Move seq* functions to CoreSeq ae0e340 CoreUtils: Move size utilities to CoreStats fa33f45 PprCore: Add size annotations for top-level bindings 29f8225 CoreLint: Use size-annotated ppr variant 82f1c78 Fix tests ae96c75 Implement -fprint-expanded-synonyms 415351a Put Opt_Static into defaultFlags if not pc_DYNAMIC_BY_DEFAULT (#7478) 2c5c297 DeriveFoldable for data types with existential constraints (#10447) 2c9de9c Handle Char#, Addr# in TH quasiquoter (fixes #10620) a5e9da8 Fix off-by-one error in GHCi line reporting (Trac #10578) 3448f98 Reduce non-determinism in ABI hashes with RULES and instance decls bc604bd Update assert to fix retc001 and retc002 (#9243) 0d4b074 Travis: actually do debug builds ac0feec Testsuite: small test cleanups f607393 Testsuite: accept new stderr for T9497{a,b,c}-run (#10224) a0371c0 Build system: fail when encountering an unknown package tag dc6e556 Testsuite: mark T2497 expect_broken_for(#10657, ['optasm', 'optllvm']) dcaa486 Testsuite: mark T7919 expect_broken_for(#7919, ['optasm','dyn','optllvm']) 11f8612 Testsuite: mark 3 tests expect_broken_for(#10181, ['optasm', 'optllvm']) 16a8739 Testsuite: mark qq007 and qq008 expect_broken(#10181) cbb4d78 Testsuite: mark qq007 and qq008 expect_broken(#10047) 43dafc9 Testsuite: mark gadt/termination expect_broken_for(#10658, ['optasm','optllvm']) 34bb460 Testsuite: mark array001 and conc034 expect_broken_for(#10659, ['optasm',...]) 9834fea Add regression test for unused implicit parameter warning (#10632) 4c96e7c Testsuite: add ImpredicativeTypes to T7861 (#7861) 7f37274 Testsuite: add -XUndecidableInstances to T3500a 029367e Testsuite: add regression test for missing class constraint 82ffc80 LlvmCodeGen: add support for MO_U_Mul2 CallishMachOp 49373ff Support wild cards in TH splices c526e09 primops: Add haddocks to BCO primops 4cd008b Do not treat prim and javascript imports as C imports in TH and QQ 96de809 Fix primops documentation syntax d71d9a9 Testsuite: fix concprog002 (AMP) 2f18b197 Testsuite: mark concprog002 expect_broken_for(#10661, ['threaded2_hT']) d0cf8f1 Testsuite: simplify T8089 (#8089) b4ef8b8 Update submodule hpc with fix for #10529 0c6c015 Revert "Revert "Change loadSrcInterface to return a list of ModIface"" 214596d Revert "Revert "Support for multiple signature files in scope."" 9ade087 primops: Fix spelling mistake e0a3c44 Delete __GLASGOW_HASKELL__ ifdefs for stage0 < 7.8 8f48fdc Use varToCoreExpr in mkWWcpr_help 3fbf496 Comments only (superclasses and improvement) 3509191 Refactor newSCWorkFromFlavoured 7c0fff4 Improve strictness analysis for exceptions cd48797 Comments and white space only 3c44a46 Refactor self-boot info efa7b3a Add NOINLINE for hs-boot functions aa78cd6 Documents -dsuppress-unfoldings 0df2348 Comments and layout only a0e8bb7 Implement -dsuppress-unfoldings b5c1400 Comments and white space only f1d0480 Avoid out-of-scope top-level Ids 7a6ed66 Comments only 55754ea Fix test T2497 to avoid infinite loop in RULES feaa095 Do occurrence analysis on result of BuiltInRule 00f3187 Make seq-of-cast rule generate a case 35eb736 T4945 is working again f519cb5 testsuite: Show killed command line on timeout 97a50d5 configure: Bump minimum bootstrap GHC version to 7.8 dbe6dac When iconv is unavailable, use an ASCII encoding to encode ASCII 18c6ee2 Travis: use ghc-7.8.4 as stage0 to fix the build d941a89 Validate: by default do show commands a7e0326 Validate: document --quiet [skip ci] 1224bb5 Add utility function isHoleName. 50b9a7a Revert "Trac #4945 is working again" 1b76997 Testsuite: recenter haddock.base allocation numbers b949c96 Eliminate zero_static_objects_list() 0d1a8d0 Two step allocator for 64-bit systems e3df1b1 Validate: explain THREADS instead of CPUS in --help cf57f8f Travis: do pass `--quiet` to validate 0b12aca Switch from recording IsBootInterface to recording full HscSource. adea827 Add ExceptionMonad instance for IOEnv. 144096e Give more informative panic for checkFamInstConsistency. 4a9b40d Export alwaysQualifyPackages and neverQualifyPackages. 939f1b2 Some utility functions for testing IfaceType equality. dd365b1 Use lookupIfaceTop for loading IfaceDecls. 5c3fc92 Fix Trac #10670 9851275 Comments only d784bde Lexer: support consecutive references to Haddock chunks (#10398) d2b4df1 Generate .dyn_o files for .hsig files with -dynamic-too 76e2341 Accept next-docstrings on GADT constructors. e78841b Update encoding001 to test the full range of non-surrogate code points b5c9426 Parenthesise TypeOperator in import hints 1852c3d DataCon: Fix redundant import 4c8e69e rts/sm: Add missing argument names in function definitions 7ec07e4 Slight refactoring to the fix for #4012 608e76c Document type functions in the Paterson conditions e809ef5 ghci: fixity declarations for infix data constructors (#10018) 5ff4dad Add a few comments from SPJ on fixity declarations f9687ca Library names, with Cabal submodule update 45c319f Fix line number in T10018 testcase 30d8349 Comments only e161634 Comments about stricteness of catch# d53d808 Refactoring around FunDeps 6e618d7 Improve instanceCantMatch 09d0505 RetainerProfile: Add missing UNTAG_STATIC_LIST_PTR b04bed0 renamer: fix module-level deprecation message 070f76a -include-pkg-deps takes only one hyphen. 7e70c06 Use isTrue# around primitive comparisons in integer-gmp c55f61c Add missing parentheses in eqBigNatWord# 474d4cc Comment tweaks only f842ad6 Implementation of StrictData language extension 2178273 Add UInfixT to TH types (fixes #10522) 81fffc4 Remove runSTRep from PrelNames bc4b64c Do not inline or apply rules on LHS of rules 2d88a53 Improve warnings for rules that might not fire 09925c3 Revert "RetainerProfile: Add missing UNTAG_STATIC_LIST_PTR" a1e8620 Revert "Eliminate zero_static_objects_list()" e343c0a Test case for #10698 a1dd7dd Fallout from more assiduous RULE warnings f83aab9 Eliminate zero_static_objects_list() 2dbb01a Add a missing check for -fcpr-off fac11f8 Comments only 4e8d74d Deal with phantom type variables in rules 92d2567 Define DsUtils.mkCastDs and use it fa915af Spit out a little more info with -dppr-debug e4114c8 Fix an outright error in competesWith 499b926 Fix Trac #10694: CPR analysis 918dcf8 The parallel package has warnings 2e33b9c Modify spec002 to be less trivial 72d23c3 Better treatment of signatures in cls/inst 24afe6d Fix missing files 5a8a8a6 Don't allowInterrupt inside uninterruptibleMask 9f7cdfe Make configure error out on missing ghc-tarballs on Windows e7c331a Make headers C++ compatible (fixes #10700) 26315ed Fix misspelled function name in a comment 4f80ec0 Improve error message for newtypes and deriving clauses e9ad42d Typos in comments and strings d7c2b01 Fix comment that confused Haddock b5097fe Testsuite: rename rename/should_fail/T5001 to T5001b (#5001) e273c67 Testsuite: mark tests recently fixed as passing + accept new stderr 756fa0a Testsuite: skip T10489 unless compiler_debugged (#10489) 6880277 Testsuite: add arrows/should_compile/T5333 (#5333) 58b5f04 Testsuite: add typecheck/should_fail/T9260 (#9260) 58986c4 Testsuite: add typecheck/should_fail/T8034 (#8034) aee19d0 Testsuite: T10245 is passing for WAY=ghci (#10245) 36bbfbd Backpack docs on renamer and depsolver, also s/package/unit/. a442800 Build system: remove function keyword from configure.ac (#10705) a66e1ba User's guide: delete ancient "Core syntax" example 7cf87df Fix #7919 (again) 353db30 Remove checked-in PDFs. 8f81af9 Typos in comments ad089f5 Give raise# a return type of open kind (#10481) 75504f3 Typos in comments 15dd700 Replace (SourceText,FastString) with StringLiteral data type d9b618f Typo in comment 37227d3 Make BranchFlag a new kind 92f5385 Support MO_U_QuotRem2 in LLVM backend 948e03e Update parallel submodule, and re-enable warnings b38ee89 Fix incorrect stack pointer usage in StgRun() on x86_64 4d8859c Typos in comments d7ced09 Minor improvement to user guide 30b32f4 Test Trac #10134 697079f 4 reduce/reduce parser conflicts resolved d9d2102 Support wild cards in data/type family instances 7ec6ffc Typos in comments [skip ci] 64b6733 CmmParse: Don't force alignment in memcpy-ish operations 30c981e Removed deprecated syntax for GADT constuctors. f063bd5 Fix #10713. b5f1c85 Test #9233 in perf/compiler/T9233 d7b053a Pretty: reformat using style from libraries/pretty (#10735) 9d24b06 Pretty: rename variables to the ones used by libraries/pretty (#10735) 25bc406 Pretty: improve error messages (#10735) 53484d3 Pretty: remove superfluous parenthesis (#10735) 2d1eae2 Pretty: kill code that has been dead since 1997 (#10735) 6f6d082 Pretty: Args of NilAbove/TextBeside/Nest/Union are always RDocs (#10735) 926e428 Pretty: use BangPatterns instead of manual unboxing Ints (#10735) f951ffc Pretty: mimic pretty API more closely (#10735) 85179b5 Pretty: use replicate for spaces and multi_ch (#10735) dd7e188 Add framework flags when linking a dynamic library 4c55f14 users_guide: Add note about #367 to Bugs section 6029748 Drop custom mapM impl for [] ecb1752 Make -fcpr-off a dynamic flag b12dba7 Make Exception datatypes into newtypes 22bbc1c Make sure that `all`, `any`, `and`, and `or` fuse (#9848) fd6b24f Additions to users' guide and release notes 575abf4 Add Fixity info for infix types e2b5738 Allow proper errors/warnings in core2core passes 617f696 Do not complain about SPECIALISE for INLINE a426154 Warn about missed specialisations for imports 49615d9 Comments only ab98860 Minor refactor to use filterInScope 9536481 Tidy up and refactor wildcard handling 28096b2 Fix quantification for inference with sigs 75f5f23 Coments only cc07c40 Comments only 294553e T8968-1 and -3 should pass 64dba51 Test Trac #10742 eca9a1a Ensure DynFlags are consistent 97843d0 base: Add instances 600b153 llvmGen: Rework LLVM mangler aa23054 Add test for #10600 (exhaustiveness check with --make and -fno-code) bc43d23 Rejigger OSMem.my_mmap to allow building on Mac a1c934c base: Add missing Traversable instance for ZipList 6cab3af Big batch of Backpack documentation edits. 79e0a10 Test Trac #10753 a192d6b Comments only f1b4864 Sync base/changelog.md with GHC 7.10.2 release 590aa0f Make oneShot open-kinded 92f35cd cmmCreateSwitchPlan: Handle singletons up-front 2c4a7d3 Update transformers submodule to 0.4.3.0 release f04c7be Fix unused-matches warnings in CmmLex.x a40ec75 Update testsuite/.gitignore [skip ci] b4ed130 Replace HsBang type with HsSrcBang and HsImplBang 2da06d7 User manual update, as prodded by #10760. 2b4710b Add missing to User's guide to fix the build 8cce7e4 Bump template-haskell to new major version 2.11 67576dd Pretty: bugfix fillNB (#10735) bcfae08 Pretty: fix potential bad formatting of error message (#10735) 5d57087 Pretty: fix a broken invariant (#10735) 85bf76a Pretty: show rational as is (#10735) f903949 Pretty: improving the space/time performance of vcat, hsep, hcat (#10735) b0dee61 template-haskell: Add changelog entry to infix type operators 7b211b4 Upgrade GCC to 5.2.0 for Windows x86 and x86_64 e415369 Update mingw tarball location 8c5b087 SysTools: Fix whitespace in error message d2dd5af DynFlags: Prohibit hpc and byte-code interpreter ec68618 Name: Show NameSort in warning 1857191 Testsuite: mark T8089 expect_broken(#7325) on Windows 8906037 Testsuite: mark encoding005 expect_broken(#10623) on Windows ca85442 Testsuite: recenter 2 performance tests on Windows 744ff88 Testsuite: speedup running a single test e367e27 Travis: prevent 10' no output, by setting VERBOSE=2 74897de Make rts/ThreadLabels.c threadsafe for debug runtime. 22aca53 Transliterate unknown characters at output ab9403d Dump files always use UTF8 encoding #10762 b17ec56 Fix rdynamic flag and test on Windows ebca3f8 rts/Printer.c: speed up '-Da' printer for 'LIBBFD' build 18a1567 Add selectors for common fields (DataCon/PatSyn) to ConLike d97e60f Comments reformating/corrections b6be81b Build system: delete half-baked Cygwin support 98f8c9e Delete sync-all a146b28 GhcMake: Fix spelling in comment 0d0e651 Bag: Add Foldable instance 9e8562a Implement getSizeofMutableByteArrayOp primop 3452473 Delete FastBool 2f29ebb Refactor: delete most of the module FastTypes 47493e6 Build system: simplify install.mk.in a1c008b Build system: delete unused distrib/Makefile a5061a9 Check options before warning about source imports. 37a0b50 Delete ExtsCompat46 (#8330) b78494e fix 64bit two-stage allocator on Solaris/AMD64 platform (#10790) fba724c configure.ac: Allow disabling of large-address-space 1c643ba Fix algorithm.tex build and update with some new info. 0f3335f Comments and white space 816d48a Implement lookupGlobal in TcEnv, and use it 711e0bf tcRnDeclsi can use tcRnSrcDecls ac0d052 TcDeriv: Kill dead code de476e9 PrelNames: Clean up list a bit 89d25b9 BinIface: Clean up whitespace 7924469 Clean up handling of knownKeyNames a8601a8 Revert "Clean up handling of knownKeyNames" 28ad98e PrelNames: introduce dcQual in place of conName 211b349 Move newImplicitBinder to from IfaceEnv to BuildTyCl 70ea94c IfaceEnv: Clean up updNameCache a bit f6035bc MkIface: Introduce PatSynId, ReflectionId, DefMethId 7bd8f8f TysWiredIn: Shuffle code around 15c63d2 base: Remove a redundant 'return' 38c98e4 RTS: Reduce MBLOCK_SPACE_SIZE on AArch64 15cb83d Add testcase for #7411 a6826c5 Make Generic (Proxy t) instance poly-kinded (fixes #10775) 1b56c40 Respect GHC_CHARENC environment variable #10762 81ae26d Dwarf: Fix DW_AT_use_UTF8 attribute cbf58a2 Dwarf: Produce {low,high}_pc attributes for compilation units 8476ce2 Dwarf: Produce .dwarf_aranges section 0c823af Fix identifier parsing in hp2ps cd2dc9e ghc-pkg --enable-multi-instance should not complain about case sensitivity. c7f0626 integer-gmp: optimise bitBigNat c1d7b4b StgCmmHeap: Re-add check for large static allocations 60120d2 Fix 7.10 validate 12098c2 Fix typo in pattern synonym documentation. 10a0775 Anchor type family instances deterministically 23a228e Fix #10815 by kind-checking type patterns against known kinds. cdbb30b Refactor according to Simon's suggestions From git at git.haskell.org Sat Sep 19 02:51:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 02:51:56 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #10815 by kind-checking type patterns against known kinds. (b749816) Message-ID: <20150919025156.4AF823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/b749816dbfdea98a558a8f3728ebaeab40180dc4/ghc >--------------------------------------------------------------- commit b749816dbfdea98a558a8f3728ebaeab40180dc4 Author: Richard Eisenberg Date: Mon Aug 31 10:46:01 2015 -0700 Fix #10815 by kind-checking type patterns against known kinds. tcFamTyPats now must take information about the instantiation of any class variables, when checking the instance of an associated type. Getting this to work out required some unexpected refactoring in TcDeriv. TcDeriv needs to look at class instances because of the possibility of associated datatypes with `deriving` specs. TcDeriv worked over the user-specified instances. But any data family instances were already processed, and TcDeriv had no way of finding the rep tycons. Indeed, TcDeriv *re-type-checked* any data family instances in an attempt to rediscover what GHC already knew. So, this commit introduces better tracking of compiled data families between TcInstDcls and TcDeriv to streamline all of this. >--------------------------------------------------------------- b749816dbfdea98a558a8f3728ebaeab40180dc4 compiler/typecheck/TcDeriv.hs | 114 +++++++++++++-------- compiler/typecheck/TcInstDcls.hs | 46 +++++---- compiler/typecheck/TcTyClsDecls.hs | 41 +++++--- compiler/typecheck/TcValidity.hs | 16 +-- compiler/types/TyCon.hs | 16 ++- libraries/Cabal | 2 +- libraries/array | 2 +- libraries/hpc | 2 +- libraries/stm | 2 +- .../tests/indexed-types/should_compile/T10815.hs | 11 ++ testsuite/tests/indexed-types/should_compile/all.T | 1 + .../tests/indexed-types/should_fail/T9160.stderr | 7 +- utils/haddock | 2 +- 13 files changed, 156 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 b749816dbfdea98a558a8f3728ebaeab40180dc4 From git at git.haskell.org Sat Sep 19 02:51:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 02:51:59 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor according to Simon's suggestions (54c012d) Message-ID: <20150919025159.097643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/54c012dff2e0a7728e1bfa8f55c0accbfd2155a6/ghc >--------------------------------------------------------------- commit 54c012dff2e0a7728e1bfa8f55c0accbfd2155a6 Author: Richard Eisenberg Date: Fri Sep 18 22:08:29 2015 -0400 Refactor according to Simon's suggestions >--------------------------------------------------------------- 54c012dff2e0a7728e1bfa8f55c0accbfd2155a6 compiler/typecheck/TcDeriv.hs | 113 +++++++-------------- compiler/typecheck/TcInstDcls.hs | 52 ++++++---- compiler/typecheck/TcRnDriver.hs | 2 +- .../tests/indexed-types/should_compile/T10815.hs | 4 + 4 files changed, 75 insertions(+), 96 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 54c012dff2e0a7728e1bfa8f55c0accbfd2155a6 From git at git.haskell.org Sat Sep 19 02:52:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 02:52:01 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Refactor according to Simon's suggestions (54c012d) Message-ID: <20150919025201.851293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: ad26c54 Testsuite: refactoring only 6740d70 Use IP based CallStack in error and undefined 010e187 Fix trac #10413 ff9432f Add test for updating a record with existentially quantified fields. 296bc70 Use a response file for linker command line arguments #10777 ba5554e Allow annotations though addTopDecls (#10486) c8f623e Expand declaration QQs first (#10047) 28ac9d3 Improve the error messages for class instance errors 3cc8f07 stm: Fix test case 5d7a873 Testsuite: don't warn about missing specialisations e0b3ff0 Testsuite: update expected output 3b23379 Testsuite: mark 4 tests expect_broken_for(#10712, opt_ways) 32a9ead Fix some tests that were broken by D861 c43c8e2 Testsuite: by default run all tests for a single way bd16e0b Testsuite: delete dead code 3744578 Injective type families 5dc88b7 Add test for T10836 (expected broken) 34b106f Accept underscores in the module parser. (Thanks spinda for the fix.) b639c97 Testsuite: fix tcfail220 - Maybe is wired-in now e1293bb Testsuite: only print msg when timeout kills process unexpectedly 79cdb25 Testsuite: ignore line number differences in call stacks (#10834) 85915e9 Make Data.List.foldr1 inline 19c6049 Fix T6018th test failure 64761ce Build system: implement `make install-strip` (#1851) 5c372fe ghc-pkg: don't print ignored errors when verbosity=0 c60c462 user-guide: Add missing tags around body 96b986b EventLog: Factor out ensureRoomFor*Event 062feee tracing: Kill EVENT_STARTUP 2c24fd7 Build system: put each BuildFlavour in a separate file (#10223) b40e559 Build system: simplify *-llvm BuildFlavours (#10223) 1abbacd Build system: cleanup utils/ghc-pkg/ghc.mk dc671a1 SPECIALIZE strictMinimum for Int and Integer c6b82e9 Further simplify the story around minimum/maximum 554be5e Build system: detect when user cloned from GitHub 864a9c4 Build system: remove hack for Mac OSX in configure.ac (#10476) a158607 Build system: delete the InstallExtraPackages variable 330fbbd Build system: make *-cross BuildFlavours consistent (#10223) 8be43dd Build system: cleanup BUILD_DIRS + add lots of Notes e4a73f4 Move GeneralCategory et al to GHC.Unicode 1b8eca1 Build system: check for inconsistent settings (#10157) dbb4e41 HeapStackCheck: Small refactoring 4356dac Forbid annotations when Safe Haskell safe mode is enabled. 23a301a Testsuite: comment out `setnumcapabilities001` (#10860) cdca31e Don't check in autogenerated hs files for recomp013. 3a71d78 Comments on oneShot a870738 Improve rejigConRes (again) 487c90e Add a test for Trac #10806 a7f6909 A CFunEqCan can be Derived 377395e Improve documentation for transform list-comps 50d1c72 Fix broken links in documentation 413fa95 Improve documentation of comprehensions f30a492 Testsuite cleanup 8c0eca3 Add assertions 18759cc Remove redundant language extensions 195af2d Dead code removal, export cleanup 4275028 Code movement 7ad4b3c s/StgArrWords/StgArrBytes/ 89324b8 Testsuite: normalise slashes in callstack output 37081ac Testsuite: mark enum01-enum03 expect_broken(#9399) on Windows 3ec205a CodeGen: fix typo in error message 08af42f hpc: use `takeDirectory` instead of `dropWhileEnd (/= '/')` c8d438f Testsuite: mark T6037 expect_fail on Windows (#6037) 12b0bb6 Account for stack allocation in the thread's allocation counter 14c4090 Pretty: fix unicode arrow operators. 325efac Fix `hp2ps -i-` e66daec DynFlags: remove unused sPgm_sysman (#8689) 8d89d80 Testsuite: add test for #10781 43eb1dc Show minimal complete definitions in ghci (#10847) 8ecf6d8 ApplicativeDo transformation 77662e1 Add namePackage function to template-haskell 48746ff Docs: make sure all libs are included in index.html (#10879) a8406f8 Pass TEST_HC_OPTS in bug1465 and T5792. b749816 Fix #10815 by kind-checking type patterns against known kinds. 54c012d Refactor according to Simon's suggestions From git at git.haskell.org Sat Sep 19 03:00:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 03:00:18 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #10815 by kind-checking type patterns against known kinds. (4d48a25) Message-ID: <20150919030018.076B63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/4d48a25d44c4ae9b458f9d1ee8cc91aceb48450b/ghc >--------------------------------------------------------------- commit 4d48a25d44c4ae9b458f9d1ee8cc91aceb48450b Author: Richard Eisenberg Date: Mon Aug 31 10:46:01 2015 -0700 Fix #10815 by kind-checking type patterns against known kinds. tcFamTyPats now must take information about the instantiation of any class variables, when checking the instance of an associated type. Getting this to work out required some unexpected refactoring in TcDeriv. TcDeriv needs to look at class instances because of the possibility of associated datatypes with `deriving` specs. TcDeriv worked over the user-specified instances. But any data family instances were already processed, and TcDeriv had no way of finding the rep tycons. Indeed, TcDeriv *re-type-checked* any data family instances in an attempt to rediscover what GHC already knew. So, this commit introduces better tracking of compiled data families between TcInstDcls and TcDeriv to streamline all of this. >--------------------------------------------------------------- 4d48a25d44c4ae9b458f9d1ee8cc91aceb48450b compiler/typecheck/TcDeriv.hs | 114 +++++++++++++-------- compiler/typecheck/TcInstDcls.hs | 46 +++++---- compiler/typecheck/TcTyClsDecls.hs | 41 +++++--- compiler/typecheck/TcValidity.hs | 16 +-- compiler/types/TyCon.hs | 16 ++- .../tests/indexed-types/should_compile/T10815.hs | 11 ++ testsuite/tests/indexed-types/should_compile/all.T | 1 + .../tests/indexed-types/should_fail/T9160.stderr | 7 +- 8 files changed, 151 insertions(+), 101 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 4d48a25d44c4ae9b458f9d1ee8cc91aceb48450b From git at git.haskell.org Sat Sep 19 03:00:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 03:00:20 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor according to Simon's suggestions (2c77f16) Message-ID: <20150919030020.DEF9D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2c77f16330c6c0768c7effc94e99e1b30d7fba8a/ghc >--------------------------------------------------------------- commit 2c77f16330c6c0768c7effc94e99e1b30d7fba8a Author: Richard Eisenberg Date: Fri Sep 18 22:08:29 2015 -0400 Refactor according to Simon's suggestions >--------------------------------------------------------------- 2c77f16330c6c0768c7effc94e99e1b30d7fba8a compiler/typecheck/TcDeriv.hs | 113 +++++++-------------- compiler/typecheck/TcInstDcls.hs | 52 ++++++---- compiler/typecheck/TcRnDriver.hs | 2 +- .../tests/indexed-types/should_compile/T10815.hs | 4 + 4 files changed, 75 insertions(+), 96 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 2c77f16330c6c0768c7effc94e99e1b30d7fba8a From git at git.haskell.org Sat Sep 19 14:02:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 14:02:39 +0000 (UTC) Subject: [commit: ghc] wip/rae: Restore context to error messages (a1eb677) Message-ID: <20150919140239.E5A503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a1eb6773f53521744a3503d8a803a3cc41f34b61/ghc >--------------------------------------------------------------- commit a1eb6773f53521744a3503d8a803a3cc41f34b61 Author: Richard Eisenberg Date: Sat Sep 19 09:45:39 2015 -0400 Restore context to error messages >--------------------------------------------------------------- a1eb6773f53521744a3503d8a803a3cc41f34b61 compiler/typecheck/TcDeriv.hs | 20 +++++--- compiler/typecheck/TcInstDcls.hs | 8 ++-- compiler/typecheck/TcTyClsDecls.hs | 21 +++++---- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 42 ++++++++--------- .../tests/typecheck/should_fail/T6018fail.stderr | 54 +++++++++++----------- 5 files changed, 79 insertions(+), 66 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 a1eb6773f53521744a3503d8a803a3cc41f34b61 From git at git.haskell.org Sat Sep 19 14:02:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 14:02:42 +0000 (UTC) Subject: [commit: ghc] wip/rae: Polish some error messages. (9072090) Message-ID: <20150919140242.B0C7F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/9072090a5c72571ce26e10333dab88435d82f91c/ghc >--------------------------------------------------------------- commit 9072090a5c72571ce26e10333dab88435d82f91c Author: Richard Eisenberg Date: Sat Sep 19 09:56:03 2015 -0400 Polish some error messages. >--------------------------------------------------------------- 9072090a5c72571ce26e10333dab88435d82f91c compiler/typecheck/FamInst.hs | 6 +++--- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 18 +++++++++--------- .../tests/typecheck/should_fail/T6018fail.stderr | 22 +++++++++++----------- .../typecheck/should_fail/T6018failclosed.stderr | 10 +++++----- 4 files changed, 28 insertions(+), 28 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 9072090a5c72571ce26e10333dab88435d82f91c From git at git.haskell.org Sat Sep 19 14:26:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 14:26:04 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D1242' created Message-ID: <20150919142604.472263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D1242 Referencing: bb0897f60abcce697a1038baba86923eb8baa971 From git at git.haskell.org Sat Sep 19 14:26:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 14:26:07 +0000 (UTC) Subject: [commit: ghc] wip/D1242: Implement function-sections for Haskell code, #8405 (bb0897f) Message-ID: <20150919142607.4147E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D1242 Link : http://ghc.haskell.org/trac/ghc/changeset/bb0897f60abcce697a1038baba86923eb8baa971/ghc >--------------------------------------------------------------- commit bb0897f60abcce697a1038baba86923eb8baa971 Author: Simon Brenner Date: Sat Sep 19 15:23:51 2015 +0200 Implement function-sections for Haskell code, #8405 Summary: This adds a flag -split-sections that does similar things to -split-objs, but using sections in single object files instead of relying on the Satanic Splitter and other abominations. This is very similar to the GCC flags -ffunction-sections and -fdata-sections. The --gc-sections linker flag, which allows unused sections to actually be removed, is added to all link commands (if the linker supports it) so that space savings from having base compiled with sections can be realized. Supported both in LLVM and the native code-gen, in theory for all architectures, but really tested on x86 only. In the GHC build, a new SplitSections variable enables -split-sections for relevant parts of the build. Test Plan: validate with both settings of SplitSections Reviewers: simonmar, austin, dterei, bgamari Subscribers: erikd, kgardas, thomie Differential Revision: https://phabricator.haskell.org/D1242 GHC Trac Issues: #8405 >--------------------------------------------------------------- bb0897f60abcce697a1038baba86923eb8baa971 compiler/cmm/Cmm.hs | 11 ++- compiler/cmm/CmmBuildInfoTables.hs | 6 +- compiler/cmm/CmmInfo.hs | 2 +- compiler/cmm/CmmParse.y | 4 +- compiler/cmm/CmmUtils.hs | 7 +- compiler/cmm/PprCmmDecl.hs | 26 ++++--- compiler/codeGen/StgCmm.hs | 3 +- compiler/codeGen/StgCmmUtils.hs | 2 +- compiler/ghc.mk | 3 + compiler/llvmGen/LlvmCodeGen/Base.hs | 8 ++- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 4 +- compiler/llvmGen/LlvmCodeGen/Data.hs | 43 ++++++++--- compiler/llvmGen/LlvmCodeGen/Ppr.hs | 4 +- compiler/main/DriverPipeline.hs | 4 ++ compiler/main/DynFlags.hs | 8 ++- compiler/main/HscMain.hs | 2 +- compiler/main/SysTools.hs | 1 + compiler/nativeGen/AsmCodeGen.hs | 7 +- compiler/nativeGen/Dwarf.hs | 12 +++- compiler/nativeGen/Dwarf/Types.hs | 23 +++--- compiler/nativeGen/PPC/CodeGen.hs | 11 ++- compiler/nativeGen/PPC/Ppr.hs | 80 ++++++++++----------- compiler/nativeGen/PprBase.hs | 51 ++++++++++++- compiler/nativeGen/SPARC/CodeGen.hs | 4 +- compiler/nativeGen/SPARC/CodeGen/Gen32.hs | 4 +- compiler/nativeGen/SPARC/Ppr.hs | 58 ++++++++------- compiler/nativeGen/X86/CodeGen.hs | 61 ++++++++-------- compiler/nativeGen/X86/Ppr.hs | 114 ++++++++++++------------------ docs/users_guide/flags.xml | 6 ++ docs/users_guide/phases.xml | 19 +++++ mk/config.mk.in | 11 +++ rts/ghc.mk | 4 ++ rules/build-package.mk | 9 +++ rules/distdir-way-opts.mk | 1 + 34 files changed, 381 insertions(+), 232 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 bb0897f60abcce697a1038baba86923eb8baa971 From git at git.haskell.org Sat Sep 19 14:27:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 14:27:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/d1141' deleted Message-ID: <20150919142742.74B8C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/d1141 From git at git.haskell.org Sat Sep 19 14:28:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 14:28:21 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D1159' deleted Message-ID: <20150919142821.806583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/D1159 From git at git.haskell.org Sat Sep 19 16:08:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 16:08:05 +0000 (UTC) Subject: [commit: ghc] master: Fix #10815 by kind-checking type patterns against known kinds. (2d4db40) Message-ID: <20150919160805.21CBC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d4db40ac07db2fc776d61aac2383608911281ff/ghc >--------------------------------------------------------------- commit 2d4db40ac07db2fc776d61aac2383608911281ff Author: Richard Eisenberg Date: Mon Aug 31 10:46:01 2015 -0700 Fix #10815 by kind-checking type patterns against known kinds. tcFamTyPats now must take information about the instantiation of any class variables, when checking the instance of an associated type. Getting this to work out required some unexpected refactoring in TcDeriv. TcDeriv needs to look at class instances because of the possibility of associated datatypes with `deriving` specs. TcDeriv worked over the user-specified instances. But any data family instances were already processed, and TcDeriv had no way of finding the rep tycons. Indeed, TcDeriv *re-type-checked* any data family instances in an attempt to rediscover what GHC already knew. So, this commit introduces better tracking of compiled data families between TcInstDcls and TcDeriv to streamline all of this. >--------------------------------------------------------------- 2d4db40ac07db2fc776d61aac2383608911281ff compiler/typecheck/TcDeriv.hs | 139 ++++++++++----------- compiler/typecheck/TcInstDcls.hs | 64 ++++++---- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 62 +++++---- compiler/typecheck/TcValidity.hs | 16 +-- compiler/types/TyCon.hs | 16 +-- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 42 +++---- .../tests/indexed-types/should_compile/T10815.hs | 15 +++ testsuite/tests/indexed-types/should_compile/all.T | 1 + .../tests/indexed-types/should_fail/T9160.stderr | 7 +- .../tests/typecheck/should_fail/T6018fail.stderr | 54 ++++---- 11 files changed, 230 insertions(+), 188 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 2d4db40ac07db2fc776d61aac2383608911281ff From git at git.haskell.org Sat Sep 19 16:08:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 16:08:07 +0000 (UTC) Subject: [commit: ghc] master: Polish some error messages. (8ee2b95) Message-ID: <20150919160807.DABED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ee2b9532e3249c652f3bdabaf4ee9e3e3a282b9/ghc >--------------------------------------------------------------- commit 8ee2b9532e3249c652f3bdabaf4ee9e3e3a282b9 Author: Richard Eisenberg Date: Sat Sep 19 09:56:03 2015 -0400 Polish some error messages. >--------------------------------------------------------------- 8ee2b9532e3249c652f3bdabaf4ee9e3e3a282b9 compiler/typecheck/FamInst.hs | 6 ++-- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 34 +++++++++--------- .../tests/typecheck/should_fail/T6018fail.stderr | 40 +++++++++++----------- .../typecheck/should_fail/T6018failclosed.stderr | 18 +++++----- 4 files changed, 49 insertions(+), 49 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 8ee2b9532e3249c652f3bdabaf4ee9e3e3a282b9 From git at git.haskell.org Sat Sep 19 20:15:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 20:15:04 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Polish some error messages. (8ee2b95) Message-ID: <20150919201504.C8AE93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 2d4db40 Fix #10815 by kind-checking type patterns against known kinds. 8ee2b95 Polish some error messages. From git at git.haskell.org Sat Sep 19 20:25:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 20:25:18 +0000 (UTC) Subject: [commit: ghc] wip/rae: Perform a validity check on assoc type defaults. (7b65d54) Message-ID: <20150919202518.5AD493A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7b65d54d4ade0f708c896adab9305869d6d7c2fb/ghc >--------------------------------------------------------------- commit 7b65d54d4ade0f708c896adab9305869d6d7c2fb Author: Richard Eisenberg Date: Sat Sep 19 14:32:44 2015 -0400 Perform a validity check on assoc type defaults. This fixes #10817 and #10899. A knock-on effect is that we must now remember locations of associated type defaults for error messages during validity checking. This isn't too bad, but it increases the size of the diff somewhat. Test cases: indexed-types/should_fail/T108{17,99} >--------------------------------------------------------------- 7b65d54d4ade0f708c896adab9305869d6d7c2fb compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 7 +++++- compiler/typecheck/TcRnDriver.hs | 4 ++-- compiler/typecheck/TcTyClsDecls.hs | 25 +++++++++++++--------- compiler/typecheck/TcValidity.hs | 14 ++++++++++++ compiler/types/Class.hs | 6 +++++- .../tests/indexed-types/should_fail/T10817.hs | 14 ++++++++++++ .../tests/indexed-types/should_fail/T10817.stderr | 6 ++++++ .../tests/indexed-types/should_fail/T10899.hs | 7 ++++++ .../tests/indexed-types/should_fail/T10899.stderr | 4 ++++ testsuite/tests/indexed-types/should_fail/all.T | 2 ++ 12 files changed, 77 insertions(+), 16 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 7b65d54d4ade0f708c896adab9305869d6d7c2fb From git at git.haskell.org Sat Sep 19 20:25:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 20:25:21 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #10347 (aca0015) Message-ID: <20150919202521.7F8983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/aca0015db6e2634602b97ac35a01f5db2db479a1/ghc >--------------------------------------------------------------- commit aca0015db6e2634602b97ac35a01f5db2db479a1 Author: Richard Eisenberg Date: Sat Sep 19 14:37:54 2015 -0400 Test #10347 >--------------------------------------------------------------- aca0015db6e2634602b97ac35a01f5db2db479a1 testsuite/tests/typecheck/should_compile/T10347.hs | 10 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T10347.hs b/testsuite/tests/typecheck/should_compile/T10347.hs new file mode 100644 index 0000000..9187a93 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10347.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE -fwarn-unusued-bindings #-} + +module T10347 (N, mkN) where + +import Data.Coerce + +newtype N a = MkN Int + +mkN :: Int -> N a +mkN = coerce diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index eff8403..6f34db4 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -474,3 +474,4 @@ test('T10632', normal, compile, ['']) test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) test('update-existential', normal, compile, ['']) +test('T10347', expect_broken(10347), compile, ['']) From git at git.haskell.org Sat Sep 19 20:25:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 20:25:24 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update user guide, fixing #10772 (be9a4a5) Message-ID: <20150919202524.406ED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/be9a4a526906177da33a9e8b5117639bf82e509e/ghc >--------------------------------------------------------------- commit be9a4a526906177da33a9e8b5117639bf82e509e Author: Richard Eisenberg Date: Sat Sep 19 14:45:28 2015 -0400 Update user guide, fixing #10772 >--------------------------------------------------------------- be9a4a526906177da33a9e8b5117639bf82e509e docs/users_guide/glasgow_exts.xml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 119de6b..7aaf1a8 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -3017,8 +3017,11 @@ GHC allows type constructors, classes, and type variables to be operators, and to be written infix, very much like expressions. More specifically: - A type constructor or class can be an operator, beginning with a colon; e.g. :*:. - The lexical syntax is the same as that for data constructors. + A type constructor or class can be any non-reserved operator. + Symbols used in types are always like capitalized identifiers; they + are never variables. Note that this is different from the lexical + syntax of data constructors, which are required to begin with a + :. Data type and type-synonym declarations can be written infix, parenthesised From git at git.haskell.org Sat Sep 19 20:25:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 20:25:27 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #10770 (733b203) Message-ID: <20150919202527.931003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/733b2037b4f23fbd602f5004971b2e6a6ec721bc/ghc >--------------------------------------------------------------- commit 733b2037b4f23fbd602f5004971b2e6a6ec721bc Author: Richard Eisenberg Date: Sat Sep 19 15:04:49 2015 -0400 Test #10770 >--------------------------------------------------------------- 733b2037b4f23fbd602f5004971b2e6a6ec721bc testsuite/tests/typecheck/should_compile/T10770a.hs | 8 ++++++++ testsuite/tests/typecheck/should_compile/T10770b.hs | 9 +++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 3 files changed, 19 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T10770a.hs b/testsuite/tests/typecheck/should_compile/T10770a.hs new file mode 100644 index 0000000..611c86e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770a.hs @@ -0,0 +1,8 @@ +module T10770a where + +import Data.Typeable + +main = print $ foo $ Just () + +foo :: Typeable (t a) => t a -> String +foo x = let k = show $ typeOf x in k diff --git a/testsuite/tests/typecheck/should_compile/T10770b.hs b/testsuite/tests/typecheck/should_compile/T10770b.hs new file mode 100644 index 0000000..62ae61c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770b.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fwarn-redundant-constraints #-} +module T10770b where + +f :: (Show a, Show (Maybe a)) => Maybe a -> String +f x = let k = show x in k + +g :: (Show a, Show (Maybe a)) => Maybe a -> String +g x = show x diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 6f34db4..da71c1d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -475,3 +475,5 @@ test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) test('update-existential', normal, compile, ['']) test('T10347', expect_broken(10347), compile, ['']) +test('T10770a', expect_broken(10770), compile, ['']) +test('T10770b', expect_broken(10770), compile, ['']) From git at git.haskell.org Sat Sep 19 20:25:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 20:25:30 +0000 (UTC) Subject: [commit: ghc] wip/rae: Allow TH quoting of assoc type defaults. (3028377) Message-ID: <20150919202530.CFEB03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/30283779ededff80bb07027eef15047a121c0b49/ghc >--------------------------------------------------------------- commit 30283779ededff80bb07027eef15047a121c0b49 Author: Richard Eisenberg Date: Sat Sep 19 15:43:15 2015 -0400 Allow TH quoting of assoc type defaults. This fixes #10811. >--------------------------------------------------------------- 30283779ededff80bb07027eef15047a121c0b49 compiler/deSugar/DsMeta.hs | 21 +++++++++++++++++++-- compiler/hsSyn/HsTypes.hs | 15 +++++++++++++++ testsuite/tests/th/T10811.hs | 7 +++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 42 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index a762810..185d9d7 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -251,7 +251,7 @@ repTyClD (L loc (DataDecl { tcdLName = tc, tcdTyVars = tvs, tcdDataDefn = defn } repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tvs, tcdFDs = fds, tcdSigs = sigs, tcdMeths = meth_binds, - tcdATs = ats, tcdATDefs = [] })) + tcdATs = ats, tcdATDefs = atds })) = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences] ; dec <- addTyVarBinds tvs $ \bndrs -> do { cxt1 <- repLContext cxt @@ -259,7 +259,8 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, ; binds1 <- rep_binds meth_binds ; fds1 <- repLFunDeps fds ; ats1 <- repFamilyDecls ats - ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1) + ; atds1 <- repAssocTyFamDefaults atds + ; decls1 <- coreList decQTyConName (ats1 ++ atds1 ++ sigs1 ++ binds1) ; repClass cxt1 cls1 bndrs fds1 decls1 } ; return $ Just (loc, dec) @@ -376,6 +377,22 @@ repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) = repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ] repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds) +repAssocTyFamDefaults :: [LTyFamDefltEqn Name] -> DsM [Core TH.DecQ] +repAssocTyFamDefaults = mapM rep_deflt + where + -- very like repTyFamEqn, but different in the details + rep_deflt :: LTyFamDefltEqn Name -> DsM (Core TH.DecQ) + rep_deflt (L _ (TyFamEqn { tfe_tycon = tc + , tfe_pats = bndrs + , tfe_rhs = rhs })) + = addTyClTyVarBinds bndrs $ \ _ -> + do { tc1 <- lookupLOcc tc + ; tys1 <- repLTys (hsLTyVarBndrsToTypes bndrs) + ; tys2 <- coreList typeQTyConName tys1 + ; rhs1 <- repLTy rhs + ; eqn1 <- repTySynEqn tys2 rhs1 + ; repTySynInst tc1 eqn1 } + ------------------------- mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name -> HsDataDefn Name -> DsM (LHsTyVarBndrs Name) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 0393cca..8353bb6 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -47,6 +47,7 @@ module HsTypes ( hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, + hsLTyVarBndrsToTypes, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, splitHsFunType, @@ -659,6 +660,20 @@ hsLTyVarLocName = fmap hsTyVarName hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name] hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs) +-- | Convert a LHsTyVarBndr to an equivalent LHsType. Used in Template Haskell +-- quoting for type family equations. +hsLTyVarBndrToType :: LHsTyVarBndr name -> LHsType name +hsLTyVarBndrToType = fmap cvt + where cvt (UserTyVar n) = HsTyVar n + cvt (KindedTyVar (L name_loc n) kind) = HsKindSig (L name_loc (HsTyVar n)) + kind + +-- | Convert a LHsTyVarBndrs to a list of types. Used in Template Haskell +-- quoting for type family equations. Works on *type* variable only, no kind +-- vars. +hsLTyVarBndrsToTypes :: LHsTyVarBndrs name -> [LHsType name] +hsLTyVarBndrsToTypes (HsQTvs { hsq_tvs = tvbs }) = map hsLTyVarBndrToType tvbs + --------------------- mkAnonWildCardTy :: HsType RdrName mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder) diff --git a/testsuite/tests/th/T10811.hs b/testsuite/tests/th/T10811.hs new file mode 100644 index 0000000..3fac190 --- /dev/null +++ b/testsuite/tests/th/T10811.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies #-} + +module Bug where + +$([d| class C a where + type F a + type F a = a |]) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index eea0fa9..85dae8b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -353,3 +353,4 @@ test('T10704', ['T10704', '-v0']) test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) +test('T10811', normal, compile, ['-v0']) From git at git.haskell.org Sat Sep 19 20:25:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Sep 2015 20:25:33 +0000 (UTC) Subject: [commit: ghc] wip/rae: Print associated types a bit better. (b11d032) Message-ID: <20150919202533.98E4A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/b11d0328034b1f3244749c133b65de42dbf02a76/ghc >--------------------------------------------------------------- commit b11d0328034b1f3244749c133b65de42dbf02a76 Author: Richard Eisenberg Date: Sat Sep 19 15:18:40 2015 -0400 Print associated types a bit better. This is part of #10811. It removes the "family" keyword from associated type family declarations, and it adds the "type" keyword to associated type family defaults. >--------------------------------------------------------------- b11d0328034b1f3244749c133b65de42dbf02a76 compiler/hsSyn/HsDecls.hs | 67 +++++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index aefbfa6..047ad14 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -670,7 +670,7 @@ instance OutputableBndr name | otherwise -- Laid out = vcat [ top_matter <+> ptext (sLit "where") - , nest 2 $ pprDeclList (map ppr ats ++ + , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++ map ppr_fam_deflt_eqn at_defs ++ pprLHsBindsForUser methods sigs) ] where @@ -695,7 +695,7 @@ pprTyClDeclFlavour :: TyClDecl a -> SDoc pprTyClDeclFlavour (ClassDecl {}) = ptext (sLit "class") pprTyClDeclFlavour (SynDecl {}) = ptext (sLit "type") pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }}) - = pprFlavour info + = pprFlavour info <+> text "family" pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } }) = ppr nd @@ -885,36 +885,45 @@ return type) default to *. -} instance (OutputableBndr name) => Outputable (FamilyDecl name) where - ppr (FamilyDecl { fdInfo = info, fdLName = ltycon - , fdTyVars = tyvars, fdResultSig = L _ result - , fdInjectivityAnn = mb_inj }) - = vcat [ pprFlavour info <+> pp_vanilla_decl_head ltycon tyvars [] <+> - pp_kind <+> pp_inj <+> pp_where - , nest 2 $ pp_eqns ] - where - pp_kind = case result of - NoSig -> empty - KindSig kind -> dcolon <+> ppr kind - TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr - pp_inj = case mb_inj of - Just (L _ (InjectivityAnn lhs rhs)) -> - hsep [ text "|", ppr lhs, text "->", hsep (map ppr rhs) ] - Nothing -> empty - (pp_where, pp_eqns) = case info of - ClosedTypeFamily mb_eqns -> - ( ptext (sLit "where") - , case mb_eqns of - Nothing -> ptext (sLit "..") - Just eqns -> vcat $ map ppr_fam_inst_eqn eqns ) - _ -> (empty, empty) + ppr = pprFamilyDecl TopLevel + +pprFamilyDecl :: OutputableBndr name => TopLevelFlag -> FamilyDecl name -> SDoc +pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon + , fdTyVars = tyvars + , fdResultSig = L _ result + , fdInjectivityAnn = mb_inj }) + = vcat [ pprFlavour info <+> pp_top_level <+> + pp_vanilla_decl_head ltycon tyvars [] <+> + pp_kind <+> pp_inj <+> pp_where + , nest 2 $ pp_eqns ] + where + pp_top_level = case top_level of + TopLevel -> text "family" + NotTopLevel -> empty + + pp_kind = case result of + NoSig -> empty + KindSig kind -> dcolon <+> ppr kind + TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr + pp_inj = case mb_inj of + Just (L _ (InjectivityAnn lhs rhs)) -> + hsep [ text "|", ppr lhs, text "->", hsep (map ppr rhs) ] + Nothing -> empty + (pp_where, pp_eqns) = case info of + ClosedTypeFamily mb_eqns -> + ( ptext (sLit "where") + , case mb_eqns of + Nothing -> ptext (sLit "..") + Just eqns -> vcat $ map ppr_fam_inst_eqn eqns ) + _ -> (empty, empty) pprFlavour :: FamilyInfo name -> SDoc -pprFlavour DataFamily = ptext (sLit "data family") -pprFlavour OpenTypeFamily = ptext (sLit "type family") -pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type family") +pprFlavour DataFamily = ptext (sLit "data") +pprFlavour OpenTypeFamily = ptext (sLit "type") +pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type") instance Outputable (FamilyInfo name) where - ppr = pprFlavour + ppr info = pprFlavour info <+> text "family" @@ -1325,7 +1334,7 @@ ppr_fam_deflt_eqn :: OutputableBndr name => LTyFamDefltEqn name -> SDoc ppr_fam_deflt_eqn (L _ (TyFamEqn { tfe_tycon = tycon , tfe_pats = tvs , tfe_rhs = rhs })) - = pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs + = text "type" <+> pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where ppr = pprDataFamInstDecl TopLevel From git at git.haskell.org Sun Sep 20 01:23:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 01:23:32 +0000 (UTC) Subject: [commit: ghc] wip/rae: Allow TH quoting of assoc type defaults. (d7d76c3) Message-ID: <20150920012332.ABCE03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/d7d76c3d384baa06318cb46085fa093599634732/ghc >--------------------------------------------------------------- commit d7d76c3d384baa06318cb46085fa093599634732 Author: Richard Eisenberg Date: Sat Sep 19 15:43:15 2015 -0400 Allow TH quoting of assoc type defaults. This fixes #10811. >--------------------------------------------------------------- d7d76c3d384baa06318cb46085fa093599634732 compiler/deSugar/DsMeta.hs | 26 +++++++++++++++++++------- compiler/hsSyn/HsTypes.hs | 15 +++++++++++++++ testsuite/tests/th/T10811.hs | 7 +++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 42 insertions(+), 7 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index a762810..0a5f203 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -251,7 +251,7 @@ repTyClD (L loc (DataDecl { tcdLName = tc, tcdTyVars = tvs, tcdDataDefn = defn } repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tvs, tcdFDs = fds, tcdSigs = sigs, tcdMeths = meth_binds, - tcdATs = ats, tcdATDefs = [] })) + tcdATs = ats, tcdATDefs = atds })) = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences] ; dec <- addTyVarBinds tvs $ \bndrs -> do { cxt1 <- repLContext cxt @@ -259,17 +259,13 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, ; binds1 <- rep_binds meth_binds ; fds1 <- repLFunDeps fds ; ats1 <- repFamilyDecls ats - ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1) + ; atds1 <- repAssocTyFamDefaults atds + ; decls1 <- coreList decQTyConName (ats1 ++ atds1 ++ sigs1 ++ binds1) ; repClass cxt1 cls1 bndrs fds1 decls1 } ; return $ Just (loc, dec) } --- Un-handled cases -repTyClD (L loc d) = putSrcSpanDs loc $ - do { warnDs (hang ds_msg 4 (ppr d)) - ; return Nothing } - ------------------------- repRoleD :: LRoleAnnotDecl Name -> DsM (SrcSpan, Core TH.DecQ) repRoleD (L loc (RoleAnnotDecl tycon roles)) @@ -376,6 +372,22 @@ repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) = repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ] repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds) +repAssocTyFamDefaults :: [LTyFamDefltEqn Name] -> DsM [Core TH.DecQ] +repAssocTyFamDefaults = mapM rep_deflt + where + -- very like repTyFamEqn, but different in the details + rep_deflt :: LTyFamDefltEqn Name -> DsM (Core TH.DecQ) + rep_deflt (L _ (TyFamEqn { tfe_tycon = tc + , tfe_pats = bndrs + , tfe_rhs = rhs })) + = addTyClTyVarBinds bndrs $ \ _ -> + do { tc1 <- lookupLOcc tc + ; tys1 <- repLTys (hsLTyVarBndrsToTypes bndrs) + ; tys2 <- coreList typeQTyConName tys1 + ; rhs1 <- repLTy rhs + ; eqn1 <- repTySynEqn tys2 rhs1 + ; repTySynInst tc1 eqn1 } + ------------------------- mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name -> HsDataDefn Name -> DsM (LHsTyVarBndrs Name) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 0393cca..8353bb6 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -47,6 +47,7 @@ module HsTypes ( hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, + hsLTyVarBndrsToTypes, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, splitHsFunType, @@ -659,6 +660,20 @@ hsLTyVarLocName = fmap hsTyVarName hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name] hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs) +-- | Convert a LHsTyVarBndr to an equivalent LHsType. Used in Template Haskell +-- quoting for type family equations. +hsLTyVarBndrToType :: LHsTyVarBndr name -> LHsType name +hsLTyVarBndrToType = fmap cvt + where cvt (UserTyVar n) = HsTyVar n + cvt (KindedTyVar (L name_loc n) kind) = HsKindSig (L name_loc (HsTyVar n)) + kind + +-- | Convert a LHsTyVarBndrs to a list of types. Used in Template Haskell +-- quoting for type family equations. Works on *type* variable only, no kind +-- vars. +hsLTyVarBndrsToTypes :: LHsTyVarBndrs name -> [LHsType name] +hsLTyVarBndrsToTypes (HsQTvs { hsq_tvs = tvbs }) = map hsLTyVarBndrToType tvbs + --------------------- mkAnonWildCardTy :: HsType RdrName mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder) diff --git a/testsuite/tests/th/T10811.hs b/testsuite/tests/th/T10811.hs new file mode 100644 index 0000000..3fac190 --- /dev/null +++ b/testsuite/tests/th/T10811.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies #-} + +module Bug where + +$([d| class C a where + type F a + type F a = a |]) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index eea0fa9..85dae8b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -353,3 +353,4 @@ test('T10704', ['T10704', '-v0']) test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) +test('T10811', normal, compile, ['-v0']) From git at git.haskell.org Sun Sep 20 01:23:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 01:23:35 +0000 (UTC) Subject: [commit: ghc] wip/rae: Clarify parsing infelicity. (850b3c2) Message-ID: <20150920012335.569FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/850b3c2433cd5fca547074e72ef0f9a0d8c1e44c/ghc >--------------------------------------------------------------- commit 850b3c2433cd5fca547074e72ef0f9a0d8c1e44c Author: Richard Eisenberg Date: Sat Sep 19 16:44:29 2015 -0400 Clarify parsing infelicity. This fixes #10855. >--------------------------------------------------------------- 850b3c2433cd5fca547074e72ef0f9a0d8c1e44c docs/users_guide/bugs.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 1b4d5c9..bff2bcf 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -101,6 +101,18 @@ main = do args <- getArgs (let x = 42 in x == 42 == True) + + + The Haskell Report allows you to put a unary + - preceding certain expressions headed by + keywords, allowing constructs like - case x of + ... or - do { ... }. GHC does + not allow this. Instead, unary - is + allowed before only expressions that could potentially + be applied as a function. + + + From git at git.haskell.org Sun Sep 20 03:59:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 03:59:28 +0000 (UTC) Subject: [commit: ghc] wip/rae: Allow TH quoting of assoc type defaults. (e5e6e47) Message-ID: <20150920035928.117F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/e5e6e47d177a78446ce1bdcaf923dfb6732cd5b3/ghc >--------------------------------------------------------------- commit e5e6e47d177a78446ce1bdcaf923dfb6732cd5b3 Author: Richard Eisenberg Date: Sat Sep 19 15:43:15 2015 -0400 Allow TH quoting of assoc type defaults. This fixes #10811. >--------------------------------------------------------------- e5e6e47d177a78446ce1bdcaf923dfb6732cd5b3 compiler/deSugar/DsMeta.hs | 29 +++++++++++++++++++---------- compiler/hsSyn/HsTypes.hs | 15 +++++++++++++++ testsuite/tests/th/T10811.hs | 7 +++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 42 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index a762810..39eab05 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -251,7 +251,7 @@ repTyClD (L loc (DataDecl { tcdLName = tc, tcdTyVars = tvs, tcdDataDefn = defn } repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tvs, tcdFDs = fds, tcdSigs = sigs, tcdMeths = meth_binds, - tcdATs = ats, tcdATDefs = [] })) + tcdATs = ats, tcdATDefs = atds })) = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences] ; dec <- addTyVarBinds tvs $ \bndrs -> do { cxt1 <- repLContext cxt @@ -259,17 +259,13 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, ; binds1 <- rep_binds meth_binds ; fds1 <- repLFunDeps fds ; ats1 <- repFamilyDecls ats - ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1) + ; atds1 <- repAssocTyFamDefaults atds + ; decls1 <- coreList decQTyConName (ats1 ++ atds1 ++ sigs1 ++ binds1) ; repClass cxt1 cls1 bndrs fds1 decls1 } ; return $ Just (loc, dec) } --- Un-handled cases -repTyClD (L loc d) = putSrcSpanDs loc $ - do { warnDs (hang ds_msg 4 (ppr d)) - ; return Nothing } - ------------------------- repRoleD :: LRoleAnnotDecl Name -> DsM (SrcSpan, Core TH.DecQ) repRoleD (L loc (RoleAnnotDecl tycon roles)) @@ -376,6 +372,22 @@ repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) = repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ] repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds) +repAssocTyFamDefaults :: [LTyFamDefltEqn Name] -> DsM [Core TH.DecQ] +repAssocTyFamDefaults = mapM rep_deflt + where + -- very like repTyFamEqn, but different in the details + rep_deflt :: LTyFamDefltEqn Name -> DsM (Core TH.DecQ) + rep_deflt (L _ (TyFamEqn { tfe_tycon = tc + , tfe_pats = bndrs + , tfe_rhs = rhs })) + = addTyClTyVarBinds bndrs $ \ _ -> + do { tc1 <- lookupLOcc tc + ; tys1 <- repLTys (hsLTyVarBndrsToTypes bndrs) + ; tys2 <- coreList typeQTyConName tys1 + ; rhs1 <- repLTy rhs + ; eqn1 <- repTySynEqn tys2 rhs1 + ; repTySynInst tc1 eqn1 } + ------------------------- mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name -> HsDataDefn Name -> DsM (LHsTyVarBndrs Name) @@ -597,9 +609,6 @@ repAnnProv (TypeAnnProvenance (L _ n)) repAnnProv ModuleAnnProvenance = rep2 moduleAnnotationName [] -ds_msg :: SDoc -ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:") - ------------------------------------------------------- -- Constructors ------------------------------------------------------- diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 0393cca..8353bb6 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -47,6 +47,7 @@ module HsTypes ( hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, + hsLTyVarBndrsToTypes, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, splitHsFunType, @@ -659,6 +660,20 @@ hsLTyVarLocName = fmap hsTyVarName hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name] hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs) +-- | Convert a LHsTyVarBndr to an equivalent LHsType. Used in Template Haskell +-- quoting for type family equations. +hsLTyVarBndrToType :: LHsTyVarBndr name -> LHsType name +hsLTyVarBndrToType = fmap cvt + where cvt (UserTyVar n) = HsTyVar n + cvt (KindedTyVar (L name_loc n) kind) = HsKindSig (L name_loc (HsTyVar n)) + kind + +-- | Convert a LHsTyVarBndrs to a list of types. Used in Template Haskell +-- quoting for type family equations. Works on *type* variable only, no kind +-- vars. +hsLTyVarBndrsToTypes :: LHsTyVarBndrs name -> [LHsType name] +hsLTyVarBndrsToTypes (HsQTvs { hsq_tvs = tvbs }) = map hsLTyVarBndrToType tvbs + --------------------- mkAnonWildCardTy :: HsType RdrName mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder) diff --git a/testsuite/tests/th/T10811.hs b/testsuite/tests/th/T10811.hs new file mode 100644 index 0000000..3fac190 --- /dev/null +++ b/testsuite/tests/th/T10811.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies #-} + +module Bug where + +$([d| class C a where + type F a + type F a = a |]) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index eea0fa9..85dae8b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -353,3 +353,4 @@ test('T10704', ['T10704', '-v0']) test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) +test('T10811', normal, compile, ['-v0']) From git at git.haskell.org Sun Sep 20 03:59:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 03:59:30 +0000 (UTC) Subject: [commit: ghc] wip/rae: Clarify parsing infelicity. (57537d6) Message-ID: <20150920035930.C588C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/57537d633343211bbd06940a4a2886d50d7dec71/ghc >--------------------------------------------------------------- commit 57537d633343211bbd06940a4a2886d50d7dec71 Author: Richard Eisenberg Date: Sat Sep 19 16:44:29 2015 -0400 Clarify parsing infelicity. This fixes #10855. >--------------------------------------------------------------- 57537d633343211bbd06940a4a2886d50d7dec71 docs/users_guide/bugs.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 1b4d5c9..bff2bcf 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -101,6 +101,18 @@ main = do args <- getArgs (let x = 42 in x == 42 == True) + + + The Haskell Report allows you to put a unary + - preceding certain expressions headed by + keywords, allowing constructs like - case x of + ... or - do { ... }. GHC does + not allow this. Instead, unary - is + allowed before only expressions that could potentially + be applied as a function. + + + From git at git.haskell.org Sun Sep 20 03:59:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 03:59:33 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor BranchLists. (e08f8fe) Message-ID: <20150920035933.9D8803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/e08f8fedbd6d29910fe83ada57fd0411aac4b815/ghc >--------------------------------------------------------------- commit e08f8fedbd6d29910fe83ada57fd0411aac4b815 Author: Richard Eisenberg Date: Sat Sep 19 23:59:22 2015 -0400 Refactor BranchLists. Now we use Array to store branches. This makes sense because we often have to do random access (once inference is done). This also vastly simplifies the awkward BranchList type. This fixes #10837. >--------------------------------------------------------------- e08f8fedbd6d29910fe83ada57fd0411aac4b815 compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/MkIface.hs | 11 +-- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/FamInst.hs | 13 ++-- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcSplice.hs | 3 +- compiler/typecheck/TcType.hs | 6 +- compiler/typecheck/TcValidity.hs | 5 +- compiler/types/CoAxiom.hs | 164 +++++++++++++++------------------------ compiler/types/Coercion.hs | 4 +- compiler/types/FamInstEnv.hs | 34 ++++---- 12 files changed, 111 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 e08f8fedbd6d29910fe83ada57fd0411aac4b815 From git at git.haskell.org Sun Sep 20 10:41:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 10:41:59 +0000 (UTC) Subject: [commit: ghc] master: Always run explicitly requested ways (extra_ways) for fast runs. (b89c491) Message-ID: <20150920104159.A2AD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b89c49138fcd62a1175d67fac62d59ac2497bfdd/ghc >--------------------------------------------------------------- commit b89c49138fcd62a1175d67fac62d59ac2497bfdd Author: Edward Z. Yang Date: Sun Sep 20 12:16:50 2015 +0200 Always run explicitly requested ways (extra_ways) for fast runs. To keep validates fast, we only one run one way. But I think that it's important for some tests to run them a few ways, just to make sure functionality, e.g. the profiler, is working. This commit changes the logic so that any way specified in extra_ways is always run for fast. The big changes is now profiling tests are run on validate. I also made it so the G1 garbage collector tests only run on slow. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, thomie, bgamari Reviewed By: austin, thomie, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1251 >--------------------------------------------------------------- b89c49138fcd62a1175d67fac62d59ac2497bfdd Makefile | 7 +++++-- testsuite/driver/testlib.py | 9 ++++++++- testsuite/tests/codeGen/should_run/all.T | 2 +- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 38c7eb9..348375f 100644 --- a/Makefile +++ b/Makefile @@ -191,12 +191,15 @@ endif # cd tests config. many many by # validate && make speed= tests ways whom # ============================================================================= -# --fast fast 2 some 1 Travis (to stay within time limit) -# --normal test 1 all 1 Phabricator (slow takes too long?) +# --fast fast 2 some 1+exs Travis (to stay within time limit) +# --normal test 1 all 1+exs Phabricator (slow takes too long?) # --slow slow 0 all all Nightly (slow is ok) # # accept 1 all 1 # +# `--fast` and `--normal` run one default way, as well as any other ways which +# are explicitly requested by the test using extra_ways(). +# # `make accept` should run all tests exactly once. There is no point in # accepting a test for multiple ways, since it should produce the same output # for all ways. diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 1700392..34a3fb8 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -676,8 +676,15 @@ def test_common_work (name, opts, func, args): # Only run all ways in slow mode. # See Note [validate and testsuite speed] in toplevel Makefile. - if config.speed > 0: + if config.accept: + # Only ever run one way do_ways = do_ways[:1] + elif config.speed > 0: + # However, if we EXPLICITLY asked for a way (with extra_ways) + # please test it! + explicit_ways = filter(lambda way: way in opts.extra_ways, do_ways) + other_ways = filter(lambda way: way not in opts.extra_ways, do_ways) + do_ways = other_ways[:1] + explicit_ways if not config.clean_only: # Run the required tests... diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index f9e0e0e..ab2ce60 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -1,5 +1,5 @@ # Test +RTS -G1 here (it isn't tested anywhere else) -setTestOpts(extra_ways(['g1'])) +setTestOpts(unless(fast(), extra_ways(['g1']))) test('cgrun001', normal, compile_and_run, ['']) test('cgrun002', normal, compile_and_run, ['']) From git at git.haskell.org Sun Sep 20 10:42:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 10:42:02 +0000 (UTC) Subject: [commit: ghc] master: Replace [PostTc id Type] with PostTc id [Type] (c738b12) Message-ID: <20150920104202.71E0F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c738b1231bc63a45be87d49cc42b7644681e509d/ghc >--------------------------------------------------------------- commit c738b1231bc63a45be87d49cc42b7644681e509d Author: Matthew Pickering Date: Sun Sep 20 12:18:21 2015 +0200 Replace [PostTc id Type] with PostTc id [Type] This gives a clearer indication as to what gets filled in when. It was suggested by Richard on D1152. Test Plan: ./validate Reviewers: austin, goldfire, bgamari Reviewed By: goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1245 >--------------------------------------------------------------- c738b1231bc63a45be87d49cc42b7644681e509d compiler/hsSyn/Convert.hs | 4 +++- compiler/hsSyn/HsExpr.hs | 11 ++++++----- compiler/hsSyn/PlaceHolder.hs | 3 +++ compiler/parser/RdrHsSyn.hs | 3 ++- compiler/rename/RnExpr.hs | 2 +- 5 files changed, 15 insertions(+), 8 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 9466ab0..0d4eaea 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -712,7 +712,9 @@ cvtl e = wrapL (cvt e) ; return $ RecordCon c' noPostTcExpr (HsRecFields flds' Nothing)} cvt (RecUpdE e flds) = do { e' <- cvtl e ; flds' <- mapM cvtFld flds - ; return $ RecordUpd e' (HsRecFields flds' Nothing) [] [] [] } + ; return $ RecordUpd e' + (HsRecFields flds' Nothing) + PlaceHolder PlaceHolder PlaceHolder } cvt (StaticE e) = fmap HsStatic $ cvtl e {- Note [Dropping constructors] diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index a3c1f6c..63fea7a 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -293,11 +293,12 @@ data HsExpr id (HsRecordBinds id) -- (HsMatchGroup Id) -- Filled in by the type checker to be -- -- a match that does the job - [DataCon] -- Filled in by the type checker to the - -- _non-empty_ list of DataCons that have - -- all the upd'd fields - [PostTc id Type] -- Argument types of *input* record type - [PostTc id Type] -- and *output* record type + (PostTc id [DataCon]) + -- Filled in by the type checker to the + -- _non-empty_ list of DataCons that have + -- all the upd'd fields + (PostTc id [Type]) -- Argument types of *input* record type + (PostTc id [Type]) -- and *output* record type -- For a type family, the arg types are of the *instance* tycon, -- not the family tycon diff --git a/compiler/hsSyn/PlaceHolder.hs b/compiler/hsSyn/PlaceHolder.hs index 91d37ea..19f2bd4 100644 --- a/compiler/hsSyn/PlaceHolder.hs +++ b/compiler/hsSyn/PlaceHolder.hs @@ -12,6 +12,7 @@ import NameSet import RdrName import Var import Coercion +import DataCon (DataCon) import Data.Data hiding ( Fixity ) import BasicTypes (Fixity) @@ -102,4 +103,6 @@ type DataId id = , Data (PostTc id Type) , Data (PostTc id Coercion) + , Data (PostTc id [Type]) + , Data (PostTc id [DataCon]) ) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index beb3b3b..a83f6b3 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -1178,7 +1178,8 @@ mkRecConstrOrUpdate (L l (HsVar c)) _ (fs,dd) | isRdrDataCon c = return (RecordCon (L l c) noPostTcExpr (mk_rec_fields fs dd)) mkRecConstrOrUpdate exp _ (fs,dd) - = return (RecordUpd exp (mk_rec_fields fs dd) [] [] []) + = return (RecordUpd exp (mk_rec_fields fs dd) + PlaceHolder PlaceHolder PlaceHolder) mk_rec_fields :: [LHsRecField id arg] -> Bool -> HsRecFields id arg mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing } diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index aaac8f1..d4b5e72 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -258,7 +258,7 @@ rnExpr (RecordCon con_id _ rbinds) rnExpr (RecordUpd expr rbinds _ _ _) = do { (expr', fvExpr) <- rnLExpr expr ; (rbinds', fvRbinds) <- rnHsRecBinds HsRecFieldUpd rbinds - ; return (RecordUpd expr' rbinds' [] [] [], + ; return (RecordUpd expr' rbinds' PlaceHolder PlaceHolder PlaceHolder, fvExpr `plusFV` fvRbinds) } rnExpr (ExprWithTySig expr pty PlaceHolder) From git at git.haskell.org Sun Sep 20 10:42:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 10:42:05 +0000 (UTC) Subject: [commit: ghc] master: Put stable pointer names in the name cache. (e156361) Message-ID: <20150920104205.5878E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e156361fd1657184c35cca78e6b1c43836dec0ec/ghc >--------------------------------------------------------------- commit e156361fd1657184c35cca78e6b1c43836dec0ec Author: Edward Z. Yang Date: Sun Sep 20 12:19:17 2015 +0200 Put stable pointer names in the name cache. Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1249 >--------------------------------------------------------------- e156361fd1657184c35cca78e6b1c43836dec0ec compiler/deSugar/DsExpr.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index d3a8156..32bd27b 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -58,6 +58,7 @@ import Bag import Outputable import FastString +import IfaceEnv import IdInfo import Data.IORef ( atomicModifyIORef', modifyIORef ) @@ -985,10 +986,9 @@ badMonadBind rhs elt_ty flag_doc -- mkSptEntryName :: SrcSpan -> DsM Name mkSptEntryName loc = do - uniq <- newUnique mod <- getModule occ <- mkWrapperName "sptEntry" - return $ mkExternalName uniq mod occ loc + newGlobalBinder mod occ loc where mkWrapperName what = do dflags <- getDynFlags From git at git.haskell.org Sun Sep 20 17:42:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 17:42:49 +0000 (UTC) Subject: [commit: ghc] master: Driver: --make -o without Main should be an error (#10895) (1637e4d) Message-ID: <20150920174249.37D9A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1637e4d16d28223aac66100cf7308d76a2a7ee7c/ghc >--------------------------------------------------------------- commit 1637e4d16d28223aac66100cf7308d76a2a7ee7c Author: Thomas Miedema Date: Sat Sep 19 16:14:47 2015 +0200 Driver: --make -o without Main should be an error (#10895) Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1253 >--------------------------------------------------------------- 1637e4d16d28223aac66100cf7308d76a2a7ee7c compiler/main/GhcMake.hs | 20 +++++++++++--------- .../should_compile => driver/should_fail}/Makefile | 0 testsuite/tests/driver/should_fail/T10895.hs | 1 + testsuite/tests/driver/should_fail/T10895.stderr | 4 ++++ testsuite/tests/driver/should_fail/all.T | 2 ++ 5 files changed, 18 insertions(+), 9 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index ba21e5b..2ea3816 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -325,18 +325,20 @@ load how_much = do a_root_is_Main = any ((==main_mod).ms_mod) mod_graph do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib - when (ghcLink dflags == LinkBinary - && isJust ofile && not do_linking) $ - liftIO $ debugTraceMsg dflags 1 $ - text ("Warning: output was redirected with -o, " ++ - "but no output will be generated\n" ++ - "because there is no " ++ - moduleNameString (moduleName main_mod) ++ " module.") - -- link everything together linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1) - loadFinish Succeeded linkresult + if ghcLink dflags == LinkBinary && isJust ofile && not do_linking + then do + liftIO $ errorMsg dflags $ text + ("output was redirected with -o, " ++ + "but no output will be generated\n" ++ + "because there is no " ++ + moduleNameString (moduleName main_mod) ++ " module.") + -- This should be an error, not a warning (#10895). + loadFinish Failed linkresult + else + loadFinish Succeeded linkresult else -- Tricky. We need to back out the effects of compiling any diff --git a/testsuite/tests/annotations/should_compile/Makefile b/testsuite/tests/driver/should_fail/Makefile similarity index 100% copy from testsuite/tests/annotations/should_compile/Makefile copy to testsuite/tests/driver/should_fail/Makefile diff --git a/testsuite/tests/driver/should_fail/T10895.hs b/testsuite/tests/driver/should_fail/T10895.hs new file mode 100644 index 0000000..91faa50 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T10895.hs @@ -0,0 +1 @@ +module NotMain where diff --git a/testsuite/tests/driver/should_fail/T10895.stderr b/testsuite/tests/driver/should_fail/T10895.stderr new file mode 100644 index 0000000..3ae52a3 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T10895.stderr @@ -0,0 +1,4 @@ + +: error: + output was redirected with -o, but no output will be generated +because there is no Main module. diff --git a/testsuite/tests/driver/should_fail/all.T b/testsuite/tests/driver/should_fail/all.T new file mode 100644 index 0000000..f068d65 --- /dev/null +++ b/testsuite/tests/driver/should_fail/all.T @@ -0,0 +1,2 @@ +# --make -o without Main should be an error, not a warning. +test('T10895', normal, multimod_compile_fail, ['T10895.hs', '-v0 -o dummy']) From git at git.haskell.org Sun Sep 20 20:27:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:27:50 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #10347 (82097b7) Message-ID: <20150920202750.8A9F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/82097b7aa8ee629715014aae3358606ec3a11e1a/ghc >--------------------------------------------------------------- commit 82097b7aa8ee629715014aae3358606ec3a11e1a Author: Richard Eisenberg Date: Sat Sep 19 14:37:54 2015 -0400 Test #10347 >--------------------------------------------------------------- 82097b7aa8ee629715014aae3358606ec3a11e1a testsuite/tests/typecheck/should_compile/T10347.hs | 10 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T10347.hs b/testsuite/tests/typecheck/should_compile/T10347.hs new file mode 100644 index 0000000..9187a93 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10347.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE -fwarn-unusued-bindings #-} + +module T10347 (N, mkN) where + +import Data.Coerce + +newtype N a = MkN Int + +mkN :: Int -> N a +mkN = coerce diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index eff8403..6f34db4 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -474,3 +474,4 @@ test('T10632', normal, compile, ['']) test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) test('update-existential', normal, compile, ['']) +test('T10347', expect_broken(10347), compile, ['']) From git at git.haskell.org Sun Sep 20 20:27:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:27:53 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update user guide, fixing #10772 (952cbb9) Message-ID: <20150920202753.5850D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/952cbb98f81134788f947eb7f770b1f2e0002812/ghc >--------------------------------------------------------------- commit 952cbb98f81134788f947eb7f770b1f2e0002812 Author: Richard Eisenberg Date: Sat Sep 19 14:45:28 2015 -0400 Update user guide, fixing #10772 >--------------------------------------------------------------- 952cbb98f81134788f947eb7f770b1f2e0002812 docs/users_guide/glasgow_exts.xml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 119de6b..7aaf1a8 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -3017,8 +3017,11 @@ GHC allows type constructors, classes, and type variables to be operators, and to be written infix, very much like expressions. More specifically: - A type constructor or class can be an operator, beginning with a colon; e.g. :*:. - The lexical syntax is the same as that for data constructors. + A type constructor or class can be any non-reserved operator. + Symbols used in types are always like capitalized identifiers; they + are never variables. Note that this is different from the lexical + syntax of data constructors, which are required to begin with a + :. Data type and type-synonym declarations can be written infix, parenthesised From git at git.haskell.org Sun Sep 20 20:27:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:27:56 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #10770 (4817798) Message-ID: <20150920202756.CA1213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/481779808eb5cd54d891ee8a81e1b87910dd1bf0/ghc >--------------------------------------------------------------- commit 481779808eb5cd54d891ee8a81e1b87910dd1bf0 Author: Richard Eisenberg Date: Sat Sep 19 15:04:49 2015 -0400 Test #10770 >--------------------------------------------------------------- 481779808eb5cd54d891ee8a81e1b87910dd1bf0 testsuite/tests/typecheck/should_compile/T10770a.hs | 8 ++++++++ testsuite/tests/typecheck/should_compile/T10770b.hs | 9 +++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 3 files changed, 19 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T10770a.hs b/testsuite/tests/typecheck/should_compile/T10770a.hs new file mode 100644 index 0000000..611c86e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770a.hs @@ -0,0 +1,8 @@ +module T10770a where + +import Data.Typeable + +main = print $ foo $ Just () + +foo :: Typeable (t a) => t a -> String +foo x = let k = show $ typeOf x in k diff --git a/testsuite/tests/typecheck/should_compile/T10770b.hs b/testsuite/tests/typecheck/should_compile/T10770b.hs new file mode 100644 index 0000000..62ae61c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770b.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fwarn-redundant-constraints #-} +module T10770b where + +f :: (Show a, Show (Maybe a)) => Maybe a -> String +f x = let k = show x in k + +g :: (Show a, Show (Maybe a)) => Maybe a -> String +g x = show x diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 6f34db4..da71c1d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -475,3 +475,5 @@ test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) test('update-existential', normal, compile, ['']) test('T10347', expect_broken(10347), compile, ['']) +test('T10770a', expect_broken(10770), compile, ['']) +test('T10770b', expect_broken(10770), compile, ['']) From git at git.haskell.org Sun Sep 20 20:28:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:00 +0000 (UTC) Subject: [commit: ghc] wip/rae: Allow TH quoting of assoc type defaults. (2574e18) Message-ID: <20150920202800.261DD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2574e18614fe1c18adc8bd33f9762ca8083aa502/ghc >--------------------------------------------------------------- commit 2574e18614fe1c18adc8bd33f9762ca8083aa502 Author: Richard Eisenberg Date: Sat Sep 19 15:43:15 2015 -0400 Allow TH quoting of assoc type defaults. This fixes #10811. >--------------------------------------------------------------- 2574e18614fe1c18adc8bd33f9762ca8083aa502 compiler/deSugar/DsMeta.hs | 29 +++++++++++++++++++---------- compiler/hsSyn/HsTypes.hs | 15 +++++++++++++++ testsuite/tests/th/T10811.hs | 7 +++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 42 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index a762810..39eab05 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -251,7 +251,7 @@ repTyClD (L loc (DataDecl { tcdLName = tc, tcdTyVars = tvs, tcdDataDefn = defn } repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tvs, tcdFDs = fds, tcdSigs = sigs, tcdMeths = meth_binds, - tcdATs = ats, tcdATDefs = [] })) + tcdATs = ats, tcdATDefs = atds })) = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences] ; dec <- addTyVarBinds tvs $ \bndrs -> do { cxt1 <- repLContext cxt @@ -259,17 +259,13 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, ; binds1 <- rep_binds meth_binds ; fds1 <- repLFunDeps fds ; ats1 <- repFamilyDecls ats - ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1) + ; atds1 <- repAssocTyFamDefaults atds + ; decls1 <- coreList decQTyConName (ats1 ++ atds1 ++ sigs1 ++ binds1) ; repClass cxt1 cls1 bndrs fds1 decls1 } ; return $ Just (loc, dec) } --- Un-handled cases -repTyClD (L loc d) = putSrcSpanDs loc $ - do { warnDs (hang ds_msg 4 (ppr d)) - ; return Nothing } - ------------------------- repRoleD :: LRoleAnnotDecl Name -> DsM (SrcSpan, Core TH.DecQ) repRoleD (L loc (RoleAnnotDecl tycon roles)) @@ -376,6 +372,22 @@ repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) = repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ] repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds) +repAssocTyFamDefaults :: [LTyFamDefltEqn Name] -> DsM [Core TH.DecQ] +repAssocTyFamDefaults = mapM rep_deflt + where + -- very like repTyFamEqn, but different in the details + rep_deflt :: LTyFamDefltEqn Name -> DsM (Core TH.DecQ) + rep_deflt (L _ (TyFamEqn { tfe_tycon = tc + , tfe_pats = bndrs + , tfe_rhs = rhs })) + = addTyClTyVarBinds bndrs $ \ _ -> + do { tc1 <- lookupLOcc tc + ; tys1 <- repLTys (hsLTyVarBndrsToTypes bndrs) + ; tys2 <- coreList typeQTyConName tys1 + ; rhs1 <- repLTy rhs + ; eqn1 <- repTySynEqn tys2 rhs1 + ; repTySynInst tc1 eqn1 } + ------------------------- mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name -> HsDataDefn Name -> DsM (LHsTyVarBndrs Name) @@ -597,9 +609,6 @@ repAnnProv (TypeAnnProvenance (L _ n)) repAnnProv ModuleAnnProvenance = rep2 moduleAnnotationName [] -ds_msg :: SDoc -ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:") - ------------------------------------------------------- -- Constructors ------------------------------------------------------- diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 0393cca..8353bb6 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -47,6 +47,7 @@ module HsTypes ( hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, + hsLTyVarBndrsToTypes, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, splitHsFunType, @@ -659,6 +660,20 @@ hsLTyVarLocName = fmap hsTyVarName hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name] hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs) +-- | Convert a LHsTyVarBndr to an equivalent LHsType. Used in Template Haskell +-- quoting for type family equations. +hsLTyVarBndrToType :: LHsTyVarBndr name -> LHsType name +hsLTyVarBndrToType = fmap cvt + where cvt (UserTyVar n) = HsTyVar n + cvt (KindedTyVar (L name_loc n) kind) = HsKindSig (L name_loc (HsTyVar n)) + kind + +-- | Convert a LHsTyVarBndrs to a list of types. Used in Template Haskell +-- quoting for type family equations. Works on *type* variable only, no kind +-- vars. +hsLTyVarBndrsToTypes :: LHsTyVarBndrs name -> [LHsType name] +hsLTyVarBndrsToTypes (HsQTvs { hsq_tvs = tvbs }) = map hsLTyVarBndrToType tvbs + --------------------- mkAnonWildCardTy :: HsType RdrName mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder) diff --git a/testsuite/tests/th/T10811.hs b/testsuite/tests/th/T10811.hs new file mode 100644 index 0000000..3fac190 --- /dev/null +++ b/testsuite/tests/th/T10811.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies #-} + +module Bug where + +$([d| class C a where + type F a + type F a = a |]) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index eea0fa9..85dae8b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -353,3 +353,4 @@ test('T10704', ['T10704', '-v0']) test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) +test('T10811', normal, compile, ['-v0']) From git at git.haskell.org Sun Sep 20 20:28:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:03 +0000 (UTC) Subject: [commit: ghc] wip/rae: Print associated types a bit better. (70f53a0) Message-ID: <20150920202803.026723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/70f53a06b4b371d889494f92fceb6bce535a822f/ghc >--------------------------------------------------------------- commit 70f53a06b4b371d889494f92fceb6bce535a822f Author: Richard Eisenberg Date: Sat Sep 19 15:18:40 2015 -0400 Print associated types a bit better. This is part of #10811. It removes the "family" keyword from associated type family declarations, and it adds the "type" keyword to associated type family defaults. >--------------------------------------------------------------- 70f53a06b4b371d889494f92fceb6bce535a822f compiler/hsSyn/HsDecls.hs | 67 +++++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index aefbfa6..047ad14 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -670,7 +670,7 @@ instance OutputableBndr name | otherwise -- Laid out = vcat [ top_matter <+> ptext (sLit "where") - , nest 2 $ pprDeclList (map ppr ats ++ + , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++ map ppr_fam_deflt_eqn at_defs ++ pprLHsBindsForUser methods sigs) ] where @@ -695,7 +695,7 @@ pprTyClDeclFlavour :: TyClDecl a -> SDoc pprTyClDeclFlavour (ClassDecl {}) = ptext (sLit "class") pprTyClDeclFlavour (SynDecl {}) = ptext (sLit "type") pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }}) - = pprFlavour info + = pprFlavour info <+> text "family" pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } }) = ppr nd @@ -885,36 +885,45 @@ return type) default to *. -} instance (OutputableBndr name) => Outputable (FamilyDecl name) where - ppr (FamilyDecl { fdInfo = info, fdLName = ltycon - , fdTyVars = tyvars, fdResultSig = L _ result - , fdInjectivityAnn = mb_inj }) - = vcat [ pprFlavour info <+> pp_vanilla_decl_head ltycon tyvars [] <+> - pp_kind <+> pp_inj <+> pp_where - , nest 2 $ pp_eqns ] - where - pp_kind = case result of - NoSig -> empty - KindSig kind -> dcolon <+> ppr kind - TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr - pp_inj = case mb_inj of - Just (L _ (InjectivityAnn lhs rhs)) -> - hsep [ text "|", ppr lhs, text "->", hsep (map ppr rhs) ] - Nothing -> empty - (pp_where, pp_eqns) = case info of - ClosedTypeFamily mb_eqns -> - ( ptext (sLit "where") - , case mb_eqns of - Nothing -> ptext (sLit "..") - Just eqns -> vcat $ map ppr_fam_inst_eqn eqns ) - _ -> (empty, empty) + ppr = pprFamilyDecl TopLevel + +pprFamilyDecl :: OutputableBndr name => TopLevelFlag -> FamilyDecl name -> SDoc +pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon + , fdTyVars = tyvars + , fdResultSig = L _ result + , fdInjectivityAnn = mb_inj }) + = vcat [ pprFlavour info <+> pp_top_level <+> + pp_vanilla_decl_head ltycon tyvars [] <+> + pp_kind <+> pp_inj <+> pp_where + , nest 2 $ pp_eqns ] + where + pp_top_level = case top_level of + TopLevel -> text "family" + NotTopLevel -> empty + + pp_kind = case result of + NoSig -> empty + KindSig kind -> dcolon <+> ppr kind + TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr + pp_inj = case mb_inj of + Just (L _ (InjectivityAnn lhs rhs)) -> + hsep [ text "|", ppr lhs, text "->", hsep (map ppr rhs) ] + Nothing -> empty + (pp_where, pp_eqns) = case info of + ClosedTypeFamily mb_eqns -> + ( ptext (sLit "where") + , case mb_eqns of + Nothing -> ptext (sLit "..") + Just eqns -> vcat $ map ppr_fam_inst_eqn eqns ) + _ -> (empty, empty) pprFlavour :: FamilyInfo name -> SDoc -pprFlavour DataFamily = ptext (sLit "data family") -pprFlavour OpenTypeFamily = ptext (sLit "type family") -pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type family") +pprFlavour DataFamily = ptext (sLit "data") +pprFlavour OpenTypeFamily = ptext (sLit "type") +pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type") instance Outputable (FamilyInfo name) where - ppr = pprFlavour + ppr info = pprFlavour info <+> text "family" @@ -1325,7 +1334,7 @@ ppr_fam_deflt_eqn :: OutputableBndr name => LTyFamDefltEqn name -> SDoc ppr_fam_deflt_eqn (L _ (TyFamEqn { tfe_tycon = tycon , tfe_pats = tvs , tfe_rhs = rhs })) - = pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs + = text "type" <+> pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where ppr = pprDataFamInstDecl TopLevel From git at git.haskell.org Sun Sep 20 20:28:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:05 +0000 (UTC) Subject: [commit: ghc] wip/rae: Re-polish error messages around injective TFs. (74ce4c6) Message-ID: <20150920202805.BD0563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/74ce4c65f31fa16cfc077efbb39fe84807a9e263/ghc >--------------------------------------------------------------- commit 74ce4c65f31fa16cfc077efbb39fe84807a9e263 Author: Richard Eisenberg Date: Sun Sep 20 15:28:55 2015 -0400 Re-polish error messages around injective TFs. The previous message was wrong, as pointed out by Jan Stolarek. >--------------------------------------------------------------- 74ce4c65f31fa16cfc077efbb39fe84807a9e263 compiler/typecheck/FamInst.hs | 41 +++++++++++----------- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 22 +++++++----- .../tests/typecheck/should_fail/T6018fail.stderr | 27 ++++++++------ .../typecheck/should_fail/T6018failclosed.stderr | 36 ++++++++++--------- 4 files changed, 69 insertions(+), 57 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 74ce4c65f31fa16cfc077efbb39fe84807a9e263 From git at git.haskell.org Sun Sep 20 20:28:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:09 +0000 (UTC) Subject: [commit: ghc] wip/rae: Small improvement in pretty-printing constructors. (f2a76c1) Message-ID: <20150920202809.2467F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/f2a76c1528ce49fe298a826eafad9085d0585e19/ghc >--------------------------------------------------------------- commit f2a76c1528ce49fe298a826eafad9085d0585e19 Author: Richard Eisenberg Date: Sun Sep 20 16:03:07 2015 -0400 Small improvement in pretty-printing constructors. This fixes #10810 by cleaning up pretty-printing of constructor declarations. This change also removes a (in my opinion) deeply bogus orphan instance OutputableBndr [Located name], making HsDecls now a non-orphan module. Yay all around. Test case: th/T10810 >--------------------------------------------------------------- f2a76c1528ce49fe298a826eafad9085d0585e19 compiler/hsSyn/HsDecls.hs | 26 ++++++++++---------------- testsuite/tests/th/T10810.hs | 6 ++++++ testsuite/tests/th/T10810.stderr | 2 ++ testsuite/tests/th/all.T | 1 + 4 files changed, 19 insertions(+), 16 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 047ad14..ecc3693 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -12,7 +12,6 @@ -- in module PlaceHolder {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Abstract syntax of global declarations. -- @@ -1114,15 +1113,16 @@ instance (OutputableBndr name) => Outputable (ConDecl name) where ppr = pprConDecl pprConDecl :: OutputableBndr name => ConDecl name -> SDoc -pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs +pprConDecl (ConDecl { con_names = [L _ con] -- NB: non-GADT means 1 con + , con_explicit = expl, con_qvars = tvs , con_cxt = cxt, con_details = details , con_res = ResTyH98, con_doc = doc }) = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details] where - ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc cons, ppr t2] - ppr_details (PrefixCon tys) = hsep (pprPrefixOcc cons + ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2] + ppr_details (PrefixCon tys) = hsep (pprPrefixOcc con : map (pprParendHsType . unLoc) tys) - ppr_details (RecCon fields) = ppr_con_names cons + ppr_details (RecCon fields) = pprPrefixOcc con <+> pprConDeclFields (unLoc fields) pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs @@ -1146,18 +1146,12 @@ pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT { -- so if we ever trip over one (albeit I can't see how that -- can happen) print it like a prefix one -ppr_con_names :: (OutputableBndr name) => [Located name] -> SDoc -ppr_con_names [x] = ppr x -ppr_con_names xs = interpp'SP xs - -instance (Outputable name) => OutputableBndr [Located name] where - pprBndr _bs xs = cat $ punctuate comma (map ppr xs) +-- this fallthrough would happen with a non-GADT-syntax ConDecl with more +-- than one constructor, which should indeed be impossible +pprConDecl (ConDecl { con_names = cons }) = pprPanic "pprConDecl" (ppr cons) - pprPrefixOcc [x] = ppr x - pprPrefixOcc xs = cat $ punctuate comma (map ppr xs) - - pprInfixOcc [x] = ppr x - pprInfixOcc xs = cat $ punctuate comma (map ppr xs) +ppr_con_names :: (OutputableBndr name) => [Located name] -> SDoc +ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc) {- ************************************************************************ diff --git a/testsuite/tests/th/T10810.hs b/testsuite/tests/th/T10810.hs new file mode 100644 index 0000000..328c3e9 --- /dev/null +++ b/testsuite/tests/th/T10810.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +module T10810 where + +$([d| data Foo = (:!) |]) diff --git a/testsuite/tests/th/T10810.stderr b/testsuite/tests/th/T10810.stderr new file mode 100644 index 0000000..c960fe1 --- /dev/null +++ b/testsuite/tests/th/T10810.stderr @@ -0,0 +1,2 @@ +T10810.hs:6:3-24: Splicing declarations + [d| data Foo = (:!) |] ======> data Foo = (:!) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 85dae8b..bad0a0e 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -354,3 +354,4 @@ test('T10704', test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) test('T10811', normal, compile, ['-v0']) +test('T10810', normal, compile, ['-v0']) From git at git.haskell.org Sun Sep 20 20:28:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:11 +0000 (UTC) Subject: [commit: ghc] wip/rae: Clarify parsing infelicity. (c306218) Message-ID: <20150920202811.D9EC03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/c3062184fbe46b7b9ad781c184276f984fa45c93/ghc >--------------------------------------------------------------- commit c3062184fbe46b7b9ad781c184276f984fa45c93 Author: Richard Eisenberg Date: Sat Sep 19 16:44:29 2015 -0400 Clarify parsing infelicity. This fixes #10855. >--------------------------------------------------------------- c3062184fbe46b7b9ad781c184276f984fa45c93 docs/users_guide/bugs.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 1b4d5c9..bff2bcf 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -101,6 +101,18 @@ main = do args <- getArgs (let x = 42 in x == 42 == True) + + + The Haskell Report allows you to put a unary + - preceding certain expressions headed by + keywords, allowing constructs like - case x of + ... or - do { ... }. GHC does + not allow this. Instead, unary - is + allowed before only expressions that could potentially + be applied as a function. + + + From git at git.haskell.org Sun Sep 20 20:28:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:14 +0000 (UTC) Subject: [commit: ghc] wip/rae: Run simplifier only when the env is clean. (0d965fc) Message-ID: <20150920202814.996FA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/0d965fcb542a8bfff94b41666c765cca8bf37d06/ghc >--------------------------------------------------------------- commit 0d965fcb542a8bfff94b41666c765cca8bf37d06 Author: Richard Eisenberg Date: Sun Sep 20 16:15:13 2015 -0400 Run simplifier only when the env is clean. This fixes #10896. In the indexed-types/should_fail/BadSock test, there is a bad type definition. This gets type-checked, an error gets reported, but then **GHC keeps going**. Later, when running the simplifier to do an ambiguity check, the bad type environment causes GHC to fall over. My solution: only run the simplifier in a clean, error-free type environment. >--------------------------------------------------------------- 0d965fcb542a8bfff94b41666c765cca8bf37d06 compiler/typecheck/TcFlatten.hs | 4 +++- compiler/typecheck/TcValidity.hs | 6 +++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 052c158..efc9e32 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1038,7 +1038,9 @@ flatten_fam_app, flatten_exact_fam_app, flatten_exact_fam_app_fully -- flatten_exact_fam_app_fully lifts out the application to top level -- Postcondition: Coercion :: Xi ~ F tys flatten_fam_app tc tys -- Can be over-saturated - = ASSERT( tyConArity tc <= length tys ) -- Type functions are saturated + = ASSERT2( tyConArity tc <= length tys + , ppr tc $$ ppr (tyConArity tc) $$ ppr tys) + -- Type functions are saturated -- The type function might be *over* saturated -- in which case the remaining arguments should -- be dealt with by AppTys diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 4f20a3d..9063dd6 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -215,7 +215,11 @@ checkAmbiguity ctxt ty ; (_wrap, wanted) <- addErrCtxtM (mk_msg ty') $ captureConstraints $ tcSubType_NC ctxt ty' ty' - ; simplifyAmbiguityCheck ty wanted + ; whenNoErrs $ -- only run the simplifier if we have a clean + -- environment. Otherwise we might trip. + -- example: indexed-types/should_fail/BadSock + -- fails in DEBUG mode without this + simplifyAmbiguityCheck ty wanted ; traceTc "Done ambiguity check for" (ppr ty) } where From git at git.haskell.org Sun Sep 20 20:28:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:17 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor BranchLists. (6974baa) Message-ID: <20150920202817.67B603A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/6974baa4118c623b2ae42f205a1dd857c5849af7/ghc >--------------------------------------------------------------- commit 6974baa4118c623b2ae42f205a1dd857c5849af7 Author: Richard Eisenberg Date: Sat Sep 19 23:59:22 2015 -0400 Refactor BranchLists. Now we use Array to store branches. This makes sense because we often have to do random access (once inference is done). This also vastly simplifies the awkward BranchList type. This fixes #10837. >--------------------------------------------------------------- 6974baa4118c623b2ae42f205a1dd857c5849af7 compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/MkIface.hs | 11 +-- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/FamInst.hs | 13 ++-- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcSplice.hs | 3 +- compiler/typecheck/TcType.hs | 6 +- compiler/typecheck/TcValidity.hs | 5 +- compiler/types/CoAxiom.hs | 164 +++++++++++++++------------------------ compiler/types/Coercion.hs | 4 +- compiler/types/FamInstEnv.hs | 34 ++++---- 12 files changed, 111 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 6974baa4118c623b2ae42f205a1dd857c5849af7 From git at git.haskell.org Sun Sep 20 20:28:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 20:28:21 +0000 (UTC) Subject: [commit: ghc] wip/rae: Perform a validity check on assoc type defaults. (2c13f56) Message-ID: <20150920202821.2EDE43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2c13f56b6ca0bb6ea803623dabb22af873807582/ghc >--------------------------------------------------------------- commit 2c13f56b6ca0bb6ea803623dabb22af873807582 Author: Richard Eisenberg Date: Sat Sep 19 14:32:44 2015 -0400 Perform a validity check on assoc type defaults. This fixes #10817 and #10899. A knock-on effect is that we must now remember locations of associated type defaults for error messages during validity checking. This isn't too bad, but it increases the size of the diff somewhat. Test cases: indexed-types/should_fail/T108{17,99} >--------------------------------------------------------------- 2c13f56b6ca0bb6ea803623dabb22af873807582 compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 7 +++++- compiler/typecheck/TcRnDriver.hs | 4 ++-- compiler/typecheck/TcTyClsDecls.hs | 26 +++++++++++++--------- compiler/typecheck/TcValidity.hs | 17 +++++++++++++- compiler/types/Class.hs | 6 ++++- .../tests/indexed-types/should_fail/T10817.hs | 14 ++++++++++++ .../tests/indexed-types/should_fail/T10817.stderr | 6 +++++ .../tests/indexed-types/should_fail/T10899.hs | 7 ++++++ .../tests/indexed-types/should_fail/T10899.stderr | 4 ++++ testsuite/tests/indexed-types/should_fail/all.T | 2 ++ testsuite/tests/typecheck/should_compile/tc253.hs | 2 ++ 13 files changed, 82 insertions(+), 17 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2c13f56b6ca0bb6ea803623dabb22af873807582 From git at git.haskell.org Sun Sep 20 21:46:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 21:46:40 +0000 (UTC) Subject: [commit: ghc] wip/rae: Run simplifier only when the env is clean. (cbd5f03) Message-ID: <20150920214640.E63523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/cbd5f038671c1c2393594b513cc084dfc89a5762/ghc >--------------------------------------------------------------- commit cbd5f038671c1c2393594b513cc084dfc89a5762 Author: Richard Eisenberg Date: Sun Sep 20 16:15:13 2015 -0400 Run simplifier only when the env is clean. This fixes #10896. In the indexed-types/should_fail/BadSock test, there is a bad type definition. This gets type-checked, an error gets reported, but then **GHC keeps going**. Later, when running the simplifier to do an ambiguity check, the bad type environment causes GHC to fall over. My solution: only run the simplifier in a clean, error-free type environment. A downside of this is that fewer error messages are reported. This makes me a bit sad, but I'm not sure how to avoid the problem. Suggestions welcome. >--------------------------------------------------------------- cbd5f038671c1c2393594b513cc084dfc89a5762 compiler/typecheck/TcFlatten.hs | 4 +++- compiler/typecheck/TcValidity.hs | 6 +++++- testsuite/tests/typecheck/should_fail/T5300.stderr | 21 +++------------------ testsuite/tests/typecheck/should_fail/T8030.stderr | 15 +-------------- 4 files changed, 12 insertions(+), 34 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 052c158..efc9e32 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1038,7 +1038,9 @@ flatten_fam_app, flatten_exact_fam_app, flatten_exact_fam_app_fully -- flatten_exact_fam_app_fully lifts out the application to top level -- Postcondition: Coercion :: Xi ~ F tys flatten_fam_app tc tys -- Can be over-saturated - = ASSERT( tyConArity tc <= length tys ) -- Type functions are saturated + = ASSERT2( tyConArity tc <= length tys + , ppr tc $$ ppr (tyConArity tc) $$ ppr tys) + -- Type functions are saturated -- The type function might be *over* saturated -- in which case the remaining arguments should -- be dealt with by AppTys diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 4f20a3d..9063dd6 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -215,7 +215,11 @@ checkAmbiguity ctxt ty ; (_wrap, wanted) <- addErrCtxtM (mk_msg ty') $ captureConstraints $ tcSubType_NC ctxt ty' ty' - ; simplifyAmbiguityCheck ty wanted + ; whenNoErrs $ -- only run the simplifier if we have a clean + -- environment. Otherwise we might trip. + -- example: indexed-types/should_fail/BadSock + -- fails in DEBUG mode without this + simplifyAmbiguityCheck ty wanted ; traceTc "Done ambiguity check for" (ppr ty) } where diff --git a/testsuite/tests/typecheck/should_fail/T5300.stderr b/testsuite/tests/typecheck/should_fail/T5300.stderr index 851d017..7e06b62 100644 --- a/testsuite/tests/typecheck/should_fail/T5300.stderr +++ b/testsuite/tests/typecheck/should_fail/T5300.stderr @@ -1,25 +1,10 @@ -T5300.hs:11:7: - Could not deduce (C1 a b c0) - from the context: (Monad m, C1 a b c) - bound by the type signature for: - f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a - at T5300.hs:11:7-50 - The type variable ?c0? is ambiguous - In the ambiguity check for the type signature for ?f1?: - f1 :: forall a b (m :: * -> *) c. - (Monad m, C1 a b c) => - a -> StateT (T b) m a - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature for ?f1?: - f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a - -T5300.hs:14:7: +T5300.hs:14:7: error: Could not deduce (C2 a2 b2 c20) from the context: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) bound by the type signature for: - f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => - a1 -> StateT (T b2) m a2 + f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => + a1 -> StateT (T b2) m a2 at T5300.hs:14:7-69 The type variable ?c20? is ambiguous In the ambiguity check for the type signature for ?f2?: diff --git a/testsuite/tests/typecheck/should_fail/T8030.stderr b/testsuite/tests/typecheck/should_fail/T8030.stderr index 8dd752e..831cf42 100644 --- a/testsuite/tests/typecheck/should_fail/T8030.stderr +++ b/testsuite/tests/typecheck/should_fail/T8030.stderr @@ -1,5 +1,5 @@ -T8030.hs:9:3: +T8030.hs:9:3: error: Couldn't match expected type ?Pr a? with actual type ?Pr a0? NB: ?Pr? is a type function, and may not be injective The type variable ?a0? is ambiguous @@ -9,16 +9,3 @@ T8030.hs:9:3: When checking the class method: op1 :: forall (k :: BOX) (a :: k). C a => Pr a In the class declaration for ?C? - -T8030.hs:10:3: - Couldn't match type ?Pr a0? with ?Pr a? - NB: ?Pr? is a type function, and may not be injective - The type variable ?a0? is ambiguous - Expected type: Pr a -> Pr a -> Pr a - Actual type: Pr a0 -> Pr a0 -> Pr a0 - In the ambiguity check for the type signature for ?op2?: - op2 :: forall (k :: BOX) (a :: k). C a => Pr a -> Pr a -> Pr a - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - When checking the class method: - op2 :: forall (k :: BOX) (a :: k). C a => Pr a -> Pr a -> Pr a - In the class declaration for ?C? From git at git.haskell.org Sun Sep 20 21:46:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 21:46:43 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor BranchLists. (7b0f7f3) Message-ID: <20150920214643.C2A5B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7b0f7f32deec7a1eec1cd6113dbce32596eb14c6/ghc >--------------------------------------------------------------- commit 7b0f7f32deec7a1eec1cd6113dbce32596eb14c6 Author: Richard Eisenberg Date: Sat Sep 19 23:59:22 2015 -0400 Refactor BranchLists. Now we use Array to store branches. This makes sense because we often have to do random access (once inference is done). This also vastly simplifies the awkward BranchList type. This fixes #10837. >--------------------------------------------------------------- 7b0f7f32deec7a1eec1cd6113dbce32596eb14c6 compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/MkIface.hs | 11 +-- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/FamInst.hs | 13 ++-- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcSplice.hs | 3 +- compiler/typecheck/TcType.hs | 6 +- compiler/typecheck/TcValidity.hs | 5 +- compiler/types/CoAxiom.hs | 164 +++++++++++++++------------------------ compiler/types/Coercion.hs | 4 +- compiler/types/FamInstEnv.hs | 34 ++++---- 12 files changed, 111 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 7b0f7f32deec7a1eec1cd6113dbce32596eb14c6 From git at git.haskell.org Sun Sep 20 21:46:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 21:46:47 +0000 (UTC) Subject: [commit: ghc] wip/rae: Perform a validity check on assoc type defaults. (ef2f886) Message-ID: <20150920214647.83D343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/ef2f8866541152850981d44bf037ea165f87c14f/ghc >--------------------------------------------------------------- commit ef2f8866541152850981d44bf037ea165f87c14f Author: Richard Eisenberg Date: Sat Sep 19 14:32:44 2015 -0400 Perform a validity check on assoc type defaults. This fixes #10817 and #10899. A knock-on effect is that we must now remember locations of associated type defaults for error messages during validity checking. This isn't too bad, but it increases the size of the diff somewhat. Test cases: indexed-types/should_fail/T108{17,99} >--------------------------------------------------------------- ef2f8866541152850981d44bf037ea165f87c14f compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 7 +++++- compiler/typecheck/TcRnDriver.hs | 4 ++-- compiler/typecheck/TcTyClsDecls.hs | 26 +++++++++++++--------- compiler/typecheck/TcValidity.hs | 17 +++++++++++++- compiler/types/Class.hs | 6 ++++- .../tests/indexed-types/should_fail/T10817.hs | 14 ++++++++++++ .../tests/indexed-types/should_fail/T10817.stderr | 6 +++++ .../tests/indexed-types/should_fail/T10899.hs | 7 ++++++ .../tests/indexed-types/should_fail/T10899.stderr | 4 ++++ testsuite/tests/indexed-types/should_fail/all.T | 2 ++ testsuite/tests/typecheck/should_compile/tc253.hs | 2 ++ 13 files changed, 82 insertions(+), 17 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ef2f8866541152850981d44bf037ea165f87c14f From git at git.haskell.org Sun Sep 20 21:46:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Sep 2015 21:46:51 +0000 (UTC) Subject: [commit: ghc] wip/rae: Slightly better `Coercible` errors. (a8a5d0d) Message-ID: <20150920214651.79C133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a8a5d0d80e6bca3c675aa59419fa2b78404967e5/ghc >--------------------------------------------------------------- commit a8a5d0d80e6bca3c675aa59419fa2b78404967e5 Author: Richard Eisenberg Date: Sun Sep 20 17:39:17 2015 -0400 Slightly better `Coercible` errors. This makes two real changes: - Equalities like (a ~R [a]) really *are* insoluble. Previously, GHC refused to give up when an occurs check bit on a representational equality. But for datatypes, it really should bail. - Now, GHC will sometimes report an occurs check error (in cases above) for representational equalities. Previously, it never did. This "fixes" #10715, where by "fix", I mean clarifies the error message. It's unclear how to do more to fix that ticket. Test cases: typecheck/should_fail/T10715{,b} >--------------------------------------------------------------- a8a5d0d80e6bca3c675aa59419fa2b78404967e5 compiler/typecheck/TcCanonical.hs | 27 ++++++++++++++++++---- compiler/typecheck/TcErrors.hs | 8 +++++-- compiler/typecheck/TcType.hs | 21 ++++++++++++++++- testsuite/tests/typecheck/should_fail/T10715.hs | 10 ++++++++ .../tests/typecheck/should_fail/T10715.stderr | 15 ++++++++++++ testsuite/tests/typecheck/should_fail/T10715b.hs | 7 ++++++ .../tests/typecheck/should_fail/T10715b.stderr | 8 +++++++ testsuite/tests/typecheck/should_fail/all.T | 2 ++ 8 files changed, 90 insertions(+), 8 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 a8a5d0d80e6bca3c675aa59419fa2b78404967e5 From git at git.haskell.org Mon Sep 21 01:43:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:38 +0000 (UTC) Subject: [commit: ghc] master: Test #10347 (1a13551) Message-ID: <20150921014338.A8D1E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a135511344f14deca314cb38cedda4bcfe53dc0/ghc >--------------------------------------------------------------- commit 1a135511344f14deca314cb38cedda4bcfe53dc0 Author: Richard Eisenberg Date: Sat Sep 19 14:37:54 2015 -0400 Test #10347 >--------------------------------------------------------------- 1a135511344f14deca314cb38cedda4bcfe53dc0 testsuite/tests/typecheck/should_compile/T10347.hs | 10 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T10347.hs b/testsuite/tests/typecheck/should_compile/T10347.hs new file mode 100644 index 0000000..9187a93 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10347.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE -fwarn-unusued-bindings #-} + +module T10347 (N, mkN) where + +import Data.Coerce + +newtype N a = MkN Int + +mkN :: Int -> N a +mkN = coerce diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index eff8403..6f34db4 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -474,3 +474,4 @@ test('T10632', normal, compile, ['']) test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) test('update-existential', normal, compile, ['']) +test('T10347', expect_broken(10347), compile, ['']) From git at git.haskell.org Mon Sep 21 01:43:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:41 +0000 (UTC) Subject: [commit: ghc] master: Test #10770 (d7f2ab0) Message-ID: <20150921014342.00CB83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7f2ab05494aac0561a19d75e6c4a9fccca24554/ghc >--------------------------------------------------------------- commit d7f2ab05494aac0561a19d75e6c4a9fccca24554 Author: Richard Eisenberg Date: Sat Sep 19 15:04:49 2015 -0400 Test #10770 >--------------------------------------------------------------- d7f2ab05494aac0561a19d75e6c4a9fccca24554 testsuite/tests/typecheck/should_compile/T10770a.hs | 8 ++++++++ testsuite/tests/typecheck/should_compile/T10770b.hs | 9 +++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 3 files changed, 19 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T10770a.hs b/testsuite/tests/typecheck/should_compile/T10770a.hs new file mode 100644 index 0000000..611c86e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770a.hs @@ -0,0 +1,8 @@ +module T10770a where + +import Data.Typeable + +main = print $ foo $ Just () + +foo :: Typeable (t a) => t a -> String +foo x = let k = show $ typeOf x in k diff --git a/testsuite/tests/typecheck/should_compile/T10770b.hs b/testsuite/tests/typecheck/should_compile/T10770b.hs new file mode 100644 index 0000000..62ae61c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770b.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fwarn-redundant-constraints #-} +module T10770b where + +f :: (Show a, Show (Maybe a)) => Maybe a -> String +f x = let k = show x in k + +g :: (Show a, Show (Maybe a)) => Maybe a -> String +g x = show x diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 6f34db4..da71c1d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -475,3 +475,5 @@ test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) test('update-existential', normal, compile, ['']) test('T10347', expect_broken(10347), compile, ['']) +test('T10770a', expect_broken(10770), compile, ['']) +test('T10770b', expect_broken(10770), compile, ['']) From git at git.haskell.org Mon Sep 21 01:43:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:44 +0000 (UTC) Subject: [commit: ghc] master: Update user guide, fixing #10772 (d19a77a) Message-ID: <20150921014344.C22F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d19a77ab420dec1dbd9c95744b987283ef5aa4cc/ghc >--------------------------------------------------------------- commit d19a77ab420dec1dbd9c95744b987283ef5aa4cc Author: Richard Eisenberg Date: Sat Sep 19 14:45:28 2015 -0400 Update user guide, fixing #10772 >--------------------------------------------------------------- d19a77ab420dec1dbd9c95744b987283ef5aa4cc docs/users_guide/glasgow_exts.xml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 119de6b..7aaf1a8 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -3017,8 +3017,11 @@ GHC allows type constructors, classes, and type variables to be operators, and to be written infix, very much like expressions. More specifically: - A type constructor or class can be an operator, beginning with a colon; e.g. :*:. - The lexical syntax is the same as that for data constructors. + A type constructor or class can be any non-reserved operator. + Symbols used in types are always like capitalized identifiers; they + are never variables. Note that this is different from the lexical + syntax of data constructors, which are required to begin with a + :. Data type and type-synonym declarations can be written infix, parenthesised From git at git.haskell.org Mon Sep 21 01:43:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:47 +0000 (UTC) Subject: [commit: ghc] master: Print associated types a bit better. (79b8e89) Message-ID: <20150921014347.AA6F43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/79b8e891d88bd4018e31be042364e314a25fbb41/ghc >--------------------------------------------------------------- commit 79b8e891d88bd4018e31be042364e314a25fbb41 Author: Richard Eisenberg Date: Sat Sep 19 15:18:40 2015 -0400 Print associated types a bit better. This is part of #10811. It removes the "family" keyword from associated type family declarations, and it adds the "type" keyword to associated type family defaults. >--------------------------------------------------------------- 79b8e891d88bd4018e31be042364e314a25fbb41 compiler/hsSyn/HsDecls.hs | 67 +++++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index aefbfa6..047ad14 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -670,7 +670,7 @@ instance OutputableBndr name | otherwise -- Laid out = vcat [ top_matter <+> ptext (sLit "where") - , nest 2 $ pprDeclList (map ppr ats ++ + , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++ map ppr_fam_deflt_eqn at_defs ++ pprLHsBindsForUser methods sigs) ] where @@ -695,7 +695,7 @@ pprTyClDeclFlavour :: TyClDecl a -> SDoc pprTyClDeclFlavour (ClassDecl {}) = ptext (sLit "class") pprTyClDeclFlavour (SynDecl {}) = ptext (sLit "type") pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }}) - = pprFlavour info + = pprFlavour info <+> text "family" pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } }) = ppr nd @@ -885,36 +885,45 @@ return type) default to *. -} instance (OutputableBndr name) => Outputable (FamilyDecl name) where - ppr (FamilyDecl { fdInfo = info, fdLName = ltycon - , fdTyVars = tyvars, fdResultSig = L _ result - , fdInjectivityAnn = mb_inj }) - = vcat [ pprFlavour info <+> pp_vanilla_decl_head ltycon tyvars [] <+> - pp_kind <+> pp_inj <+> pp_where - , nest 2 $ pp_eqns ] - where - pp_kind = case result of - NoSig -> empty - KindSig kind -> dcolon <+> ppr kind - TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr - pp_inj = case mb_inj of - Just (L _ (InjectivityAnn lhs rhs)) -> - hsep [ text "|", ppr lhs, text "->", hsep (map ppr rhs) ] - Nothing -> empty - (pp_where, pp_eqns) = case info of - ClosedTypeFamily mb_eqns -> - ( ptext (sLit "where") - , case mb_eqns of - Nothing -> ptext (sLit "..") - Just eqns -> vcat $ map ppr_fam_inst_eqn eqns ) - _ -> (empty, empty) + ppr = pprFamilyDecl TopLevel + +pprFamilyDecl :: OutputableBndr name => TopLevelFlag -> FamilyDecl name -> SDoc +pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon + , fdTyVars = tyvars + , fdResultSig = L _ result + , fdInjectivityAnn = mb_inj }) + = vcat [ pprFlavour info <+> pp_top_level <+> + pp_vanilla_decl_head ltycon tyvars [] <+> + pp_kind <+> pp_inj <+> pp_where + , nest 2 $ pp_eqns ] + where + pp_top_level = case top_level of + TopLevel -> text "family" + NotTopLevel -> empty + + pp_kind = case result of + NoSig -> empty + KindSig kind -> dcolon <+> ppr kind + TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr + pp_inj = case mb_inj of + Just (L _ (InjectivityAnn lhs rhs)) -> + hsep [ text "|", ppr lhs, text "->", hsep (map ppr rhs) ] + Nothing -> empty + (pp_where, pp_eqns) = case info of + ClosedTypeFamily mb_eqns -> + ( ptext (sLit "where") + , case mb_eqns of + Nothing -> ptext (sLit "..") + Just eqns -> vcat $ map ppr_fam_inst_eqn eqns ) + _ -> (empty, empty) pprFlavour :: FamilyInfo name -> SDoc -pprFlavour DataFamily = ptext (sLit "data family") -pprFlavour OpenTypeFamily = ptext (sLit "type family") -pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type family") +pprFlavour DataFamily = ptext (sLit "data") +pprFlavour OpenTypeFamily = ptext (sLit "type") +pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type") instance Outputable (FamilyInfo name) where - ppr = pprFlavour + ppr info = pprFlavour info <+> text "family" @@ -1325,7 +1334,7 @@ ppr_fam_deflt_eqn :: OutputableBndr name => LTyFamDefltEqn name -> SDoc ppr_fam_deflt_eqn (L _ (TyFamEqn { tfe_tycon = tycon , tfe_pats = tvs , tfe_rhs = rhs })) - = pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs + = text "type" <+> pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where ppr = pprDataFamInstDecl TopLevel From git at git.haskell.org Mon Sep 21 01:43:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:50 +0000 (UTC) Subject: [commit: ghc] master: Allow TH quoting of assoc type defaults. (1292c17) Message-ID: <20150921014350.EDAC93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1292c17e61400dfa0c27eddff4bea6a935006657/ghc >--------------------------------------------------------------- commit 1292c17e61400dfa0c27eddff4bea6a935006657 Author: Richard Eisenberg Date: Sat Sep 19 15:43:15 2015 -0400 Allow TH quoting of assoc type defaults. This fixes #10811. >--------------------------------------------------------------- 1292c17e61400dfa0c27eddff4bea6a935006657 compiler/deSugar/DsMeta.hs | 29 +++++++++++++++++++---------- compiler/hsSyn/HsTypes.hs | 15 +++++++++++++++ testsuite/tests/th/T10811.hs | 7 +++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 42 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index a762810..39eab05 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -251,7 +251,7 @@ repTyClD (L loc (DataDecl { tcdLName = tc, tcdTyVars = tvs, tcdDataDefn = defn } repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tvs, tcdFDs = fds, tcdSigs = sigs, tcdMeths = meth_binds, - tcdATs = ats, tcdATDefs = [] })) + tcdATs = ats, tcdATDefs = atds })) = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences] ; dec <- addTyVarBinds tvs $ \bndrs -> do { cxt1 <- repLContext cxt @@ -259,17 +259,13 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, ; binds1 <- rep_binds meth_binds ; fds1 <- repLFunDeps fds ; ats1 <- repFamilyDecls ats - ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1) + ; atds1 <- repAssocTyFamDefaults atds + ; decls1 <- coreList decQTyConName (ats1 ++ atds1 ++ sigs1 ++ binds1) ; repClass cxt1 cls1 bndrs fds1 decls1 } ; return $ Just (loc, dec) } --- Un-handled cases -repTyClD (L loc d) = putSrcSpanDs loc $ - do { warnDs (hang ds_msg 4 (ppr d)) - ; return Nothing } - ------------------------- repRoleD :: LRoleAnnotDecl Name -> DsM (SrcSpan, Core TH.DecQ) repRoleD (L loc (RoleAnnotDecl tycon roles)) @@ -376,6 +372,22 @@ repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) = repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ] repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds) +repAssocTyFamDefaults :: [LTyFamDefltEqn Name] -> DsM [Core TH.DecQ] +repAssocTyFamDefaults = mapM rep_deflt + where + -- very like repTyFamEqn, but different in the details + rep_deflt :: LTyFamDefltEqn Name -> DsM (Core TH.DecQ) + rep_deflt (L _ (TyFamEqn { tfe_tycon = tc + , tfe_pats = bndrs + , tfe_rhs = rhs })) + = addTyClTyVarBinds bndrs $ \ _ -> + do { tc1 <- lookupLOcc tc + ; tys1 <- repLTys (hsLTyVarBndrsToTypes bndrs) + ; tys2 <- coreList typeQTyConName tys1 + ; rhs1 <- repLTy rhs + ; eqn1 <- repTySynEqn tys2 rhs1 + ; repTySynInst tc1 eqn1 } + ------------------------- mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name -> HsDataDefn Name -> DsM (LHsTyVarBndrs Name) @@ -597,9 +609,6 @@ repAnnProv (TypeAnnProvenance (L _ n)) repAnnProv ModuleAnnProvenance = rep2 moduleAnnotationName [] -ds_msg :: SDoc -ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:") - ------------------------------------------------------- -- Constructors ------------------------------------------------------- diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 0393cca..8353bb6 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -47,6 +47,7 @@ module HsTypes ( hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, + hsLTyVarBndrsToTypes, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, splitHsFunType, @@ -659,6 +660,20 @@ hsLTyVarLocName = fmap hsTyVarName hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name] hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs) +-- | Convert a LHsTyVarBndr to an equivalent LHsType. Used in Template Haskell +-- quoting for type family equations. +hsLTyVarBndrToType :: LHsTyVarBndr name -> LHsType name +hsLTyVarBndrToType = fmap cvt + where cvt (UserTyVar n) = HsTyVar n + cvt (KindedTyVar (L name_loc n) kind) = HsKindSig (L name_loc (HsTyVar n)) + kind + +-- | Convert a LHsTyVarBndrs to a list of types. Used in Template Haskell +-- quoting for type family equations. Works on *type* variable only, no kind +-- vars. +hsLTyVarBndrsToTypes :: LHsTyVarBndrs name -> [LHsType name] +hsLTyVarBndrsToTypes (HsQTvs { hsq_tvs = tvbs }) = map hsLTyVarBndrToType tvbs + --------------------- mkAnonWildCardTy :: HsType RdrName mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder) diff --git a/testsuite/tests/th/T10811.hs b/testsuite/tests/th/T10811.hs new file mode 100644 index 0000000..3fac190 --- /dev/null +++ b/testsuite/tests/th/T10811.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies #-} + +module Bug where + +$([d| class C a where + type F a + type F a = a |]) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index eea0fa9..85dae8b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -353,3 +353,4 @@ test('T10704', ['T10704', '-v0']) test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) +test('T10811', normal, compile, ['-v0']) From git at git.haskell.org Mon Sep 21 01:43:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:53 +0000 (UTC) Subject: [commit: ghc] master: Re-polish error messages around injective TFs. (93fafe0) Message-ID: <20150921014353.AD4D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93fafe057da20c40ff0a0f383e3341cac6aaee23/ghc >--------------------------------------------------------------- commit 93fafe057da20c40ff0a0f383e3341cac6aaee23 Author: Richard Eisenberg Date: Sun Sep 20 15:28:55 2015 -0400 Re-polish error messages around injective TFs. The previous message was wrong, as pointed out by Jan Stolarek. >--------------------------------------------------------------- 93fafe057da20c40ff0a0f383e3341cac6aaee23 compiler/typecheck/FamInst.hs | 41 +++++++++++----------- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 22 +++++++----- .../tests/typecheck/should_fail/T6018fail.stderr | 27 ++++++++------ .../typecheck/should_fail/T6018failclosed.stderr | 36 ++++++++++--------- 4 files changed, 69 insertions(+), 57 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 93fafe057da20c40ff0a0f383e3341cac6aaee23 From git at git.haskell.org Mon Sep 21 01:43:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:57 +0000 (UTC) Subject: [commit: ghc] master: Small improvement in pretty-printing constructors. (6a20920) Message-ID: <20150921014357.041943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6a2092050c14570b9131fb5189c96dc562713b4c/ghc >--------------------------------------------------------------- commit 6a2092050c14570b9131fb5189c96dc562713b4c Author: Richard Eisenberg Date: Sun Sep 20 16:03:07 2015 -0400 Small improvement in pretty-printing constructors. This fixes #10810 by cleaning up pretty-printing of constructor declarations. This change also removes a (in my opinion) deeply bogus orphan instance OutputableBndr [Located name], making HsDecls now a non-orphan module. Yay all around. Test case: th/T10810 >--------------------------------------------------------------- 6a2092050c14570b9131fb5189c96dc562713b4c compiler/hsSyn/HsDecls.hs | 26 ++++++++++---------------- testsuite/tests/th/T10810.hs | 6 ++++++ testsuite/tests/th/T10810.stderr | 2 ++ testsuite/tests/th/all.T | 1 + 4 files changed, 19 insertions(+), 16 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 047ad14..ecc3693 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -12,7 +12,6 @@ -- in module PlaceHolder {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Abstract syntax of global declarations. -- @@ -1114,15 +1113,16 @@ instance (OutputableBndr name) => Outputable (ConDecl name) where ppr = pprConDecl pprConDecl :: OutputableBndr name => ConDecl name -> SDoc -pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs +pprConDecl (ConDecl { con_names = [L _ con] -- NB: non-GADT means 1 con + , con_explicit = expl, con_qvars = tvs , con_cxt = cxt, con_details = details , con_res = ResTyH98, con_doc = doc }) = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details] where - ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc cons, ppr t2] - ppr_details (PrefixCon tys) = hsep (pprPrefixOcc cons + ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2] + ppr_details (PrefixCon tys) = hsep (pprPrefixOcc con : map (pprParendHsType . unLoc) tys) - ppr_details (RecCon fields) = ppr_con_names cons + ppr_details (RecCon fields) = pprPrefixOcc con <+> pprConDeclFields (unLoc fields) pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs @@ -1146,18 +1146,12 @@ pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT { -- so if we ever trip over one (albeit I can't see how that -- can happen) print it like a prefix one -ppr_con_names :: (OutputableBndr name) => [Located name] -> SDoc -ppr_con_names [x] = ppr x -ppr_con_names xs = interpp'SP xs - -instance (Outputable name) => OutputableBndr [Located name] where - pprBndr _bs xs = cat $ punctuate comma (map ppr xs) +-- this fallthrough would happen with a non-GADT-syntax ConDecl with more +-- than one constructor, which should indeed be impossible +pprConDecl (ConDecl { con_names = cons }) = pprPanic "pprConDecl" (ppr cons) - pprPrefixOcc [x] = ppr x - pprPrefixOcc xs = cat $ punctuate comma (map ppr xs) - - pprInfixOcc [x] = ppr x - pprInfixOcc xs = cat $ punctuate comma (map ppr xs) +ppr_con_names :: (OutputableBndr name) => [Located name] -> SDoc +ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc) {- ************************************************************************ diff --git a/testsuite/tests/th/T10810.hs b/testsuite/tests/th/T10810.hs new file mode 100644 index 0000000..328c3e9 --- /dev/null +++ b/testsuite/tests/th/T10810.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +module T10810 where + +$([d| data Foo = (:!) |]) diff --git a/testsuite/tests/th/T10810.stderr b/testsuite/tests/th/T10810.stderr new file mode 100644 index 0000000..c960fe1 --- /dev/null +++ b/testsuite/tests/th/T10810.stderr @@ -0,0 +1,2 @@ +T10810.hs:6:3-24: Splicing declarations + [d| data Foo = (:!) |] ======> data Foo = (:!) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 85dae8b..bad0a0e 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -354,3 +354,4 @@ test('T10704', test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) test('T10811', normal, compile, ['-v0']) +test('T10810', normal, compile, ['-v0']) From git at git.haskell.org Mon Sep 21 01:43:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:43:59 +0000 (UTC) Subject: [commit: ghc] master: Clarify parsing infelicity. (27f9186) Message-ID: <20150921014359.C963C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27f9186d8e35387c3f48f848ff3b2c8e967a9c97/ghc >--------------------------------------------------------------- commit 27f9186d8e35387c3f48f848ff3b2c8e967a9c97 Author: Richard Eisenberg Date: Sat Sep 19 16:44:29 2015 -0400 Clarify parsing infelicity. This fixes #10855. >--------------------------------------------------------------- 27f9186d8e35387c3f48f848ff3b2c8e967a9c97 docs/users_guide/bugs.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 1b4d5c9..bff2bcf 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -101,6 +101,18 @@ main = do args <- getArgs (let x = 42 in x == 42 == True) + + + The Haskell Report allows you to put a unary + - preceding certain expressions headed by + keywords, allowing constructs like - case x of + ... or - do { ... }. GHC does + not allow this. Instead, unary - is + allowed before only expressions that could potentially + be applied as a function. + + + From git at git.haskell.org Mon Sep 21 01:50:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:50:35 +0000 (UTC) Subject: [commit: ghc] wip/rae: Run simplifier only when the env is clean. (974a762) Message-ID: <20150921015035.601F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/974a76271d68644ddcda1b1d54f9a847a3b67690/ghc >--------------------------------------------------------------- commit 974a76271d68644ddcda1b1d54f9a847a3b67690 Author: Richard Eisenberg Date: Sun Sep 20 16:15:13 2015 -0400 Run simplifier only when the env is clean. This fixes #10896. In the indexed-types/should_fail/BadSock test, there is a bad type definition. This gets type-checked, an error gets reported, but then **GHC keeps going**. Later, when running the simplifier to do an ambiguity check, the bad type environment causes GHC to fall over. My solution: only run the simplifier in a clean, error-free type environment. A downside of this is that fewer error messages are reported. This makes me a bit sad, but I'm not sure how to avoid the problem. Suggestions welcome. >--------------------------------------------------------------- 974a76271d68644ddcda1b1d54f9a847a3b67690 compiler/typecheck/TcFlatten.hs | 4 +++- compiler/typecheck/TcValidity.hs | 6 +++++- testsuite/tests/typecheck/should_fail/T5300.stderr | 21 +++------------------ testsuite/tests/typecheck/should_fail/T8030.stderr | 15 +-------------- 4 files changed, 12 insertions(+), 34 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 052c158..efc9e32 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1038,7 +1038,9 @@ flatten_fam_app, flatten_exact_fam_app, flatten_exact_fam_app_fully -- flatten_exact_fam_app_fully lifts out the application to top level -- Postcondition: Coercion :: Xi ~ F tys flatten_fam_app tc tys -- Can be over-saturated - = ASSERT( tyConArity tc <= length tys ) -- Type functions are saturated + = ASSERT2( tyConArity tc <= length tys + , ppr tc $$ ppr (tyConArity tc) $$ ppr tys) + -- Type functions are saturated -- The type function might be *over* saturated -- in which case the remaining arguments should -- be dealt with by AppTys diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 4f20a3d..9063dd6 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -215,7 +215,11 @@ checkAmbiguity ctxt ty ; (_wrap, wanted) <- addErrCtxtM (mk_msg ty') $ captureConstraints $ tcSubType_NC ctxt ty' ty' - ; simplifyAmbiguityCheck ty wanted + ; whenNoErrs $ -- only run the simplifier if we have a clean + -- environment. Otherwise we might trip. + -- example: indexed-types/should_fail/BadSock + -- fails in DEBUG mode without this + simplifyAmbiguityCheck ty wanted ; traceTc "Done ambiguity check for" (ppr ty) } where diff --git a/testsuite/tests/typecheck/should_fail/T5300.stderr b/testsuite/tests/typecheck/should_fail/T5300.stderr index 851d017..7e06b62 100644 --- a/testsuite/tests/typecheck/should_fail/T5300.stderr +++ b/testsuite/tests/typecheck/should_fail/T5300.stderr @@ -1,25 +1,10 @@ -T5300.hs:11:7: - Could not deduce (C1 a b c0) - from the context: (Monad m, C1 a b c) - bound by the type signature for: - f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a - at T5300.hs:11:7-50 - The type variable ?c0? is ambiguous - In the ambiguity check for the type signature for ?f1?: - f1 :: forall a b (m :: * -> *) c. - (Monad m, C1 a b c) => - a -> StateT (T b) m a - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature for ?f1?: - f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a - -T5300.hs:14:7: +T5300.hs:14:7: error: Could not deduce (C2 a2 b2 c20) from the context: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) bound by the type signature for: - f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => - a1 -> StateT (T b2) m a2 + f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => + a1 -> StateT (T b2) m a2 at T5300.hs:14:7-69 The type variable ?c20? is ambiguous In the ambiguity check for the type signature for ?f2?: diff --git a/testsuite/tests/typecheck/should_fail/T8030.stderr b/testsuite/tests/typecheck/should_fail/T8030.stderr index 8dd752e..831cf42 100644 --- a/testsuite/tests/typecheck/should_fail/T8030.stderr +++ b/testsuite/tests/typecheck/should_fail/T8030.stderr @@ -1,5 +1,5 @@ -T8030.hs:9:3: +T8030.hs:9:3: error: Couldn't match expected type ?Pr a? with actual type ?Pr a0? NB: ?Pr? is a type function, and may not be injective The type variable ?a0? is ambiguous @@ -9,16 +9,3 @@ T8030.hs:9:3: When checking the class method: op1 :: forall (k :: BOX) (a :: k). C a => Pr a In the class declaration for ?C? - -T8030.hs:10:3: - Couldn't match type ?Pr a0? with ?Pr a? - NB: ?Pr? is a type function, and may not be injective - The type variable ?a0? is ambiguous - Expected type: Pr a -> Pr a -> Pr a - Actual type: Pr a0 -> Pr a0 -> Pr a0 - In the ambiguity check for the type signature for ?op2?: - op2 :: forall (k :: BOX) (a :: k). C a => Pr a -> Pr a -> Pr a - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - When checking the class method: - op2 :: forall (k :: BOX) (a :: k). C a => Pr a -> Pr a -> Pr a - In the class declaration for ?C? From git at git.haskell.org Mon Sep 21 01:50:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:50:39 +0000 (UTC) Subject: [commit: ghc] wip/rae: Perform a validity check on assoc type defaults. (51c7306) Message-ID: <20150921015039.5C1573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/51c73064d4eb2eec4bfebcdc4228c740038213b8/ghc >--------------------------------------------------------------- commit 51c73064d4eb2eec4bfebcdc4228c740038213b8 Author: Richard Eisenberg Date: Sat Sep 19 14:32:44 2015 -0400 Perform a validity check on assoc type defaults. This fixes #10817 and #10899. A knock-on effect is that we must now remember locations of associated type defaults for error messages during validity checking. This isn't too bad, but it increases the size of the diff somewhat. Test cases: indexed-types/should_fail/T108{17,99} >--------------------------------------------------------------- 51c73064d4eb2eec4bfebcdc4228c740038213b8 compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 7 +++++- compiler/typecheck/TcRnDriver.hs | 4 ++-- compiler/typecheck/TcTyClsDecls.hs | 26 +++++++++++++--------- compiler/typecheck/TcValidity.hs | 17 +++++++++++++- compiler/types/Class.hs | 6 ++++- .../tests/indexed-types/should_fail/T10817.hs | 14 ++++++++++++ .../tests/indexed-types/should_fail/T10817.stderr | 6 +++++ .../tests/indexed-types/should_fail/T10899.hs | 7 ++++++ .../tests/indexed-types/should_fail/T10899.stderr | 4 ++++ testsuite/tests/indexed-types/should_fail/all.T | 2 ++ testsuite/tests/typecheck/should_compile/tc253.hs | 2 ++ 13 files changed, 82 insertions(+), 17 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 51c73064d4eb2eec4bfebcdc4228c740038213b8 From git at git.haskell.org Mon Sep 21 01:50:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:50:42 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor BranchLists. (577c3ce) Message-ID: <20150921015042.4B5E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/577c3ce18f2453c4911705e70ba0870171e75f99/ghc >--------------------------------------------------------------- commit 577c3ce18f2453c4911705e70ba0870171e75f99 Author: Richard Eisenberg Date: Sat Sep 19 23:59:22 2015 -0400 Refactor BranchLists. Now we use Array to store branches. This makes sense because we often have to do random access (once inference is done). This also vastly simplifies the awkward BranchList type. This fixes #10837. >--------------------------------------------------------------- 577c3ce18f2453c4911705e70ba0870171e75f99 compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/MkIface.hs | 11 +-- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/FamInst.hs | 13 ++-- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcSplice.hs | 3 +- compiler/typecheck/TcType.hs | 6 +- compiler/typecheck/TcValidity.hs | 5 +- compiler/types/CoAxiom.hs | 164 +++++++++++++++------------------------ compiler/types/Coercion.hs | 4 +- compiler/types/FamInstEnv.hs | 34 ++++---- 12 files changed, 111 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 577c3ce18f2453c4911705e70ba0870171e75f99 From git at git.haskell.org Mon Sep 21 01:50:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:50:46 +0000 (UTC) Subject: [commit: ghc] wip/rae: Slightly better `Coercible` errors. (7669c8a) Message-ID: <20150921015046.3A8EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7669c8ab2d3c2c02c1eb88b88dd6307b9ebaddc3/ghc >--------------------------------------------------------------- commit 7669c8ab2d3c2c02c1eb88b88dd6307b9ebaddc3 Author: Richard Eisenberg Date: Sun Sep 20 17:39:17 2015 -0400 Slightly better `Coercible` errors. This makes two real changes: - Equalities like (a ~R [a]) really *are* insoluble. Previously, GHC refused to give up when an occurs check bit on a representational equality. But for datatypes, it really should bail. - Now, GHC will sometimes report an occurs check error (in cases above) for representational equalities. Previously, it never did. This "fixes" #10715, where by "fix", I mean clarifies the error message. It's unclear how to do more to fix that ticket. Test cases: typecheck/should_fail/T10715{,b} >--------------------------------------------------------------- 7669c8ab2d3c2c02c1eb88b88dd6307b9ebaddc3 compiler/typecheck/TcCanonical.hs | 27 ++++++++++++++++++---- compiler/typecheck/TcErrors.hs | 8 +++++-- compiler/typecheck/TcType.hs | 21 ++++++++++++++++- testsuite/tests/typecheck/should_fail/T10715.hs | 10 ++++++++ .../tests/typecheck/should_fail/T10715.stderr | 15 ++++++++++++ testsuite/tests/typecheck/should_fail/T10715b.hs | 7 ++++++ .../tests/typecheck/should_fail/T10715b.stderr | 8 +++++++ testsuite/tests/typecheck/should_fail/all.T | 2 ++ 8 files changed, 90 insertions(+), 8 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 7669c8ab2d3c2c02c1eb88b88dd6307b9ebaddc3 From git at git.haskell.org Mon Sep 21 01:50:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 01:50:48 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Slightly better `Coercible` errors. (7669c8a) Message-ID: <20150921015048.689203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: b89c491 Always run explicitly requested ways (extra_ways) for fast runs. c738b12 Replace [PostTc id Type] with PostTc id [Type] e156361 Put stable pointer names in the name cache. 1637e4d Driver: --make -o without Main should be an error (#10895) 1a13551 Test #10347 d19a77a Update user guide, fixing #10772 d7f2ab0 Test #10770 79b8e89 Print associated types a bit better. 1292c17 Allow TH quoting of assoc type defaults. 27f9186 Clarify parsing infelicity. 93fafe0 Re-polish error messages around injective TFs. 6a20920 Small improvement in pretty-printing constructors. 974a762 Run simplifier only when the env is clean. 577c3ce Refactor BranchLists. 51c7306 Perform a validity check on assoc type defaults. 7669c8a Slightly better `Coercible` errors. From git at git.haskell.org Mon Sep 21 14:52:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 14:52:16 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix typo in test for #10347. (cbcad85) Message-ID: <20150921145216.2177A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/cbcad859acb350a33dec077d50438f929afbf0ad/ghc >--------------------------------------------------------------- commit cbcad859acb350a33dec077d50438f929afbf0ad Author: Richard Eisenberg Date: Mon Sep 21 09:40:02 2015 -0400 Fix typo in test for #10347. Thanks to Gabor Greif for spotting the mistake. >--------------------------------------------------------------- cbcad859acb350a33dec077d50438f929afbf0ad testsuite/tests/typecheck/should_compile/T10347.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_compile/T10347.hs b/testsuite/tests/typecheck/should_compile/T10347.hs index 9187a93..ca9fdd9 100644 --- a/testsuite/tests/typecheck/should_compile/T10347.hs +++ b/testsuite/tests/typecheck/should_compile/T10347.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE -fwarn-unusued-bindings #-} +{-# OPTIONS_GHC -fwarn-unused-binds #-} module T10347 (N, mkN) where From git at git.haskell.org Mon Sep 21 14:52:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 14:52:20 +0000 (UTC) Subject: [commit: ghc] wip/rae: Slightly better `Coercible` errors. (2f9809e) Message-ID: <20150921145220.2F9293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2f9809efdbc11fee445dbe3d5c555433ec3c5e6a/ghc >--------------------------------------------------------------- commit 2f9809efdbc11fee445dbe3d5c555433ec3c5e6a Author: Richard Eisenberg Date: Sun Sep 20 17:39:17 2015 -0400 Slightly better `Coercible` errors. This makes two real changes: - Equalities like (a ~R [a]) really *are* insoluble. Previously, GHC refused to give up when an occurs check bit on a representational equality. But for datatypes, it really should bail. - Now, GHC will sometimes report an occurs check error (in cases above) for representational equalities. Previously, it never did. This "fixes" #10715, where by "fix", I mean clarifies the error message. It's unclear how to do more to fix that ticket. Test cases: typecheck/should_fail/T10715{,b} >--------------------------------------------------------------- 2f9809efdbc11fee445dbe3d5c555433ec3c5e6a compiler/typecheck/TcCanonical.hs | 29 ++++++++++++++++++---- compiler/typecheck/TcErrors.hs | 8 ++++-- compiler/typecheck/TcType.hs | 21 +++++++++++++++- testsuite/tests/typecheck/should_fail/T10715.hs | 10 ++++++++ .../tests/typecheck/should_fail/T10715.stderr | 15 +++++++++++ testsuite/tests/typecheck/should_fail/T10715b.hs | 7 ++++++ .../tests/typecheck/should_fail/T10715b.stderr | 8 ++++++ testsuite/tests/typecheck/should_fail/all.T | 2 ++ 8 files changed, 92 insertions(+), 8 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 2f9809efdbc11fee445dbe3d5c555433ec3c5e6a From git at git.haskell.org Mon Sep 21 14:52:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 14:52:23 +0000 (UTC) Subject: [commit: ghc] wip/rae: Perform a validity check on assoc type defaults. (e27b267) Message-ID: <20150921145223.C2C193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/e27b267f3675180c03a75282dd952b8a59339a1f/ghc >--------------------------------------------------------------- commit e27b267f3675180c03a75282dd952b8a59339a1f Author: Richard Eisenberg Date: Sat Sep 19 14:32:44 2015 -0400 Perform a validity check on assoc type defaults. This fixes #10817 and #10899. A knock-on effect is that we must now remember locations of associated type defaults for error messages during validity checking. This isn't too bad, but it increases the size of the diff somewhat. Test cases: indexed-types/should_fail/T108{17,99} >--------------------------------------------------------------- e27b267f3675180c03a75282dd952b8a59339a1f compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 7 +++++- compiler/typecheck/TcRnDriver.hs | 4 ++-- compiler/typecheck/TcTyClsDecls.hs | 26 +++++++++++++--------- compiler/typecheck/TcValidity.hs | 17 +++++++++++++- compiler/types/Class.hs | 6 ++++- .../tests/indexed-types/should_fail/T10817.hs | 14 ++++++++++++ .../tests/indexed-types/should_fail/T10817.stderr | 6 +++++ .../tests/indexed-types/should_fail/T10899.hs | 7 ++++++ .../tests/indexed-types/should_fail/T10899.stderr | 4 ++++ testsuite/tests/indexed-types/should_fail/all.T | 2 ++ testsuite/tests/typecheck/should_compile/tc253.hs | 2 ++ 13 files changed, 82 insertions(+), 17 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e27b267f3675180c03a75282dd952b8a59339a1f From git at git.haskell.org Mon Sep 21 14:52:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 14:52:26 +0000 (UTC) Subject: [commit: ghc] wip/rae: Run simplifier only when the env is clean. (8e8b9ed) Message-ID: <20150921145226.83B0D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/8e8b9ed9849ba21e454e6204b368f8e993feaf7b/ghc >--------------------------------------------------------------- commit 8e8b9ed9849ba21e454e6204b368f8e993feaf7b Author: Richard Eisenberg Date: Sun Sep 20 16:15:13 2015 -0400 Run simplifier only when the env is clean. This fixes #10896. In the indexed-types/should_fail/BadSock test, there is a bad type definition. This gets type-checked, an error gets reported, but then **GHC keeps going**. Later, when running the simplifier to do an ambiguity check, the bad type environment causes GHC to fall over. My solution: only run the simplifier in a clean, error-free type environment. A downside of this is that fewer error messages are reported. This makes me a bit sad, but I'm not sure how to avoid the problem. Suggestions welcome. >--------------------------------------------------------------- 8e8b9ed9849ba21e454e6204b368f8e993feaf7b compiler/typecheck/TcFlatten.hs | 4 +++- compiler/typecheck/TcValidity.hs | 6 +++++- testsuite/tests/typecheck/should_fail/T5300.stderr | 21 +++------------------ testsuite/tests/typecheck/should_fail/T8030.stderr | 15 +-------------- 4 files changed, 12 insertions(+), 34 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 052c158..efc9e32 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1038,7 +1038,9 @@ flatten_fam_app, flatten_exact_fam_app, flatten_exact_fam_app_fully -- flatten_exact_fam_app_fully lifts out the application to top level -- Postcondition: Coercion :: Xi ~ F tys flatten_fam_app tc tys -- Can be over-saturated - = ASSERT( tyConArity tc <= length tys ) -- Type functions are saturated + = ASSERT2( tyConArity tc <= length tys + , ppr tc $$ ppr (tyConArity tc) $$ ppr tys) + -- Type functions are saturated -- The type function might be *over* saturated -- in which case the remaining arguments should -- be dealt with by AppTys diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index c21e683..ae416e7 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -216,7 +216,11 @@ checkAmbiguity ctxt ty ; (_wrap, wanted) <- addErrCtxtM (mk_msg ty') $ captureConstraints $ tcSubType_NC ctxt ty' ty' - ; simplifyAmbiguityCheck ty wanted + ; whenNoErrs $ -- only run the simplifier if we have a clean + -- environment. Otherwise we might trip. + -- example: indexed-types/should_fail/BadSock + -- fails in DEBUG mode without this + simplifyAmbiguityCheck ty wanted ; traceTc "Done ambiguity check for" (ppr ty) } where diff --git a/testsuite/tests/typecheck/should_fail/T5300.stderr b/testsuite/tests/typecheck/should_fail/T5300.stderr index 851d017..7e06b62 100644 --- a/testsuite/tests/typecheck/should_fail/T5300.stderr +++ b/testsuite/tests/typecheck/should_fail/T5300.stderr @@ -1,25 +1,10 @@ -T5300.hs:11:7: - Could not deduce (C1 a b c0) - from the context: (Monad m, C1 a b c) - bound by the type signature for: - f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a - at T5300.hs:11:7-50 - The type variable ?c0? is ambiguous - In the ambiguity check for the type signature for ?f1?: - f1 :: forall a b (m :: * -> *) c. - (Monad m, C1 a b c) => - a -> StateT (T b) m a - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature for ?f1?: - f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a - -T5300.hs:14:7: +T5300.hs:14:7: error: Could not deduce (C2 a2 b2 c20) from the context: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) bound by the type signature for: - f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => - a1 -> StateT (T b2) m a2 + f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => + a1 -> StateT (T b2) m a2 at T5300.hs:14:7-69 The type variable ?c20? is ambiguous In the ambiguity check for the type signature for ?f2?: diff --git a/testsuite/tests/typecheck/should_fail/T8030.stderr b/testsuite/tests/typecheck/should_fail/T8030.stderr index 8dd752e..831cf42 100644 --- a/testsuite/tests/typecheck/should_fail/T8030.stderr +++ b/testsuite/tests/typecheck/should_fail/T8030.stderr @@ -1,5 +1,5 @@ -T8030.hs:9:3: +T8030.hs:9:3: error: Couldn't match expected type ?Pr a? with actual type ?Pr a0? NB: ?Pr? is a type function, and may not be injective The type variable ?a0? is ambiguous @@ -9,16 +9,3 @@ T8030.hs:9:3: When checking the class method: op1 :: forall (k :: BOX) (a :: k). C a => Pr a In the class declaration for ?C? - -T8030.hs:10:3: - Couldn't match type ?Pr a0? with ?Pr a? - NB: ?Pr? is a type function, and may not be injective - The type variable ?a0? is ambiguous - Expected type: Pr a -> Pr a -> Pr a - Actual type: Pr a0 -> Pr a0 -> Pr a0 - In the ambiguity check for the type signature for ?op2?: - op2 :: forall (k :: BOX) (a :: k). C a => Pr a -> Pr a -> Pr a - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - When checking the class method: - op2 :: forall (k :: BOX) (a :: k). C a => Pr a -> Pr a -> Pr a - In the class declaration for ?C? From git at git.haskell.org Mon Sep 21 14:52:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 14:52:29 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor BranchLists. (124eb13) Message-ID: <20150921145229.668A83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/124eb138caa5e5a080f4c90c31985800390e7b55/ghc >--------------------------------------------------------------- commit 124eb138caa5e5a080f4c90c31985800390e7b55 Author: Richard Eisenberg Date: Sat Sep 19 23:59:22 2015 -0400 Refactor BranchLists. Now we use Array to store branches. This makes sense because we often have to do random access (once inference is done). This also vastly simplifies the awkward BranchList type. This fixes #10837. >--------------------------------------------------------------- 124eb138caa5e5a080f4c90c31985800390e7b55 compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/MkIface.hs | 11 +-- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/FamInst.hs | 13 ++-- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcSplice.hs | 3 +- compiler/typecheck/TcType.hs | 6 +- compiler/typecheck/TcValidity.hs | 5 +- compiler/types/CoAxiom.hs | 164 +++++++++++++++------------------------ compiler/types/Coercion.hs | 4 +- compiler/types/FamInstEnv.hs | 34 ++++---- 12 files changed, 111 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 124eb138caa5e5a080f4c90c31985800390e7b55 From git at git.haskell.org Mon Sep 21 14:53:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 14:53:45 +0000 (UTC) Subject: [commit: ghc] master's head updated: Run simplifier only when the env is clean. (8e8b9ed) Message-ID: <20150921145345.C6EED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: cbcad85 Fix typo in test for #10347. 2f9809e Slightly better `Coercible` errors. e27b267 Perform a validity check on assoc type defaults. 8e8b9ed Run simplifier only when the env is clean. From git at git.haskell.org Mon Sep 21 16:02:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 16:02:21 +0000 (UTC) Subject: [commit: ghc] master: Refactor BranchLists. (cd2840a) Message-ID: <20150921160221.AE0F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cd2840a784f4136a8cfdb704124e892430ad9ead/ghc >--------------------------------------------------------------- commit cd2840a784f4136a8cfdb704124e892430ad9ead Author: Richard Eisenberg Date: Sat Sep 19 23:59:22 2015 -0400 Refactor BranchLists. Now we use Array to store branches. This makes sense because we often have to do random access (once inference is done). This also vastly simplifies the awkward BranchList type. This fixes #10837 and updates submodule utils/haddock. >--------------------------------------------------------------- cd2840a784f4136a8cfdb704124e892430ad9ead compiler/coreSyn/CoreLint.hs | 2 +- compiler/iface/MkIface.hs | 11 +-- compiler/iface/TcIface.hs | 2 +- compiler/typecheck/FamInst.hs | 13 ++-- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcSplice.hs | 3 +- compiler/typecheck/TcType.hs | 6 +- compiler/typecheck/TcValidity.hs | 5 +- compiler/types/CoAxiom.hs | 164 +++++++++++++++------------------------ compiler/types/Coercion.hs | 4 +- compiler/types/FamInstEnv.hs | 34 ++++---- utils/haddock | 2 +- 13 files changed, 112 insertions(+), 145 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 cd2840a784f4136a8cfdb704124e892430ad9ead From git at git.haskell.org Mon Sep 21 16:14:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 16:14:45 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: names and comments (ddad613) Message-ID: <20150921161445.6D6353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/ddad61319710f5a561ca785cac105358981deeac/ghc >--------------------------------------------------------------- commit ddad61319710f5a561ca785cac105358981deeac Author: George Karachalias Date: Mon Sep 21 18:16:44 2015 +0200 names and comments >--------------------------------------------------------------- ddad61319710f5a561ca785cac105358981deeac compiler/deSugar/Check.hs | 151 ++++++++++++++++++++++++++++++---------------- 1 file changed, 100 insertions(+), 51 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 ddad61319710f5a561ca785cac105358981deeac From git at git.haskell.org Mon Sep 21 16:24:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 16:24:12 +0000 (UTC) Subject: [commit: ghc] master: `_ <- mapM` --> `mapM_` (c234acb) Message-ID: <20150921162412.3749B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c234acbe76da85556befad3eaa0c7c6b31e9e1c3/ghc >--------------------------------------------------------------- commit c234acbe76da85556befad3eaa0c7c6b31e9e1c3 Author: Richard Eisenberg Date: Mon Sep 21 12:25:37 2015 -0400 `_ <- mapM` --> `mapM_` Thanks for the suggestion, Austin. Just missed that while making a bunch of similar changes. >--------------------------------------------------------------- c234acbe76da85556befad3eaa0c7c6b31e9e1c3 compiler/typecheck/TcValidity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index b2a4f68..9268e4d 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1224,7 +1224,7 @@ wrongATArgErr ty instTy = checkValidCoAxiom :: CoAxiom Branched -> TcM () checkValidCoAxiom (CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) - = do { _ <- mapM (checkValidCoAxBranch Nothing fam_tc) branch_list + = do { mapM_ (checkValidCoAxBranch Nothing fam_tc) branch_list ; foldlM_ check_branch_compat [] branch_list } where branch_list = fromBranches branches From git at git.haskell.org Mon Sep 21 18:52:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 18:52:54 +0000 (UTC) Subject: [commit: ghc] master: Revert "Revert "Revert "Support for multiple signature files in scope.""" (3f13c20) Message-ID: <20150921185254.1923E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3f13c20e0c29d3db974c2a0d7d5ec15abd5a434b/ghc >--------------------------------------------------------------- commit 3f13c20e0c29d3db974c2a0d7d5ec15abd5a434b Author: Edward Z. Yang Date: Fri Sep 11 17:13:30 2015 -0700 Revert "Revert "Revert "Support for multiple signature files in scope.""" This reverts commit 214596de224afa576a9c295bcf53c6941d6892e0. >--------------------------------------------------------------- 3f13c20e0c29d3db974c2a0d7d5ec15abd5a434b compiler/deSugar/DsMonad.hs | 2 +- compiler/ghci/Linker.hs | 46 ++--- compiler/iface/LoadIface.hs | 18 +- compiler/iface/MkIface.hs | 18 +- compiler/main/DriverMkDepend.hs | 5 +- compiler/main/DynamicLoading.hs | 21 +- compiler/main/Finder.hs | 77 +++----- compiler/main/GHC.hs | 30 +-- compiler/main/GhcMake.hs | 19 +- compiler/main/HscTypes.hs | 36 +--- compiler/main/Packages.hs | 214 +++++++-------------- docs/users_guide/separate_compilation.xml | 5 - ghc/Main.hs | 5 +- testsuite/.gitignore | 6 - testsuite/tests/cabal/sigcabal02/Main.hs | 7 - testsuite/tests/cabal/sigcabal02/Makefile | 34 ---- testsuite/tests/cabal/sigcabal02/Setup.hs | 2 - testsuite/tests/cabal/sigcabal02/ShouldFail.hs | 1 - testsuite/tests/cabal/sigcabal02/all.T | 9 - testsuite/tests/cabal/sigcabal02/p/LICENSE | 0 testsuite/tests/cabal/sigcabal02/p/Map.hsig | 18 -- testsuite/tests/cabal/sigcabal02/p/P.hs | 12 -- testsuite/tests/cabal/sigcabal02/p/Set.hsig | 13 -- testsuite/tests/cabal/sigcabal02/p/p.cabal | 14 -- testsuite/tests/cabal/sigcabal02/q/LICENSE | 0 testsuite/tests/cabal/sigcabal02/q/Map.hsig | 7 - testsuite/tests/cabal/sigcabal02/q/Q.hs | 7 - testsuite/tests/cabal/sigcabal02/q/q.cabal | 13 -- testsuite/tests/cabal/sigcabal02/sigcabal02.stderr | 4 - testsuite/tests/cabal/sigcabal02/sigcabal02.stdout | 5 - testsuite/tests/driver/recomp014/Makefile | 31 --- testsuite/tests/driver/recomp014/all.T | 4 - testsuite/tests/driver/recomp014/recomp014.stdout | 4 - testsuite/tests/driver/sigof01/Makefile | 6 - testsuite/tests/driver/sigof01/all.T | 10 - testsuite/tests/driver/sigof01/sigof01i.script | 1 - testsuite/tests/driver/sigof01/sigof01i.stdout | 3 - testsuite/tests/driver/sigof01/sigof01i2.script | 3 - testsuite/tests/driver/sigof01/sigof01i2.stdout | 9 - testsuite/tests/package/package09e.stderr | 2 +- 40 files changed, 139 insertions(+), 582 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 3f13c20e0c29d3db974c2a0d7d5ec15abd5a434b From git at git.haskell.org Mon Sep 21 18:52:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 18:52:56 +0000 (UTC) Subject: [commit: ghc] master: Revert "Revert "Revert "Change loadSrcInterface to return a list of ModIface""" (09d214d) Message-ID: <20150921185256.E2FB73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/09d214dcd8e831c128c684facb7c8da1d63c58bc/ghc >--------------------------------------------------------------- commit 09d214dcd8e831c128c684facb7c8da1d63c58bc Author: Edward Z. Yang Date: Fri Sep 11 17:15:52 2015 -0700 Revert "Revert "Revert "Change loadSrcInterface to return a list of ModIface""" This reverts commit 0c6c015d42c2bd0ee008f790c7c0cb4c5b78ca6b. >--------------------------------------------------------------- 09d214dcd8e831c128c684facb7c8da1d63c58bc compiler/iface/LoadIface.hs | 50 ++++----------------------- compiler/rename/RnEnv.hs | 5 ++- compiler/rename/RnNames.hs | 75 +++++++++++++++------------------------- compiler/typecheck/TcRnDriver.hs | 5 ++- 4 files changed, 38 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 09d214dcd8e831c128c684facb7c8da1d63c58bc From git at git.haskell.org Mon Sep 21 18:53:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 18:53:01 +0000 (UTC) Subject: [commit: ghc] master: Unify hsig and hs-boot; add preliminary "hs-boot" merging. (06d46b1) Message-ID: <20150921185301.223CE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/06d46b1e4507e09eb2a7a04998a92610c8dc6277/ghc >--------------------------------------------------------------- commit 06d46b1e4507e09eb2a7a04998a92610c8dc6277 Author: Edward Z. Yang Date: Fri Jul 24 15:13:49 2015 -0700 Unify hsig and hs-boot; add preliminary "hs-boot" merging. This patch drops the file level distinction between hs-boot and hsig; we figure out which one we are compiling based on whether or not there is a corresponding hs file lying around. To make the "import A" syntax continue to work for bare hs-boot files, we also introduce hs-boot merging, which takes an A.hi-boot and converts it to an A.hi when there is no A.hs file in scope. This will be generalized in Backpack to merge multiple A.hi files together; which means we can jettison the "load multiple interface files" functionality. This works automatically for --make, but for one-shot compilation we need a new mode: ghc --merge-requirements A will generate an A.hi/A.o from a local A.hi-boot file; Backpack will extend this mechanism further. Has Haddock submodule update to deal with change in msHsFilePath behavior. - This commit drops support for the hsig extension. Can we support it? It's annoying because the finder code is written with the assumption that where there's an hs-boot file, there's always an hs file too. To support hsig, you'd have to probe two locations. Easier to just not support it. - #10333 affects us, modifying an hs-boot still doesn't trigger recomp. - See compiler/main/Finder.hs: this diff is very skeevy, but it seems to work. - This code cunningly doesn't drop hs-boot files from the "drop hs-boot files" module graph, if they don't have a corresponding hs file. I have no idea if this actually is useful. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari, spinda Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1098 >--------------------------------------------------------------- 06d46b1e4507e09eb2a7a04998a92610c8dc6277 compiler/deSugar/Desugar.hs | 2 +- compiler/iface/LoadIface.hs | 2 +- compiler/iface/MkIface.hs | 47 +++- compiler/main/DriverMkDepend.hs | 6 +- compiler/main/DriverPhases.hs | 80 +++---- compiler/main/DriverPipeline.hs | 248 ++++++++++++++------- compiler/main/Finder.hs | 8 +- compiler/main/GHC.hs | 2 +- compiler/main/GhcMake.hs | 103 ++++++--- compiler/main/HscMain.hs | 95 +++++++- compiler/main/HscTypes.hs | 40 ++-- compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 43 ++-- compiler/typecheck/TcRnMonad.hs | 2 +- ghc/Main.hs | 19 +- testsuite/.gitignore | 1 + .../dynamicToo005/{A005.hsig => A005.hs-boot} | 0 .../tests/driver/dynamicToo/dynamicToo005/Makefile | 8 +- .../dynamicToo/dynamicToo006/{A.hsig => A.hs-boot} | 0 .../tests/driver/dynamicToo/dynamicToo006/Makefile | 2 + testsuite/tests/driver/recomp014/Makefile | 33 +++ testsuite/tests/driver/recomp014/all.T | 4 + .../retc003.stdout => recomp014/recomp014.stdout} | 5 +- .../tests/driver/sigof01/{B.hsig => B.hs-boot} | 0 testsuite/tests/driver/sigof01/Makefile | 9 +- testsuite/tests/driver/sigof01/all.T | 10 + testsuite/tests/driver/sigof01/sigof01i.script | 1 + .../sigof01/{sigof01.stdout => sigof01i.stdout} | 0 testsuite/tests/driver/sigof01/sigof01i2.script | 3 + testsuite/tests/driver/sigof01/sigof01i2.stdout | 9 + testsuite/tests/driver/sigof01/sigof01m.stdout | 7 +- testsuite/tests/driver/sigof02/Makefile | 21 +- .../tests/driver/sigof02/{Map.hsig => Map.hs-boot} | 0 .../sigof02/{MapAsSet.hsig => MapAsSet.hs-boot} | 0 testsuite/tests/driver/sigof02/sigof02dm.stdout | 8 +- testsuite/tests/driver/sigof02/sigof02m.stdout | 10 +- .../driver/sigof03/{ASig1.hsig => ASig1.hs-boot} | 0 .../driver/sigof03/{ASig2.hsig => ASig2.hs-boot} | 0 testsuite/tests/driver/sigof03/Makefile | 5 +- testsuite/tests/driver/sigof04/Makefile | 2 +- .../tests/driver/sigof04/{Sig.hsig => Sig.hs-boot} | 0 testsuite/tests/driver/sigof04/sigof04.stderr | 4 +- testsuite/tests/typecheck/should_compile/all.T | 2 +- .../should_compile/{tc264.hsig => tc264.hs-boot} | 0 .../tests/typecheck/should_compile/tc264.stderr | 2 +- testsuite/tests/typecheck/should_fail/all.T | 8 +- .../{tcfail219.hsig => tcfail219.hs-boot} | 0 .../tests/typecheck/should_fail/tcfail219.stderr | 5 +- .../{tcfail220.hsig => tcfail220.hs-boot} | 0 .../tests/typecheck/should_fail/tcfail220.stderr | 10 +- .../{tcfail221.hsig => tcfail221.hs-boot} | 0 .../tests/typecheck/should_fail/tcfail221.stderr | 8 +- .../{tcfail222.hsig => tcfail222.hs-boot} | 0 .../tests/typecheck/should_fail/tcfail222.stderr | 6 +- utils/ghctags/Main.hs | 7 +- utils/haddock | 2 +- 57 files changed, 605 insertions(+), 292 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 06d46b1e4507e09eb2a7a04998a92610c8dc6277 From git at git.haskell.org Mon Sep 21 20:18:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 20:18:03 +0000 (UTC) Subject: [commit: ghc] master: Fix build failure, I think. (d516d2e) Message-ID: <20150921201803.307C93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d516d2e1a4ca349b4a0ad0ed2e71e8ea8808c1d7/ghc >--------------------------------------------------------------- commit d516d2e1a4ca349b4a0ad0ed2e71e8ea8808c1d7 Author: Edward Z. Yang Date: Mon Sep 21 13:20:07 2015 -0700 Fix build failure, I think. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- d516d2e1a4ca349b4a0ad0ed2e71e8ea8808c1d7 compiler/main/HscTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 00ceb41..ddb4ca1 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -2474,7 +2474,7 @@ instance Outputable ModSummary where <> text (hscSourceString (ms_hsc_src ms)) <> comma, text "ms_textual_imps =" <+> ppr (ms_textual_imps ms), text "ms_srcimps =" <+> ppr (ms_srcimps ms), - if not (null (ms_merge_imps ms)) + if not (null (snd (ms_merge_imps ms))) then text "ms_merge_imps =" <+> ppr (ms_merge_imps ms) else empty]), char '}' From git at git.haskell.org Mon Sep 21 21:51:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 21:51:00 +0000 (UTC) Subject: [commit: ghc] master: Remove graphFromVerticesAndAdjacency (07f6418) Message-ID: <20150921215100.529123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/07f6418e690bc44b7b24ca3e376494287679e544/ghc >--------------------------------------------------------------- commit 07f6418e690bc44b7b24ca3e376494287679e544 Author: Bartosz Nitka Date: Mon Sep 21 16:52:10 2015 -0500 Remove graphFromVerticesAndAdjacency It's not used anywhere. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D1266 >--------------------------------------------------------------- 07f6418e690bc44b7b24ca3e376494287679e544 compiler/utils/Digraph.hs | 20 +------------------- 1 file changed, 1 insertion(+), 19 deletions(-) diff --git a/compiler/utils/Digraph.hs b/compiler/utils/Digraph.hs index 3f6ee29..d5924a9 100644 --- a/compiler/utils/Digraph.hs +++ b/compiler/utils/Digraph.hs @@ -4,7 +4,7 @@ -- For Functor SCC. ToDo: Remove me when 7.10 is released {-# OPTIONS_GHC -fno-warn-orphans #-} module Digraph( - Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices, + Graph, graphFromEdgedVertices, SCC(..), Node, flattenSCC, flattenSCCs, stronglyConnCompG, @@ -96,24 +96,6 @@ type Node key payload = (payload, key, [key]) emptyGraph :: Graph a emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing) -graphFromVerticesAndAdjacency - :: Ord key - => [(node, key)] - -> [(key, key)] -- First component is source vertex key, - -- second is target vertex key (thing depended on) - -- Unlike the other interface I insist they correspond to - -- actual vertices because the alternative hides bugs. I can't - -- do the same thing for the other one for backcompat reasons. - -> Graph (node, key) -graphFromVerticesAndAdjacency [] _ = emptyGraph -graphFromVerticesAndAdjacency vertices edges = Graph graph vertex_node (key_vertex . key_extractor) - where key_extractor = snd - (bounds, vertex_node, key_vertex, _) = reduceNodesIntoVertices vertices key_extractor - key_vertex_pair (a, b) = (expectJust "graphFromVerticesAndAdjacency" $ key_vertex a, - expectJust "graphFromVerticesAndAdjacency" $ key_vertex b) - reduced_edges = map key_vertex_pair edges - graph = buildG bounds reduced_edges - graphFromEdgedVertices :: Ord key => [Node key payload] -- The graph; its ok for the From git at git.haskell.org Mon Sep 21 21:51:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 21:51:03 +0000 (UTC) Subject: [commit: ghc] master: TcDeriv: Use a NameEnv instead of association list (5a8b055) Message-ID: <20150921215103.553653A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a8b055ece4ae63eef1fc794f352b7be66e4a0cd/ghc >--------------------------------------------------------------- commit 5a8b055ece4ae63eef1fc794f352b7be66e4a0cd Author: Ben Gamari Date: Mon Sep 21 16:52:23 2015 -0500 TcDeriv: Use a NameEnv instead of association list It's unlikely that these lists would have become very large but nevertheless this is an easy and worthwhile change. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D1265 >--------------------------------------------------------------- 5a8b055ece4ae63eef1fc794f352b7be66e4a0cd compiler/typecheck/TcDeriv.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index a8a83f5..d76302f 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -47,6 +47,7 @@ import DataCon import Maybes import RdrName import Name +import NameEnv import NameSet import TyCon import TcType @@ -441,18 +442,19 @@ pprRepTy fi@(FamInst { fi_tys = lhs }) -- As of 24 April 2012, this only shares MetaTyCons between derivations of -- Generic and Generic1; thus the types and logic are quite simple. type CommonAuxiliary = MetaTyCons -type CommonAuxiliaries = [(TyCon, CommonAuxiliary)] -- NSF what is a more efficient map type? +type CommonAuxiliaries = NameEnv CommonAuxiliary commonAuxiliaries :: [DerivSpec ()] -> TcM (CommonAuxiliaries, BagDerivStuff) -commonAuxiliaries = foldM snoc ([], emptyBag) where +commonAuxiliaries = foldM snoc (emptyNameEnv, emptyBag) where snoc acc@(cas, stuff) (DS {ds_name = nm, ds_cls = cls, ds_tc = rep_tycon}) | getUnique cls `elem` [genClassKey, gen1ClassKey] = extendComAux $ genGenericMetaTyCons rep_tycon (nameModule nm) | otherwise = return acc where extendComAux m -- don't run m if its already in the accumulator - | any ((rep_tycon ==) . fst) cas = return acc + | elemNameEnv (tyConName rep_tycon) cas = return acc | otherwise = do (ca, new_stuff) <- m - return $ ((rep_tycon, ca) : cas, stuff `unionBags` new_stuff) + return ( extendNameEnv cas (tyConName rep_tycon) ca + , stuff `unionBags` new_stuff) renameDeriv :: Bool -> [InstInfo RdrName] @@ -1982,7 +1984,8 @@ genInst comauxs | otherwise = do { (meth_binds, deriv_stuff) <- genDerivStuff loc clas dfun_name rep_tycon - (lookup rep_tycon comauxs) + (lookupNameEnv comauxs + (tyConName rep_tycon)) ; inst_spec <- newDerivClsInst theta spec ; traceTc "newder" (ppr inst_spec) ; let inst_info = InstInfo { iSpec = inst_spec From git at git.haskell.org Mon Sep 21 22:44:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Sep 2015 22:44:12 +0000 (UTC) Subject: [commit: ghc] master: Remove (now bogus) assert. (83e23c1) Message-ID: <20150921224412.4EA683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/83e23c1a4cce36de68c3c8323d27f24182b33f34/ghc >--------------------------------------------------------------- commit 83e23c1a4cce36de68c3c8323d27f24182b33f34 Author: Edward Z. Yang Date: Mon Sep 21 15:46:09 2015 -0700 Remove (now bogus) assert. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 83e23c1a4cce36de68c3c8323d27f24182b33f34 compiler/main/GhcMake.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index cc112da..3d29b1d 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -162,9 +162,12 @@ load how_much = do -- (see msDeps) let all_home_mods = [ms_mod_name s | s <- mod_graph, not (isBootSummary s)] - bad_boot_mods = [s | s <- mod_graph, isBootSummary s, - not (ms_mod_name s `elem` all_home_mods)] - ASSERT( null bad_boot_mods ) return () + -- TODO: Figure out what the correct form of this assert is. It's violated + -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot + -- files without corresponding hs files. + -- bad_boot_mods = [s | s <- mod_graph, isBootSummary s, + -- not (ms_mod_name s `elem` all_home_mods)] + -- ASSERT( null bad_boot_mods ) return () -- check that the module given in HowMuch actually exists, otherwise -- topSortModuleGraph will bomb later. From git at git.haskell.org Tue Sep 22 00:19:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 00:19:28 +0000 (UTC) Subject: [commit: packages/hpc] master: update expected testsuite output (886429b) Message-ID: <20150922001928.1BE953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/886429bf84097bbc16cdb6602b60ba1b9156cf6a >--------------------------------------------------------------- commit 886429bf84097bbc16cdb6602b60ba1b9156cf6a Author: Eric Seidel Date: Sat Sep 19 19:26:15 2015 -0700 update expected testsuite output Signed-off-by: Austin Seipp >--------------------------------------------------------------- 886429bf84097bbc16cdb6602b60ba1b9156cf6a tests/simple/tixs/T10529a.stderr | 2 ++ tests/simple/tixs/T10529b.stderr | 2 ++ tests/simple/tixs/T10529c.stderr | 2 ++ 3 files changed, 6 insertions(+) diff --git a/tests/simple/tixs/T10529a.stderr b/tests/simple/tixs/T10529a.stderr index 5107218..d83560a 100644 --- a/tests/simple/tixs/T10529a.stderr +++ b/tests/simple/tixs/T10529a.stderr @@ -1 +1,3 @@ hpc: can not find NonExistingModule in ./.hpc +CallStack: + error, called at libraries/hpc/Trace/Hpc/Mix.hs:119:15 in hpc-0.6.0.2:Trace.Hpc.Mix diff --git a/tests/simple/tixs/T10529b.stderr b/tests/simple/tixs/T10529b.stderr index 4035997..151b953 100644 --- a/tests/simple/tixs/T10529b.stderr +++ b/tests/simple/tixs/T10529b.stderr @@ -1,2 +1,4 @@ hpc: hash in tix file for module Main (1234567890) does not match hash in ./.hpc/Main.mix (2454134535) +CallStack: + error, called at libraries/hpc/Trace/Hpc/Mix.hs:129:17 in hpc-0.6.0.2:Trace.Hpc.Mix diff --git a/tests/simple/tixs/T10529c.stderr b/tests/simple/tixs/T10529c.stderr index 5a0db11..5c2f649 100644 --- a/tests/simple/tixs/T10529c.stderr +++ b/tests/simple/tixs/T10529c.stderr @@ -1 +1,3 @@ hpc: can not parse ./.hpc/NoParse.mix +CallStack: + error, called at libraries/hpc/Trace/Hpc/Mix.hs:103:43 in hpc-0.6.0.2:Trace.Hpc.Mix From git at git.haskell.org Tue Sep 22 00:22:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 00:22:57 +0000 (UTC) Subject: [commit: ghc] master: base: use Show for ErrorCall in uncaughtExceptionHandler (0b852fc) Message-ID: <20150922002257.24A6E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0b852fcf74c65291aeb6357973ecb715735d6383/ghc >--------------------------------------------------------------- commit 0b852fcf74c65291aeb6357973ecb715735d6383 Author: Eric Seidel Date: Mon Sep 21 19:18:56 2015 -0500 base: use Show for ErrorCall in uncaughtExceptionHandler The default top-level exception handler now uses the `Show` instance for `ErrorCall` when printing exceptions, so it will actually print the out-of-band data (e.g. `CallStack`s) in compiled binaries, instead of just printing the error message. This also updates the hpc submodule to fix the test output. Reviewed By: austin, thomie Differential Revision: https://phabricator.haskell.org/D1217 >--------------------------------------------------------------- 0b852fcf74c65291aeb6357973ecb715735d6383 compiler/deSugar/DsBinds.hs | 2 +- libraries/base/GHC/Conc/Sync.hs | 4 +--- libraries/base/tests/all.T | 4 ++++ libraries/base/tests/readFloat.stderr | 2 ++ libraries/base/tests/topHandler04.hs | 5 +++++ libraries/base/tests/topHandler04.stderr | 2 ++ libraries/hpc | 2 +- testsuite/driver/testlib.py | 4 ++-- testsuite/tests/array/should_run/arr003.stderr | 2 ++ testsuite/tests/array/should_run/arr004.stderr | 2 ++ testsuite/tests/array/should_run/arr007.stderr | 2 ++ testsuite/tests/array/should_run/arr008.stderr | 2 ++ testsuite/tests/codeGen/should_run/T5626.stderr | 3 +++ testsuite/tests/codeGen/should_run/cgrun016.stderr | 2 ++ testsuite/tests/codeGen/should_run/cgrun045.stderr | 2 ++ testsuite/tests/codeGen/should_run/cgrun051.stderr | 2 ++ testsuite/tests/codeGen/should_run/cgrun059.stderr | 2 ++ testsuite/tests/concurrent/should_run/conc021.stderr | 2 ++ testsuite/tests/deriving/should_run/T5628.stderr | 2 ++ testsuite/tests/driver/sigof02/sigof02.stderr | 3 +++ testsuite/tests/driver/sigof02/sigof02m.stderr | 3 +++ testsuite/tests/ffi/should_run/ffi008.stderr | 2 ++ testsuite/tests/ffi/should_run/fptrfail01.stderr | 2 ++ testsuite/tests/ghc-e/should_run/ghc-e005.stderr | 2 ++ testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr | 2 ++ testsuite/tests/simplCore/should_fail/T7411.stderr | 4 +++- testsuite/tests/simplCore/should_run/T457.stderr | 2 ++ testsuite/tests/simplCore/should_run/T5587.stderr | 2 ++ testsuite/tests/simplCore/should_run/T5625.stderr | 3 +++ testsuite/tests/stranal/should_run/strun002.stderr | 2 ++ 30 files changed, 67 insertions(+), 8 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 0b852fcf74c65291aeb6357973ecb715735d6383 From git at git.haskell.org Tue Sep 22 00:30:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 00:30:15 +0000 (UTC) Subject: [commit: ghc] master: Make derived names deterministic (d4d34a7) Message-ID: <20150922003015.04D533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4d34a73aacc225a8f28d7138137bf548c9e51cc/ghc >--------------------------------------------------------------- commit d4d34a73aacc225a8f28d7138137bf548c9e51cc Author: Bartosz Nitka Date: Mon Sep 21 19:30:41 2015 -0500 Make derived names deterministic The names of auxiliary bindings end up in the interface file, and since uniques are nondeterministic, we end up with nondeterministic interface files. This uses the package and module name in the generated name, so I believe it should avoid problems from #7947 and be deterministic as well. The generated names look like this now: `$cLrlbmVwI3gpI8G2E6Hg3mO` and with `-ppr-debug`: `$c$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal$String`. Reviewed By: simonmar, austin, ezyang Differential Revision: https://phabricator.haskell.org/D1133 GHC Trac Issues: #4012 >--------------------------------------------------------------- d4d34a73aacc225a8f28d7138137bf548c9e51cc compiler/backpack/ShPackageKey.hs | 45 +++------------------------------- compiler/basicTypes/Module.hs | 9 +++++++ compiler/basicTypes/Name.hs | 17 +++++++++++++ compiler/typecheck/TcGenDeriv.hs | 34 ++++++++++++++------------ compiler/utils/Encoding.hs | 51 ++++++++++++++++++++++++++++++++++++++- 5 files changed, 97 insertions(+), 59 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 d4d34a73aacc225a8f28d7138137bf548c9e51cc From git at git.haskell.org Tue Sep 22 02:49:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 02:49:21 +0000 (UTC) Subject: [commit: ghc] master: DeriveLift extension (#1830) (089b72f) Message-ID: <20150922024921.C810B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/089b72f524a6a7564346baca9595fcd07081ec40/ghc >--------------------------------------------------------------- commit 089b72f524a6a7564346baca9595fcd07081ec40 Author: RyanGlScott Date: Mon Sep 21 21:50:55 2015 -0500 DeriveLift extension (#1830) Summary: This implements -XDeriveLift, which allows for automatic derivation of the Lift class from template-haskell. The implementation is based off of Ian Lynagh's th-lift library (http://hackage.haskell.org/package/th-lift). Test Plan: ./validate Reviewers: hvr, simonpj, bgamari, goldfire, austin Reviewed By: goldfire, austin Subscribers: osa1, thomie Differential Revision: https://phabricator.haskell.org/D1168 GHC Trac Issues: #1830 >--------------------------------------------------------------- 089b72f524a6a7564346baca9595fcd07081ec40 compiler/main/DynFlags.hs | 2 + compiler/prelude/PrelNames.hs | 9 ++ compiler/prelude/THNames.hs | 49 ++++++- compiler/typecheck/TcDeriv.hs | 13 +- compiler/typecheck/TcGenDeriv.hs | 127 +++++++++++++++++- docs/users_guide/7.12.1-notes.xml | 7 + docs/users_guide/flags.xml | 6 + docs/users_guide/glasgow_exts.xml | 149 +++++++++++++++++++++ .../template-haskell/Language/Haskell/TH/Syntax.hs | 23 ++++ testsuite/tests/deriving/should_compile/T1830.hs | 6 + testsuite/tests/deriving/should_compile/all.T | 1 + testsuite/tests/deriving/should_fail/T1830.hs | 5 + testsuite/tests/deriving/should_fail/T1830.stderr | 5 + testsuite/tests/deriving/should_fail/all.T | 1 + testsuite/tests/driver/T4437.hs | 3 +- testsuite/tests/th/T1830.hs | 15 +++ .../DsStrictData.stdout => th/T1830.stdout} | 1 - testsuite/tests/th/T1830a.hs | 47 +++++++ testsuite/tests/th/all.T | 4 + 19 files changed, 462 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 089b72f524a6a7564346baca9595fcd07081ec40 From git at git.haskell.org Tue Sep 22 12:13:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 12:13:00 +0000 (UTC) Subject: [commit: ghc] master: HscMain: Place CPP macro invocation on one line (4cdab73) Message-ID: <20150922121300.AE3F43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4cdab73f084fda8ea0538908f8d266c800a8b586/ghc >--------------------------------------------------------------- commit 4cdab73f084fda8ea0538908f8d266c800a8b586 Author: Ben Gamari Date: Tue Sep 22 14:14:32 2015 +0200 HscMain: Place CPP macro invocation on one line Clang's CPP implementation seems to barf otherwise >--------------------------------------------------------------- 4cdab73f084fda8ea0538908f8d266c800a8b586 compiler/main/HscMain.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 00cff28..e5c6ce1 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -804,8 +804,7 @@ hscMergeFrontEnd hsc_env mod_summary = do -- 'TcGblEnv' resulting from type-checking. hscFileFrontEnd :: ModSummary -> Hsc TcGblEnv hscFileFrontEnd mod_summary = do - MASSERT( ms_hsc_src mod_summary == HsBootFile || - ms_hsc_src mod_summary == HsSrcFile ) + MASSERT( ms_hsc_src mod_summary == HsBootFile || ms_hsc_src mod_summary == HsSrcFile ) hpm <- hscParse' mod_summary hsc_env <- getHscEnv tcg_env <- tcRnModule' hsc_env mod_summary False hpm From git at git.haskell.org Tue Sep 22 14:47:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 14:47:34 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Clean up types of mkWeak# (07dae12) Message-ID: <20150922144734.0417F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/07dae12cdff170a366bb56945720337b96b44538/ghc >--------------------------------------------------------------- commit 07dae12cdff170a366bb56945720337b96b44538 Author: Ben Gamari Date: Fri Sep 18 17:54:22 2015 +0200 Clean up types of mkWeak# Previously the types needlessly used (), which is defined ghc-prim, leading to unfortunate import cycles. See #10867 for details. >--------------------------------------------------------------- 07dae12cdff170a366bb56945720337b96b44538 compiler/prelude/primops.txt.pp | 6 +++--- libraries/base/GHC/Weak.hs | 2 +- utils/genprimopcode/Main.hs | 10 ---------- 3 files changed, 4 insertions(+), 14 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 5fe02b2..af5e0c9 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2081,7 +2081,7 @@ primop CatchSTMOp "catchSTM#" GenPrimOp primop Check "check#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, () #) ) + -> (State# RealWorld -> State# RealWorld) with out_of_line = True has_side_effects = True @@ -2332,7 +2332,7 @@ primtype Weak# b -- note that tyvar "o" denotes openAlphaTyVar primop MkWeakOp "mkWeak#" GenPrimOp - o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #) + a -> b -> (State# RealWorld -> State# RealWorld) -> (# State# RealWorld, Weak# b #) with has_side_effects = True out_of_line = True @@ -2364,7 +2364,7 @@ primop DeRefWeakOp "deRefWeak#" GenPrimOp primop FinalizeWeakOp "finalizeWeak#" GenPrimOp Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, - (State# RealWorld -> (# State# RealWorld, () #)) #) + (State# RealWorld -> State# RealWorld) #) with has_side_effects = True out_of_line = True diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs index 6d4d80e..9434bd9 100644 --- a/libraries/base/GHC/Weak.hs +++ b/libraries/base/GHC/Weak.hs @@ -141,7 +141,7 @@ Instance Eq (Weak v) where -- the IO primitives are inlined by hand here to get the optimal -- code (sigh) --SDM. -runFinalizerBatch :: Int -> Array# (IO ()) -> IO () +runFinalizerBatch :: Int -> Array# (State# RealWorld -> State# RealWorld) -> IO () runFinalizerBatch (I# n) arr = let go m = IO $ \s -> case m of diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 3ab8ff8..2a5218e 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -262,16 +262,6 @@ gen_hs_source (Info defaults entries) = ++ "-}\n" ++ "import GHC.Types (Coercible)\n" - ++ "import GHC.Tuple ()\n" - -- Note [Import GHC.Tuple into GHC.Prim] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- This expresses a dependency on GHC.Tuple, which we need - -- to ensure that GHC.Tuple is compiled first. The generated - -- code in this module mentions '()', and that in turn tries - -- to ensure that its home module is loaded (for instances I think) - -- So it had better be there, when compiling with --make or Haddock. - -- It's more kosher anyway to be explicit about the dependency. - ++ "default ()" -- If we don't say this then the default type include Integer -- so that runs off and loads modules that are not part of -- pacakge ghc-prim at all. And that in turn somehow ends up From git at git.haskell.org Tue Sep 22 14:47:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 14:47:36 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Move CallStack back to base (05a36ad) Message-ID: <20150922144736.DA75A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/05a36addd363bd40099f587d17b7ed96a700b959/ghc >--------------------------------------------------------------- commit 05a36addd363bd40099f587d17b7ed96a700b959 Author: Ben Gamari Date: Sun Sep 20 08:27:34 2015 +0200 Move CallStack back to base CallStack requires tuples, instances of which are defined in GHC.Tuple. Unfortunately the D757 change to Typeable deriving means that GHC.Tuple must import GHC.Types for the type representation types, resulting in a cycle. >--------------------------------------------------------------- 05a36addd363bd40099f587d17b7ed96a700b959 libraries/base/GHC/Stack.hsc | 51 +++++++++++++++++++++++++++++++++++++++++ libraries/ghc-prim/GHC/Types.hs | 1 - 2 files changed, 51 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc index a2283ff..5bff6d1 100644 --- a/libraries/base/GHC/Stack.hsc +++ b/libraries/base/GHC/Stack.hsc @@ -22,6 +22,9 @@ module GHC.Stack ( whoCreated, errorWithStackTrace, + -- * Implicit parameter call stacks + SrcLoc(..), CallStack(..), + -- * Internals CostCentreStack, CostCentre, @@ -128,3 +131,51 @@ errorWithStackTrace x = unsafeDupablePerformIO $ do if null stack then throwIO (ErrorCall x) else throwIO (ErrorCallWithLocation x (renderStack stack)) + +---------------------------------------------------------------------- +-- Explicit call-stacks built via ImplicitParams +---------------------------------------------------------------------- + +-- | @CallStack at s are an alternate method of obtaining the call stack at a given +-- point in the program. +-- +-- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will +-- solve it with the current location. If another @CallStack@ implicit-parameter +-- is in-scope (e.g. as a function argument), the new location will be appended +-- to the one in-scope, creating an explicit call-stack. For example, +-- +-- @ +-- myerror :: (?loc :: CallStack) => String -> a +-- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc) +-- @ +-- ghci> myerror "die" +-- *** Exception: die +-- CallStack: +-- ?loc, called at MyError.hs:7:51 in main:MyError +-- myerror, called at :2:1 in interactive:Ghci1 +-- +-- @CallStack at s do not interact with the RTS and do not require compilation with +-- @-prof at . On the other hand, as they are built up explicitly using +-- implicit-parameters, they will generally not contain as much information as +-- the simulated call-stacks maintained by the RTS. +-- +-- A @CallStack@ is a @[(String, SrcLoc)]@. The @String@ is the name of +-- function that was called, the 'SrcLoc' is the call-site. The list is +-- ordered with the most recently called function at the head. +-- +-- @since 4.8.2.0 +data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)] } + -- See Note [Overview of implicit CallStacks] + +-- | A single location in the source code. +-- +-- @since 4.8.2.0 +data SrcLoc = SrcLoc + { srcLocPackage :: [Char] + , srcLocModule :: [Char] + , srcLocFile :: [Char] + , srcLocStartLine :: Int + , srcLocStartCol :: Int + , srcLocEndLine :: Int + , srcLocEndCol :: Int + } diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index fe76819..a9e6a47 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -35,7 +35,6 @@ module GHC.Types ( ) where import GHC.Prim -import GHC.Tuple () infixr 5 : From git at git.haskell.org Tue Sep 22 14:47:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 14:47:39 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Weak (a43cb77) Message-ID: <20150922144739.BA18D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/a43cb777ff0f4f702fb6f0e15b48a044383197da/ghc >--------------------------------------------------------------- commit a43cb777ff0f4f702fb6f0e15b48a044383197da Author: Ben Gamari Date: Sun Sep 20 08:33:11 2015 +0200 Weak >--------------------------------------------------------------- a43cb777ff0f4f702fb6f0e15b48a044383197da compiler/prelude/primops.txt.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index af5e0c9..4f4a1b7 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2332,7 +2332,7 @@ primtype Weak# b -- note that tyvar "o" denotes openAlphaTyVar primop MkWeakOp "mkWeak#" GenPrimOp - a -> b -> (State# RealWorld -> State# RealWorld) -> (# State# RealWorld, Weak# b #) + o -> b -> (State# RealWorld -> State# RealWorld) -> (# State# RealWorld, Weak# b #) with has_side_effects = True out_of_line = True From git at git.haskell.org Tue Sep 22 14:47:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 14:47:42 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Clarify where typeable for GHC.Types is derived (eb3eae8) Message-ID: <20150922144742.B007B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/eb3eae86ca62c8b404894c3ad0ee97e10d8d0b73/ghc >--------------------------------------------------------------- commit eb3eae86ca62c8b404894c3ad0ee97e10d8d0b73 Author: Ben Gamari Date: Sun Sep 20 08:33:34 2015 +0200 Clarify where typeable for GHC.Types is derived >--------------------------------------------------------------- eb3eae86ca62c8b404894c3ad0ee97e10d8d0b73 libraries/ghc-prim/GHC/Types.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index a9e6a47..b186a84 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -380,6 +380,14 @@ type lets us use the TrNameS constructor when allocating static data; but we also need TrNameD for the case where we are deserialising a TyCon or Module (for example when deserialising a TypeRep), in which case we can't conveniently come up with an Addr#. + + +Note [Representations of types defined in GHC.Types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The representations for the types defined in GHC.Types are +defined in GHC.Typeable.Internal. + -} #include "MachDeps.h" From git at git.haskell.org Tue Sep 22 14:47:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 14:47:45 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Move CallStack (e908229) Message-ID: <20150922144745.CA4233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/e9082298823e6971dd03b249bb92f2183a5ed2ce/ghc >--------------------------------------------------------------- commit e9082298823e6971dd03b249bb92f2183a5ed2ce Author: Ben Gamari Date: Sun Sep 20 08:35:01 2015 +0200 Move CallStack >--------------------------------------------------------------- e9082298823e6971dd03b249bb92f2183a5ed2ce libraries/ghc-prim/GHC/Types.hs | 50 ----------------------------------------- 1 file changed, 50 deletions(-) diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index b186a84..202b0e0 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -30,7 +30,6 @@ module GHC.Types ( SPEC(..), Nat, Symbol, Coercible, - SrcLoc(..), CallStack(..), TyCon(..), TrName(..), Module(..) ) where @@ -310,55 +309,6 @@ you're reading this in 2023 then things went wrong). See #8326. -- loops should be aggressively specialized. data SPEC = SPEC | SPEC2 --- | A single location in the source code. --- --- @since 4.8.2.0 -data SrcLoc = SrcLoc - { srcLocPackage :: [Char] - , srcLocModule :: [Char] - , srcLocFile :: [Char] - , srcLocStartLine :: Int - , srcLocStartCol :: Int - , srcLocEndLine :: Int - , srcLocEndCol :: Int - } - ----------------------------------------------------------------------- --- Explicit call-stacks built via ImplicitParams ----------------------------------------------------------------------- - --- | @CallStack at s are an alternate method of obtaining the call stack at a given --- point in the program. --- --- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will --- solve it with the current location. If another @CallStack@ implicit-parameter --- is in-scope (e.g. as a function argument), the new location will be appended --- to the one in-scope, creating an explicit call-stack. For example, --- --- @ --- myerror :: (?loc :: CallStack) => String -> a --- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc) --- @ --- ghci> myerror "die" --- *** Exception: die --- CallStack: --- ?loc, called at MyError.hs:7:51 in main:MyError --- myerror, called at :2:1 in interactive:Ghci1 --- --- @CallStack at s do not interact with the RTS and do not require compilation with --- @-prof at . On the other hand, as they are built up explicitly using --- implicit-parameters, they will generally not contain as much information as --- the simulated call-stacks maintained by the RTS. --- --- A @CallStack@ is a @[(String, SrcLoc)]@. The @String@ is the name of --- function that was called, the 'SrcLoc' is the call-site. The list is --- ordered with the most recently called function at the head. --- --- @since 4.8.2.0 -data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)] } - -- See Note [Overview of implicit CallStacks] - - {- ********************************************************************* * * Runtime represntation of TyCon From git at git.haskell.org Tue Sep 22 14:47:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 14:47:48 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Move CallStack type out of GHC.Types (cb79b9f) Message-ID: <20150922144748.EEB913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/cb79b9f14ac7a34beba34805fd1d995d0a2bf64b/ghc >--------------------------------------------------------------- commit cb79b9f14ac7a34beba34805fd1d995d0a2bf64b Author: Ben Gamari Date: Sun Sep 20 10:36:00 2015 +0200 Move CallStack type out of GHC.Types >--------------------------------------------------------------- cb79b9f14ac7a34beba34805fd1d995d0a2bf64b libraries/base/GHC/Exception.hs | 1 + libraries/base/GHC/Exception.hs-boot | 2 +- libraries/base/GHC/Exts.hs | 2 +- libraries/base/GHC/Stack.hsc | 48 ----------------------- libraries/ghc-prim/GHC/Types/Stack.hs | 72 +++++++++++++++++++++++++++++++++++ libraries/ghc-prim/ghc-prim.cabal | 1 + 6 files changed, 76 insertions(+), 50 deletions(-) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index 3fbae05..38d2675 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -37,6 +37,7 @@ import Data.Typeable (Typeable, cast) -- loop: Data.Typeable -> GHC.Err -> GHC.Exception import GHC.Base import GHC.Show +import GHC.Types.Stack {- | The @SomeException@ type is the root of the exception type hierarchy. diff --git a/libraries/base/GHC/Exception.hs-boot b/libraries/base/GHC/Exception.hs-boot index 594f266..0353333 100644 --- a/libraries/base/GHC/Exception.hs-boot +++ b/libraries/base/GHC/Exception.hs-boot @@ -28,7 +28,7 @@ module GHC.Exception ( SomeException, errorCallException, errorCallWithCallStackException, divZeroException, overflowException, ratioZeroDenomException ) where -import GHC.Types( Char, CallStack ) +import GHC.Types.Stack( Char, CallStack ) data SomeException divZeroException, overflowException, ratioZeroDenomException :: SomeException diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index ffc27d1..2fb1b58 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -77,7 +77,7 @@ import GHC.Base hiding (coerce) -- implicitly comes from GHC.Prim import GHC.Word import GHC.Int import GHC.Ptr -import GHC.Stack +import GHC.Types.Stack import qualified Data.Coerce import Data.String diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc index 5bff6d1..6ef1fa5 100644 --- a/libraries/base/GHC/Stack.hsc +++ b/libraries/base/GHC/Stack.hsc @@ -131,51 +131,3 @@ errorWithStackTrace x = unsafeDupablePerformIO $ do if null stack then throwIO (ErrorCall x) else throwIO (ErrorCallWithLocation x (renderStack stack)) - ----------------------------------------------------------------------- --- Explicit call-stacks built via ImplicitParams ----------------------------------------------------------------------- - --- | @CallStack at s are an alternate method of obtaining the call stack at a given --- point in the program. --- --- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will --- solve it with the current location. If another @CallStack@ implicit-parameter --- is in-scope (e.g. as a function argument), the new location will be appended --- to the one in-scope, creating an explicit call-stack. For example, --- --- @ --- myerror :: (?loc :: CallStack) => String -> a --- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc) --- @ --- ghci> myerror "die" --- *** Exception: die --- CallStack: --- ?loc, called at MyError.hs:7:51 in main:MyError --- myerror, called at :2:1 in interactive:Ghci1 --- --- @CallStack at s do not interact with the RTS and do not require compilation with --- @-prof at . On the other hand, as they are built up explicitly using --- implicit-parameters, they will generally not contain as much information as --- the simulated call-stacks maintained by the RTS. --- --- A @CallStack@ is a @[(String, SrcLoc)]@. The @String@ is the name of --- function that was called, the 'SrcLoc' is the call-site. The list is --- ordered with the most recently called function at the head. --- --- @since 4.8.2.0 -data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)] } - -- See Note [Overview of implicit CallStacks] - --- | A single location in the source code. --- --- @since 4.8.2.0 -data SrcLoc = SrcLoc - { srcLocPackage :: [Char] - , srcLocModule :: [Char] - , srcLocFile :: [Char] - , srcLocStartLine :: Int - , srcLocStartCol :: Int - , srcLocEndLine :: Int - , srcLocEndCol :: Int - } diff --git a/libraries/ghc-prim/GHC/Types/Stack.hs b/libraries/ghc-prim/GHC/Types/Stack.hs new file mode 100644 index 0000000..02f7628 --- /dev/null +++ b/libraries/ghc-prim/GHC/Types/Stack.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Types.Stack +-- Copyright : (c) The University of Glasgow 2015 +-- License : see libraries/ghc-prim/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- type definitions for call-stacks via implicit parameters. +-- Use GHC.Exts from the base package instead of importing this +-- module directly. +-- +----------------------------------------------------------------------------- + +module GHC.Types.Stack ( + -- * Implicit parameter call stacks + SrcLoc(..), CallStack(..), + ) where + +import GHC.Types + +---------------------------------------------------------------------- +-- Explicit call-stacks built via ImplicitParams +---------------------------------------------------------------------- + +-- | @CallStack at s are an alternate method of obtaining the call stack at a given +-- point in the program. +-- +-- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will +-- solve it with the current location. If another @CallStack@ implicit-parameter +-- is in-scope (e.g. as a function argument), the new location will be appended +-- to the one in-scope, creating an explicit call-stack. For example, +-- +-- @ +-- myerror :: (?loc :: CallStack) => String -> a +-- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc) +-- @ +-- ghci> myerror "die" +-- *** Exception: die +-- CallStack: +-- ?loc, called at MyError.hs:7:51 in main:MyError +-- myerror, called at :2:1 in interactive:Ghci1 +-- +-- @CallStack at s do not interact with the RTS and do not require compilation with +-- @-prof at . On the other hand, as they are built up explicitly using +-- implicit-parameters, they will generally not contain as much information as +-- the simulated call-stacks maintained by the RTS. +-- +-- A @CallStack@ is a @[(String, SrcLoc)]@. The @String@ is the name of +-- function that was called, the 'SrcLoc' is the call-site. The list is +-- ordered with the most recently called function at the head. +-- +-- @since 4.8.2.0 +data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)] } + -- See Note [Overview of implicit CallStacks] + +-- | A single location in the source code. +-- +-- @since 4.8.2.0 +data SrcLoc = SrcLoc + { srcLocPackage :: [Char] + , srcLocModule :: [Char] + , srcLocFile :: [Char] + , srcLocStartLine :: Int + , srcLocStartCol :: Int + , srcLocEndLine :: Int + , srcLocEndCol :: Int + } diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index 58b6ee0..bb3fc53 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -50,6 +50,7 @@ Library GHC.PrimopWrappers GHC.Tuple GHC.Types + GHC.Types.Stack if flag(include-ghc-prim) exposed-modules: GHC.Prim From git at git.haskell.org Tue Sep 22 21:57:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 21:57:41 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: IntWord64: Add import to GHC.Types (e8926ac) Message-ID: <20150922215741.6A5C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/e8926acecbf97836ee7192d7dd62c42ee9f4e133/ghc >--------------------------------------------------------------- commit e8926acecbf97836ee7192d7dd62c42ee9f4e133 Author: Ben Gamari Date: Tue Sep 22 22:49:08 2015 +0200 IntWord64: Add import to GHC.Types >--------------------------------------------------------------- e8926acecbf97836ee7192d7dd62c42ee9f4e133 libraries/ghc-prim/GHC/IntWord64.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index 52dc08e..94f74aa 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -23,8 +23,9 @@ module GHC.IntWord64 ( #endif ) where +import GHC.Types + #if WORD_SIZE_IN_BITS < 64 -import GHC.Prim foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int# foreign import ccall unsafe "hs_neWord64" neWord64# :: Word64# -> Word64# -> Int# From git at git.haskell.org Tue Sep 22 21:57:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 21:57:44 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: PrelNames: Fix unique key type (5a00384) Message-ID: <20150922215744.37C363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/5a00384f2c94c85768514a2735a2af9bfd734419/ghc >--------------------------------------------------------------- commit 5a00384f2c94c85768514a2735a2af9bfd734419 Author: Ben Gamari Date: Tue Sep 22 22:49:19 2015 +0200 PrelNames: Fix unique key type >--------------------------------------------------------------- 5a00384f2c94c85768514a2735a2af9bfd734419 compiler/prelude/PrelNames.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index d7eec94..749aa77 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -1652,9 +1652,9 @@ ipDataConKey :: Unique ipDataConKey = mkPreludeDataConUnique 38 trTyConDataConKey, trModuleDataConKey, trNameSDataConKey :: Unique -trTyConDataConKey = mkPreludeTyConUnique 185 -trModuleDataConKey = mkPreludeTyConUnique 186 -trNameSDataConKey = mkPreludeTyConUnique 187 +trTyConDataConKey = mkPreludeDataConUnique 185 +trModuleDataConKey = mkPreludeDataConUnique 186 +trNameSDataConKey = mkPreludeDataConUnique 187 {- ************************************************************************ From git at git.haskell.org Tue Sep 22 21:57:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 21:57:47 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Move CallStack back to base as GHC.Stack.Types (88fdd85) Message-ID: <20150922215747.759523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/88fdd85981daa501b1cf2608778871ba0c8856c2/ghc >--------------------------------------------------------------- commit 88fdd85981daa501b1cf2608778871ba0c8856c2 Author: Ben Gamari Date: Tue Sep 22 23:58:29 2015 +0200 Move CallStack back to base as GHC.Stack.Types >--------------------------------------------------------------- 88fdd85981daa501b1cf2608778871ba0c8856c2 compiler/prelude/PrelNames.hs | 9 +++++---- libraries/base/GHC/Err.hs | 3 ++- libraries/base/GHC/Exception.hs | 2 +- libraries/base/GHC/Exception.hs-boot | 3 ++- libraries/base/GHC/Exts.hs | 2 +- .../{ghc-prim/GHC/Types/Stack.hs => base/GHC/Stack/Types.hs} | 4 ++-- libraries/base/base.cabal | 1 + libraries/ghc-prim/ghc-prim.cabal | 1 - 8 files changed, 14 insertions(+), 11 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 749aa77..7cda68d 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -456,8 +456,9 @@ gHC_PARR' = mkBaseModule (fsLit "GHC.PArr") gHC_SRCLOC :: Module gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc") -gHC_STACK :: Module +gHC_STACK, gHC_STACK_TYPES :: Module gHC_STACK = mkBaseModule (fsLit "GHC.Stack") +gHC_STACK_TYPES = mkBaseModule (fsLit "GHC.Stack") gHC_STATICPTR :: Module gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr") @@ -1207,11 +1208,11 @@ knownSymbolClassName = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolCl -- Source Locations callStackDataConName, callStackTyConName, srcLocDataConName :: Name callStackDataConName - = dcQual gHC_TYPES (fsLit "CallStack") callStackDataConKey + = dcQual gHC_STACK_TYPES (fsLit "CallStack") callStackDataConKey callStackTyConName - = tcQual gHC_TYPES (fsLit "CallStack") callStackTyConKey + = tcQual gHC_STACK_TYPES (fsLit "CallStack") callStackTyConKey srcLocDataConName - = dcQual gHC_SRCLOC (fsLit "SrcLoc") srcLocDataConKey + = dcQual gHC_STACK_TYPES (fsLit "SrcLoc") srcLocDataConKey -- plugins pLUGINS :: Module diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs index 8cdb107..6c40cba 100644 --- a/libraries/base/GHC/Err.hs +++ b/libraries/base/GHC/Err.hs @@ -23,7 +23,8 @@ module GHC.Err( absentErr, error, undefined ) where import GHC.CString () -import GHC.Types +import GHC.Types (Char) +import GHC.Stack.Types import GHC.Prim import GHC.Integer () -- Make sure Integer is compiled first -- because GHC depends on it in a wired-in way diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index 38d2675..02c6cfa 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -37,7 +37,7 @@ import Data.Typeable (Typeable, cast) -- loop: Data.Typeable -> GHC.Err -> GHC.Exception import GHC.Base import GHC.Show -import GHC.Types.Stack +import GHC.Stack.Types {- | The @SomeException@ type is the root of the exception type hierarchy. diff --git a/libraries/base/GHC/Exception.hs-boot b/libraries/base/GHC/Exception.hs-boot index 0353333..f89fed1 100644 --- a/libraries/base/GHC/Exception.hs-boot +++ b/libraries/base/GHC/Exception.hs-boot @@ -28,7 +28,8 @@ module GHC.Exception ( SomeException, errorCallException, errorCallWithCallStackException, divZeroException, overflowException, ratioZeroDenomException ) where -import GHC.Types.Stack( Char, CallStack ) +import GHC.Types ( Char ) +import GHC.Stack.Types ( CallStack ) data SomeException divZeroException, overflowException, ratioZeroDenomException :: SomeException diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 2fb1b58..47f5b5b 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -77,7 +77,7 @@ import GHC.Base hiding (coerce) -- implicitly comes from GHC.Prim import GHC.Word import GHC.Int import GHC.Ptr -import GHC.Types.Stack +import GHC.Stack.Types import qualified Data.Coerce import Data.String diff --git a/libraries/ghc-prim/GHC/Types/Stack.hs b/libraries/base/GHC/Stack/Types.hs similarity index 97% rename from libraries/ghc-prim/GHC/Types/Stack.hs rename to libraries/base/GHC/Stack/Types.hs index 02f7628..fc9d6c2 100644 --- a/libraries/ghc-prim/GHC/Types/Stack.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | --- Module : GHC.Types.Stack +-- Module : GHC.Stack.Types -- Copyright : (c) The University of Glasgow 2015 -- License : see libraries/ghc-prim/LICENSE -- @@ -16,7 +16,7 @@ -- ----------------------------------------------------------------------------- -module GHC.Types.Stack ( +module GHC.Stack.Types ( -- * Implicit parameter call stacks SrcLoc(..), CallStack(..), ) where diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 33734a0..3ec2815 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -250,6 +250,7 @@ Library GHC.Show GHC.Stable GHC.Stack + GHC.Stack.Types GHC.Stats GHC.Storable GHC.TopHandler diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index bb3fc53..58b6ee0 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -50,7 +50,6 @@ Library GHC.PrimopWrappers GHC.Tuple GHC.Types - GHC.Types.Stack if flag(include-ghc-prim) exposed-modules: GHC.Prim From git at git.haskell.org Tue Sep 22 21:57:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 21:57:50 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Fix missing PrelNames (e6ae13a) Message-ID: <20150922215750.6D7AB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/e6ae13ac233fbdfea2102852f43f5cf84766a51c/ghc >--------------------------------------------------------------- commit e6ae13ac233fbdfea2102852f43f5cf84766a51c Author: Ben Gamari Date: Tue Sep 22 23:58:46 2015 +0200 Fix missing PrelNames >--------------------------------------------------------------- e6ae13ac233fbdfea2102852f43f5cf84766a51c compiler/prelude/PrelNames.hs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 7cda68d..a3e3742 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -208,7 +208,9 @@ basicKnownKeyNames typeRepTyConName, mkPolyTyConAppName, mkAppTyName, + typeRepIdName, typeLitTypeRepName, + trTyConDataConName, trModuleDataConName, trNameSDataConName, -- Dynamic toDynName, @@ -659,11 +661,6 @@ showString_RDR = varQual_RDR gHC_SHOW (fsLit "showString") showSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showSpace") showParen_RDR = varQual_RDR gHC_SHOW (fsLit "showParen") -typeRep_RDR, mkTyCon_RDR, mkTyConApp_RDR :: RdrName -typeRep_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "typeRep#") -mkTyCon_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyCon") -mkTyConApp_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyConApp") - undefined_RDR :: RdrName undefined_RDR = varQual_RDR gHC_ERR (fsLit "undefined") From git at git.haskell.org Tue Sep 22 21:57:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Sep 2015 21:57:53 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: IntWord64: Fix import (f310fa9) Message-ID: <20150922215753.576823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/f310fa92ad1cb184b9aec12d546ea94e4850b919/ghc >--------------------------------------------------------------- commit f310fa92ad1cb184b9aec12d546ea94e4850b919 Author: Ben Gamari Date: Tue Sep 22 23:59:04 2015 +0200 IntWord64: Fix import >--------------------------------------------------------------- f310fa92ad1cb184b9aec12d546ea94e4850b919 libraries/ghc-prim/GHC/IntWord64.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index 94f74aa..7a3d72c 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -23,10 +23,11 @@ module GHC.IntWord64 ( #endif ) where -import GHC.Types #if WORD_SIZE_IN_BITS < 64 +import GHC.Prim + foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int# foreign import ccall unsafe "hs_neWord64" neWord64# :: Word64# -> Word64# -> Int# foreign import ccall unsafe "hs_ltWord64" ltWord64# :: Word64# -> Word64# -> Int# From git at git.haskell.org Wed Sep 23 06:44:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 06:44:11 +0000 (UTC) Subject: [commit: packages/stm] master: mkWeak# now expects raw State# function (8fb3b33) Message-ID: <20150923064411.BD1083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/8fb3b3336971d784c091dbca674ae1401e506e76 >--------------------------------------------------------------- commit 8fb3b3336971d784c091dbca674ae1401e506e76 Author: Ben Gamari Date: Wed Sep 23 01:26:31 2015 +0200 mkWeak# now expects raw State# function Fallout from GHC Trac #10867. >--------------------------------------------------------------- 8fb3b3336971d784c091dbca674ae1401e506e76 Control/Concurrent/STM/TMVar.hs | 5 ++++- Control/Concurrent/STM/TVar.hs | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/Control/Concurrent/STM/TMVar.hs b/Control/Concurrent/STM/TMVar.hs index e9477df..eed4a9b 100644 --- a/Control/Concurrent/STM/TMVar.hs +++ b/Control/Concurrent/STM/TMVar.hs @@ -160,5 +160,8 @@ isEmptyTMVar (TMVar t) = do -- @since 2.4.4 mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a)) mkWeakTMVar tmv@(TMVar (TVar t#)) f = IO $ \s -> - case mkWeak# t# tmv f s of (# s1, w #) -> (# s1, Weak w #) + case mkWeak# t# tmv finalizer s of (# s1, w #) -> (# s1, Weak w #) + where + finalizer :: State# RealWorld -> State# RealWorld + finalizer s' = case unIO f s' of (# s'', () #) -> s'' #endif diff --git a/Control/Concurrent/STM/TVar.hs b/Control/Concurrent/STM/TVar.hs index 709a7ca..dbf5321 100644 --- a/Control/Concurrent/STM/TVar.hs +++ b/Control/Concurrent/STM/TVar.hs @@ -77,4 +77,7 @@ swapTVar var new = do -- @since 2.4.3 mkWeakTVar :: TVar a -> IO () -> IO (Weak (TVar a)) mkWeakTVar t@(TVar t#) f = IO $ \s -> - case mkWeak# t# t f s of (# s1, w #) -> (# s1, Weak w #) + case mkWeak# t# t finalizer s of (# s1, w #) -> (# s1, Weak w #) + where + finalizer :: State# RealWorld -> State# RealWorld + finalizer s' = case unIO f s' of (# s'', () #) -> s'' From git at git.haskell.org Wed Sep 23 08:34:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 08:34:11 +0000 (UTC) Subject: [commit: ghc] master: testsuite: attempt fixing fallout from 089b72f52 (79f5732) Message-ID: <20150923083411.404D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/79f57325dca4d1ce4601d01c4fab50f7bcfc9b9b/ghc >--------------------------------------------------------------- commit 79f57325dca4d1ce4601d01c4fab50f7bcfc9b9b Author: Austin Seipp Date: Wed Sep 23 03:35:05 2015 -0500 testsuite: attempt fixing fallout from 089b72f52 A few tests had the same name which is a big no-no, so I reorganized them a little. The naming is somewhat haphazard, though... Signed-off-by: Austin Seipp >--------------------------------------------------------------- 79f57325dca4d1ce4601d01c4fab50f7bcfc9b9b testsuite/tests/deriving/should_compile/{T1830.hs => T1830_2.hs} | 2 +- testsuite/tests/deriving/should_compile/all.T | 2 +- testsuite/tests/deriving/should_fail/{T1830.hs => T1830_1.hs} | 2 +- .../tests/deriving/should_fail/{T1830.stderr => T1830_1.stderr} | 2 +- testsuite/tests/deriving/should_fail/all.T | 2 +- testsuite/tests/th/{T1830.hs => T1830_3.hs} | 2 +- testsuite/tests/th/{T1830.stdout => T1830_3.stdout} | 0 testsuite/tests/th/{T1830a.hs => T1830_3a.hs} | 2 +- testsuite/tests/th/all.T | 6 +++--- 9 files changed, 10 insertions(+), 10 deletions(-) diff --git a/testsuite/tests/deriving/should_compile/T1830.hs b/testsuite/tests/deriving/should_compile/T1830_2.hs similarity index 82% rename from testsuite/tests/deriving/should_compile/T1830.hs rename to testsuite/tests/deriving/should_compile/T1830_2.hs index edaff7b..5720aa7 100644 --- a/testsuite/tests/deriving/should_compile/T1830.hs +++ b/testsuite/tests/deriving/should_compile/T1830_2.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveLift #-} -module T1830 where +module T1830_2 where import Language.Haskell.TH.Syntax (Lift) diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index ec81cc3..b1cf3bc 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -16,7 +16,7 @@ test('drv015', normal, compile, ['']) test('drv020', normal, compile, ['']) test('drv022', normal, compile, ['']) test('deriving-1935', normal, compile, ['']) -test('T1830', normal, compile, ['']) +test('T1830_2', normal, compile, ['']) test('T2378', normal, compile, ['']) test('T2856', normal, compile, ['']) test('T3057', extra_clean(['T3057A.o', 'T3057A.hi']), multimod_compile, ['T3057', '-v0']) diff --git a/testsuite/tests/deriving/should_fail/T1830.hs b/testsuite/tests/deriving/should_fail/T1830_1.hs similarity index 78% rename from testsuite/tests/deriving/should_fail/T1830.hs rename to testsuite/tests/deriving/should_fail/T1830_1.hs index 8108d73..e3c2889 100644 --- a/testsuite/tests/deriving/should_fail/T1830.hs +++ b/testsuite/tests/deriving/should_fail/T1830_1.hs @@ -1,4 +1,4 @@ -module T1830 where +module T1830_1 where import Language.Haskell.TH.Syntax (Lift) diff --git a/testsuite/tests/deriving/should_fail/T1830.stderr b/testsuite/tests/deriving/should_fail/T1830_1.stderr similarity index 87% rename from testsuite/tests/deriving/should_fail/T1830.stderr rename to testsuite/tests/deriving/should_fail/T1830_1.stderr index 9c42091..c869b0c 100644 --- a/testsuite/tests/deriving/should_fail/T1830.stderr +++ b/testsuite/tests/deriving/should_fail/T1830_1.stderr @@ -1,5 +1,5 @@ -T1830.hs:5:29: error: +T1830_1.hs:5:29: error: Can't make a derived instance of ?Lift (Foo a)?: You need DeriveLift to derive an instance for this class In the data declaration for ?Foo? diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index d659612..28ede8b 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -16,7 +16,7 @@ test('drvfail016', extra_clean(['drvfail016.hi-boot', 'drvfail016.o-boot']), run_command, ['$MAKE --no-print-directory -s drvfail016']) -test('T1830', normal, compile_fail, ['']) +test('T1830_1', normal, compile_fail, ['']) test('T2394', normal, compile_fail, ['']) # T2604 was removed as it was out of date re: fixing #9858 test('T2701', normal, compile_fail, ['']) diff --git a/testsuite/tests/th/T1830.hs b/testsuite/tests/th/T1830_3.hs similarity index 95% rename from testsuite/tests/th/T1830.hs rename to testsuite/tests/th/T1830_3.hs index a119ec5..3a17548 100644 --- a/testsuite/tests/th/T1830.hs +++ b/testsuite/tests/th/T1830_3.hs @@ -2,7 +2,7 @@ module Main where import Language.Haskell.TH.Syntax (lift) -import T1830a +import T1830_3a main :: IO () main = do diff --git a/testsuite/tests/th/T1830.stdout b/testsuite/tests/th/T1830_3.stdout similarity index 100% rename from testsuite/tests/th/T1830.stdout rename to testsuite/tests/th/T1830_3.stdout diff --git a/testsuite/tests/th/T1830a.hs b/testsuite/tests/th/T1830_3a.hs similarity index 98% rename from testsuite/tests/th/T1830a.hs rename to testsuite/tests/th/T1830_3a.hs index 5012acd..49c059d 100644 --- a/testsuite/tests/th/T1830a.hs +++ b/testsuite/tests/th/T1830_3a.hs @@ -2,7 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} -module T1830a where +module T1830_3a where import GHC.Exts import Language.Haskell.TH.Syntax (Lift(..)) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 0bb4aa4..f72cc30 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -127,10 +127,10 @@ test('TH_ghci1', normal, ghci_script, ['TH_ghci1.script']) test('TH_linePragma', normal, compile_fail, ['-v0']) -test('T1830', - extra_clean(['T1830a.o','T1830a.hi']), +test('T1830_3', + extra_clean(['T1830_3a.o','T1830_3a.hi']), multimod_compile_and_run, - ['T1830', '-v0']) + ['T1830_3', '-v0']) test('T2700', normal, compile, ['-v0']) test('T2817', normal, compile, ['-v0']) test('T2713', normal, compile_fail, ['-v0']) From git at git.haskell.org Wed Sep 23 09:54:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 09:54:24 +0000 (UTC) Subject: [commit: ghc] master: Remove references to () from types of mkWeak# and friends (c6bdf4f) Message-ID: <20150923095424.7839F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6bdf4fb0b06ac55a7bb200f0ef31ea9a7a830ec/ghc >--------------------------------------------------------------- commit c6bdf4fb0b06ac55a7bb200f0ef31ea9a7a830ec Author: Ben Gamari Date: Fri Sep 18 17:54:22 2015 +0200 Remove references to () from types of mkWeak# and friends Previously the types needlessly used (), which is defined ghc-prim, leading to unfortunate import cycles. See #10867 for details. Updates stm submodule. >--------------------------------------------------------------- c6bdf4fb0b06ac55a7bb200f0ef31ea9a7a830ec compiler/prelude/primops.txt.pp | 6 +++--- libraries/base/Control/Concurrent/MVar.hs | 7 +++++-- libraries/base/Data/IORef.hs | 7 +++++-- libraries/base/GHC/Conc/Sync.hs | 2 +- libraries/base/GHC/ForeignPtr.hs | 16 +++++++++++++--- libraries/base/GHC/MVar.hs | 7 +++++-- libraries/base/GHC/Weak.hs | 14 +++++++++----- libraries/stm | 2 +- 8 files changed, 42 insertions(+), 19 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 c6bdf4fb0b06ac55a7bb200f0ef31ea9a7a830ec From git at git.haskell.org Wed Sep 23 09:54:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 09:54:27 +0000 (UTC) Subject: [commit: ghc] master: DsBinds: Avoid using String when desugaring CallStack construction (65bf7ba) Message-ID: <20150923095427.497A23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/65bf7baa81772b7f07a4c74d3510dbd2ef03592d/ghc >--------------------------------------------------------------- commit 65bf7baa81772b7f07a4c74d3510dbd2ef03592d Author: Ben Gamari Date: Wed Sep 23 00:56:03 2015 +0200 DsBinds: Avoid using String when desugaring CallStack construction Previously CallStacks would be built using String, which would pull in GHC.Base while compiling GHC.Err. Use [Char] instead. >--------------------------------------------------------------- 65bf7baa81772b7f07a4c74d3510dbd2ef03592d compiler/deSugar/DsBinds.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 6576093..28e866d 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -47,7 +47,7 @@ import Type import Kind (returnsConstraintKind) import Coercion hiding (substCo) import TysWiredIn ( eqBoxDataCon, coercibleDataCon, mkListTy - , mkBoxedTupleTy, stringTy, typeNatKind, typeSymbolKind ) + , mkBoxedTupleTy, charTy, typeNatKind, typeSymbolKind ) import Id import MkId(proxyHashId) import Class @@ -1023,7 +1023,10 @@ dsEvCallStack cs = do , return $ mkIntExprInt df (srcSpanEndCol l) ]) - let callSiteTy = mkBoxedTupleTy [stringTy, srcLocTy] + -- Be careful to use [Char] instead of String here to avoid + -- unnecessary dependencies on GHC.Base, particularly when + -- building GHC.Err.absentError + let callSiteTy = mkBoxedTupleTy [mkListTy charTy, srcLocTy] matchId <- newSysLocalDs $ mkListTy callSiteTy From git at git.haskell.org Wed Sep 23 13:05:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 13:05:38 +0000 (UTC) Subject: [commit: ghc] master: Annotate CmmBranch with an optional likely target (939a7d6) Message-ID: <20150923130538.B81633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/939a7d6367501d43be73f4e41db7395af1194989/ghc >--------------------------------------------------------------- commit 939a7d6367501d43be73f4e41db7395af1194989 Author: Simon Marlow Date: Mon Sep 21 09:14:33 2015 +0100 Annotate CmmBranch with an optional likely target Summary: This allows the code generator to give hints to later code generation steps about which branch is most likely to be taken. Right now it is only taken into account in one place: a special case in CmmContFlowOpt that swapped branches over to maximise the chance of fallthrough, which is now disabled when there is a likelihood setting. Test Plan: validate Reviewers: austin, simonpj, bgamari, ezyang, tibbe Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1273 >--------------------------------------------------------------- 939a7d6367501d43be73f4e41db7395af1194989 compiler/cmm/CmmCommonBlockElim.hs | 6 +++--- compiler/cmm/CmmContFlowOpt.hs | 29 ++++++++++++++++++----------- compiler/cmm/CmmImplementSwitchPlans.hs | 4 ++-- compiler/cmm/CmmLayoutStack.hs | 2 +- compiler/cmm/CmmLint.hs | 2 +- compiler/cmm/CmmNode.hs | 20 +++++++++++--------- compiler/cmm/CmmParse.y | 2 +- compiler/cmm/CmmProcPoint.hs | 4 ++-- compiler/cmm/MkGraph.hs | 7 ++++--- compiler/cmm/PprC.hs | 4 ++-- compiler/cmm/PprCmm.hs | 5 ++++- compiler/codeGen/StgCmmExpr.hs | 3 ++- compiler/codeGen/StgCmmLayout.hs | 5 +++-- compiler/codeGen/StgCmmMonad.hs | 6 +++--- compiler/codeGen/StgCmmUtils.hs | 2 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 +- compiler/nativeGen/AsmCodeGen.hs | 4 ++-- compiler/nativeGen/PPC/CodeGen.hs | 7 ++++--- compiler/nativeGen/SPARC/CodeGen.hs | 7 ++++--- compiler/nativeGen/X86/CodeGen.hs | 7 ++++--- 20 files changed, 73 insertions(+), 55 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 939a7d6367501d43be73f4e41db7395af1194989 From git at git.haskell.org Wed Sep 23 18:12:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 18:12:54 +0000 (UTC) Subject: [commit: ghc] master: Add constant-folding rule for Data.Bits.bit (cf90a1e) Message-ID: <20150923181254.E4AA93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf90a1e14efb900f94a3824b242be1c38b16a563/ghc >--------------------------------------------------------------- commit cf90a1e14efb900f94a3824b242be1c38b16a563 Author: Ben Gamari Date: Wed Sep 23 13:10:13 2015 -0500 Add constant-folding rule for Data.Bits.bit This adds a constant-folding rule for `Integer`'s implementation of `bit` and fixes the `T8832` testcase. Fixes #8832. Reviewed By: simonpj, austin Differential Revision: https://phabricator.haskell.org/D1255 GHC Trac Issues: #8832 >--------------------------------------------------------------- cf90a1e14efb900f94a3824b242be1c38b16a563 compiler/prelude/PrelNames.hs | 8 +++-- compiler/prelude/PrelRules.hs | 39 +++++++++++++++++----- testsuite/tests/simplCore/should_compile/Makefile | 2 +- .../tests/simplCore/should_compile/T8832.stdout | 21 ++++++------ testsuite/tests/simplCore/should_compile/all.T | 2 +- 5 files changed, 50 insertions(+), 22 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index a6eb834..be6396c 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -308,7 +308,7 @@ basicKnownKeyNames decodeDoubleIntegerName, gcdIntegerName, lcmIntegerName, andIntegerName, orIntegerName, xorIntegerName, complementIntegerName, - shiftLIntegerName, shiftRIntegerName, + shiftLIntegerName, shiftRIntegerName, bitIntegerName, -- Float/Double rationalToFloatName, @@ -939,7 +939,7 @@ integerTyConName, mkIntegerName, integerSDataConName, decodeDoubleIntegerName, gcdIntegerName, lcmIntegerName, andIntegerName, orIntegerName, xorIntegerName, complementIntegerName, - shiftLIntegerName, shiftRIntegerName :: Name + shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey integerSDataConName = dcQual gHC_INTEGER_TYPE (fsLit n) integerSDataConKey where n = case cIntegerLibraryType of @@ -986,6 +986,7 @@ xorIntegerName = varQual gHC_INTEGER_TYPE (fsLit "xorInteger") xor complementIntegerName = varQual gHC_INTEGER_TYPE (fsLit "complementInteger") complementIntegerIdKey shiftLIntegerName = varQual gHC_INTEGER_TYPE (fsLit "shiftLInteger") shiftLIntegerIdKey shiftRIntegerName = varQual gHC_INTEGER_TYPE (fsLit "shiftRInteger") shiftRIntegerIdKey +bitIntegerName = varQual gHC_INTEGER_TYPE (fsLit "bitInteger") bitIntegerIdKey -- GHC.Real types and classes rationalTyConName, ratioTyConName, ratioDataConName, realClassName, @@ -1901,6 +1902,9 @@ typeSymbolTypeRepKey = mkPreludeMiscIdUnique 507 toDynIdKey :: Unique toDynIdKey = mkPreludeMiscIdUnique 508 +bitIntegerIdKey :: Unique +bitIntegerIdKey = mkPreludeMiscIdUnique 509 + {- ************************************************************************ * * diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 1ab8543..d44c224 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -1003,6 +1003,7 @@ builtinIntegerRules = rule_unop "complementInteger" complementIntegerName complement, rule_Int_binop "shiftLInteger" shiftLIntegerName shiftL, rule_Int_binop "shiftRInteger" shiftRIntegerName shiftR, + rule_bitInteger "bitInteger" bitIntegerName, -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs rule_divop_one "quotInteger" quotIntegerName quot, rule_divop_one "remInteger" remIntegerName rem, @@ -1039,6 +1040,9 @@ builtinIntegerRules = rule_unop str name op = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, ru_try = match_Integer_unop op } + rule_bitInteger str name + = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, + ru_try = match_IntToInteger_unop (bit . fromIntegral) } rule_binop str name op = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2, ru_try = match_Integer_binop op } @@ -1155,14 +1159,7 @@ match_magicDict _ = Nothing -- Similarly Int64, Word64 match_IntToInteger :: RuleFun -match_IntToInteger _ id_unf fn [xl] - | Just (MachInt x) <- exprIsLiteral_maybe id_unf xl - = case idType fn of - FunTy _ integerTy -> - Just (Lit (LitInteger x integerTy)) - _ -> - panic "match_IntToInteger: Id has the wrong type" -match_IntToInteger _ _ _ _ = Nothing +match_IntToInteger = match_IntToInteger_unop id match_WordToInteger :: RuleFun match_WordToInteger _ id_unf id [xl] @@ -1209,6 +1206,32 @@ match_Integer_unop unop _ id_unf _ [xl] = Just (Lit (LitInteger (unop x) i)) match_Integer_unop _ _ _ _ _ = Nothing +{- Note [Rewriting bitInteger] + +For most types the bitInteger operation can be implemented in terms of shifts. +The integer-gmp package, however, can do substantially better than this if +allowed to provide its own implementation. However, in so doing it previously lost +constant-folding (see Trac #8832). The bitInteger rule above provides constant folding +specifically for this function. + +There is, however, a bit of trickiness here when it comes to ranges. While the +AST encodes all integers (even MachInts) as Integers, `bit` expects the bit +index to be given as an Int. Hence we coerce to an Int in the rule definition. +This will behave a bit funny for constants larger than the word size, but the user +should expect some funniness given that they will have at very least ignored a +warning in this case. +-} + +match_IntToInteger_unop :: (Integer -> Integer) -> RuleFun +match_IntToInteger_unop unop _ id_unf fn [xl] + | Just (MachInt x) <- exprIsLiteral_maybe id_unf xl + = case idType fn of + FunTy _ integerTy -> + Just (Lit (LitInteger (unop x) integerTy)) + _ -> + panic "match_IntToInteger_unop: Id has the wrong type" +match_IntToInteger_unop _ _ _ _ _ = Nothing + match_Integer_binop :: (Integer -> Integer -> Integer) -> RuleFun match_Integer_binop binop _ id_unf _ [xl,yl] | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index 7f43daf..8c6ec45 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -4,7 +4,7 @@ include $(TOP)/mk/test.mk T8832: $(RM) -f T8832.o T8832.hi - '$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl T8832.hs | grep '#' + '$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl T8832.hs | grep '^[a-zA-Z0-9]\+ =' T8274: $(RM) -f T8274.o T8274.hi diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout b/testsuite/tests/simplCore/should_compile/T8832.stdout index 9c10451..a351735 100644 --- a/testsuite/tests/simplCore/should_compile/T8832.stdout +++ b/testsuite/tests/simplCore/should_compile/T8832.stdout @@ -1,10 +1,11 @@ -i = GHC.Types.I# 0# -i8 = GHC.Int.I8# 0# -i16 = GHC.Int.I16# 0# -i32 = GHC.Int.I32# 0# -i64 = GHC.Int.I64# 0# -w = GHC.Types.W# 0## -w8 = GHC.Word.W8# 0## -w16 = GHC.Word.W16# 0## -w32 = GHC.Word.W32# 0## -w64 = GHC.Word.W64# 0## +i = I# 0# +i8 = I8# 0# +i16 = I16# 0# +i32 = I32# 0# +i64 = I64# 0# +w = W# 0## +w8 = W8# 0## +w16 = W16# 0## +w32 = W32# 0## +w64 = W64# 0## +z = 0 diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index b337c9c..c99b8f2 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -202,7 +202,7 @@ test('T5996', ['$MAKE -s --no-print-directory T5996']) test('T8537', normal, compile, ['']) test('T8832', - expect_broken(8832), + normal, run_command, ['$MAKE -s --no-print-directory T8832 T8832_WORDSIZE_OPTS=' + ('-DT8832_WORDSIZE_64' if wordsize(64) else '')]) From git at git.haskell.org Wed Sep 23 18:12:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 18:12:57 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal to recognize DeriveLift (73921df) Message-ID: <20150923181257.CB5A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/73921df27cac0615d2272b8729381aa0f229a0c8/ghc >--------------------------------------------------------------- commit 73921df27cac0615d2272b8729381aa0f229a0c8 Author: RyanGlScott Date: Wed Sep 23 13:10:42 2015 -0500 Update Cabal to recognize DeriveLift This should (1) fix the ./validate build, which I accidentally broke in D1168, and (2) update the Cabal submodule so that it recognizes `DeriveLift` as a GHC extension. Reviewed By: adamse, austin Differential Revision: https://phabricator.haskell.org/D1269 GHC Trac Issues: #1830 >--------------------------------------------------------------- 73921df27cac0615d2272b8729381aa0f229a0c8 libraries/Cabal | 2 +- testsuite/tests/cabal/cabal07/cabal07.stderr | 1 - testsuite/tests/driver/T1372/T1372.stderr | 1 - testsuite/tests/driver/T4437.hs | 3 +-- 4 files changed, 2 insertions(+), 5 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index ad11363..e6304ff 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit ad1136358d10d68f3d94fa2fe0f11a25331bdf17 +Subproject commit e6304ff660ca629b1b664f0848a601959e31cb31 diff --git a/testsuite/tests/cabal/cabal07/cabal07.stderr b/testsuite/tests/cabal/cabal07/cabal07.stderr index 049d77c..23249b6 100644 --- a/testsuite/tests/cabal/cabal07/cabal07.stderr +++ b/testsuite/tests/cabal/cabal07/cabal07.stderr @@ -4,4 +4,3 @@ Q.hs:3:8: error: It is a member of the hidden package ?containers-0.5.6.2 at 0tT640fErehCGZtZRn6YbE?. Perhaps you need to add ?containers? to the build-depends in your .cabal file. Use -v to see a list of the files searched for. -ExitFailure 1 \ No newline at end of file diff --git a/testsuite/tests/driver/T1372/T1372.stderr b/testsuite/tests/driver/T1372/T1372.stderr index d48426c..f1024e6 100644 --- a/testsuite/tests/driver/T1372/T1372.stderr +++ b/testsuite/tests/driver/T1372/T1372.stderr @@ -1,3 +1,2 @@ Main.hs:5:5: error: Data constructor not in scope: T -ExitFailure 1 \ No newline at end of file diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 9d5202e..c197cbd 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -35,8 +35,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRuleTransitional", "StaticPointers", "StrictData", - "ApplicativeDo", - "DeriveLift"] -- TODO add this to Cabal + "ApplicativeDo"] -- TODO add this to Cabal expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", From git at git.haskell.org Wed Sep 23 18:13:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 18:13:00 +0000 (UTC) Subject: [commit: ghc] master: base: export allocation counter/limit API from System.Mem (453cdbf) Message-ID: <20150923181300.BBB773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/453cdbfcea6962d0a2b5f532b5cdf53d5f82143d/ghc >--------------------------------------------------------------- commit 453cdbfcea6962d0a2b5f532b5cdf53d5f82143d Author: Simon Marlow Date: Wed Sep 23 13:13:28 2015 -0500 base: export allocation counter/limit API from System.Mem Previously it was only available from GHC.Conc, but it makes sense for it to be available from a more official place where people might find it. While I was here, I improved the docs a little. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D1272 >--------------------------------------------------------------- 453cdbfcea6962d0a2b5f532b5cdf53d5f82143d docs/users_guide/7.12.1-notes.xml | 12 ++++++++++++ libraries/base/GHC/Conc/Sync.hs | 4 +++- libraries/base/GHC/IO/Exception.hs | 4 ++-- libraries/base/System/Mem.hs | 21 ++++++++++++++++----- 4 files changed, 33 insertions(+), 8 deletions(-) diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index b23e3d8..c71887f 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -324,6 +324,18 @@ (see Trac #9516). + + + Per-thread allocation counters + (setAllocationCounter and + getAllocationCounter) and limits + (enableAllocationLimit, + disableAllocationLimit are now + available from System.Mem. + Previously this functionality was only available + from GHC.Conc. + + diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 81ec7fa..db6f841 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -213,7 +213,9 @@ getAllocationCounter = do -- to 100K, but tunable with the @+RTS -xq@ option) so that it can handle -- the exception and perform any necessary clean up. If it exhausts -- this additional allowance, another 'AllocationLimitExceeded' exception --- is sent, and so forth. +-- is sent, and so forth. Like other asynchronous exceptions, the +-- 'AllocationLimitExceeded' exception is deferred while the thread is inside +-- 'mask' or an exception handler in 'catch'. -- -- Note that memory allocation is unrelated to /live memory/, also -- known as /heap residency/. A thread can allocate a large amount of diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index e723ebd..7e483de 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -98,8 +98,8 @@ instance Show Deadlock where ----- -- |This thread has exceeded its allocation limit. See --- 'GHC.Conc.setAllocationCounter' and --- 'GHC.Conc.enableAllocationLimit'. +-- 'System.Mem.setAllocationCounter' and +-- 'System.Mem.enableAllocationLimit'. -- -- @since 4.8.0.0 data AllocationLimitExceeded = AllocationLimitExceeded diff --git a/libraries/base/System/Mem.hs b/libraries/base/System/Mem.hs index a894f4d..c47a52d 100644 --- a/libraries/base/System/Mem.hs +++ b/libraries/base/System/Mem.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE Safe #-} - ----------------------------------------------------------------------------- -- | -- Module : System.Mem @@ -14,17 +12,30 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE Trustworthy #-} +-- allocation counter stuff is safe, but GHC.Conc.Sync is Unsafe + module System.Mem - ( performGC + ( + -- * Garbage collection + performGC , performMajorGC , performMinorGC + + -- * Allocation counter and limits + , setAllocationCounter + , getAllocationCounter + , enableAllocationLimit + , disableAllocationLimit ) where --- | Triggers an immediate garbage collection. +import GHC.Conc.Sync + +-- | Triggers an immediate major garbage collection. performGC :: IO () performGC = performMajorGC --- | Triggers an immediate garbage collection. +-- | Triggers an immediate major garbage collection. -- -- @since 4.7.0.0 foreign import ccall "performMajorGC" performMajorGC :: IO () From git at git.haskell.org Wed Sep 23 18:19:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 18:19:22 +0000 (UTC) Subject: [commit: ghc] master: reify associated types when reifying typeclasses (5c11523) Message-ID: <20150923181922.B6BB93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5c115236fe795aa01f0c10106f1b1c959486a739/ghc >--------------------------------------------------------------- commit 5c115236fe795aa01f0c10106f1b1c959486a739 Author: ?mer Sinan A?acan Date: Wed Sep 23 13:19:58 2015 -0500 reify associated types when reifying typeclasses As reported in Trac #10891, Template Haskell's `reify` was not generating Decls for associated types. This patch fixes that. Note that even though `reifyTyCon` function used in this patch returns some type instances, I'm ignoring that. Here's an example of how associated types are encoded with this patch: (Simplified representation) class C a where type F a :: * --> OpenTypeFamilyD "F" ["a"] With default type instances: class C a where type F a :: * type F a = a --> OpenTypeFamilyD "F" ["a"] TySynInstD "F" (TySynEqn [VarT "a"] "a") Reviewed By: goldfire Differential Revision: https://phabricator.haskell.org/D1254 GHC Trac Issues: #10891 >--------------------------------------------------------------- 5c115236fe795aa01f0c10106f1b1c959486a739 compiler/typecheck/TcSplice.hs | 28 +++++++++++++++++++++-- testsuite/tests/th/T10891.hs | 39 +++++++++++++++++++++++++++++++++ testsuite/tests/th/T10891.stderr | 12 ++++++++++ testsuite/tests/th/TH_reifyDecl1.stderr | 2 ++ testsuite/tests/th/all.T | 1 + 5 files changed, 80 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 2a21705..a07d80b 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1202,12 +1202,13 @@ reifyClass cls = do { cxt <- reifyCxt theta ; inst_envs <- tcGetInstEnvs ; insts <- reifyClassInstances cls (InstEnv.classInstances inst_envs cls) + ; assocTys <- concatMapM reifyAT ats ; ops <- concatMapM reify_op op_stuff ; tvs' <- reifyTyVars tvs - ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' ops + ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' (assocTys ++ ops) ; return (TH.ClassI dec insts) } where - (tvs, fds, theta, _, _, op_stuff) = classExtraBigSig cls + (tvs, fds, theta, _, ats, op_stuff) = classExtraBigSig cls fds' = map reifyFunDep fds reify_op (op, def_meth) = do { ty <- reifyType (idType op) @@ -1219,6 +1220,29 @@ reifyClass cls ; return [TH.SigD nm' ty, TH.DefaultSigD nm' gdm_ty] } _ -> return [TH.SigD nm' ty] } + reifyAT :: ClassATItem -> TcM [TH.Dec] + reifyAT (ATI tycon def) = do + tycon' <- reifyTyCon tycon + case tycon' of + TH.FamilyI dec _ -> do + let (tyName, tyArgs) = tfNames dec + (dec :) <$> maybe (return []) + (fmap (:[]) . reifyDefImpl tyName tyArgs) + def + _ -> pprPanic "reifyAT" (text (show tycon')) + + reifyDefImpl :: TH.Name -> [TH.Name] -> Type -> TcM TH.Dec + reifyDefImpl n args ty = + TH.TySynInstD n . TH.TySynEqn (map TH.VarT args) <$> reifyType ty + + tfNames :: TH.Dec -> (TH.Name, [TH.Name]) + tfNames (TH.OpenTypeFamilyD n args _ _) = (n, map bndrName args) + tfNames d = pprPanic "tfNames" (text (show d)) + + bndrName :: TH.TyVarBndr -> TH.Name + bndrName (TH.PlainTV n) = n + bndrName (TH.KindedTV n _) = n + ------------------------------ -- | Annotate (with TH.SigT) a type if the first parameter is True -- and if the type contains a free variable. diff --git a/testsuite/tests/th/T10891.hs b/testsuite/tests/th/T10891.hs new file mode 100644 index 0000000..d91caf9 --- /dev/null +++ b/testsuite/tests/th/T10891.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TypeFamilies #-} + +module T10891 where + +import Language.Haskell.TH +import System.IO + +class C a where + f :: a -> Int + +class C' a where + type F a :: * + type F a = a + f' :: a -> Int + +class C'' a where + data Fd a :: * + +instance C' Int where + type F Int = Bool + f' = id + +instance C'' Int where + data Fd Int = B Bool | C Char + +$(return []) + +test :: () +test = + $(let + display :: Name -> Q () + display q = do + i <- reify q + runIO (hPutStrLn stderr (pprint i) >> hFlush stderr) + in do + display ''C + display ''C' + display ''C'' + [| () |]) diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr new file mode 100644 index 0000000..874f4f0 --- /dev/null +++ b/testsuite/tests/th/T10891.stderr @@ -0,0 +1,12 @@ +class T10891.C (a_0 :: *) + where T10891.f :: forall (a_0 :: *) . T10891.C a_0 => + a_0 -> GHC.Types.Int +class T10891.C' (a_0 :: *) + where type T10891.F (a_0 :: *) :: * + type T10891.F a_0 = a_0 + T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 => + a_0 -> GHC.Types.Int +instance T10891.C' GHC.Types.Int +class T10891.C'' (a_0 :: *) + where data T10891.Fd (a_0 :: *) :: * +instance T10891.C'' GHC.Types.Int diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr index 503f533..e655587 100644 --- a/testsuite/tests/th/TH_reifyDecl1.stderr +++ b/testsuite/tests/th/TH_reifyDecl1.stderr @@ -20,6 +20,8 @@ class TH_reifyDecl1.C2 (a_0 :: *) a_0 -> GHC.Types.Int instance TH_reifyDecl1.C2 GHC.Types.Int class TH_reifyDecl1.C3 (a_0 :: *) + where type TH_reifyDecl1.AT1 (a_0 :: *) :: * + data TH_reifyDecl1.AT2 (a_0 :: *) :: * instance TH_reifyDecl1.C3 GHC.Types.Int type family TH_reifyDecl1.AT1 (a_0 :: *) :: * type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f72cc30..9d4736c 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -359,3 +359,4 @@ test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) test('T10811', normal, compile, ['-v0']) test('T10810', normal, compile, ['-v0']) +test('T10891', normal, compile, ['-v0']) From git at git.haskell.org Wed Sep 23 20:40:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:40:43 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Move CallStack back to base (602b864) Message-ID: <20150923204043.79C023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/602b864849e372f0f48f274cdb880aec776d5523/ghc >--------------------------------------------------------------- commit 602b864849e372f0f48f274cdb880aec776d5523 Author: Ben Gamari Date: Sun Sep 20 08:27:34 2015 +0200 Move CallStack back to base CallStack requires tuples, instances of which are defined in GHC.Tuple. Unfortunately the D757 change to Typeable deriving means that GHC.Tuple must import GHC.Types for the type representation types, resulting in a cycle. >--------------------------------------------------------------- 602b864849e372f0f48f274cdb880aec776d5523 compiler/prelude/PrelNames.hs | 9 +++-- libraries/base/GHC/Err.hs | 3 +- libraries/base/GHC/Exception.hs | 1 + libraries/base/GHC/Exception.hs-boot | 3 +- libraries/base/GHC/Stack.hsc | 3 ++ libraries/base/GHC/Stack/Types.hs | 72 ++++++++++++++++++++++++++++++++++++ libraries/base/base.cabal | 1 + libraries/ghc-prim/GHC/Types.hs | 52 +------------------------- 8 files changed, 88 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 602b864849e372f0f48f274cdb880aec776d5523 From git at git.haskell.org Wed Sep 23 20:40:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:40:46 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Make the generated GHC.Prim module import GHC.Tuple (458112c) Message-ID: <20150923204046.6CA2D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/458112ce4a88f4240d8b74635e15d406919c5430/ghc >--------------------------------------------------------------- commit 458112ce4a88f4240d8b74635e15d406919c5430 Author: Simon Peyton Jones Date: Fri Aug 28 15:24:02 2015 +0100 Make the generated GHC.Prim module import GHC.Tuple See Note [Import GHC.Tuple into GHC.Prim] in genprimopcode/Main.hs I think this has been a lurking bug for ages. Lacking it, Haddock's invocation of GHC for the ghc-prim library says Checking module GHC.Prim... attempting to use module ?GHC.Tuple? (libraries/ghc-prim/./GHC/Tuple.hs) which is not loaded >--------------------------------------------------------------- 458112ce4a88f4240d8b74635e15d406919c5430 utils/genprimopcode/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 2a5218e..3ab8ff8 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -262,6 +262,16 @@ gen_hs_source (Info defaults entries) = ++ "-}\n" ++ "import GHC.Types (Coercible)\n" + ++ "import GHC.Tuple ()\n" + -- Note [Import GHC.Tuple into GHC.Prim] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- This expresses a dependency on GHC.Tuple, which we need + -- to ensure that GHC.Tuple is compiled first. The generated + -- code in this module mentions '()', and that in turn tries + -- to ensure that its home module is loaded (for instances I think) + -- So it had better be there, when compiling with --make or Haddock. + -- It's more kosher anyway to be explicit about the dependency. + ++ "default ()" -- If we don't say this then the default type include Integer -- so that runs off and loads modules that are not part of -- pacakge ghc-prim at all. And that in turn somehow ends up From git at git.haskell.org Wed Sep 23 20:40:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:40:49 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: IntWord64: Add import to GHC.Types (d9b24f6) Message-ID: <20150923204049.5C1693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/d9b24f606fd00c5f5103a5e1f3ad8064e4c9674a/ghc >--------------------------------------------------------------- commit d9b24f606fd00c5f5103a5e1f3ad8064e4c9674a Author: Ben Gamari Date: Tue Sep 22 22:49:08 2015 +0200 IntWord64: Add import to GHC.Types >--------------------------------------------------------------- d9b24f606fd00c5f5103a5e1f3ad8064e4c9674a libraries/base/GHC/Stack/Types.hs | 4 ++++ libraries/ghc-prim/GHC/IntWord64.hs | 3 +++ 2 files changed, 7 insertions(+) diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index fc9d6c2..5c37f64 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -23,6 +23,10 @@ module GHC.Stack.Types ( import GHC.Types +-- Make implicit dependency known to build system +import GHC.Tuple () +import GHC.Integer () + ---------------------------------------------------------------------- -- Explicit call-stacks built via ImplicitParams ---------------------------------------------------------------------- diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index 52dc08e..35bbfd8 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -23,7 +23,10 @@ module GHC.IntWord64 ( #endif ) where +import GHC.Types () -- Make implicit dependency known to build system + #if WORD_SIZE_IN_BITS < 64 + import GHC.Prim foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int# From git at git.haskell.org Wed Sep 23 20:40:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:40:52 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Generate Typeable info at definition sites (e5c95e2) Message-ID: <20150923204052.F3CED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/e5c95e22585568aa84be972de621dbc274089b6e/ghc >--------------------------------------------------------------- commit e5c95e22585568aa84be972de621dbc274089b6e Author: Ben Gamari Date: Wed Aug 26 18:24:34 2015 +0200 Generate Typeable info at definition sites This patch implements the idea floated in Trac #9858, namely that we should generate type-representation information at the data type declaration site, rather than when solving a Typeable constraint. However, this turned out quite a bit harder than I expected. I still think it's the right thing to do, and it's done now, but it was quite a struggle. See particularly * Note [Grand plan for Typeable] in TcTypeable (which is a new module) * Note [The overall promotion story] in DataCon (clarifies existing stuff) The most painful bit was that to generate Typeable instances (ie TyConRepName bindings) for every TyCon is tricky for types in ghc-prim etc: * We need to have enough data types around to *define* a TyCon * Many of these types are wired-in Also, to minimise the code generated for each data type, I wanted to generate pure data, not CAFs with unpackCString# stuff floating about. Performance ~~~~~~~~~~~ Three perf/compiler tests start to allocate quite a bit more. This isn't surprising, because they all allocate zillions of data types, with practically no other code, esp. T1969 * T1969: GHC allocates 30% more * T5642: GHC allocates 14% more * T9872d: GHC allocates 5% more I'm treating this as acceptable. The payoff comes in Typeable-heavy code. Remaining to do ~~~~~~~~~~~~~~~ * I think that "TyCon" and "Module" are over-generic names to use for the runtime type representations used in GHC.Typeable. Better might be "TrTyCon" and "TrModule". But I have not yet done this * Add more info the the "TyCon" e.g. source location where it was defined * Use the new "Module" type to help with Trac Trac #10068 * It would be possible to generate TyConRepName (ie Typeable instances) selectively rather than all the time. We'd need to persist the information in interface files. Lacking a motivating reason I have not done this, but it would not be difficult. Refactoring ~~~~~~~~~~~ As is so often the case, I ended up refactoring more than I intended. In particular * In TyCon, a type *family* (whether type or data) is repesented by a FamilyTyCon * a algebraic data type (including data/newtype instances) is represented by AlgTyCon This wasn't true before; a data family was represented as an AlgTyCon. There are some corresponding changes in IfaceSyn. * Also get rid of the (unhelpfully named) tyConParent. * In TyCon define 'Promoted', isomorphic to Maybe, used when things are optionally promoted; and use it elsewhere in GHC. * Cleanup handling of knownKeyNames * Each TyCon, including promoted TyCons, contains its TyConRepName, if it has one. This is, in effect, the name of its Typeable instance. * Move mkDefaultMethodIds, mkRecSelBinds from TcTyClsDecls to TcTyDecls >--------------------------------------------------------------- e5c95e22585568aa84be972de621dbc274089b6e compiler/basicTypes/DataCon.hs | 222 ++++++++++---- compiler/basicTypes/OccName.hs | 19 +- compiler/basicTypes/Unique.hs | 51 +++- compiler/deSugar/DsBinds.hs | 276 +++++++++-------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsUtils.hs | 6 +- compiler/iface/BuildTyCl.hs | 31 +- compiler/iface/IfaceSyn.hs | 107 +++---- compiler/iface/MkIface.hs | 11 +- compiler/iface/TcIface.hs | 89 +++--- compiler/main/HscMain.hs | 13 +- compiler/main/HscTypes.hs | 12 +- compiler/prelude/PrelInfo.hs | 111 +++---- compiler/prelude/PrelNames.hs | 73 +++-- compiler/prelude/TysPrim.hs | 38 ++- compiler/prelude/TysWiredIn.hs | 55 ++-- compiler/typecheck/TcBinds.hs | 35 ++- compiler/typecheck/TcEvidence.hs | 53 ++-- compiler/typecheck/TcGenGenerics.hs | 38 ++- compiler/typecheck/TcHsSyn.hs | 28 +- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 19 +- compiler/typecheck/TcInteract.hs | 147 +++++---- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 40 +-- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcSplice.hs | 14 + compiler/typecheck/TcTyClsDecls.hs | 324 ++++---------------- compiler/typecheck/TcTyDecls.hs | 330 +++++++++++++++----- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcTypeable.hs | 206 +++++++++++++ compiler/types/TyCon.hs | 404 ++++++++++++++----------- compiler/types/Type.hs | 9 + compiler/utils/Binary.hs | 11 +- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/Env.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 +- libraries/base/Data/Typeable.hs | 3 +- libraries/base/Data/Typeable/Internal.hs | 336 ++++++++++++-------- libraries/base/GHC/Show.hs | 10 + libraries/ghc-prim/GHC/Classes.hs | 36 ++- libraries/ghc-prim/GHC/Magic.hs | 2 + libraries/ghc-prim/GHC/Tuple.hs | 3 + libraries/ghc-prim/GHC/Types.hs | 55 +++- libraries/hpc | 2 +- utils/haddock | 2 +- 47 files changed, 2003 insertions(+), 1267 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 e5c95e22585568aa84be972de621dbc274089b6e From git at git.haskell.org Wed Sep 23 20:40:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:40:55 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Update testsuite (3d9dfae) Message-ID: <20150923204055.CE72D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/3d9dfaecfeed63d267a803a4c2ab6ca4dcb6487d/ghc >--------------------------------------------------------------- commit 3d9dfaecfeed63d267a803a4c2ab6ca4dcb6487d Author: Ben Gamari Date: Wed Sep 23 19:30:54 2015 +0200 Update testsuite >--------------------------------------------------------------- 3d9dfaecfeed63d267a803a4c2ab6ca4dcb6487d .../tests/deSugar/should_compile/T2431.stderr | 29 +++++++++- testsuite/tests/deriving/should_fail/T10524.stderr | 5 +- testsuite/tests/deriving/should_fail/T9687.stderr | 4 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/ghci.debugger/scripts/print019.stderr | 4 +- .../indexed-types/should_compile/T3017.stderr | 2 +- .../tests/numeric/should_compile/T7116.stdout | 29 +++++++++- .../should_fail/overloadedlistsfail01.stderr | 4 +- testsuite/tests/polykinds/T8132.stderr | 4 +- testsuite/tests/quasiquotation/T7918.stdout | 3 ++ testsuite/tests/roles/should_compile/Roles1.stderr | 61 ++++++++++++++++++++++ .../tests/roles/should_compile/Roles13.stderr | 53 +++++++++++++++++-- .../tests/roles/should_compile/Roles14.stderr | 7 +++ testsuite/tests/roles/should_compile/Roles2.stderr | 13 +++++ testsuite/tests/roles/should_compile/Roles4.stderr | 13 +++++ testsuite/tests/roles/should_compile/T8958.stderr | 9 +++- .../tests/simplCore/should_compile/T3717.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T3772.stdout | 29 +++++++++- .../tests/simplCore/should_compile/T4908.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T4930.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T7360.stderr | 47 ++++++++++++++++- .../tests/simplCore/should_compile/T8274.stdout | 8 +++ .../tests/simplCore/should_compile/T9400.stderr | 17 +++++- .../simplCore/should_compile/spec-inline.stderr | 29 +++++++++- .../tests/stranal/should_compile/T10694.stdout | 3 ++ .../stranal/sigs/BottomFromInnerLambda.stderr | 1 + testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr | 2 + testsuite/tests/stranal/sigs/HyperStrUse.stderr | 1 + testsuite/tests/stranal/sigs/StrAnalExample.stderr | 1 + testsuite/tests/stranal/sigs/T8569.stderr | 2 + testsuite/tests/stranal/sigs/T8598.stderr | 1 + testsuite/tests/stranal/sigs/UnsatFun.stderr | 1 + testsuite/tests/th/TH_Roles2.stderr | 8 +++ .../tests/typecheck/should_compile/holes2.stderr | 6 +-- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- .../tests/typecheck/should_fail/tcfail072.stderr | 4 +- .../tests/typecheck/should_fail/tcfail133.stderr | 7 ++- 37 files changed, 461 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 3d9dfaecfeed63d267a803a4c2ab6ca4dcb6487d From git at git.haskell.org Wed Sep 23 20:40:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:40:58 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: More refactoring in matchClass (762dbb5) Message-ID: <20150923204058.A72793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/762dbb519cefb98871da6ebc594b6dd17946527a/ghc >--------------------------------------------------------------- commit 762dbb519cefb98871da6ebc594b6dd17946527a Author: Simon Peyton Jones Date: Fri Aug 28 10:48:32 2015 +0100 More refactoring in matchClass This refactoring was unforced, but tidies up the structure so I can see what is happening. >--------------------------------------------------------------- 762dbb519cefb98871da6ebc594b6dd17946527a compiler/typecheck/TcInteract.hs | 309 +++++++++++++++++++++------------------ 1 file changed, 170 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 762dbb519cefb98871da6ebc594b6dd17946527a From git at git.haskell.org Wed Sep 23 20:41:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:41:01 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Typeable (5e54256) Message-ID: <20150923204101.96DF83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/5e54256733546c68090d2cb2f0c75fd9bad52b7b/ghc >--------------------------------------------------------------- commit 5e54256733546c68090d2cb2f0c75fd9bad52b7b Author: Ben Gamari Date: Wed Sep 23 16:57:38 2015 +0200 Typeable >--------------------------------------------------------------- 5e54256733546c68090d2cb2f0c75fd9bad52b7b compiler/deSugar/DsBinds.hs | 1 - compiler/iface/BuildTyCl.hs | 11 ++++++++++- compiler/iface/IfaceSyn.hs | 26 ++++++++++++++++---------- compiler/prelude/PrelNames.hs | 4 ++++ compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcSplice.hs | 14 -------------- compiler/typecheck/TcTyClsDecls.hs | 14 ++++++++++---- compiler/types/TyCon.hs | 7 ++++--- libraries/ghc-prim/GHC/Types.hs | 3 +-- libraries/hpc | 2 +- utils/haddock | 2 +- 11 files changed, 48 insertions(+), 38 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 5e54256733546c68090d2cb2f0c75fd9bad52b7b From git at git.haskell.org Wed Sep 23 20:41:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:41:04 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: testsuite: Fix GHCi test output (7f1f9d0) Message-ID: <20150923204104.A7BBD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/7f1f9d0fabfdd49b2e83e72510ca9776f57497a8/ghc >--------------------------------------------------------------- commit 7f1f9d0fabfdd49b2e83e72510ca9776f57497a8 Author: Ben Gamari Date: Wed Sep 23 20:31:12 2015 +0200 testsuite: Fix GHCi test output >--------------------------------------------------------------- 7f1f9d0fabfdd49b2e83e72510ca9776f57497a8 testsuite/tests/ghci.debugger/scripts/T2740.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break009.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break010.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break011.stdout | 8 ++++---- testsuite/tests/ghci.debugger/scripts/break012.stdout | 16 ++++++++-------- testsuite/tests/ghci.debugger/scripts/break018.stdout | 4 ++-- .../tests/ghci.debugger/scripts/break022/break022.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break028.stdout | 6 +++--- testsuite/tests/ghci.debugger/scripts/print031.stdout | 2 +- 9 files changed, 24 insertions(+), 24 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/T2740.stdout b/testsuite/tests/ghci.debugger/scripts/T2740.stdout index c6733bc..1f3e6d9 100644 --- a/testsuite/tests/ghci.debugger/scripts/T2740.stdout +++ b/testsuite/tests/ghci.debugger/scripts/T2740.stdout @@ -1,5 +1,5 @@ Stopped at T2740.hs:(3,1)-(4,25) -_result :: a = _ +_result :: a2 = _ Stopped at T2740.hs:3:11-13 _result :: Bool = _ x :: Integer = 1 diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout index b926ed2..1454366 100644 --- a/testsuite/tests/ghci.debugger/scripts/break009.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ *** Exception: Prelude.head: empty list CallStack: - error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List + error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List diff --git a/testsuite/tests/ghci.debugger/scripts/break010.stdout b/testsuite/tests/ghci.debugger/scripts/break010.stdout index 2751b6d..682f4c3 100644 --- a/testsuite/tests/ghci.debugger/scripts/break010.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break010.stdout @@ -1,5 +1,5 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index dafc1fc..67bbec7 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -9,12 +9,12 @@ _exception :: e = _ -2 : main (../Test7.hs:2:8-29) Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Logged breakpoint at ../Test7.hs:2:8-29 -_result :: IO a12 +_result :: IO a14 no more logged breakpoints Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Stopped at _exception :: e already at the beginning of the history @@ -23,7 +23,7 @@ _exception = SomeException "foo" "CallStack: error, called at ../Test7.hs:2:18 in main:Main") -_result :: a12 = _ +_result :: a14 = _ _exception :: SomeException = SomeException (ErrorCallWithLocation "foo" diff --git a/testsuite/tests/ghci.debugger/scripts/break012.stdout b/testsuite/tests/ghci.debugger/scripts/break012.stdout index 70fa0f3..88e8b3e 100644 --- a/testsuite/tests/ghci.debugger/scripts/break012.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break012.stdout @@ -1,16 +1,16 @@ Stopped at break012.hs:(1,1)-(5,18) -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ Stopped at break012.hs:5:10-18 -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ a :: t = _ -b :: a2 -> a2 = _ +b :: a4 -> a4 = _ c :: () = _ -d :: a -> a -> a = _ +d :: a2 -> a2 -> a2 = _ a :: t -b :: a2 -> a2 +b :: a4 -> a4 c :: () -d :: a -> a -> a +d :: a2 -> a2 -> a2 a = (_t1::t) -b = (_t2::a2 -> a2) +b = (_t2::a4 -> a4) c = (_t3::()) -d = (_t4::a -> a -> a) +d = (_t4::a2 -> a2 -> a2) diff --git a/testsuite/tests/ghci.debugger/scripts/break018.stdout b/testsuite/tests/ghci.debugger/scripts/break018.stdout index a12e119..11ef547 100644 --- a/testsuite/tests/ghci.debugger/scripts/break018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break018.stdout @@ -1,5 +1,5 @@ Stopped at ../mdo.hs:(30,1)-(32,27) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ Stopped at ../mdo.hs:(30,16)-(32,27) _result :: IO (N Char) = _ x :: Char = 'h' @@ -10,4 +10,4 @@ f :: N Char = _ l :: N Char = _ x :: Char = 'h' Stopped at ../mdo.hs:(8,1)-(9,42) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout index 99ac58d..a87ffce 100644 --- a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at A.hs:4:1-9 Stopped at A.hs:4:1-9 -_result :: a1 = _ +_result :: a3 = _ Stopped at A.hs:4:7-9 _result :: () = _ x :: () = () diff --git a/testsuite/tests/ghci.debugger/scripts/break028.stdout b/testsuite/tests/ghci.debugger/scripts/break028.stdout index 2438d73..896a241 100644 --- a/testsuite/tests/ghci.debugger/scripts/break028.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break028.stdout @@ -1,5 +1,5 @@ Stopped at break028.hs:15:1-24 -_result :: Id a = _ +_result :: Id a3 = _ Stopped at break028.hs:15:23-24 -_result :: Id a = _ -x' :: Id a = _ +_result :: Id a3 = _ +x' :: Id a3 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/print031.stdout b/testsuite/tests/ghci.debugger/scripts/print031.stdout index 529b698..da3e142 100644 --- a/testsuite/tests/ghci.debugger/scripts/print031.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print031.stdout @@ -4,5 +4,5 @@ Stopped at print031.hs:7:1-19 _result :: Bool = _ Stopped at print031.hs:7:7-19 _result :: Bool = _ -x :: t (Phantom a) = [Just (Phantom 1)] +x :: t (Phantom a5) = [Just (Phantom 1)] x = [Just (Phantom 1)] From git at git.haskell.org Wed Sep 23 20:41:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:41:07 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Fixes (c68e985) Message-ID: <20150923204107.A90EE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/c68e985701ea3112001b0478ec32d54c87fa9ff6/ghc >--------------------------------------------------------------- commit c68e985701ea3112001b0478ec32d54c87fa9ff6 Author: Ben Gamari Date: Wed Sep 23 21:12:03 2015 +0200 Fixes >--------------------------------------------------------------- c68e985701ea3112001b0478ec32d54c87fa9ff6 libraries/hpc | 2 +- testsuite/tests/simplCore/should_compile/rule2.stderr | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/libraries/hpc b/libraries/hpc index 5a1ee4e..886429b 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 5a1ee4e8a2056beff16f0a3cac2c4da61b96f317 +Subproject commit 886429bf84097bbc16cdb6602b60ba1b9156cf6a diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr index 082f9aa..da97b88 100644 --- a/testsuite/tests/simplCore/should_compile/rule2.stderr +++ b/testsuite/tests/simplCore/should_compile/rule2.stderr @@ -10,13 +10,14 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 12 +Total ticks: 13 2 PreInlineUnconditionally 1 f 1 lvl 1 UnfoldingDone 1 Roman.bar 1 RuleFired 1 foo/bar +1 LetFloatFromLet 1 1 EtaReduction 1 ds 7 BetaReduction 1 f From git at git.haskell.org Wed Sep 23 20:41:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:41:10 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Accept more test output (c76e81f) Message-ID: <20150923204110.859553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/c76e81fd98480a43c0cef72a8fd70ae5c85f6e3b/ghc >--------------------------------------------------------------- commit c76e81fd98480a43c0cef72a8fd70ae5c85f6e3b Author: Ben Gamari Date: Wed Sep 23 21:57:49 2015 +0200 Accept more test output >--------------------------------------------------------------- c76e81fd98480a43c0cef72a8fd70ae5c85f6e3b compiler/deSugar/DsBinds.hs | 2 +- .../tests/ghci.debugger/scripts/print018.stdout | 6 +++--- testsuite/tests/ghci/scripts/T8674.stdout | 4 +--- testsuite/tests/roles/should_compile/Roles3.stderr | 25 ++++++++++++++++++++++ .../tests/simplCore/should_compile/T3234.stderr | 4 ++-- .../tests/typecheck/should_fail/T9858a.stderr | 6 +++--- .../tests/typecheck/should_fail/T9858b.stderr | 5 ++--- .../should_fail/TcStaticPointersFail02.stderr | 4 +--- 8 files changed, 38 insertions(+), 18 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 4887354..57f463c 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -945,7 +945,7 @@ ds_ev_typeable ty (EvTypeableTyLit _) -- typeLitTypeRep :: String -> TypeRep -- ; let finst = mkTyApps (Var ctr) [ty] -- proxy = mkTyApps (Var proxyHashId) [typeKind ty, ty] - ; tag <- mkStringExpr str + ; let tag = Lit $ MachStr $ fastStringToByteString $ mkFastString str ; return (mkApps (Var ctr) [tag]) } where str diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout index d5b7d46..a00d537 100644 --- a/testsuite/tests/ghci.debugger/scripts/print018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout @@ -3,9 +3,9 @@ Stopped at ../Test.hs:40:1-17 _result :: () = _ Stopped at ../Test.hs:40:10-17 _result :: () = _ -x :: a17 = _ -x = (_t1::a17) -x :: a17 +x :: a36 = _ +x = (_t1::a36) +x :: a36 () x = Unary x :: Unary diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout index 6c13176..45d4f0a 100644 --- a/testsuite/tests/ghci/scripts/T8674.stdout +++ b/testsuite/tests/ghci/scripts/T8674.stdout @@ -1,5 +1,3 @@ -type role Sing nominal -data family Sing (a :: k) - -- Defined at T8674.hs:4:1 +data family Sing (a :: k) -- Defined at T8674.hs:4:1 data instance Sing Bool = SBool -- Defined at T8674.hs:6:15 data instance Sing a = SNil -- Defined at T8674.hs:5:15 diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 6f25b63..483b349 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -26,4 +26,29 @@ Dependent packages: [base-4.8.2.0, ghc-prim-0.4.0.0, integer-gmp-1.0.0.0] ==================== Typechecker ==================== +Roles3.$tcC4 + = TyCon + 12861862461396457184## + 6389612623460961504## + Roles3.$trModule + (TrNameS "C4"#) +Roles3.$tcC3 + = TyCon + 5998139369941479154## + 6816352641934636458## + Roles3.$trModule + (TrNameS "C3"#) +Roles3.$tcC2 + = TyCon + 8833962732139387711## + 7891126688522429937## + Roles3.$trModule + (TrNameS "C2"#) +Roles3.$tcC1 + = TyCon + 16242970448469140073## + 10229725431456576413## + Roles3.$trModule + (TrNameS "C1"#) +Roles3.$trModule = Module (TrNameS "main"#) (TrNameS "Roles3"#) diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr index c3591d0..d317991 100644 --- a/testsuite/tests/simplCore/should_compile/T3234.stderr +++ b/testsuite/tests/simplCore/should_compile/T3234.stderr @@ -10,7 +10,7 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 45 +Total ticks: 46 14 PreInlineUnconditionally 1 n @@ -37,7 +37,7 @@ Total ticks: 45 1 foldr/single 1 unpack 1 unpack-list -1 LetFloatFromLet 1 +2 LetFloatFromLet 2 22 BetaReduction 1 a 1 b diff --git a/testsuite/tests/typecheck/should_fail/T9858a.stderr b/testsuite/tests/typecheck/should_fail/T9858a.stderr index a42339e..9cb68e0 100644 --- a/testsuite/tests/typecheck/should_fail/T9858a.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858a.stderr @@ -1,9 +1,9 @@ T9858a.hs:28:18: error: - No instance for (Typeable - ((() :: Constraint, () :: Constraint) => ())) + No instance for (Typeable (() :: Constraint)) arising from a use of ?cast? - (maybe you haven't applied a function to enough arguments?) + GHC can't yet do polykinded + Typeable (() :: Constraint :: Constraint) In the expression: cast e In the expression: case cast e of { Just e' -> ecast e' } In an equation for ?supercast?: diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr index 656ff53..a84c1bd 100644 --- a/testsuite/tests/typecheck/should_fail/T9858b.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr @@ -1,8 +1,7 @@ T9858b.hs:7:8: error: - No instance for (Typeable (Eq Int => Int)) - arising from a use of ?typeRep? - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable (Eq Int)) arising from a use of ?typeRep? + GHC can't yet do polykinded Typeable (Eq Int :: Constraint) In the expression: typeRep (Proxy :: Proxy (Eq Int => Int)) In an equation for ?test?: test = typeRep (Proxy :: Proxy (Eq Int => Int)) diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index f63fb47..6237b76 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -6,8 +6,6 @@ TcStaticPointersFail02.hs:9:6: error: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - No instance for (Typeable (Monad m => a -> m a)) - arising from a static form - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable m) arising from a static form In the expression: static return In an equation for ?f2?: f2 = static return From git at git.haskell.org Wed Sep 23 20:41:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 20:41:13 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2's head updated: Accept more test output (c76e81f) Message-ID: <20150923204113.B56FA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9858-typeable-ben2' now includes: 5d7a873 Testsuite: don't warn about missing specialisations e0b3ff0 Testsuite: update expected output 3b23379 Testsuite: mark 4 tests expect_broken_for(#10712, opt_ways) 32a9ead Fix some tests that were broken by D861 c43c8e2 Testsuite: by default run all tests for a single way bd16e0b Testsuite: delete dead code 3744578 Injective type families 5dc88b7 Add test for T10836 (expected broken) 34b106f Accept underscores in the module parser. (Thanks spinda for the fix.) b639c97 Testsuite: fix tcfail220 - Maybe is wired-in now e1293bb Testsuite: only print msg when timeout kills process unexpectedly 79cdb25 Testsuite: ignore line number differences in call stacks (#10834) 85915e9 Make Data.List.foldr1 inline 19c6049 Fix T6018th test failure 64761ce Build system: implement `make install-strip` (#1851) 5c372fe ghc-pkg: don't print ignored errors when verbosity=0 c60c462 user-guide: Add missing tags around body 96b986b EventLog: Factor out ensureRoomFor*Event 062feee tracing: Kill EVENT_STARTUP 2c24fd7 Build system: put each BuildFlavour in a separate file (#10223) b40e559 Build system: simplify *-llvm BuildFlavours (#10223) 1abbacd Build system: cleanup utils/ghc-pkg/ghc.mk dc671a1 SPECIALIZE strictMinimum for Int and Integer c6b82e9 Further simplify the story around minimum/maximum 554be5e Build system: detect when user cloned from GitHub 864a9c4 Build system: remove hack for Mac OSX in configure.ac (#10476) a158607 Build system: delete the InstallExtraPackages variable 330fbbd Build system: make *-cross BuildFlavours consistent (#10223) 8be43dd Build system: cleanup BUILD_DIRS + add lots of Notes e4a73f4 Move GeneralCategory et al to GHC.Unicode 1b8eca1 Build system: check for inconsistent settings (#10157) dbb4e41 HeapStackCheck: Small refactoring 4356dac Forbid annotations when Safe Haskell safe mode is enabled. 23a301a Testsuite: comment out `setnumcapabilities001` (#10860) cdca31e Don't check in autogenerated hs files for recomp013. 3a71d78 Comments on oneShot a870738 Improve rejigConRes (again) 487c90e Add a test for Trac #10806 a7f6909 A CFunEqCan can be Derived 377395e Improve documentation for transform list-comps 50d1c72 Fix broken links in documentation 413fa95 Improve documentation of comprehensions f30a492 Testsuite cleanup 8c0eca3 Add assertions 18759cc Remove redundant language extensions 195af2d Dead code removal, export cleanup 4275028 Code movement 7ad4b3c s/StgArrWords/StgArrBytes/ 89324b8 Testsuite: normalise slashes in callstack output 37081ac Testsuite: mark enum01-enum03 expect_broken(#9399) on Windows 3ec205a CodeGen: fix typo in error message 08af42f hpc: use `takeDirectory` instead of `dropWhileEnd (/= '/')` c8d438f Testsuite: mark T6037 expect_fail on Windows (#6037) 12b0bb6 Account for stack allocation in the thread's allocation counter 14c4090 Pretty: fix unicode arrow operators. 325efac Fix `hp2ps -i-` e66daec DynFlags: remove unused sPgm_sysman (#8689) 8d89d80 Testsuite: add test for #10781 43eb1dc Show minimal complete definitions in ghci (#10847) 8ecf6d8 ApplicativeDo transformation 77662e1 Add namePackage function to template-haskell 48746ff Docs: make sure all libs are included in index.html (#10879) a8406f8 Pass TEST_HC_OPTS in bug1465 and T5792. 2d4db40 Fix #10815 by kind-checking type patterns against known kinds. 8ee2b95 Polish some error messages. b89c491 Always run explicitly requested ways (extra_ways) for fast runs. c738b12 Replace [PostTc id Type] with PostTc id [Type] e156361 Put stable pointer names in the name cache. 1637e4d Driver: --make -o without Main should be an error (#10895) 1a13551 Test #10347 d19a77a Update user guide, fixing #10772 d7f2ab0 Test #10770 79b8e89 Print associated types a bit better. 1292c17 Allow TH quoting of assoc type defaults. 27f9186 Clarify parsing infelicity. 93fafe0 Re-polish error messages around injective TFs. 6a20920 Small improvement in pretty-printing constructors. cbcad85 Fix typo in test for #10347. 2f9809e Slightly better `Coercible` errors. e27b267 Perform a validity check on assoc type defaults. 8e8b9ed Run simplifier only when the env is clean. cd2840a Refactor BranchLists. c234acb `_ <- mapM` --> `mapM_` 3f13c20 Revert "Revert "Revert "Support for multiple signature files in scope.""" 09d214d Revert "Revert "Revert "Change loadSrcInterface to return a list of ModIface""" 06d46b1 Unify hsig and hs-boot; add preliminary "hs-boot" merging. d516d2e Fix build failure, I think. 07f6418 Remove graphFromVerticesAndAdjacency 5a8b055 TcDeriv: Use a NameEnv instead of association list 83e23c1 Remove (now bogus) assert. 0b852fc base: use Show for ErrorCall in uncaughtExceptionHandler d4d34a7 Make derived names deterministic 089b72f DeriveLift extension (#1830) 4cdab73 HscMain: Place CPP macro invocation on one line 79f5732 testsuite: attempt fixing fallout from 089b72f52 c6bdf4f Remove references to () from types of mkWeak# and friends 65bf7ba DsBinds: Avoid using String when desugaring CallStack construction 602b864 Move CallStack back to base d9b24f6 IntWord64: Add import to GHC.Types 458112c Make the generated GHC.Prim module import GHC.Tuple e5c95e2 Generate Typeable info at definition sites 5e54256 Typeable 762dbb5 More refactoring in matchClass 3d9dfae Update testsuite 7f1f9d0 testsuite: Fix GHCi test output c68e985 Fixes c76e81f Accept more test output From git at git.haskell.org Wed Sep 23 21:23:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 21:23:34 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Fix haddock commit (d66e36a) Message-ID: <20150923212334.877613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/d66e36a43ab855aed845067a3b5487a4438d32e2/ghc >--------------------------------------------------------------- commit d66e36a43ab855aed845067a3b5487a4438d32e2 Author: Ben Gamari Date: Wed Sep 23 23:25:22 2015 +0200 Fix haddock commit >--------------------------------------------------------------- d66e36a43ab855aed845067a3b5487a4438d32e2 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 9322e71..289ef81 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 9322e716bd354b750ecb97bb8c95cae7bb51c73e +Subproject commit 289ef817aad02c341beb6d4c28ba0495872f5a0f From git at git.haskell.org Wed Sep 23 23:11:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Sep 2015 23:11:05 +0000 (UTC) Subject: [commit: ghc] master: Revert "reify associated types when reifying typeclasses" (39a262e) Message-ID: <20150923231105.913F13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/39a262e53bab3b7cf827fa9f22226da5fca055be/ghc >--------------------------------------------------------------- commit 39a262e53bab3b7cf827fa9f22226da5fca055be Author: Austin Seipp Date: Wed Sep 23 18:12:14 2015 -0500 Revert "reify associated types when reifying typeclasses" This caused the build to fail, due to some type checking errors. Whoops. This reverts commit 5c115236fe795aa01f0c10106f1b1c959486a739. >--------------------------------------------------------------- 39a262e53bab3b7cf827fa9f22226da5fca055be compiler/typecheck/TcSplice.hs | 28 ++--------------------- testsuite/tests/th/T10891.hs | 39 --------------------------------- testsuite/tests/th/T10891.stderr | 12 ---------- testsuite/tests/th/TH_reifyDecl1.stderr | 2 -- testsuite/tests/th/all.T | 1 - 5 files changed, 2 insertions(+), 80 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index a07d80b..2a21705 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1202,13 +1202,12 @@ reifyClass cls = do { cxt <- reifyCxt theta ; inst_envs <- tcGetInstEnvs ; insts <- reifyClassInstances cls (InstEnv.classInstances inst_envs cls) - ; assocTys <- concatMapM reifyAT ats ; ops <- concatMapM reify_op op_stuff ; tvs' <- reifyTyVars tvs - ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' (assocTys ++ ops) + ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' ops ; return (TH.ClassI dec insts) } where - (tvs, fds, theta, _, ats, op_stuff) = classExtraBigSig cls + (tvs, fds, theta, _, _, op_stuff) = classExtraBigSig cls fds' = map reifyFunDep fds reify_op (op, def_meth) = do { ty <- reifyType (idType op) @@ -1220,29 +1219,6 @@ reifyClass cls ; return [TH.SigD nm' ty, TH.DefaultSigD nm' gdm_ty] } _ -> return [TH.SigD nm' ty] } - reifyAT :: ClassATItem -> TcM [TH.Dec] - reifyAT (ATI tycon def) = do - tycon' <- reifyTyCon tycon - case tycon' of - TH.FamilyI dec _ -> do - let (tyName, tyArgs) = tfNames dec - (dec :) <$> maybe (return []) - (fmap (:[]) . reifyDefImpl tyName tyArgs) - def - _ -> pprPanic "reifyAT" (text (show tycon')) - - reifyDefImpl :: TH.Name -> [TH.Name] -> Type -> TcM TH.Dec - reifyDefImpl n args ty = - TH.TySynInstD n . TH.TySynEqn (map TH.VarT args) <$> reifyType ty - - tfNames :: TH.Dec -> (TH.Name, [TH.Name]) - tfNames (TH.OpenTypeFamilyD n args _ _) = (n, map bndrName args) - tfNames d = pprPanic "tfNames" (text (show d)) - - bndrName :: TH.TyVarBndr -> TH.Name - bndrName (TH.PlainTV n) = n - bndrName (TH.KindedTV n _) = n - ------------------------------ -- | Annotate (with TH.SigT) a type if the first parameter is True -- and if the type contains a free variable. diff --git a/testsuite/tests/th/T10891.hs b/testsuite/tests/th/T10891.hs deleted file mode 100644 index d91caf9..0000000 --- a/testsuite/tests/th/T10891.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module T10891 where - -import Language.Haskell.TH -import System.IO - -class C a where - f :: a -> Int - -class C' a where - type F a :: * - type F a = a - f' :: a -> Int - -class C'' a where - data Fd a :: * - -instance C' Int where - type F Int = Bool - f' = id - -instance C'' Int where - data Fd Int = B Bool | C Char - -$(return []) - -test :: () -test = - $(let - display :: Name -> Q () - display q = do - i <- reify q - runIO (hPutStrLn stderr (pprint i) >> hFlush stderr) - in do - display ''C - display ''C' - display ''C'' - [| () |]) diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr deleted file mode 100644 index 874f4f0..0000000 --- a/testsuite/tests/th/T10891.stderr +++ /dev/null @@ -1,12 +0,0 @@ -class T10891.C (a_0 :: *) - where T10891.f :: forall (a_0 :: *) . T10891.C a_0 => - a_0 -> GHC.Types.Int -class T10891.C' (a_0 :: *) - where type T10891.F (a_0 :: *) :: * - type T10891.F a_0 = a_0 - T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 => - a_0 -> GHC.Types.Int -instance T10891.C' GHC.Types.Int -class T10891.C'' (a_0 :: *) - where data T10891.Fd (a_0 :: *) :: * -instance T10891.C'' GHC.Types.Int diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr index e655587..503f533 100644 --- a/testsuite/tests/th/TH_reifyDecl1.stderr +++ b/testsuite/tests/th/TH_reifyDecl1.stderr @@ -20,8 +20,6 @@ class TH_reifyDecl1.C2 (a_0 :: *) a_0 -> GHC.Types.Int instance TH_reifyDecl1.C2 GHC.Types.Int class TH_reifyDecl1.C3 (a_0 :: *) - where type TH_reifyDecl1.AT1 (a_0 :: *) :: * - data TH_reifyDecl1.AT2 (a_0 :: *) :: * instance TH_reifyDecl1.C3 GHC.Types.Int type family TH_reifyDecl1.AT1 (a_0 :: *) :: * type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 9d4736c..f72cc30 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -359,4 +359,3 @@ test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) test('T10811', normal, compile, ['-v0']) test('T10810', normal, compile, ['-v0']) -test('T10891', normal, compile, ['-v0']) From git at git.haskell.org Thu Sep 24 07:42:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Sep 2015 07:42:19 +0000 (UTC) Subject: [commit: ghc] master: Fix a bug with mallocForeignPtr and finalizers (#10904) (2440e3c) Message-ID: <20150924074219.3AFBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2440e3c6b479ac532e2660374a78c8482e903bed/ghc >--------------------------------------------------------------- commit 2440e3c6b479ac532e2660374a78c8482e903bed Author: Simon Marlow Date: Wed Sep 23 10:01:23 2015 +0100 Fix a bug with mallocForeignPtr and finalizers (#10904) Summary: See Note [MallocPtr finalizers] Test Plan: validate; new test T10904 Reviewers: ezyang, bgamari, austin, hvr, rwbarton Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1275 >--------------------------------------------------------------- 2440e3c6b479ac532e2660374a78c8482e903bed libraries/base/GHC/ForeignPtr.hs | 36 +++++++++++++++++++++--------------- rts/sm/MarkWeak.c | 5 +++++ testsuite/tests/rts/T10904.hs | 28 ++++++++++++++++++++++++++++ testsuite/tests/rts/T10904lib.c | 30 ++++++++++++++++++++++++++++++ testsuite/tests/rts/all.T | 4 ++++ 5 files changed, 88 insertions(+), 15 deletions(-) diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 0b9118e..a1ff1ba 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -248,11 +248,18 @@ addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO () -- finalizer will run /before/ all other finalizers for the same -- object which have already been registered. addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of - PlainForeignPtr r -> f r >> return () - MallocPtr _ r -> f r >> return () + PlainForeignPtr r -> insertCFinalizer r fp 0# nullAddr# p () + MallocPtr _ r -> insertCFinalizer r fp 0# nullAddr# p c _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer" - where - f r = insertCFinalizer r fp 0# nullAddr# p + +-- Note [MallocPtr finalizers] (#10904) +-- +-- When we have C finalizers for a MallocPtr, the memory is +-- heap-resident and would normally be recovered by the GC before the +-- finalizers run. To prevent the memory from being reused too early, +-- we attach the MallocPtr constructor to the "value" field of the +-- weak pointer when we call mkWeak# in ensureCFinalizerWeak below. +-- The GC will keep this field alive until the finalizers have run. addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO () @@ -261,11 +268,9 @@ addForeignPtrFinalizerEnv :: -- finalizer. The environment passed to the finalizer is fixed by the -- second argument to 'addForeignPtrFinalizerEnv' addForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of - PlainForeignPtr r -> f r >> return () - MallocPtr _ r -> f r >> return () + PlainForeignPtr r -> insertCFinalizer r fp 1# ep p () + MallocPtr _ r -> insertCFinalizer r fp 1# ep p c _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer" - where - f r = insertCFinalizer r fp 1# ep p addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO () -- ^This function adds a finalizer to the given @ForeignPtr at . The @@ -327,9 +332,9 @@ insertHaskellFinalizer r f = do data MyWeak = MyWeak (Weak# ()) insertCFinalizer :: - IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> IO () -insertCFinalizer r fp flag ep p = do - MyWeak w <- ensureCFinalizerWeak r + IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () +insertCFinalizer r fp flag ep p val = do + MyWeak w <- ensureCFinalizerWeak r val IO $ \s -> case addCFinalizerToWeak# fp p flag ep w s of (# s1, 1# #) -> (# s1, () #) @@ -337,16 +342,17 @@ insertCFinalizer r fp flag ep p = do -- has finalized w by calling foreignPtrFinalizer. We retry now. -- This won't be an infinite loop because that thread must have -- replaced the content of r before calling finalizeWeak#. - (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p) s1 + (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p val) s1 -ensureCFinalizerWeak :: IORef Finalizers -> IO MyWeak -ensureCFinalizerWeak ref@(IORef (STRef r#)) = do +ensureCFinalizerWeak :: IORef Finalizers -> value -> IO MyWeak +ensureCFinalizerWeak ref@(IORef (STRef r#)) value = do fin <- readIORef ref case fin of CFinalizers weak -> return (MyWeak weak) HaskellFinalizers{} -> noMixingError NoFinalizers -> IO $ \s -> - case mkWeakNoFinalizer# r# () s of { (# s1, w #) -> + case mkWeakNoFinalizer# r# (unsafeCoerce# value) s of { (# s1, w #) -> + -- See Note [MallocPtr finalizers] (#10904) case atomicModifyMutVar# r# (update w) s1 of { (# s2, (weak, needKill ) #) -> if needKill diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c index 60ac53f..9a32198 100644 --- a/rts/sm/MarkWeak.c +++ b/rts/sm/MarkWeak.c @@ -191,6 +191,11 @@ static void collectDeadWeakPtrs (generation *gen) { StgWeak *w, *next_w; for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) { + // If we have C finalizers, keep the value alive for this GC. + // See Note [MallocPtr finalizers] in GHC.ForeignPtr, and #10904 + if (w->cfinalizers != &stg_NO_FINALIZER_closure) { + evacuate(&w->value); + } evacuate(&w->finalizer); next_w = w->link; w->link = dead_weak_ptr_list; diff --git a/testsuite/tests/rts/T10904.hs b/testsuite/tests/rts/T10904.hs new file mode 100644 index 0000000..264df3a --- /dev/null +++ b/testsuite/tests/rts/T10904.hs @@ -0,0 +1,28 @@ +import Control.Concurrent +import Control.Monad +import Foreign +import Foreign.C.Types +import System.Environment + + +foreign import ccall safe "finalizerlib.h init_value" + init_value :: Ptr CInt -> IO () + +foreign import ccall safe "finalizerlib.h &finalize_value" + finalize_value :: FinalizerPtr CInt + + +allocateValue :: IO () +allocateValue = do + fp <- mallocForeignPtrBytes 10000 + withForeignPtr fp init_value + addForeignPtrFinalizer finalize_value fp + + +main :: IO () +main = do + [n] <- fmap (fmap read) getArgs + _ <- forkIO (loop n) + loop n + where + loop n = replicateM_ n allocateValue diff --git a/testsuite/tests/rts/T10904lib.c b/testsuite/tests/rts/T10904lib.c new file mode 100644 index 0000000..bfed67b --- /dev/null +++ b/testsuite/tests/rts/T10904lib.c @@ -0,0 +1,30 @@ +#include +#include + + +#define MAGIC 0x11223344 + +void +init_value(int * p) +{ + *p = MAGIC; +} + + +void +finalize_value(int * p) +{ + static long counter = 0; + + counter += 1; + + if (counter % 1000000 == 0) { + fprintf(stderr, "finalize_value: %ld calls\n", counter); + } + + if (*p != MAGIC) { + fprintf(stderr, "finalize_value: %x != %x after %ld calls\n", + *p, MAGIC, counter); + abort(); + } +} diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index c9ad12b..9892050 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -329,3 +329,7 @@ test('T9839_06', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_ # in 'epoll' and 'select' backends on reading from EBADF # mingw32 skip as UNIX pipe and close(fd) is used to exercise the problem test('T10590', [ignore_output, when(opsys('mingw32'),skip)], compile_and_run, ['']) + +# 20000 was easily enough to trigger the bug with 7.10 +test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ], + compile_and_run, ['T10904lib.c']) From git at git.haskell.org Thu Sep 24 07:50:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Sep 2015 07:50:34 +0000 (UTC) Subject: [commit: ghc] master: Fix DeriveGeneric for types with same OccName (#10487) (b08a533d) Message-ID: <20150924075034.7BAD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b08a533dc87423a75bce037eb403d7828d3330d3/ghc >--------------------------------------------------------------- commit b08a533dc87423a75bce037eb403d7828d3330d3 Author: ?mer Sinan A?acan Date: Thu Sep 24 00:51:19 2015 -0700 Fix DeriveGeneric for types with same OccName (#10487) Summary: DeriveGeneric generates some data types (for data type constructors and for selectors of those constructors) and instances for those types. This patch changes name generation for these new types to make it working with data types with same names imported from different modules and with data types with same names imported from same modules(using module imports). Bonus content: - Some refactoring in `TcGenGenerics.metaTyConsToDerivStuff` to remove some redundant partial function applications and to remove a duplicated function. - Remove some unused names from `OccName`. (those were used for an old implementation of `DeriveGeneric`) Reviewers: kosmikus, simonpj, dreixel, ezyang, bgamari, austin Reviewed By: bgamari, austin Subscribers: ezyang, thomie Differential Revision: https://phabricator.haskell.org/D1081 GHC Trac Issues: #10487 >--------------------------------------------------------------- b08a533dc87423a75bce037eb403d7828d3330d3 compiler/basicTypes/OccName.hs | 37 ++-- compiler/typecheck/TcDeriv.hs | 27 ++- compiler/typecheck/TcEnv.hs | 20 ++- compiler/typecheck/TcGenGenerics.hs | 52 +++--- testsuite/tests/deriving/should_compile/T10487.hs | 12 ++ .../tests/deriving/should_compile/T10487_M.hs | 3 + testsuite/tests/deriving/should_compile/all.T | 2 +- testsuite/tests/generics/GenDerivOutput.stderr | 80 +++++---- testsuite/tests/generics/GenDerivOutput1_0.stderr | 36 ++-- testsuite/tests/generics/GenDerivOutput1_1.stderr | 192 ++++++++++++--------- 10 files changed, 270 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 b08a533dc87423a75bce037eb403d7828d3330d3 From git at git.haskell.org Thu Sep 24 10:04:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Sep 2015 10:04:00 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: update expected output for T8832 on 32-bit systems (#8832) (4f9ee91) Message-ID: <20150924100400.A76443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f9ee91303be9c122af6e91e5e599f589e3f196f/ghc >--------------------------------------------------------------- commit 4f9ee91303be9c122af6e91e5e599f589e3f196f Author: Thomas Miedema Date: Thu Sep 24 12:04:33 2015 +0200 Testsuite: update expected output for T8832 on 32-bit systems (#8832) >--------------------------------------------------------------- 4f9ee91303be9c122af6e91e5e599f589e3f196f testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 index 4c7228f..3186412 100644 --- a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 +++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 @@ -6,3 +6,4 @@ w = GHC.Types.W# 0## w8 = GHC.Word.W8# 0## w16 = GHC.Word.W16# 0## w32 = GHC.Word.W32# 0## +z = 0 From git at git.haskell.org Thu Sep 24 10:08:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Sep 2015 10:08:53 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: properly fix T8832.stdout-ws-32 (#8832) (5883b56) Message-ID: <20150924100853.133C63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5883b5665860ed5f3199c59dc0d843a66408741b/ghc >--------------------------------------------------------------- commit 5883b5665860ed5f3199c59dc0d843a66408741b Author: Thomas Miedema Date: Thu Sep 24 12:10:29 2015 +0200 Testsuite: properly fix T8832.stdout-ws-32 (#8832) >--------------------------------------------------------------- 5883b5665860ed5f3199c59dc0d843a66408741b .../tests/simplCore/should_compile/T8832.stdout-ws-32 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 index 3186412..8978c6c 100644 --- a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 +++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 @@ -1,9 +1,9 @@ -i = GHC.Types.I# 0# -i8 = GHC.Int.I8# 0# -i16 = GHC.Int.I16# 0# -i32 = GHC.Int.I32# 0# -w = GHC.Types.W# 0## -w8 = GHC.Word.W8# 0## -w16 = GHC.Word.W16# 0## -w32 = GHC.Word.W32# 0## +i = I# 0# +i8 = I8# 0# +i16 = I16# 0# +i32 = I32# 0# +w = W# 0## +w8 = W8# 0## +w16 = W16# 0## +w32 = W32# 0## z = 0 From git at git.haskell.org Thu Sep 24 12:56:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Sep 2015 12:56:56 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: add test for #10767 (1395185) Message-ID: <20150924125656.580F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1395185f56cda4774d27ae419b10f570276b674d/ghc >--------------------------------------------------------------- commit 1395185f56cda4774d27ae419b10f570276b674d Author: Thomas Miedema Date: Thu Sep 24 14:51:56 2015 +0200 Testsuite: add test for #10767 >--------------------------------------------------------------- 1395185f56cda4774d27ae419b10f570276b674d testsuite/tests/deSugar/should_compile/T10767.hs | 48 ++++++++++++++++++++++++ testsuite/tests/deSugar/should_compile/all.T | 1 + 2 files changed, 49 insertions(+) diff --git a/testsuite/tests/deSugar/should_compile/T10767.hs b/testsuite/tests/deSugar/should_compile/T10767.hs new file mode 100644 index 0000000..65d08f4 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T10767.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-} + +module Main where + +{- ghc-7.8.4 and ghc-7.10.2 showed a confusing warning: + +T10767.hs:43:1: Warning: + RULE left-hand side too complicated to desugar + Optimised lhs: case cobox_aWY + of _ [Occ=Dead] { GHC.Types.Eq# cobox -> + genLength @ Int $dSpecList_aWX + } + Orig lhs: case cobox_aWY of cobox_aWY { GHC.Types.Eq# cobox -> + genLength @ Int $dSpecList_aWX + } +-} + +import Data.Proxy + +class SpecList a where + type List a :: * + + slCase :: List a -> b -> (a -> List a -> b) -> b + +data IntList + = ILNil + | ILCons {-# UNPACK #-} !Int IntList + deriving (Show) + +instance SpecList Int where + type List Int = IntList + + slCase ILNil n _ = n + slCase (ILCons i t) _ c = c i t + +fromList :: [Int] -> IntList +fromList [] = ILNil +fromList (h : t) = ILCons h (fromList t) + +lst1 :: IntList +lst1 = fromList [1..10] + +{-# SPECIALIZE genLength :: Proxy Int -> List Int -> Int #-} +genLength :: forall a . SpecList a => Proxy a -> List a -> Int +genLength p lst = slCase lst 0 (\(_ :: a) tail -> 1 + genLength p tail) + +main :: IO () +main = print (genLength (Proxy :: Proxy Int) lst1) diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 1ae9011..543e01e 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -102,3 +102,4 @@ test('T2431', normal, compile, ['-ddump-simpl -dsuppress-uniques']) test('T7669', normal, compile, ['']) test('T8470', normal, compile, ['']) test('T10251', normal, compile, ['']) +test('T10767', normal, compile, ['']) From git at git.haskell.org Fri Sep 25 10:38:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Sep 2015 10:38:51 +0000 (UTC) Subject: [commit: packages/stm] master: Another rework of Weak interface (f7db2c3) Message-ID: <20150925103851.B79D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/f7db2c3df86ec644e5e06baa8090a1cb525754e2 >--------------------------------------------------------------- commit f7db2c3df86ec644e5e06baa8090a1cb525754e2 Author: Ben Gamari Date: Thu Sep 24 17:40:15 2015 +0200 Another rework of Weak interface >--------------------------------------------------------------- f7db2c3df86ec644e5e06baa8090a1cb525754e2 Control/Concurrent/STM/TMVar.hs | 5 +---- Control/Concurrent/STM/TVar.hs | 5 +---- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/Control/Concurrent/STM/TMVar.hs b/Control/Concurrent/STM/TMVar.hs index eed4a9b..f3ac30a 100644 --- a/Control/Concurrent/STM/TMVar.hs +++ b/Control/Concurrent/STM/TMVar.hs @@ -159,9 +159,6 @@ isEmptyTMVar (TMVar t) = do -- -- @since 2.4.4 mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a)) -mkWeakTMVar tmv@(TMVar (TVar t#)) f = IO $ \s -> +mkWeakTMVar tmv@(TMVar (TVar t#)) (IO finalizer) = IO $ \s -> case mkWeak# t# tmv finalizer s of (# s1, w #) -> (# s1, Weak w #) - where - finalizer :: State# RealWorld -> State# RealWorld - finalizer s' = case unIO f s' of (# s'', () #) -> s'' #endif diff --git a/Control/Concurrent/STM/TVar.hs b/Control/Concurrent/STM/TVar.hs index dbf5321..88a6dfb 100644 --- a/Control/Concurrent/STM/TVar.hs +++ b/Control/Concurrent/STM/TVar.hs @@ -76,8 +76,5 @@ swapTVar var new = do -- -- @since 2.4.3 mkWeakTVar :: TVar a -> IO () -> IO (Weak (TVar a)) -mkWeakTVar t@(TVar t#) f = IO $ \s -> +mkWeakTVar t@(TVar t#) (IO finalizer) = IO $ \s -> case mkWeak# t# t finalizer s of (# s1, w #) -> (# s1, Weak w #) - where - finalizer :: State# RealWorld -> State# RealWorld - finalizer s' = case unIO f s' of (# s'', () #) -> s'' From git at git.haskell.org Fri Sep 25 10:40:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Sep 2015 10:40:24 +0000 (UTC) Subject: [commit: ghc] master: Weak: Don't require wrapping/unwrapping of finalizers (fb40926) Message-ID: <20150925104024.BF4193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb4092642f057f258d07cd6979925f4e2579eda6/ghc >--------------------------------------------------------------- commit fb4092642f057f258d07cd6979925f4e2579eda6 Author: Ben Gamari Date: Wed Sep 23 14:36:40 2015 +0200 Weak: Don't require wrapping/unwrapping of finalizers To quote Simon Marlow, We don't expect users to ever write code that uses mkWeak# or finalizeWeak#, we have safe interfaces to these. Let's document the type unsafety and fix the problem with () without introducing any overhead. Updates stm submodule. >--------------------------------------------------------------- fb4092642f057f258d07cd6979925f4e2579eda6 compiler/prelude/primops.txt.pp | 10 ++++++++-- libraries/base/Control/Concurrent/MVar.hs | 5 +---- libraries/base/Data/IORef.hs | 5 +---- libraries/base/GHC/ForeignPtr.hs | 17 +++++------------ libraries/base/GHC/MVar.hs | 5 +---- libraries/base/GHC/Weak.hs | 7 ++----- libraries/stm | 2 +- 7 files changed, 19 insertions(+), 32 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index d1786a0..e060deb 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2332,7 +2332,8 @@ primtype Weak# b -- note that tyvar "o" denotes openAlphaTyVar primop MkWeakOp "mkWeak#" GenPrimOp - o -> b -> (State# RealWorld -> State# RealWorld) -> State# RealWorld -> (# State# RealWorld, Weak# b #) + o -> b -> (State# RealWorld -> (# State# RealWorld, c #)) + -> State# RealWorld -> (# State# RealWorld, Weak# b #) with has_side_effects = True out_of_line = True @@ -2364,7 +2365,12 @@ primop DeRefWeakOp "deRefWeak#" GenPrimOp primop FinalizeWeakOp "finalizeWeak#" GenPrimOp Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, - (State# RealWorld -> State# RealWorld) #) + (State# RealWorld -> (# State# RealWorld, b #) ) #) + { Finalize a weak pointer. The return value is an unboxed tuple + containing the new state of the world and an "unboxed Maybe", + represented by an {\tt Int#} and a (possibly invalid) finalization + action. An {\tt Int#} of {\tt 1} indicates that the finalizer is valid. The + return value {\tt b} from the finalizer should be ignored. } with has_side_effects = True out_of_line = True diff --git a/libraries/base/Control/Concurrent/MVar.hs b/libraries/base/Control/Concurrent/MVar.hs index 5ffac11..f76eaeb 100644 --- a/libraries/base/Control/Concurrent/MVar.hs +++ b/libraries/base/Control/Concurrent/MVar.hs @@ -271,7 +271,4 @@ addMVarFinalizer = GHC.MVar.addMVarFinalizer -- @since 4.6.0.0 mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a)) mkWeakMVar m@(MVar m#) (IO f) = IO $ \s -> - case mkWeak# m# m finalizer s of (# s1, w #) -> (# s1, Weak w #) - where - finalizer :: State# RealWorld -> State# RealWorld - finalizer s' = case f s' of (# s'', () #) -> s'' + case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #) diff --git a/libraries/base/Data/IORef.hs b/libraries/base/Data/IORef.hs index bcd1a65..c6275f5 100644 --- a/libraries/base/Data/IORef.hs +++ b/libraries/base/Data/IORef.hs @@ -43,11 +43,8 @@ import GHC.Weak -- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer -- to run when 'IORef' is garbage-collected mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a)) -mkWeakIORef r@(IORef (STRef r#)) (IO f) = IO $ \s -> +mkWeakIORef r@(IORef (STRef r#)) (IO finalizer) = IO $ \s -> case mkWeak# r# r finalizer s of (# s1, w #) -> (# s1, Weak w #) - where - finalizer :: State# RealWorld -> State# RealWorld - finalizer s' = case f s' of (# s'', () #) -> s'' -- |Mutate the contents of an 'IORef'. -- diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index a1ff1ba..d0688f0 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -296,14 +296,9 @@ addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do if noFinalizers then IO $ \s -> case r of { IORef (STRef r#) -> - case mkWeak# r# () finalizer' s of { (# s1, _ #) -> - (# s1, () #) }} + case mkWeak# r# () (unIO $ foreignPtrFinalizer r) s of { + (# s1, _ #) -> (# s1, () #) }} else return () - where - finalizer' :: State# RealWorld -> State# RealWorld - finalizer' s = - case unIO (foreignPtrFinalizer r) s of - (# s', () #) -> s' addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do noFinalizers <- insertHaskellFinalizer r finalizer if noFinalizers @@ -312,10 +307,8 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do (# s1, _ #) -> (# s1, () #) else return () where - finalizer' :: State# RealWorld -> State# RealWorld - finalizer' s = - case unIO (foreignPtrFinalizer r >> touch f) s of - (# s', () #) -> s' + finalizer' :: State# RealWorld -> (# State# RealWorld, () #) + finalizer' = unIO (foreignPtrFinalizer r >> touch f) addForeignPtrConcFinalizer_ _ _ = error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer" @@ -375,7 +368,7 @@ foreignPtrFinalizer r = do case fs of NoFinalizers -> return () CFinalizers w -> IO $ \s -> case finalizeWeak# w s of - (# s1, 1#, f #) -> case f s1 of s2 -> (# s2, () #) + (# s1, 1#, f #) -> f s1 (# s1, _, _ #) -> (# s1, () #) HaskellFinalizers actions -> sequence_ actions diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs index bdad179..6cbbe7b 100644 --- a/libraries/base/GHC/MVar.hs +++ b/libraries/base/GHC/MVar.hs @@ -177,8 +177,5 @@ isEmptyMVar (MVar mv#) = IO $ \ s# -> -- "System.Mem.Weak" for more about finalizers. addMVarFinalizer :: MVar a -> IO () -> IO () addMVarFinalizer (MVar m) (IO finalizer) = - IO $ \s -> case mkWeak# m () finalizer' s of { (# s1, _ #) -> (# s1, () #) } - where - finalizer' :: State# RealWorld -> State# RealWorld - finalizer' s' = case finalizer s' of (# s'', () #) -> s'' + IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) } diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs index b2c3273..8f886a6 100644 --- a/libraries/base/GHC/Weak.hs +++ b/libraries/base/GHC/Weak.hs @@ -101,10 +101,7 @@ mkWeak :: k -- ^ key -> IO (Weak v) -- ^ returns: a weak pointer object mkWeak key val (Just (IO finalizer)) = IO $ \s -> - case mkWeak# key val finalizer' s of { (# s1, w #) -> (# s1, Weak w #) } - where - finalizer' :: State# RealWorld -> State# RealWorld - finalizer' s' = case finalizer s' of (# s'', () #) -> s'' + case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) } mkWeak key val Nothing = IO $ \s -> case mkWeakNoFinalizer# key val s of { (# s1, w #) -> (# s1, Weak w #) } @@ -129,7 +126,7 @@ finalize :: Weak v -> IO () finalize (Weak w) = IO $ \s -> case finalizeWeak# w s of (# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finalizer - (# s1, _, f #) -> case f s1 of s2 -> (# s2, () #) + (# s1, _, f #) -> f s1 {- Instance Eq (Weak v) where diff --git a/libraries/stm b/libraries/stm index 8fb3b33..f7db2c3d 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 8fb3b3336971d784c091dbca674ae1401e506e76 +Subproject commit f7db2c3df86ec644e5e06baa8090a1cb525754e2 From git at git.haskell.org Fri Sep 25 10:49:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Sep 2015 10:49:09 +0000 (UTC) Subject: [commit: ghc] master: Dwarf: Rename binding to avoid shadowing ppr (a98815a) Message-ID: <20150925104909.D33083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a98815a9f11ea467aa96033cb7839d2662a29efc/ghc >--------------------------------------------------------------- commit a98815a9f11ea467aa96033cb7839d2662a29efc Author: Ben Gamari Date: Fri Sep 25 12:51:01 2015 +0200 Dwarf: Rename binding to avoid shadowing ppr Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1221 >--------------------------------------------------------------- a98815a9f11ea467aa96033cb7839d2662a29efc compiler/nativeGen/Dwarf/Types.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs index 17fbf3b..846f8dc 100644 --- a/compiler/nativeGen/Dwarf/Types.hs +++ b/compiler/nativeGen/Dwarf/Types.hs @@ -370,21 +370,21 @@ pprSetUnwind plat g (_, uw) pprUnwindExpr :: Bool -> UnwindExpr -> SDoc pprUnwindExpr spIsCFA expr = sdocWithPlatform $ \plat -> - let ppr (UwConst i) + let pprE (UwConst i) | i >= 0 && i < 32 = pprByte (dW_OP_lit0 + fromIntegral i) | otherwise = pprByte dW_OP_consts $$ pprLEBInt i -- lazy... - ppr (UwReg Sp i) | spIsCFA + pprE (UwReg Sp i) | spIsCFA = if i == 0 then pprByte dW_OP_call_frame_cfa else ppr (UwPlus (UwReg Sp 0) (UwConst i)) - ppr (UwReg g i) = pprByte (dW_OP_breg0+dwarfGlobalRegNo plat g) $$ + pprE (UwReg g i) = pprByte (dW_OP_breg0+dwarfGlobalRegNo plat g) $$ pprLEBInt i - ppr (UwDeref u) = ppr u $$ pprByte dW_OP_deref - ppr (UwPlus u1 u2) = ppr u1 $$ ppr u2 $$ pprByte dW_OP_plus - ppr (UwMinus u1 u2) = ppr u1 $$ ppr u2 $$ pprByte dW_OP_minus - ppr (UwTimes u1 u2) = ppr u1 $$ ppr u2 $$ pprByte dW_OP_mul + pprE (UwDeref u) = pprE u $$ pprByte dW_OP_deref + pprE (UwPlus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus + pprE (UwMinus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus + pprE (UwTimes u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul in ptext (sLit "\t.byte 1f-.-1") $$ - ppr expr $$ + pprE expr $$ ptext (sLit "1:") -- | Generate code for re-setting the unwind information for a From git at git.haskell.org Fri Sep 25 10:50:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Sep 2015 10:50:05 +0000 (UTC) Subject: [commit: ghc] master: Dwarf: Ensure block length is encoded correctly (a0b1f41) Message-ID: <20150925105005.291153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a0b1f414a459e102f5c3d93bfbf53ebe0d81c467/ghc >--------------------------------------------------------------- commit a0b1f414a459e102f5c3d93bfbf53ebe0d81c467 Author: Ben Gamari Date: Fri Sep 25 12:51:54 2015 +0200 Dwarf: Ensure block length is encoded correctly This is supposed to be encoded with ULEB128 which the previous implementation would only guarranty with short lengths. This likely holds in nearly all cases, but I'd really rather not take changes. I fix this using the `.uleb128` directive. I'm not certain that this is portable across assemblers but it makes this quite straightforward and at the moment I value correctness over portability. Test Plan: Compare implementation to DWARF spec Reviewers: scpmw, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1220 >--------------------------------------------------------------- a0b1f414a459e102f5c3d93bfbf53ebe0d81c467 compiler/nativeGen/Dwarf/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs index 846f8dc..a2d07b8 100644 --- a/compiler/nativeGen/Dwarf/Types.hs +++ b/compiler/nativeGen/Dwarf/Types.hs @@ -383,7 +383,7 @@ pprUnwindExpr spIsCFA expr pprE (UwPlus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus pprE (UwMinus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus pprE (UwTimes u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul - in ptext (sLit "\t.byte 1f-.-1") $$ + in ptext (sLit "\t.uleb128 1f-.-1") $$ -- DW_FORM_block length pprE expr $$ ptext (sLit "1:") From git at git.haskell.org Fri Sep 25 11:07:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Sep 2015 11:07:55 +0000 (UTC) Subject: [commit: ghc] master: Skip a possible BOM in utf8 encoding (f7fd864) Message-ID: <20150925110755.51BFE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7fd864ce6d41cf22d25f18a0cdc5e2e9db71304/ghc >--------------------------------------------------------------- commit f7fd864ce6d41cf22d25f18a0cdc5e2e9db71304 Author: Joachim Breitner Date: Wed Sep 23 10:10:03 2015 +0200 Skip a possible BOM in utf8 encoding and not the system locale, which might be something else. This fixes bug #10907. A test is added, but less useful than it could be until task #10909 is done. Differential Revision: D1274 >--------------------------------------------------------------- f7fd864ce6d41cf22d25f18a0cdc5e2e9db71304 compiler/utils/StringBuffer.hs | 10 +++++++--- testsuite/tests/parser/unicode/T10907.hs | 1 + testsuite/tests/parser/unicode/all.T | 3 +++ 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs index 2e339d8..6b39fc8 100644 --- a/compiler/utils/StringBuffer.hs +++ b/compiler/utils/StringBuffer.hs @@ -53,6 +53,8 @@ import Data.Maybe import Control.Exception import System.IO import System.IO.Unsafe ( unsafePerformIO ) +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) +import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) ) import GHC.Exts @@ -131,14 +133,16 @@ skipBOM h size offset = then do -- Validate assumption that handle is in binary mode. ASSERTM( hGetEncoding h >>= return . isNothing ) - -- Temporarily select text mode to make `hLookAhead` and - -- `hGetChar` return full Unicode characters. - bracket_ (hSetBinaryMode h False) (hSetBinaryMode h True) $ do + -- Temporarily select utf8 encoding with error ignoring, + -- to make `hLookAhead` and `hGetChar` return full Unicode characters. + bracket_ (hSetEncoding h safeEncoding) (hSetBinaryMode h True) $ do c <- hLookAhead h if c == '\xfeff' then hGetChar h >> hTell h else return offset else return offset + where + safeEncoding = mkUTF8 IgnoreCodingFailure newUTF8StringBuffer :: ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer newUTF8StringBuffer buf ptr size = do diff --git a/testsuite/tests/parser/unicode/T10907.hs b/testsuite/tests/parser/unicode/T10907.hs new file mode 100644 index 0000000..60aa3e7 --- /dev/null +++ b/testsuite/tests/parser/unicode/T10907.hs @@ -0,0 +1 @@ +?module ByteOrderMark () where diff --git a/testsuite/tests/parser/unicode/all.T b/testsuite/tests/parser/unicode/all.T index ec08ae5..6972a0d 100644 --- a/testsuite/tests/parser/unicode/all.T +++ b/testsuite/tests/parser/unicode/all.T @@ -22,3 +22,6 @@ test('T2302', only_ways(['normal']), compile_fail, ['']) test('T4373', normal, compile, ['']) test('T6016', extra_clean(['T6016-twoBOMs']), compile_and_run, ['-package ghc']) test('T7671', normal, compile, ['']) +# TODO: This test ought to be run in a non-UTF8 locale, but this is not yet +# supported by the test suite (see 10907) +test('T10907', normal, compile, ['']) From git at git.haskell.org Fri Sep 25 15:17:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Sep 2015 15:17:50 +0000 (UTC) Subject: [commit: ghc] master: Debug: Remove extraneous LANGUAGE CPP (3fbf8f4) Message-ID: <20150925151750.580B23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3fbf8f46052dbcc45e01fa4f616b11b4acf4d859/ghc >--------------------------------------------------------------- commit 3fbf8f46052dbcc45e01fa4f616b11b4acf4d859 Author: Ben Gamari Date: Mon Aug 24 11:42:24 2015 +0200 Debug: Remove extraneous LANGUAGE CPP >--------------------------------------------------------------- 3fbf8f46052dbcc45e01fa4f616b11b4acf4d859 compiler/cmm/Debug.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/cmm/Debug.hs b/compiler/cmm/Debug.hs index 069f5cc..83db2a1 100644 --- a/compiler/cmm/Debug.hs +++ b/compiler/cmm/Debug.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, CPP #-} +{-# LANGUAGE GADTs #-} ----------------------------------------------------------------------------- -- From git at git.haskell.org Sat Sep 26 17:26:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 17:26:20 +0000 (UTC) Subject: [commit: ghc] master: rts: Clean up whitespace in Trace.h (988b2ba) Message-ID: <20150926172620.1E55F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/988b2baa9745bd7871d179d11d4ca653041a1aa9/ghc >--------------------------------------------------------------- commit 988b2baa9745bd7871d179d11d4ca653041a1aa9 Author: Ben Gamari Date: Sat Sep 26 19:03:18 2015 +0200 rts: Clean up whitespace in Trace.h >--------------------------------------------------------------- 988b2baa9745bd7871d179d11d4ca653041a1aa9 rts/Trace.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Trace.h b/rts/Trace.h index c85167c..2c11a9f 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -485,7 +485,7 @@ void dtraceUserMarkerWrapper(Capability *cap, char *msg); // // Dtrace - dtrace probes are unconditionally added as probe activation is // handled by the dtrace component of the kernel, and inactive probes are -// very cheap ? usually, one no-op. Consequently, dtrace can be used with +// very cheap - usually, one no-op. Consequently, dtrace can be used with // all flavours of the RTS. In addition, we still support logging events to // a file, even in the presence of dtrace. This is, eg, useful when tracing // on a server, but browsing trace information with ThreadScope on a local From git at git.haskell.org Sat Sep 26 19:27:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 19:27:11 +0000 (UTC) Subject: [commit: ghc] master: reify associated types when reifying typeclasses(#10891) (b4d43b4) Message-ID: <20150926192711.51D973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4d43b4e9f4f4fba068ab1e132113c4cd305dfe3/ghc >--------------------------------------------------------------- commit b4d43b4e9f4f4fba068ab1e132113c4cd305dfe3 Author: ?mer Sinan A?acan Date: Sat Sep 26 21:07:51 2015 +0200 reify associated types when reifying typeclasses(#10891) As reported in Trac #10891, Template Haskell's `reify` was not generating Decls for associated types. This patch fixes that. Note that even though `reifyTyCon` function used in this patch returns some type instances, I'm ignoring that. Here's an example of how associated types are encoded with this patch: (Simplified representation) class C a where type F a :: * --> OpenTypeFamilyD "F" ["a"] With default type instances: class C a where type F a :: * type F a = a --> OpenTypeFamilyD "F" ["a"] TySynInstD "F" (TySynEqn [VarT "a"] "a") Test Plan: This patch was already reviewed and even merged. The patch is later reverted because apparently it broke the build some time between the validation of this patch and merge. Creating this new ticket to fix the validation. Reviewers: goldfire, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1277 GHC Trac Issues: #10891 >--------------------------------------------------------------- b4d43b4e9f4f4fba068ab1e132113c4cd305dfe3 compiler/typecheck/TcSplice.hs | 28 +++++++++++++++++++++-- testsuite/tests/th/T10891.hs | 39 +++++++++++++++++++++++++++++++++ testsuite/tests/th/T10891.stderr | 12 ++++++++++ testsuite/tests/th/TH_reifyDecl1.stderr | 2 ++ testsuite/tests/th/all.T | 1 + 5 files changed, 80 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 2a21705..c8eb9f8 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1202,12 +1202,13 @@ reifyClass cls = do { cxt <- reifyCxt theta ; inst_envs <- tcGetInstEnvs ; insts <- reifyClassInstances cls (InstEnv.classInstances inst_envs cls) + ; assocTys <- concatMapM reifyAT ats ; ops <- concatMapM reify_op op_stuff ; tvs' <- reifyTyVars tvs - ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' ops + ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' (assocTys ++ ops) ; return (TH.ClassI dec insts) } where - (tvs, fds, theta, _, _, op_stuff) = classExtraBigSig cls + (tvs, fds, theta, _, ats, op_stuff) = classExtraBigSig cls fds' = map reifyFunDep fds reify_op (op, def_meth) = do { ty <- reifyType (idType op) @@ -1219,6 +1220,29 @@ reifyClass cls ; return [TH.SigD nm' ty, TH.DefaultSigD nm' gdm_ty] } _ -> return [TH.SigD nm' ty] } + reifyAT :: ClassATItem -> TcM [TH.Dec] + reifyAT (ATI tycon def) = do + tycon' <- reifyTyCon tycon + case tycon' of + TH.FamilyI dec _ -> do + let (tyName, tyArgs) = tfNames dec + (dec :) <$> maybe (return []) + (fmap (:[]) . reifyDefImpl tyName tyArgs . fst) + def + _ -> pprPanic "reifyAT" (text (show tycon')) + + reifyDefImpl :: TH.Name -> [TH.Name] -> Type -> TcM TH.Dec + reifyDefImpl n args ty = + TH.TySynInstD n . TH.TySynEqn (map TH.VarT args) <$> reifyType ty + + tfNames :: TH.Dec -> (TH.Name, [TH.Name]) + tfNames (TH.OpenTypeFamilyD n args _ _) = (n, map bndrName args) + tfNames d = pprPanic "tfNames" (text (show d)) + + bndrName :: TH.TyVarBndr -> TH.Name + bndrName (TH.PlainTV n) = n + bndrName (TH.KindedTV n _) = n + ------------------------------ -- | Annotate (with TH.SigT) a type if the first parameter is True -- and if the type contains a free variable. diff --git a/testsuite/tests/th/T10891.hs b/testsuite/tests/th/T10891.hs new file mode 100644 index 0000000..d91caf9 --- /dev/null +++ b/testsuite/tests/th/T10891.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TypeFamilies #-} + +module T10891 where + +import Language.Haskell.TH +import System.IO + +class C a where + f :: a -> Int + +class C' a where + type F a :: * + type F a = a + f' :: a -> Int + +class C'' a where + data Fd a :: * + +instance C' Int where + type F Int = Bool + f' = id + +instance C'' Int where + data Fd Int = B Bool | C Char + +$(return []) + +test :: () +test = + $(let + display :: Name -> Q () + display q = do + i <- reify q + runIO (hPutStrLn stderr (pprint i) >> hFlush stderr) + in do + display ''C + display ''C' + display ''C'' + [| () |]) diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr new file mode 100644 index 0000000..874f4f0 --- /dev/null +++ b/testsuite/tests/th/T10891.stderr @@ -0,0 +1,12 @@ +class T10891.C (a_0 :: *) + where T10891.f :: forall (a_0 :: *) . T10891.C a_0 => + a_0 -> GHC.Types.Int +class T10891.C' (a_0 :: *) + where type T10891.F (a_0 :: *) :: * + type T10891.F a_0 = a_0 + T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 => + a_0 -> GHC.Types.Int +instance T10891.C' GHC.Types.Int +class T10891.C'' (a_0 :: *) + where data T10891.Fd (a_0 :: *) :: * +instance T10891.C'' GHC.Types.Int diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr index 503f533..e655587 100644 --- a/testsuite/tests/th/TH_reifyDecl1.stderr +++ b/testsuite/tests/th/TH_reifyDecl1.stderr @@ -20,6 +20,8 @@ class TH_reifyDecl1.C2 (a_0 :: *) a_0 -> GHC.Types.Int instance TH_reifyDecl1.C2 GHC.Types.Int class TH_reifyDecl1.C3 (a_0 :: *) + where type TH_reifyDecl1.AT1 (a_0 :: *) :: * + data TH_reifyDecl1.AT2 (a_0 :: *) :: * instance TH_reifyDecl1.C3 GHC.Types.Int type family TH_reifyDecl1.AT1 (a_0 :: *) :: * type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f72cc30..9d4736c 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -359,3 +359,4 @@ test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) test('T10811', normal, compile, ['-v0']) test('T10810', normal, compile, ['-v0']) +test('T10891', normal, compile, ['-v0']) From git at git.haskell.org Sat Sep 26 21:50:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:06 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: IntWord64: Add import to GHC.Types (3cc8dd5) Message-ID: <20150926215006.135643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/3cc8dd5df429d7aecfffb66d7fa6e110eedb7a02/ghc >--------------------------------------------------------------- commit 3cc8dd5df429d7aecfffb66d7fa6e110eedb7a02 Author: Ben Gamari Date: Tue Sep 22 22:49:08 2015 +0200 IntWord64: Add import to GHC.Types >--------------------------------------------------------------- 3cc8dd5df429d7aecfffb66d7fa6e110eedb7a02 libraries/base/GHC/Stack/Types.hs | 4 ++++ libraries/ghc-prim/GHC/IntWord64.hs | 3 +++ 2 files changed, 7 insertions(+) diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index fc9d6c2..5c37f64 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -23,6 +23,10 @@ module GHC.Stack.Types ( import GHC.Types +-- Make implicit dependency known to build system +import GHC.Tuple () +import GHC.Integer () + ---------------------------------------------------------------------- -- Explicit call-stacks built via ImplicitParams ---------------------------------------------------------------------- diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index 52dc08e..35bbfd8 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -23,7 +23,10 @@ module GHC.IntWord64 ( #endif ) where +import GHC.Types () -- Make implicit dependency known to build system + #if WORD_SIZE_IN_BITS < 64 + import GHC.Prim foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int# From git at git.haskell.org Sat Sep 26 21:50:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:08 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Make the generated GHC.Prim module import GHC.Tuple (a92d65b) Message-ID: <20150926215008.C665A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/a92d65b357cc5d70a836f13b9e7d4dc81e060061/ghc >--------------------------------------------------------------- commit a92d65b357cc5d70a836f13b9e7d4dc81e060061 Author: Simon Peyton Jones Date: Fri Aug 28 15:24:02 2015 +0100 Make the generated GHC.Prim module import GHC.Tuple See Note [Import GHC.Tuple into GHC.Prim] in genprimopcode/Main.hs I think this has been a lurking bug for ages. Lacking it, Haddock's invocation of GHC for the ghc-prim library says Checking module GHC.Prim... attempting to use module ?GHC.Tuple? (libraries/ghc-prim/./GHC/Tuple.hs) which is not loaded >--------------------------------------------------------------- a92d65b357cc5d70a836f13b9e7d4dc81e060061 utils/genprimopcode/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 2a5218e..3ab8ff8 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -262,6 +262,16 @@ gen_hs_source (Info defaults entries) = ++ "-}\n" ++ "import GHC.Types (Coercible)\n" + ++ "import GHC.Tuple ()\n" + -- Note [Import GHC.Tuple into GHC.Prim] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- This expresses a dependency on GHC.Tuple, which we need + -- to ensure that GHC.Tuple is compiled first. The generated + -- code in this module mentions '()', and that in turn tries + -- to ensure that its home module is loaded (for instances I think) + -- So it had better be there, when compiling with --make or Haddock. + -- It's more kosher anyway to be explicit about the dependency. + ++ "default ()" -- If we don't say this then the default type include Integer -- so that runs off and loads modules that are not part of -- pacakge ghc-prim at all. And that in turn somehow ends up From git at git.haskell.org Sat Sep 26 21:50:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:11 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Move CallStack back to base (a6e0309) Message-ID: <20150926215011.F2AB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/a6e0309b4a0d383ee6023db41e1fd89bba48a987/ghc >--------------------------------------------------------------- commit a6e0309b4a0d383ee6023db41e1fd89bba48a987 Author: Ben Gamari Date: Sun Sep 20 08:27:34 2015 +0200 Move CallStack back to base CallStack requires tuples, instances of which are defined in GHC.Tuple. Unfortunately the D757 change to Typeable deriving means that GHC.Tuple must import GHC.Types for the type representation types, resulting in a cycle. >--------------------------------------------------------------- a6e0309b4a0d383ee6023db41e1fd89bba48a987 compiler/prelude/PrelNames.hs | 9 +++-- libraries/base/GHC/Err.hs | 3 +- libraries/base/GHC/Exception.hs | 1 + libraries/base/GHC/Exception.hs-boot | 3 +- libraries/base/GHC/Stack.hsc | 3 ++ libraries/base/GHC/Stack/Types.hs | 72 ++++++++++++++++++++++++++++++++++++ libraries/base/base.cabal | 1 + libraries/ghc-prim/GHC/Types.hs | 52 +------------------------- 8 files changed, 88 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 a6e0309b4a0d383ee6023db41e1fd89bba48a987 From git at git.haskell.org Sat Sep 26 21:50:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:14 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: More refactoring in matchClass (133c5bd) Message-ID: <20150926215014.B4E783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/133c5bdd06d28092c95367dcfb0beb948c8d7c56/ghc >--------------------------------------------------------------- commit 133c5bdd06d28092c95367dcfb0beb948c8d7c56 Author: Simon Peyton Jones Date: Fri Aug 28 10:48:32 2015 +0100 More refactoring in matchClass This refactoring was unforced, but tidies up the structure so I can see what is happening. >--------------------------------------------------------------- 133c5bdd06d28092c95367dcfb0beb948c8d7c56 compiler/typecheck/TcInteract.hs | 309 +++++++++++++++++++++------------------ 1 file changed, 170 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 133c5bdd06d28092c95367dcfb0beb948c8d7c56 From git at git.haskell.org Sat Sep 26 21:50:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:18 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Generate Typeable info at definition sites (a862936) Message-ID: <20150926215018.384543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/a86293691663f15141d5317c83c9c90ab5c4a14b/ghc >--------------------------------------------------------------- commit a86293691663f15141d5317c83c9c90ab5c4a14b Author: Ben Gamari Date: Wed Aug 26 18:24:34 2015 +0200 Generate Typeable info at definition sites This patch implements the idea floated in Trac #9858, namely that we should generate type-representation information at the data type declaration site, rather than when solving a Typeable constraint. However, this turned out quite a bit harder than I expected. I still think it's the right thing to do, and it's done now, but it was quite a struggle. See particularly * Note [Grand plan for Typeable] in TcTypeable (which is a new module) * Note [The overall promotion story] in DataCon (clarifies existing stuff) The most painful bit was that to generate Typeable instances (ie TyConRepName bindings) for every TyCon is tricky for types in ghc-prim etc: * We need to have enough data types around to *define* a TyCon * Many of these types are wired-in Also, to minimise the code generated for each data type, I wanted to generate pure data, not CAFs with unpackCString# stuff floating about. Performance ~~~~~~~~~~~ Three perf/compiler tests start to allocate quite a bit more. This isn't surprising, because they all allocate zillions of data types, with practically no other code, esp. T1969 * T1969: GHC allocates 30% more * T5642: GHC allocates 14% more * T9872d: GHC allocates 5% more I'm treating this as acceptable. The payoff comes in Typeable-heavy code. Remaining to do ~~~~~~~~~~~~~~~ * I think that "TyCon" and "Module" are over-generic names to use for the runtime type representations used in GHC.Typeable. Better might be "TrTyCon" and "TrModule". But I have not yet done this * Add more info the the "TyCon" e.g. source location where it was defined * Use the new "Module" type to help with Trac Trac #10068 * It would be possible to generate TyConRepName (ie Typeable instances) selectively rather than all the time. We'd need to persist the information in interface files. Lacking a motivating reason I have not done this, but it would not be difficult. Refactoring ~~~~~~~~~~~ As is so often the case, I ended up refactoring more than I intended. In particular * In TyCon, a type *family* (whether type or data) is repesented by a FamilyTyCon * a algebraic data type (including data/newtype instances) is represented by AlgTyCon This wasn't true before; a data family was represented as an AlgTyCon. There are some corresponding changes in IfaceSyn. * Also get rid of the (unhelpfully named) tyConParent. * In TyCon define 'Promoted', isomorphic to Maybe, used when things are optionally promoted; and use it elsewhere in GHC. * Cleanup handling of knownKeyNames * Each TyCon, including promoted TyCons, contains its TyConRepName, if it has one. This is, in effect, the name of its Typeable instance. * Move mkDefaultMethodIds, mkRecSelBinds from TcTyClsDecls to TcTyDecls >--------------------------------------------------------------- a86293691663f15141d5317c83c9c90ab5c4a14b compiler/basicTypes/DataCon.hs | 222 ++++++++++---- compiler/basicTypes/OccName.hs | 19 +- compiler/basicTypes/Unique.hs | 51 ++- compiler/deSugar/DsBinds.hs | 277 ++++++++--------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsUtils.hs | 6 +- compiler/iface/BuildTyCl.hs | 42 ++- compiler/iface/IfaceSyn.hs | 97 +++--- compiler/iface/MkIface.hs | 11 +- compiler/iface/TcIface.hs | 89 +++--- compiler/main/HscMain.hs | 13 +- compiler/main/HscTypes.hs | 12 +- compiler/prelude/PrelInfo.hs | 111 +++---- compiler/prelude/PrelNames.hs | 79 +++-- compiler/prelude/TysPrim.hs | 38 ++- compiler/prelude/TysWiredIn.hs | 55 ++-- compiler/typecheck/TcBinds.hs | 35 ++- compiler/typecheck/TcEvidence.hs | 53 +++- compiler/typecheck/TcGenGenerics.hs | 41 ++- compiler/typecheck/TcHsSyn.hs | 28 +- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 19 +- compiler/typecheck/TcInteract.hs | 147 +++++---- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 40 ++- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcTyClsDecls.hs | 330 ++++---------------- compiler/typecheck/TcTyDecls.hs | 330 +++++++++++++++----- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcTypeable.hs | 206 +++++++++++++ compiler/types/TyCon.hs | 409 ++++++++++++++----------- compiler/types/Type.hs | 9 + compiler/utils/Binary.hs | 11 +- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/Env.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 +- libraries/base/Data/Typeable.hs | 3 +- libraries/base/Data/Typeable/Internal.hs | 336 ++++++++++++-------- libraries/base/GHC/Show.hs | 10 + libraries/base/GHC/Stack/Types.hs | 13 + libraries/ghc-prim/GHC/Classes.hs | 36 ++- libraries/ghc-prim/GHC/Magic.hs | 2 + libraries/ghc-prim/GHC/Tuple.hs | 3 + libraries/ghc-prim/GHC/Types.hs | 54 +++- utils/haddock | 2 +- 46 files changed, 2024 insertions(+), 1264 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 a86293691663f15141d5317c83c9c90ab5c4a14b From git at git.haskell.org Sat Sep 26 21:50:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:20 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Update testsuite (6b107f4) Message-ID: <20150926215020.F174C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/6b107f435e9cf6ca8767e28bb8f9cb3be712287e/ghc >--------------------------------------------------------------- commit 6b107f435e9cf6ca8767e28bb8f9cb3be712287e Author: Ben Gamari Date: Wed Sep 23 19:30:54 2015 +0200 Update testsuite >--------------------------------------------------------------- 6b107f435e9cf6ca8767e28bb8f9cb3be712287e .../tests/deSugar/should_compile/T2431.stderr | 29 +++++++++- testsuite/tests/deriving/should_fail/T10524.stderr | 5 +- testsuite/tests/deriving/should_fail/T9687.stderr | 4 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/ghci.debugger/scripts/print019.stderr | 4 +- .../indexed-types/should_compile/T3017.stderr | 2 +- .../tests/numeric/should_compile/T7116.stdout | 29 +++++++++- .../should_fail/overloadedlistsfail01.stderr | 4 +- testsuite/tests/polykinds/T8132.stderr | 4 +- testsuite/tests/quasiquotation/T7918.stdout | 3 ++ testsuite/tests/roles/should_compile/Roles1.stderr | 61 ++++++++++++++++++++++ .../tests/roles/should_compile/Roles13.stderr | 53 +++++++++++++++++-- .../tests/roles/should_compile/Roles14.stderr | 7 +++ testsuite/tests/roles/should_compile/Roles2.stderr | 13 +++++ testsuite/tests/roles/should_compile/Roles4.stderr | 13 +++++ testsuite/tests/roles/should_compile/T8958.stderr | 9 +++- .../tests/simplCore/should_compile/T3717.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T3772.stdout | 29 +++++++++- .../tests/simplCore/should_compile/T4908.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T4930.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T7360.stderr | 47 ++++++++++++++++- .../tests/simplCore/should_compile/T8274.stdout | 8 +++ .../tests/simplCore/should_compile/T9400.stderr | 17 +++++- .../tests/simplCore/should_compile/rule2.stderr | 3 +- .../simplCore/should_compile/spec-inline.stderr | 29 +++++++++- .../tests/stranal/should_compile/T10694.stdout | 3 ++ .../stranal/sigs/BottomFromInnerLambda.stderr | 1 + testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr | 2 + testsuite/tests/stranal/sigs/HyperStrUse.stderr | 1 + testsuite/tests/stranal/sigs/StrAnalExample.stderr | 1 + testsuite/tests/stranal/sigs/T8569.stderr | 2 + testsuite/tests/stranal/sigs/T8598.stderr | 1 + testsuite/tests/stranal/sigs/UnsatFun.stderr | 1 + testsuite/tests/th/TH_Roles2.stderr | 8 +++ .../tests/typecheck/should_compile/holes2.stderr | 6 +-- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- .../tests/typecheck/should_fail/tcfail072.stderr | 4 +- .../tests/typecheck/should_fail/tcfail133.stderr | 7 ++- 38 files changed, 463 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6b107f435e9cf6ca8767e28bb8f9cb3be712287e From git at git.haskell.org Sat Sep 26 21:50:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:23 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Accept more test output (390ecd2) Message-ID: <20150926215023.AADDF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/390ecd2dbf261f701bb60e82f60a01bde985b632/ghc >--------------------------------------------------------------- commit 390ecd2dbf261f701bb60e82f60a01bde985b632 Author: Ben Gamari Date: Wed Sep 23 21:57:49 2015 +0200 Accept more test output >--------------------------------------------------------------- 390ecd2dbf261f701bb60e82f60a01bde985b632 compiler/deSugar/DsBinds.hs | 2 +- .../tests/ghci.debugger/scripts/print018.stdout | 6 +++--- testsuite/tests/ghci/scripts/T8674.stdout | 4 +--- testsuite/tests/roles/should_compile/Roles3.stderr | 25 ++++++++++++++++++++++ .../tests/simplCore/should_compile/T3234.stderr | 4 ++-- .../tests/typecheck/should_fail/T9858a.stderr | 6 +++--- .../tests/typecheck/should_fail/T9858b.stderr | 5 ++--- .../should_fail/TcStaticPointersFail02.stderr | 4 +--- 8 files changed, 38 insertions(+), 18 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 4887354..57f463c 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -945,7 +945,7 @@ ds_ev_typeable ty (EvTypeableTyLit _) -- typeLitTypeRep :: String -> TypeRep -- ; let finst = mkTyApps (Var ctr) [ty] -- proxy = mkTyApps (Var proxyHashId) [typeKind ty, ty] - ; tag <- mkStringExpr str + ; let tag = Lit $ MachStr $ fastStringToByteString $ mkFastString str ; return (mkApps (Var ctr) [tag]) } where str diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout index d5b7d46..a00d537 100644 --- a/testsuite/tests/ghci.debugger/scripts/print018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout @@ -3,9 +3,9 @@ Stopped at ../Test.hs:40:1-17 _result :: () = _ Stopped at ../Test.hs:40:10-17 _result :: () = _ -x :: a17 = _ -x = (_t1::a17) -x :: a17 +x :: a36 = _ +x = (_t1::a36) +x :: a36 () x = Unary x :: Unary diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout index 6c13176..45d4f0a 100644 --- a/testsuite/tests/ghci/scripts/T8674.stdout +++ b/testsuite/tests/ghci/scripts/T8674.stdout @@ -1,5 +1,3 @@ -type role Sing nominal -data family Sing (a :: k) - -- Defined at T8674.hs:4:1 +data family Sing (a :: k) -- Defined at T8674.hs:4:1 data instance Sing Bool = SBool -- Defined at T8674.hs:6:15 data instance Sing a = SNil -- Defined at T8674.hs:5:15 diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 6f25b63..483b349 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -26,4 +26,29 @@ Dependent packages: [base-4.8.2.0, ghc-prim-0.4.0.0, integer-gmp-1.0.0.0] ==================== Typechecker ==================== +Roles3.$tcC4 + = TyCon + 12861862461396457184## + 6389612623460961504## + Roles3.$trModule + (TrNameS "C4"#) +Roles3.$tcC3 + = TyCon + 5998139369941479154## + 6816352641934636458## + Roles3.$trModule + (TrNameS "C3"#) +Roles3.$tcC2 + = TyCon + 8833962732139387711## + 7891126688522429937## + Roles3.$trModule + (TrNameS "C2"#) +Roles3.$tcC1 + = TyCon + 16242970448469140073## + 10229725431456576413## + Roles3.$trModule + (TrNameS "C1"#) +Roles3.$trModule = Module (TrNameS "main"#) (TrNameS "Roles3"#) diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr index c3591d0..d317991 100644 --- a/testsuite/tests/simplCore/should_compile/T3234.stderr +++ b/testsuite/tests/simplCore/should_compile/T3234.stderr @@ -10,7 +10,7 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 45 +Total ticks: 46 14 PreInlineUnconditionally 1 n @@ -37,7 +37,7 @@ Total ticks: 45 1 foldr/single 1 unpack 1 unpack-list -1 LetFloatFromLet 1 +2 LetFloatFromLet 2 22 BetaReduction 1 a 1 b diff --git a/testsuite/tests/typecheck/should_fail/T9858a.stderr b/testsuite/tests/typecheck/should_fail/T9858a.stderr index a42339e..9cb68e0 100644 --- a/testsuite/tests/typecheck/should_fail/T9858a.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858a.stderr @@ -1,9 +1,9 @@ T9858a.hs:28:18: error: - No instance for (Typeable - ((() :: Constraint, () :: Constraint) => ())) + No instance for (Typeable (() :: Constraint)) arising from a use of ?cast? - (maybe you haven't applied a function to enough arguments?) + GHC can't yet do polykinded + Typeable (() :: Constraint :: Constraint) In the expression: cast e In the expression: case cast e of { Just e' -> ecast e' } In an equation for ?supercast?: diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr index 656ff53..a84c1bd 100644 --- a/testsuite/tests/typecheck/should_fail/T9858b.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr @@ -1,8 +1,7 @@ T9858b.hs:7:8: error: - No instance for (Typeable (Eq Int => Int)) - arising from a use of ?typeRep? - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable (Eq Int)) arising from a use of ?typeRep? + GHC can't yet do polykinded Typeable (Eq Int :: Constraint) In the expression: typeRep (Proxy :: Proxy (Eq Int => Int)) In an equation for ?test?: test = typeRep (Proxy :: Proxy (Eq Int => Int)) diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index f63fb47..6237b76 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -6,8 +6,6 @@ TcStaticPointersFail02.hs:9:6: error: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - No instance for (Typeable (Monad m => a -> m a)) - arising from a static form - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable m) arising from a static form In the expression: static return In an equation for ?f2?: f2 = static return From git at git.haskell.org Sat Sep 26 21:50:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:26 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: testsuite: Fix GHCi test output (db5217f) Message-ID: <20150926215026.6D8E13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/db5217f5d0520a7d90c25b1136fe704a7f53c15d/ghc >--------------------------------------------------------------- commit db5217f5d0520a7d90c25b1136fe704a7f53c15d Author: Ben Gamari Date: Wed Sep 23 20:31:12 2015 +0200 testsuite: Fix GHCi test output >--------------------------------------------------------------- db5217f5d0520a7d90c25b1136fe704a7f53c15d testsuite/tests/ghci.debugger/scripts/T2740.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break009.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break010.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break011.stdout | 8 ++++---- testsuite/tests/ghci.debugger/scripts/break012.stdout | 16 ++++++++-------- testsuite/tests/ghci.debugger/scripts/break018.stdout | 4 ++-- .../tests/ghci.debugger/scripts/break022/break022.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break028.stdout | 6 +++--- testsuite/tests/ghci.debugger/scripts/print031.stdout | 2 +- 9 files changed, 24 insertions(+), 24 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/T2740.stdout b/testsuite/tests/ghci.debugger/scripts/T2740.stdout index c6733bc..1f3e6d9 100644 --- a/testsuite/tests/ghci.debugger/scripts/T2740.stdout +++ b/testsuite/tests/ghci.debugger/scripts/T2740.stdout @@ -1,5 +1,5 @@ Stopped at T2740.hs:(3,1)-(4,25) -_result :: a = _ +_result :: a2 = _ Stopped at T2740.hs:3:11-13 _result :: Bool = _ x :: Integer = 1 diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout index b926ed2..1454366 100644 --- a/testsuite/tests/ghci.debugger/scripts/break009.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ *** Exception: Prelude.head: empty list CallStack: - error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List + error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List diff --git a/testsuite/tests/ghci.debugger/scripts/break010.stdout b/testsuite/tests/ghci.debugger/scripts/break010.stdout index 2751b6d..682f4c3 100644 --- a/testsuite/tests/ghci.debugger/scripts/break010.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break010.stdout @@ -1,5 +1,5 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index dafc1fc..67bbec7 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -9,12 +9,12 @@ _exception :: e = _ -2 : main (../Test7.hs:2:8-29) Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Logged breakpoint at ../Test7.hs:2:8-29 -_result :: IO a12 +_result :: IO a14 no more logged breakpoints Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Stopped at _exception :: e already at the beginning of the history @@ -23,7 +23,7 @@ _exception = SomeException "foo" "CallStack: error, called at ../Test7.hs:2:18 in main:Main") -_result :: a12 = _ +_result :: a14 = _ _exception :: SomeException = SomeException (ErrorCallWithLocation "foo" diff --git a/testsuite/tests/ghci.debugger/scripts/break012.stdout b/testsuite/tests/ghci.debugger/scripts/break012.stdout index 70fa0f3..88e8b3e 100644 --- a/testsuite/tests/ghci.debugger/scripts/break012.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break012.stdout @@ -1,16 +1,16 @@ Stopped at break012.hs:(1,1)-(5,18) -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ Stopped at break012.hs:5:10-18 -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ a :: t = _ -b :: a2 -> a2 = _ +b :: a4 -> a4 = _ c :: () = _ -d :: a -> a -> a = _ +d :: a2 -> a2 -> a2 = _ a :: t -b :: a2 -> a2 +b :: a4 -> a4 c :: () -d :: a -> a -> a +d :: a2 -> a2 -> a2 a = (_t1::t) -b = (_t2::a2 -> a2) +b = (_t2::a4 -> a4) c = (_t3::()) -d = (_t4::a -> a -> a) +d = (_t4::a2 -> a2 -> a2) diff --git a/testsuite/tests/ghci.debugger/scripts/break018.stdout b/testsuite/tests/ghci.debugger/scripts/break018.stdout index a12e119..11ef547 100644 --- a/testsuite/tests/ghci.debugger/scripts/break018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break018.stdout @@ -1,5 +1,5 @@ Stopped at ../mdo.hs:(30,1)-(32,27) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ Stopped at ../mdo.hs:(30,16)-(32,27) _result :: IO (N Char) = _ x :: Char = 'h' @@ -10,4 +10,4 @@ f :: N Char = _ l :: N Char = _ x :: Char = 'h' Stopped at ../mdo.hs:(8,1)-(9,42) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout index 99ac58d..a87ffce 100644 --- a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at A.hs:4:1-9 Stopped at A.hs:4:1-9 -_result :: a1 = _ +_result :: a3 = _ Stopped at A.hs:4:7-9 _result :: () = _ x :: () = () diff --git a/testsuite/tests/ghci.debugger/scripts/break028.stdout b/testsuite/tests/ghci.debugger/scripts/break028.stdout index 2438d73..896a241 100644 --- a/testsuite/tests/ghci.debugger/scripts/break028.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break028.stdout @@ -1,5 +1,5 @@ Stopped at break028.hs:15:1-24 -_result :: Id a = _ +_result :: Id a3 = _ Stopped at break028.hs:15:23-24 -_result :: Id a = _ -x' :: Id a = _ +_result :: Id a3 = _ +x' :: Id a3 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/print031.stdout b/testsuite/tests/ghci.debugger/scripts/print031.stdout index 529b698..da3e142 100644 --- a/testsuite/tests/ghci.debugger/scripts/print031.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print031.stdout @@ -4,5 +4,5 @@ Stopped at print031.hs:7:1-19 _result :: Bool = _ Stopped at print031.hs:7:7-19 _result :: Bool = _ -x :: t (Phantom a) = [Just (Phantom 1)] +x :: t (Phantom a5) = [Just (Phantom 1)] x = [Just (Phantom 1)] From git at git.haskell.org Sat Sep 26 21:50:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:50:29 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2's head updated: Accept more test output (390ecd2) Message-ID: <20150926215029.0814D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9858-typeable-ben2' now includes: 939a7d6 Annotate CmmBranch with an optional likely target cf90a1e Add constant-folding rule for Data.Bits.bit 73921df Update Cabal to recognize DeriveLift 453cdbf base: export allocation counter/limit API from System.Mem 5c11523 reify associated types when reifying typeclasses 39a262e Revert "reify associated types when reifying typeclasses" 2440e3c Fix a bug with mallocForeignPtr and finalizers (#10904) b08a533d Fix DeriveGeneric for types with same OccName (#10487) 4f9ee91 Testsuite: update expected output for T8832 on 32-bit systems (#8832) 5883b56 Testsuite: properly fix T8832.stdout-ws-32 (#8832) 1395185 Testsuite: add test for #10767 fb40926 Weak: Don't require wrapping/unwrapping of finalizers a98815a Dwarf: Rename binding to avoid shadowing ppr a0b1f41 Dwarf: Ensure block length is encoded correctly f7fd864 Skip a possible BOM in utf8 encoding a6e0309 Move CallStack back to base 3cc8dd5 IntWord64: Add import to GHC.Types a92d65b Make the generated GHC.Prim module import GHC.Tuple a862936 Generate Typeable info at definition sites 133c5bd More refactoring in matchClass 6b107f4 Update testsuite db5217f testsuite: Fix GHCi test output 390ecd2 Accept more test output From git at git.haskell.org Sat Sep 26 21:52:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:13 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Move CallStack back to base (158a5b5) Message-ID: <20150926215213.ADEF23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/158a5b5435dfc2aa7daee2b2c9c392d3e14bf60c/ghc >--------------------------------------------------------------- commit 158a5b5435dfc2aa7daee2b2c9c392d3e14bf60c Author: Ben Gamari Date: Sun Sep 20 08:27:34 2015 +0200 Move CallStack back to base CallStack requires tuples, instances of which are defined in GHC.Tuple. Unfortunately the D757 change to Typeable deriving means that GHC.Tuple must import GHC.Types for the type representation types, resulting in a cycle. >--------------------------------------------------------------- 158a5b5435dfc2aa7daee2b2c9c392d3e14bf60c compiler/prelude/PrelNames.hs | 9 +++-- libraries/base/GHC/Err.hs | 3 +- libraries/base/GHC/Exception.hs | 1 + libraries/base/GHC/Exception.hs-boot | 3 +- libraries/base/GHC/Stack.hsc | 3 ++ libraries/base/GHC/Stack/Types.hs | 72 ++++++++++++++++++++++++++++++++++++ libraries/base/base.cabal | 1 + libraries/ghc-prim/GHC/Types.hs | 52 +------------------------- 8 files changed, 88 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 158a5b5435dfc2aa7daee2b2c9c392d3e14bf60c From git at git.haskell.org Sat Sep 26 21:52:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:16 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: More refactoring in matchClass (90683f6) Message-ID: <20150926215216.74C1C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/90683f6bdf208c13f3b7eeea35f1f184804424c4/ghc >--------------------------------------------------------------- commit 90683f6bdf208c13f3b7eeea35f1f184804424c4 Author: Simon Peyton Jones Date: Fri Aug 28 10:48:32 2015 +0100 More refactoring in matchClass This refactoring was unforced, but tidies up the structure so I can see what is happening. >--------------------------------------------------------------- 90683f6bdf208c13f3b7eeea35f1f184804424c4 compiler/typecheck/TcInteract.hs | 309 +++++++++++++++++++++------------------ 1 file changed, 170 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 90683f6bdf208c13f3b7eeea35f1f184804424c4 From git at git.haskell.org Sat Sep 26 21:52:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:19 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Make the generated GHC.Prim module import GHC.Tuple (f257398) Message-ID: <20150926215219.43E6F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/f25739873cf622c73638a55587df768f3b372388/ghc >--------------------------------------------------------------- commit f25739873cf622c73638a55587df768f3b372388 Author: Simon Peyton Jones Date: Fri Aug 28 15:24:02 2015 +0100 Make the generated GHC.Prim module import GHC.Tuple See Note [Import GHC.Tuple into GHC.Prim] in genprimopcode/Main.hs I think this has been a lurking bug for ages. Lacking it, Haddock's invocation of GHC for the ghc-prim library says Checking module GHC.Prim... attempting to use module ?GHC.Tuple? (libraries/ghc-prim/./GHC/Tuple.hs) which is not loaded >--------------------------------------------------------------- f25739873cf622c73638a55587df768f3b372388 utils/genprimopcode/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 2a5218e..3ab8ff8 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -262,6 +262,16 @@ gen_hs_source (Info defaults entries) = ++ "-}\n" ++ "import GHC.Types (Coercible)\n" + ++ "import GHC.Tuple ()\n" + -- Note [Import GHC.Tuple into GHC.Prim] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- This expresses a dependency on GHC.Tuple, which we need + -- to ensure that GHC.Tuple is compiled first. The generated + -- code in this module mentions '()', and that in turn tries + -- to ensure that its home module is loaded (for instances I think) + -- So it had better be there, when compiling with --make or Haddock. + -- It's more kosher anyway to be explicit about the dependency. + ++ "default ()" -- If we don't say this then the default type include Integer -- so that runs off and loads modules that are not part of -- pacakge ghc-prim at all. And that in turn somehow ends up From git at git.haskell.org Sat Sep 26 21:52:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:22 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Generate Typeable info at definition sites (99f7b3f) Message-ID: <20150926215222.AB58B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/99f7b3fc94cf438164ce9647308e0a0f96a60259/ghc >--------------------------------------------------------------- commit 99f7b3fc94cf438164ce9647308e0a0f96a60259 Author: Ben Gamari Date: Wed Aug 26 18:24:34 2015 +0200 Generate Typeable info at definition sites This patch implements the idea floated in Trac #9858, namely that we should generate type-representation information at the data type declaration site, rather than when solving a Typeable constraint. However, this turned out quite a bit harder than I expected. I still think it's the right thing to do, and it's done now, but it was quite a struggle. See particularly * Note [Grand plan for Typeable] in TcTypeable (which is a new module) * Note [The overall promotion story] in DataCon (clarifies existing stuff) The most painful bit was that to generate Typeable instances (ie TyConRepName bindings) for every TyCon is tricky for types in ghc-prim etc: * We need to have enough data types around to *define* a TyCon * Many of these types are wired-in Also, to minimise the code generated for each data type, I wanted to generate pure data, not CAFs with unpackCString# stuff floating about. Performance ~~~~~~~~~~~ Three perf/compiler tests start to allocate quite a bit more. This isn't surprising, because they all allocate zillions of data types, with practically no other code, esp. T1969 * T1969: GHC allocates 30% more * T5642: GHC allocates 14% more * T9872d: GHC allocates 5% more I'm treating this as acceptable. The payoff comes in Typeable-heavy code. Remaining to do ~~~~~~~~~~~~~~~ * I think that "TyCon" and "Module" are over-generic names to use for the runtime type representations used in GHC.Typeable. Better might be "TrTyCon" and "TrModule". But I have not yet done this * Add more info the the "TyCon" e.g. source location where it was defined * Use the new "Module" type to help with Trac Trac #10068 * It would be possible to generate TyConRepName (ie Typeable instances) selectively rather than all the time. We'd need to persist the information in interface files. Lacking a motivating reason I have not done this, but it would not be difficult. Refactoring ~~~~~~~~~~~ As is so often the case, I ended up refactoring more than I intended. In particular * In TyCon, a type *family* (whether type or data) is repesented by a FamilyTyCon * a algebraic data type (including data/newtype instances) is represented by AlgTyCon This wasn't true before; a data family was represented as an AlgTyCon. There are some corresponding changes in IfaceSyn. * Also get rid of the (unhelpfully named) tyConParent. * In TyCon define 'Promoted', isomorphic to Maybe, used when things are optionally promoted; and use it elsewhere in GHC. * Cleanup handling of knownKeyNames * Each TyCon, including promoted TyCons, contains its TyConRepName, if it has one. This is, in effect, the name of its Typeable instance. * Move mkDefaultMethodIds, mkRecSelBinds from TcTyClsDecls to TcTyDecls >--------------------------------------------------------------- 99f7b3fc94cf438164ce9647308e0a0f96a60259 compiler/basicTypes/DataCon.hs | 222 ++++++++++---- compiler/basicTypes/OccName.hs | 19 +- compiler/basicTypes/Unique.hs | 51 ++- compiler/deSugar/DsBinds.hs | 277 ++++++++--------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsUtils.hs | 6 +- compiler/iface/BuildTyCl.hs | 42 ++- compiler/iface/IfaceSyn.hs | 97 +++--- compiler/iface/MkIface.hs | 11 +- compiler/iface/TcIface.hs | 89 +++--- compiler/main/HscMain.hs | 13 +- compiler/main/HscTypes.hs | 12 +- compiler/prelude/PrelInfo.hs | 111 +++---- compiler/prelude/PrelNames.hs | 79 +++-- compiler/prelude/TysPrim.hs | 38 ++- compiler/prelude/TysWiredIn.hs | 55 ++-- compiler/typecheck/TcBinds.hs | 35 ++- compiler/typecheck/TcEvidence.hs | 53 +++- compiler/typecheck/TcGenGenerics.hs | 41 ++- compiler/typecheck/TcHsSyn.hs | 28 +- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 19 +- compiler/typecheck/TcInteract.hs | 147 +++++---- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 40 ++- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcTyClsDecls.hs | 330 ++++---------------- compiler/typecheck/TcTyDecls.hs | 330 +++++++++++++++----- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcTypeable.hs | 206 +++++++++++++ compiler/types/TyCon.hs | 409 ++++++++++++++----------- compiler/types/Type.hs | 9 + compiler/utils/Binary.hs | 11 +- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/Env.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 +- libraries/base/Data/Typeable.hs | 3 +- libraries/base/Data/Typeable/Internal.hs | 336 ++++++++++++-------- libraries/base/GHC/Show.hs | 10 + libraries/base/GHC/Stack/Types.hs | 13 + libraries/ghc-prim/GHC/Classes.hs | 36 ++- libraries/ghc-prim/GHC/Magic.hs | 2 + libraries/ghc-prim/GHC/Tuple.hs | 3 + libraries/ghc-prim/GHC/Types.hs | 54 +++- utils/haddock | 2 +- 46 files changed, 2024 insertions(+), 1264 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 99f7b3fc94cf438164ce9647308e0a0f96a60259 From git at git.haskell.org Sat Sep 26 21:52:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:25 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: IntWord64: Add import to GHC.Types (f85f1a6) Message-ID: <20150926215225.682443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/f85f1a6fe327805fc0a765c43125d29b70a8da9c/ghc >--------------------------------------------------------------- commit f85f1a6fe327805fc0a765c43125d29b70a8da9c Author: Ben Gamari Date: Tue Sep 22 22:49:08 2015 +0200 IntWord64: Add import to GHC.Types >--------------------------------------------------------------- f85f1a6fe327805fc0a765c43125d29b70a8da9c libraries/base/GHC/Stack/Types.hs | 4 ++++ libraries/ghc-prim/GHC/IntWord64.hs | 3 +++ 2 files changed, 7 insertions(+) diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index fc9d6c2..5c37f64 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -23,6 +23,10 @@ module GHC.Stack.Types ( import GHC.Types +-- Make implicit dependency known to build system +import GHC.Tuple () +import GHC.Integer () + ---------------------------------------------------------------------- -- Explicit call-stacks built via ImplicitParams ---------------------------------------------------------------------- diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index 52dc08e..35bbfd8 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -23,7 +23,10 @@ module GHC.IntWord64 ( #endif ) where +import GHC.Types () -- Make implicit dependency known to build system + #if WORD_SIZE_IN_BITS < 64 + import GHC.Prim foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int# From git at git.haskell.org Sat Sep 26 21:52:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:28 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: testsuite: Fix GHCi test output (21f5833) Message-ID: <20150926215228.20F563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/21f583365970f58fc4a319c8a392002f372d4589/ghc >--------------------------------------------------------------- commit 21f583365970f58fc4a319c8a392002f372d4589 Author: Ben Gamari Date: Wed Sep 23 20:31:12 2015 +0200 testsuite: Fix GHCi test output >--------------------------------------------------------------- 21f583365970f58fc4a319c8a392002f372d4589 testsuite/tests/ghci.debugger/scripts/T2740.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break009.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break010.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break011.stdout | 8 ++++---- testsuite/tests/ghci.debugger/scripts/break012.stdout | 16 ++++++++-------- testsuite/tests/ghci.debugger/scripts/break018.stdout | 4 ++-- .../tests/ghci.debugger/scripts/break022/break022.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break028.stdout | 6 +++--- testsuite/tests/ghci.debugger/scripts/print031.stdout | 2 +- 9 files changed, 24 insertions(+), 24 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/T2740.stdout b/testsuite/tests/ghci.debugger/scripts/T2740.stdout index c6733bc..1f3e6d9 100644 --- a/testsuite/tests/ghci.debugger/scripts/T2740.stdout +++ b/testsuite/tests/ghci.debugger/scripts/T2740.stdout @@ -1,5 +1,5 @@ Stopped at T2740.hs:(3,1)-(4,25) -_result :: a = _ +_result :: a2 = _ Stopped at T2740.hs:3:11-13 _result :: Bool = _ x :: Integer = 1 diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout index b926ed2..1454366 100644 --- a/testsuite/tests/ghci.debugger/scripts/break009.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ *** Exception: Prelude.head: empty list CallStack: - error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List + error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List diff --git a/testsuite/tests/ghci.debugger/scripts/break010.stdout b/testsuite/tests/ghci.debugger/scripts/break010.stdout index 2751b6d..682f4c3 100644 --- a/testsuite/tests/ghci.debugger/scripts/break010.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break010.stdout @@ -1,5 +1,5 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index dafc1fc..67bbec7 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -9,12 +9,12 @@ _exception :: e = _ -2 : main (../Test7.hs:2:8-29) Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Logged breakpoint at ../Test7.hs:2:8-29 -_result :: IO a12 +_result :: IO a14 no more logged breakpoints Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Stopped at _exception :: e already at the beginning of the history @@ -23,7 +23,7 @@ _exception = SomeException "foo" "CallStack: error, called at ../Test7.hs:2:18 in main:Main") -_result :: a12 = _ +_result :: a14 = _ _exception :: SomeException = SomeException (ErrorCallWithLocation "foo" diff --git a/testsuite/tests/ghci.debugger/scripts/break012.stdout b/testsuite/tests/ghci.debugger/scripts/break012.stdout index 70fa0f3..88e8b3e 100644 --- a/testsuite/tests/ghci.debugger/scripts/break012.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break012.stdout @@ -1,16 +1,16 @@ Stopped at break012.hs:(1,1)-(5,18) -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ Stopped at break012.hs:5:10-18 -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ a :: t = _ -b :: a2 -> a2 = _ +b :: a4 -> a4 = _ c :: () = _ -d :: a -> a -> a = _ +d :: a2 -> a2 -> a2 = _ a :: t -b :: a2 -> a2 +b :: a4 -> a4 c :: () -d :: a -> a -> a +d :: a2 -> a2 -> a2 a = (_t1::t) -b = (_t2::a2 -> a2) +b = (_t2::a4 -> a4) c = (_t3::()) -d = (_t4::a -> a -> a) +d = (_t4::a2 -> a2 -> a2) diff --git a/testsuite/tests/ghci.debugger/scripts/break018.stdout b/testsuite/tests/ghci.debugger/scripts/break018.stdout index a12e119..11ef547 100644 --- a/testsuite/tests/ghci.debugger/scripts/break018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break018.stdout @@ -1,5 +1,5 @@ Stopped at ../mdo.hs:(30,1)-(32,27) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ Stopped at ../mdo.hs:(30,16)-(32,27) _result :: IO (N Char) = _ x :: Char = 'h' @@ -10,4 +10,4 @@ f :: N Char = _ l :: N Char = _ x :: Char = 'h' Stopped at ../mdo.hs:(8,1)-(9,42) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout index 99ac58d..a87ffce 100644 --- a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at A.hs:4:1-9 Stopped at A.hs:4:1-9 -_result :: a1 = _ +_result :: a3 = _ Stopped at A.hs:4:7-9 _result :: () = _ x :: () = () diff --git a/testsuite/tests/ghci.debugger/scripts/break028.stdout b/testsuite/tests/ghci.debugger/scripts/break028.stdout index 2438d73..896a241 100644 --- a/testsuite/tests/ghci.debugger/scripts/break028.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break028.stdout @@ -1,5 +1,5 @@ Stopped at break028.hs:15:1-24 -_result :: Id a = _ +_result :: Id a3 = _ Stopped at break028.hs:15:23-24 -_result :: Id a = _ -x' :: Id a = _ +_result :: Id a3 = _ +x' :: Id a3 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/print031.stdout b/testsuite/tests/ghci.debugger/scripts/print031.stdout index 529b698..da3e142 100644 --- a/testsuite/tests/ghci.debugger/scripts/print031.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print031.stdout @@ -4,5 +4,5 @@ Stopped at print031.hs:7:1-19 _result :: Bool = _ Stopped at print031.hs:7:7-19 _result :: Bool = _ -x :: t (Phantom a) = [Just (Phantom 1)] +x :: t (Phantom a5) = [Just (Phantom 1)] x = [Just (Phantom 1)] From git at git.haskell.org Sat Sep 26 21:52:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:30 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Accept more test output (4a3e411) Message-ID: <20150926215230.E87283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/4a3e411c43290bdb4726f191199baedd685112b1/ghc >--------------------------------------------------------------- commit 4a3e411c43290bdb4726f191199baedd685112b1 Author: Ben Gamari Date: Wed Sep 23 21:57:49 2015 +0200 Accept more test output >--------------------------------------------------------------- 4a3e411c43290bdb4726f191199baedd685112b1 compiler/deSugar/DsBinds.hs | 2 +- .../tests/ghci.debugger/scripts/print018.stdout | 6 +++--- testsuite/tests/ghci/scripts/T8674.stdout | 4 +--- testsuite/tests/roles/should_compile/Roles3.stderr | 25 ++++++++++++++++++++++ .../tests/simplCore/should_compile/T3234.stderr | 4 ++-- .../tests/typecheck/should_fail/T9858a.stderr | 6 +++--- .../tests/typecheck/should_fail/T9858b.stderr | 5 ++--- .../should_fail/TcStaticPointersFail02.stderr | 4 +--- 8 files changed, 38 insertions(+), 18 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 4887354..57f463c 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -945,7 +945,7 @@ ds_ev_typeable ty (EvTypeableTyLit _) -- typeLitTypeRep :: String -> TypeRep -- ; let finst = mkTyApps (Var ctr) [ty] -- proxy = mkTyApps (Var proxyHashId) [typeKind ty, ty] - ; tag <- mkStringExpr str + ; let tag = Lit $ MachStr $ fastStringToByteString $ mkFastString str ; return (mkApps (Var ctr) [tag]) } where str diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout index d5b7d46..a00d537 100644 --- a/testsuite/tests/ghci.debugger/scripts/print018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout @@ -3,9 +3,9 @@ Stopped at ../Test.hs:40:1-17 _result :: () = _ Stopped at ../Test.hs:40:10-17 _result :: () = _ -x :: a17 = _ -x = (_t1::a17) -x :: a17 +x :: a36 = _ +x = (_t1::a36) +x :: a36 () x = Unary x :: Unary diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout index 6c13176..45d4f0a 100644 --- a/testsuite/tests/ghci/scripts/T8674.stdout +++ b/testsuite/tests/ghci/scripts/T8674.stdout @@ -1,5 +1,3 @@ -type role Sing nominal -data family Sing (a :: k) - -- Defined at T8674.hs:4:1 +data family Sing (a :: k) -- Defined at T8674.hs:4:1 data instance Sing Bool = SBool -- Defined at T8674.hs:6:15 data instance Sing a = SNil -- Defined at T8674.hs:5:15 diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 6f25b63..483b349 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -26,4 +26,29 @@ Dependent packages: [base-4.8.2.0, ghc-prim-0.4.0.0, integer-gmp-1.0.0.0] ==================== Typechecker ==================== +Roles3.$tcC4 + = TyCon + 12861862461396457184## + 6389612623460961504## + Roles3.$trModule + (TrNameS "C4"#) +Roles3.$tcC3 + = TyCon + 5998139369941479154## + 6816352641934636458## + Roles3.$trModule + (TrNameS "C3"#) +Roles3.$tcC2 + = TyCon + 8833962732139387711## + 7891126688522429937## + Roles3.$trModule + (TrNameS "C2"#) +Roles3.$tcC1 + = TyCon + 16242970448469140073## + 10229725431456576413## + Roles3.$trModule + (TrNameS "C1"#) +Roles3.$trModule = Module (TrNameS "main"#) (TrNameS "Roles3"#) diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr index c3591d0..d317991 100644 --- a/testsuite/tests/simplCore/should_compile/T3234.stderr +++ b/testsuite/tests/simplCore/should_compile/T3234.stderr @@ -10,7 +10,7 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 45 +Total ticks: 46 14 PreInlineUnconditionally 1 n @@ -37,7 +37,7 @@ Total ticks: 45 1 foldr/single 1 unpack 1 unpack-list -1 LetFloatFromLet 1 +2 LetFloatFromLet 2 22 BetaReduction 1 a 1 b diff --git a/testsuite/tests/typecheck/should_fail/T9858a.stderr b/testsuite/tests/typecheck/should_fail/T9858a.stderr index a42339e..9cb68e0 100644 --- a/testsuite/tests/typecheck/should_fail/T9858a.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858a.stderr @@ -1,9 +1,9 @@ T9858a.hs:28:18: error: - No instance for (Typeable - ((() :: Constraint, () :: Constraint) => ())) + No instance for (Typeable (() :: Constraint)) arising from a use of ?cast? - (maybe you haven't applied a function to enough arguments?) + GHC can't yet do polykinded + Typeable (() :: Constraint :: Constraint) In the expression: cast e In the expression: case cast e of { Just e' -> ecast e' } In an equation for ?supercast?: diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr index 656ff53..a84c1bd 100644 --- a/testsuite/tests/typecheck/should_fail/T9858b.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr @@ -1,8 +1,7 @@ T9858b.hs:7:8: error: - No instance for (Typeable (Eq Int => Int)) - arising from a use of ?typeRep? - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable (Eq Int)) arising from a use of ?typeRep? + GHC can't yet do polykinded Typeable (Eq Int :: Constraint) In the expression: typeRep (Proxy :: Proxy (Eq Int => Int)) In an equation for ?test?: test = typeRep (Proxy :: Proxy (Eq Int => Int)) diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index f63fb47..6237b76 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -6,8 +6,6 @@ TcStaticPointersFail02.hs:9:6: error: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - No instance for (Typeable (Monad m => a -> m a)) - arising from a static form - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable m) arising from a static form In the expression: static return In an equation for ?f2?: f2 = static return From git at git.haskell.org Sat Sep 26 21:52:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:33 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Update testsuite (f2717f0) Message-ID: <20150926215233.B46FE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/f2717f09ed5df4f0b97198b7382f29720a7a19fc/ghc >--------------------------------------------------------------- commit f2717f09ed5df4f0b97198b7382f29720a7a19fc Author: Ben Gamari Date: Wed Sep 23 19:30:54 2015 +0200 Update testsuite >--------------------------------------------------------------- f2717f09ed5df4f0b97198b7382f29720a7a19fc .../tests/deSugar/should_compile/T2431.stderr | 29 +++++++++- testsuite/tests/deriving/should_fail/T10524.stderr | 5 +- testsuite/tests/deriving/should_fail/T9687.stderr | 4 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/ghci.debugger/scripts/print019.stderr | 4 +- .../indexed-types/should_compile/T3017.stderr | 2 +- .../tests/numeric/should_compile/T7116.stdout | 29 +++++++++- .../should_fail/overloadedlistsfail01.stderr | 4 +- testsuite/tests/polykinds/T8132.stderr | 4 +- testsuite/tests/quasiquotation/T7918.stdout | 3 ++ testsuite/tests/roles/should_compile/Roles1.stderr | 61 ++++++++++++++++++++++ .../tests/roles/should_compile/Roles13.stderr | 53 +++++++++++++++++-- .../tests/roles/should_compile/Roles14.stderr | 7 +++ testsuite/tests/roles/should_compile/Roles2.stderr | 13 +++++ testsuite/tests/roles/should_compile/Roles4.stderr | 13 +++++ testsuite/tests/roles/should_compile/T8958.stderr | 9 +++- .../tests/simplCore/should_compile/T3717.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T3772.stdout | 29 +++++++++- .../tests/simplCore/should_compile/T4908.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T4930.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T7360.stderr | 47 ++++++++++++++++- .../tests/simplCore/should_compile/T8274.stdout | 8 +++ .../tests/simplCore/should_compile/T9400.stderr | 17 +++++- .../tests/simplCore/should_compile/rule2.stderr | 3 +- .../simplCore/should_compile/spec-inline.stderr | 29 +++++++++- .../tests/stranal/should_compile/T10694.stdout | 3 ++ .../stranal/sigs/BottomFromInnerLambda.stderr | 1 + testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr | 2 + testsuite/tests/stranal/sigs/HyperStrUse.stderr | 1 + testsuite/tests/stranal/sigs/StrAnalExample.stderr | 1 + testsuite/tests/stranal/sigs/T8569.stderr | 2 + testsuite/tests/stranal/sigs/T8598.stderr | 1 + testsuite/tests/stranal/sigs/UnsatFun.stderr | 1 + testsuite/tests/th/TH_Roles2.stderr | 8 +++ .../tests/typecheck/should_compile/holes2.stderr | 6 +-- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- .../tests/typecheck/should_fail/tcfail072.stderr | 4 +- .../tests/typecheck/should_fail/tcfail133.stderr | 7 ++- 38 files changed, 463 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f2717f09ed5df4f0b97198b7382f29720a7a19fc From git at git.haskell.org Sat Sep 26 21:52:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Sep 2015 21:52:36 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2's head updated: Accept more test output (4a3e411) Message-ID: <20150926215236.3DC7B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9858-typeable-ben2' now includes: 3fbf8f4 Debug: Remove extraneous LANGUAGE CPP 988b2ba rts: Clean up whitespace in Trace.h b4d43b4 reify associated types when reifying typeclasses(#10891) 158a5b5 Move CallStack back to base f85f1a6 IntWord64: Add import to GHC.Types f257398 Make the generated GHC.Prim module import GHC.Tuple 99f7b3f Generate Typeable info at definition sites 90683f6 More refactoring in matchClass f2717f0 Update testsuite 21f5833 testsuite: Fix GHCi test output 4a3e411 Accept more test output From git at git.haskell.org Mon Sep 28 06:54:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 06:54:44 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T10071' created Message-ID: <20150928065444.B2D843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T10071 Referencing: a56a548f9c0aec9162e486018d38493544e742fe From git at git.haskell.org Mon Sep 28 06:54:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 06:54:47 +0000 (UTC) Subject: [commit: ghc] wip/T10071: Allow deprecations in class decl bodies (9776dc8) Message-ID: <20150928065447.7F6F73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10071 Link : http://ghc.haskell.org/trac/ghc/changeset/9776dc838e1fc7ce27d3db0a0d893555ea6487db/ghc >--------------------------------------------------------------- commit 9776dc838e1fc7ce27d3db0a0d893555ea6487db Author: Herbert Valerio Riedel Date: Fri Jun 5 14:04:18 2015 +0200 Allow deprecations in class decl bodies ...and I was helped by Alan to get the types to line up... >--------------------------------------------------------------- 9776dc838e1fc7ce27d3db0a0d893555ea6487db compiler/parser/Parser.y | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index b88a3b1..42c85ac 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1233,6 +1233,11 @@ decl_cls : at_decl_cls { sLL $1 $> (unitOL $1) } ; ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (GenericSig l ty))) [mj AnnDefault $1,mj AnnDcolon $3] } } + -- class method-use deprecations (Trac #10071) + | '{-# DEPRECATED' deprecations '#-}' + {% ams (sLL $1 $> $ unitOL $ sLL $1 $> $ + WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2))) [mo $1,mc $3] } + decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } -- Reversed : decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1) From git at git.haskell.org Mon Sep 28 06:54:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 06:54:50 +0000 (UTC) Subject: [commit: ghc] wip/T10071: WIP (a56a548) Message-ID: <20150928065450.3E07B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10071 Link : http://ghc.haskell.org/trac/ghc/changeset/a56a548f9c0aec9162e486018d38493544e742fe/ghc >--------------------------------------------------------------- commit a56a548f9c0aec9162e486018d38493544e742fe Author: Herbert Valerio Riedel Date: Sat Jun 27 20:39:40 2015 +0200 WIP >--------------------------------------------------------------- a56a548f9c0aec9162e486018d38493544e742fe compiler/main/HscTypes.hs | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 67b0694..6aa6122 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1934,11 +1934,29 @@ but they are mostly elaborated elsewhere -} ------------------ Warnings ------------------------- + +-- data WarnItem = WI OccName WarnInfo (Located SourceText) [Located (SourceText,FastString)] +-- data WarnInfo = Warning | DeprecTop | DeprecMeth + +-- Some overlap w/ 'WarningTxt' +data WarnItem = WarnItem OccName !WarnInfo (Located SourceText) [Located (SourceText,FastString)] + deriving Eq + +data WarnInfo + = Warning -- top-level indented + | DeprecTop -- top-level indented + | DeprecMeth -- class-body indented + deriving (Eq, Enum) + +instance Binary WarnInfo where + put_ bh wi = putByte bh (fromIntegral $ fromEnum wi) + get bh = toEnum . fromIntegral <$> getByte bh + -- | Warning information for a module data Warnings = NoWarnings -- ^ Nothing deprecated | WarnAll WarningTxt -- ^ Whole module deprecated - | WarnSome [(OccName,WarningTxt)] -- ^ Some specific things deprecated + | WarnSome [WarnInfo] -- ^ Some specific things deprecated -- Only an OccName is needed because -- (1) a deprecation always applies to a binding From git at git.haskell.org Mon Sep 28 12:45:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 12:45:24 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: IntWord64: Add import of GHC.Types (cce0519) Message-ID: <20150928124524.84E7D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/cce05194164eb4068c8237eb227065ac773fc418/ghc >--------------------------------------------------------------- commit cce05194164eb4068c8237eb227065ac773fc418 Author: Ben Gamari Date: Tue Sep 22 22:49:08 2015 +0200 IntWord64: Add import of GHC.Types >--------------------------------------------------------------- cce05194164eb4068c8237eb227065ac773fc418 libraries/base/GHC/Stack/Types.hs | 4 ++++ libraries/ghc-prim/GHC/IntWord64.hs | 3 +++ 2 files changed, 7 insertions(+) diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index fc9d6c2..5c37f64 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -23,6 +23,10 @@ module GHC.Stack.Types ( import GHC.Types +-- Make implicit dependency known to build system +import GHC.Tuple () +import GHC.Integer () + ---------------------------------------------------------------------- -- Explicit call-stacks built via ImplicitParams ---------------------------------------------------------------------- diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index 52dc08e..35bbfd8 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -23,7 +23,10 @@ module GHC.IntWord64 ( #endif ) where +import GHC.Types () -- Make implicit dependency known to build system + #if WORD_SIZE_IN_BITS < 64 + import GHC.Prim foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int# From git at git.haskell.org Mon Sep 28 12:45:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 12:45:27 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: More refactoring in matchClass (f3d7b65) Message-ID: <20150928124527.5EFAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/f3d7b65e4a30460534bdb0877ddc5b11c191b4e9/ghc >--------------------------------------------------------------- commit f3d7b65e4a30460534bdb0877ddc5b11c191b4e9 Author: Simon Peyton Jones Date: Fri Aug 28 10:48:32 2015 +0100 More refactoring in matchClass This refactoring was unforced, but tidies up the structure so I can see what is happening. >--------------------------------------------------------------- f3d7b65e4a30460534bdb0877ddc5b11c191b4e9 compiler/typecheck/TcInteract.hs | 309 +++++++++++++++++++++------------------ 1 file changed, 170 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 f3d7b65e4a30460534bdb0877ddc5b11c191b4e9 From git at git.haskell.org Mon Sep 28 12:45:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 12:45:30 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Accept more test output (933bbe2) Message-ID: <20150928124530.202173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/933bbe2b47a73260209cd24fc9c548bc7584099b/ghc >--------------------------------------------------------------- commit 933bbe2b47a73260209cd24fc9c548bc7584099b Author: Ben Gamari Date: Wed Sep 23 21:57:49 2015 +0200 Accept more test output >--------------------------------------------------------------- 933bbe2b47a73260209cd24fc9c548bc7584099b compiler/deSugar/DsBinds.hs | 2 +- .../tests/ghci.debugger/scripts/print018.stdout | 6 +++--- testsuite/tests/ghci/scripts/T8674.stdout | 4 +--- testsuite/tests/roles/should_compile/Roles3.stderr | 25 ++++++++++++++++++++++ .../tests/simplCore/should_compile/T3234.stderr | 4 ++-- .../tests/typecheck/should_fail/T9858a.stderr | 6 +++--- .../tests/typecheck/should_fail/T9858b.stderr | 5 ++--- .../should_fail/TcStaticPointersFail02.stderr | 4 +--- 8 files changed, 38 insertions(+), 18 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 4887354..57f463c 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -945,7 +945,7 @@ ds_ev_typeable ty (EvTypeableTyLit _) -- typeLitTypeRep :: String -> TypeRep -- ; let finst = mkTyApps (Var ctr) [ty] -- proxy = mkTyApps (Var proxyHashId) [typeKind ty, ty] - ; tag <- mkStringExpr str + ; let tag = Lit $ MachStr $ fastStringToByteString $ mkFastString str ; return (mkApps (Var ctr) [tag]) } where str diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout index d5b7d46..a00d537 100644 --- a/testsuite/tests/ghci.debugger/scripts/print018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout @@ -3,9 +3,9 @@ Stopped at ../Test.hs:40:1-17 _result :: () = _ Stopped at ../Test.hs:40:10-17 _result :: () = _ -x :: a17 = _ -x = (_t1::a17) -x :: a17 +x :: a36 = _ +x = (_t1::a36) +x :: a36 () x = Unary x :: Unary diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout index 6c13176..45d4f0a 100644 --- a/testsuite/tests/ghci/scripts/T8674.stdout +++ b/testsuite/tests/ghci/scripts/T8674.stdout @@ -1,5 +1,3 @@ -type role Sing nominal -data family Sing (a :: k) - -- Defined at T8674.hs:4:1 +data family Sing (a :: k) -- Defined at T8674.hs:4:1 data instance Sing Bool = SBool -- Defined at T8674.hs:6:15 data instance Sing a = SNil -- Defined at T8674.hs:5:15 diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 6f25b63..483b349 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -26,4 +26,29 @@ Dependent packages: [base-4.8.2.0, ghc-prim-0.4.0.0, integer-gmp-1.0.0.0] ==================== Typechecker ==================== +Roles3.$tcC4 + = TyCon + 12861862461396457184## + 6389612623460961504## + Roles3.$trModule + (TrNameS "C4"#) +Roles3.$tcC3 + = TyCon + 5998139369941479154## + 6816352641934636458## + Roles3.$trModule + (TrNameS "C3"#) +Roles3.$tcC2 + = TyCon + 8833962732139387711## + 7891126688522429937## + Roles3.$trModule + (TrNameS "C2"#) +Roles3.$tcC1 + = TyCon + 16242970448469140073## + 10229725431456576413## + Roles3.$trModule + (TrNameS "C1"#) +Roles3.$trModule = Module (TrNameS "main"#) (TrNameS "Roles3"#) diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr index c3591d0..d317991 100644 --- a/testsuite/tests/simplCore/should_compile/T3234.stderr +++ b/testsuite/tests/simplCore/should_compile/T3234.stderr @@ -10,7 +10,7 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 45 +Total ticks: 46 14 PreInlineUnconditionally 1 n @@ -37,7 +37,7 @@ Total ticks: 45 1 foldr/single 1 unpack 1 unpack-list -1 LetFloatFromLet 1 +2 LetFloatFromLet 2 22 BetaReduction 1 a 1 b diff --git a/testsuite/tests/typecheck/should_fail/T9858a.stderr b/testsuite/tests/typecheck/should_fail/T9858a.stderr index a42339e..9cb68e0 100644 --- a/testsuite/tests/typecheck/should_fail/T9858a.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858a.stderr @@ -1,9 +1,9 @@ T9858a.hs:28:18: error: - No instance for (Typeable - ((() :: Constraint, () :: Constraint) => ())) + No instance for (Typeable (() :: Constraint)) arising from a use of ?cast? - (maybe you haven't applied a function to enough arguments?) + GHC can't yet do polykinded + Typeable (() :: Constraint :: Constraint) In the expression: cast e In the expression: case cast e of { Just e' -> ecast e' } In an equation for ?supercast?: diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr index 656ff53..a84c1bd 100644 --- a/testsuite/tests/typecheck/should_fail/T9858b.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr @@ -1,8 +1,7 @@ T9858b.hs:7:8: error: - No instance for (Typeable (Eq Int => Int)) - arising from a use of ?typeRep? - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable (Eq Int)) arising from a use of ?typeRep? + GHC can't yet do polykinded Typeable (Eq Int :: Constraint) In the expression: typeRep (Proxy :: Proxy (Eq Int => Int)) In an equation for ?test?: test = typeRep (Proxy :: Proxy (Eq Int => Int)) diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index f63fb47..6237b76 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -6,8 +6,6 @@ TcStaticPointersFail02.hs:9:6: error: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - No instance for (Typeable (Monad m => a -> m a)) - arising from a static form - (maybe you haven't applied a function to enough arguments?) + No instance for (Typeable m) arising from a static form In the expression: static return In an equation for ?f2?: f2 = static return From git at git.haskell.org Mon Sep 28 12:45:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 12:45:32 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: testsuite: Fix GHCi test output (5de2d31) Message-ID: <20150928124532.E04723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/5de2d319d78ae85245d706627326e93898ccb224/ghc >--------------------------------------------------------------- commit 5de2d319d78ae85245d706627326e93898ccb224 Author: Ben Gamari Date: Wed Sep 23 20:31:12 2015 +0200 testsuite: Fix GHCi test output >--------------------------------------------------------------- 5de2d319d78ae85245d706627326e93898ccb224 testsuite/tests/ghci.debugger/scripts/T2740.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break009.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break010.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break011.stdout | 8 ++++---- testsuite/tests/ghci.debugger/scripts/break012.stdout | 16 ++++++++-------- testsuite/tests/ghci.debugger/scripts/break018.stdout | 4 ++-- .../tests/ghci.debugger/scripts/break022/break022.stdout | 2 +- testsuite/tests/ghci.debugger/scripts/break028.stdout | 6 +++--- testsuite/tests/ghci.debugger/scripts/print031.stdout | 2 +- 9 files changed, 24 insertions(+), 24 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/T2740.stdout b/testsuite/tests/ghci.debugger/scripts/T2740.stdout index c6733bc..1f3e6d9 100644 --- a/testsuite/tests/ghci.debugger/scripts/T2740.stdout +++ b/testsuite/tests/ghci.debugger/scripts/T2740.stdout @@ -1,5 +1,5 @@ Stopped at T2740.hs:(3,1)-(4,25) -_result :: a = _ +_result :: a2 = _ Stopped at T2740.hs:3:11-13 _result :: Bool = _ x :: Integer = 1 diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout index b926ed2..1454366 100644 --- a/testsuite/tests/ghci.debugger/scripts/break009.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ *** Exception: Prelude.head: empty list CallStack: - error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List + error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List diff --git a/testsuite/tests/ghci.debugger/scripts/break010.stdout b/testsuite/tests/ghci.debugger/scripts/break010.stdout index 2751b6d..682f4c3 100644 --- a/testsuite/tests/ghci.debugger/scripts/break010.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break010.stdout @@ -1,5 +1,5 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ Stopped at ../Test6.hs:5:8-11 -_result :: a = _ +_result :: a2 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index dafc1fc..67bbec7 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -9,12 +9,12 @@ _exception :: e = _ -2 : main (../Test7.hs:2:8-29) Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Logged breakpoint at ../Test7.hs:2:8-29 -_result :: IO a12 +_result :: IO a14 no more logged breakpoints Logged breakpoint at ../Test7.hs:2:18-28 -_result :: a12 +_result :: a14 Stopped at _exception :: e already at the beginning of the history @@ -23,7 +23,7 @@ _exception = SomeException "foo" "CallStack: error, called at ../Test7.hs:2:18 in main:Main") -_result :: a12 = _ +_result :: a14 = _ _exception :: SomeException = SomeException (ErrorCallWithLocation "foo" diff --git a/testsuite/tests/ghci.debugger/scripts/break012.stdout b/testsuite/tests/ghci.debugger/scripts/break012.stdout index 70fa0f3..88e8b3e 100644 --- a/testsuite/tests/ghci.debugger/scripts/break012.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break012.stdout @@ -1,16 +1,16 @@ Stopped at break012.hs:(1,1)-(5,18) -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ Stopped at break012.hs:5:10-18 -_result :: (t, a1 -> a1, (), a -> a -> a) = _ +_result :: (t, a3 -> a3, (), a2 -> a2 -> a2) = _ a :: t = _ -b :: a2 -> a2 = _ +b :: a4 -> a4 = _ c :: () = _ -d :: a -> a -> a = _ +d :: a2 -> a2 -> a2 = _ a :: t -b :: a2 -> a2 +b :: a4 -> a4 c :: () -d :: a -> a -> a +d :: a2 -> a2 -> a2 a = (_t1::t) -b = (_t2::a2 -> a2) +b = (_t2::a4 -> a4) c = (_t3::()) -d = (_t4::a -> a -> a) +d = (_t4::a2 -> a2 -> a2) diff --git a/testsuite/tests/ghci.debugger/scripts/break018.stdout b/testsuite/tests/ghci.debugger/scripts/break018.stdout index a12e119..11ef547 100644 --- a/testsuite/tests/ghci.debugger/scripts/break018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break018.stdout @@ -1,5 +1,5 @@ Stopped at ../mdo.hs:(30,1)-(32,27) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ Stopped at ../mdo.hs:(30,16)-(32,27) _result :: IO (N Char) = _ x :: Char = 'h' @@ -10,4 +10,4 @@ f :: N Char = _ l :: N Char = _ x :: Char = 'h' Stopped at ../mdo.hs:(8,1)-(9,42) -_result :: IO (N a) = _ +_result :: IO (N a6) = _ diff --git a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout index 99ac58d..a87ffce 100644 --- a/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break022/break022.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at A.hs:4:1-9 Stopped at A.hs:4:1-9 -_result :: a1 = _ +_result :: a3 = _ Stopped at A.hs:4:7-9 _result :: () = _ x :: () = () diff --git a/testsuite/tests/ghci.debugger/scripts/break028.stdout b/testsuite/tests/ghci.debugger/scripts/break028.stdout index 2438d73..896a241 100644 --- a/testsuite/tests/ghci.debugger/scripts/break028.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break028.stdout @@ -1,5 +1,5 @@ Stopped at break028.hs:15:1-24 -_result :: Id a = _ +_result :: Id a3 = _ Stopped at break028.hs:15:23-24 -_result :: Id a = _ -x' :: Id a = _ +_result :: Id a3 = _ +x' :: Id a3 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/print031.stdout b/testsuite/tests/ghci.debugger/scripts/print031.stdout index 529b698..da3e142 100644 --- a/testsuite/tests/ghci.debugger/scripts/print031.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print031.stdout @@ -4,5 +4,5 @@ Stopped at print031.hs:7:1-19 _result :: Bool = _ Stopped at print031.hs:7:7-19 _result :: Bool = _ -x :: t (Phantom a) = [Just (Phantom 1)] +x :: t (Phantom a5) = [Just (Phantom 1)] x = [Just (Phantom 1)] From git at git.haskell.org Mon Sep 28 12:45:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 12:45:36 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Generate Typeable info at definition sites (285cd00) Message-ID: <20150928124536.405223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/285cd0012dfafb3a03cbb002e8519199df3329e1/ghc >--------------------------------------------------------------- commit 285cd0012dfafb3a03cbb002e8519199df3329e1 Author: Ben Gamari Date: Wed Aug 26 18:24:34 2015 +0200 Generate Typeable info at definition sites This patch implements the idea floated in Trac #9858, namely that we should generate type-representation information at the data type declaration site, rather than when solving a Typeable constraint. However, this turned out quite a bit harder than I expected. I still think it's the right thing to do, and it's done now, but it was quite a struggle. See particularly * Note [Grand plan for Typeable] in TcTypeable (which is a new module) * Note [The overall promotion story] in DataCon (clarifies existing stuff) The most painful bit was that to generate Typeable instances (ie TyConRepName bindings) for every TyCon is tricky for types in ghc-prim etc: * We need to have enough data types around to *define* a TyCon * Many of these types are wired-in Also, to minimise the code generated for each data type, I wanted to generate pure data, not CAFs with unpackCString# stuff floating about. Performance ~~~~~~~~~~~ Three perf/compiler tests start to allocate quite a bit more. This isn't surprising, because they all allocate zillions of data types, with practically no other code, esp. T1969 * T1969: GHC allocates 30% more * T5642: GHC allocates 14% more * T9872d: GHC allocates 5% more I'm treating this as acceptable. The payoff comes in Typeable-heavy code. Remaining to do ~~~~~~~~~~~~~~~ * I think that "TyCon" and "Module" are over-generic names to use for the runtime type representations used in GHC.Typeable. Better might be "TrTyCon" and "TrModule". But I have not yet done this * Add more info the the "TyCon" e.g. source location where it was defined * Use the new "Module" type to help with Trac Trac #10068 * It would be possible to generate TyConRepName (ie Typeable instances) selectively rather than all the time. We'd need to persist the information in interface files. Lacking a motivating reason I have not done this, but it would not be difficult. Refactoring ~~~~~~~~~~~ As is so often the case, I ended up refactoring more than I intended. In particular * In TyCon, a type *family* (whether type or data) is repesented by a FamilyTyCon * a algebraic data type (including data/newtype instances) is represented by AlgTyCon This wasn't true before; a data family was represented as an AlgTyCon. There are some corresponding changes in IfaceSyn. * Also get rid of the (unhelpfully named) tyConParent. * In TyCon define 'Promoted', isomorphic to Maybe, used when things are optionally promoted; and use it elsewhere in GHC. * Cleanup handling of knownKeyNames * Each TyCon, including promoted TyCons, contains its TyConRepName, if it has one. This is, in effect, the name of its Typeable instance. * Move mkDefaultMethodIds, mkRecSelBinds from TcTyClsDecls to TcTyDecls >--------------------------------------------------------------- 285cd0012dfafb3a03cbb002e8519199df3329e1 compiler/basicTypes/DataCon.hs | 222 ++++++++++---- compiler/basicTypes/OccName.hs | 19 +- compiler/basicTypes/Unique.hs | 51 ++- compiler/deSugar/DsBinds.hs | 277 ++++++++--------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsUtils.hs | 6 +- compiler/iface/BuildTyCl.hs | 42 ++- compiler/iface/IfaceSyn.hs | 97 +++--- compiler/iface/MkIface.hs | 11 +- compiler/iface/TcIface.hs | 89 +++--- compiler/main/HscMain.hs | 13 +- compiler/main/HscTypes.hs | 12 +- compiler/prelude/PrelInfo.hs | 111 +++---- compiler/prelude/PrelNames.hs | 79 +++-- compiler/prelude/TysPrim.hs | 38 ++- compiler/prelude/TysWiredIn.hs | 55 ++-- compiler/typecheck/TcBinds.hs | 35 ++- compiler/typecheck/TcEvidence.hs | 53 +++- compiler/typecheck/TcGenGenerics.hs | 41 ++- compiler/typecheck/TcHsSyn.hs | 28 +- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 19 +- compiler/typecheck/TcInteract.hs | 147 +++++---- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 40 ++- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcTyClsDecls.hs | 330 ++++---------------- compiler/typecheck/TcTyDecls.hs | 330 +++++++++++++++----- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcTypeable.hs | 206 +++++++++++++ compiler/types/TyCon.hs | 409 ++++++++++++++----------- compiler/types/Type.hs | 9 + compiler/utils/Binary.hs | 11 +- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/Env.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 +- libraries/base/Data/Typeable.hs | 3 +- libraries/base/Data/Typeable/Internal.hs | 336 ++++++++++++-------- libraries/base/GHC/Show.hs | 10 + libraries/base/GHC/Stack/Types.hs | 13 + libraries/ghc-prim/GHC/Classes.hs | 36 ++- libraries/ghc-prim/GHC/Magic.hs | 2 + libraries/ghc-prim/GHC/Tuple.hs | 3 + libraries/ghc-prim/GHC/Types.hs | 54 +++- utils/haddock | 2 +- 46 files changed, 2024 insertions(+), 1264 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 285cd0012dfafb3a03cbb002e8519199df3329e1 From git at git.haskell.org Mon Sep 28 12:45:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 12:45:39 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben2: Update testsuite (3215653) Message-ID: <20150928124539.252693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben2 Link : http://ghc.haskell.org/trac/ghc/changeset/32156539a42a6a0d1714ba2ea70da587b684718f/ghc >--------------------------------------------------------------- commit 32156539a42a6a0d1714ba2ea70da587b684718f Author: Ben Gamari Date: Wed Sep 23 19:30:54 2015 +0200 Update testsuite >--------------------------------------------------------------- 32156539a42a6a0d1714ba2ea70da587b684718f .../tests/deSugar/should_compile/T2431.stderr | 29 +++++++++- testsuite/tests/deriving/should_fail/T10524.stderr | 5 +- testsuite/tests/deriving/should_fail/T9687.stderr | 4 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/ghci.debugger/scripts/print019.stderr | 4 +- .../indexed-types/should_compile/T3017.stderr | 2 +- .../tests/numeric/should_compile/T7116.stdout | 29 +++++++++- .../should_fail/overloadedlistsfail01.stderr | 4 +- testsuite/tests/polykinds/T8132.stderr | 4 +- testsuite/tests/quasiquotation/T7918.stdout | 3 ++ testsuite/tests/roles/should_compile/Roles1.stderr | 61 ++++++++++++++++++++++ .../tests/roles/should_compile/Roles13.stderr | 53 +++++++++++++++++-- .../tests/roles/should_compile/Roles14.stderr | 7 +++ testsuite/tests/roles/should_compile/Roles2.stderr | 13 +++++ testsuite/tests/roles/should_compile/Roles4.stderr | 13 +++++ testsuite/tests/roles/should_compile/T8958.stderr | 9 +++- .../tests/simplCore/should_compile/T3717.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T3772.stdout | 29 +++++++++- .../tests/simplCore/should_compile/T4908.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T4930.stderr | 29 +++++++++- .../tests/simplCore/should_compile/T7360.stderr | 47 ++++++++++++++++- .../tests/simplCore/should_compile/T8274.stdout | 8 +++ .../tests/simplCore/should_compile/T9400.stderr | 17 +++++- .../tests/simplCore/should_compile/rule2.stderr | 3 +- .../simplCore/should_compile/spec-inline.stderr | 29 +++++++++- .../tests/stranal/should_compile/T10694.stdout | 3 ++ .../stranal/sigs/BottomFromInnerLambda.stderr | 1 + testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr | 2 + testsuite/tests/stranal/sigs/HyperStrUse.stderr | 1 + testsuite/tests/stranal/sigs/StrAnalExample.stderr | 1 + testsuite/tests/stranal/sigs/T8569.stderr | 2 + testsuite/tests/stranal/sigs/T8598.stderr | 1 + testsuite/tests/stranal/sigs/UnsatFun.stderr | 1 + testsuite/tests/th/TH_Roles2.stderr | 8 +++ .../tests/typecheck/should_compile/holes2.stderr | 6 +-- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- .../tests/typecheck/should_fail/tcfail072.stderr | 4 +- .../tests/typecheck/should_fail/tcfail133.stderr | 7 ++- 38 files changed, 463 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 32156539a42a6a0d1714ba2ea70da587b684718f From git at git.haskell.org Mon Sep 28 12:55:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Sep 2015 12:55:26 +0000 (UTC) Subject: [commit: ghc] master: Allow enumDeltaIntegerFB to be inlined (78053f4) Message-ID: <20150928125526.95E413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78053f449d47a90c977ec3a893524f2cdb5d33f9/ghc >--------------------------------------------------------------- commit 78053f449d47a90c977ec3a893524f2cdb5d33f9 Author: Joachim Breitner Date: Mon Sep 28 13:48:40 2015 +0200 Allow enumDeltaIntegerFB to be inlined The function is very small and the compiler should be at liberty to inline it. But it is recursive, so it did not do it before. By applying the usual transformation with a local recursive function, GHC can now inline it, producing the loop that one would expect. >--------------------------------------------------------------- 78053f449d47a90c977ec3a893524f2cdb5d33f9 libraries/base/GHC/Enum.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index a11d4f8..0d91cc7 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -704,7 +704,8 @@ the special case varies more from the general case, due to the issue of overflow {-# NOINLINE [0] enumDeltaIntegerFB #-} enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b -enumDeltaIntegerFB c x d = x `seq` (x `c` enumDeltaIntegerFB c (x+d) d) +enumDeltaIntegerFB c x d = go x + where go x = x `seq` (x `c` go (x+d)) {-# NOINLINE [1] enumDeltaInteger #-} enumDeltaInteger :: Integer -> Integer -> [Integer] From git at git.haskell.org Tue Sep 29 16:08:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:08:59 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Forbid annotations when Safe Haskell safe mode is enabled. (d73a8ec) Message-ID: <20150929160859.686163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d73a8ec43e30354a30765fe64213fb04c7d839c4/ghc >--------------------------------------------------------------- commit d73a8ec43e30354a30765fe64213fb04c7d839c4 Author: David Kraeutmann Date: Tue Sep 8 11:35:33 2015 -0500 Forbid annotations when Safe Haskell safe mode is enabled. For now, this fails compliation immediately with an error. If desired, this can be a warning that annotations in Safe Haskell are ignored. Signed-off-by: David Kraeutmann Reviewed By: goldfire, austin Differential Revision: https://phabricator.haskell.org/D1226 GHC Trac Issues: #10826 >--------------------------------------------------------------- d73a8ec43e30354a30765fe64213fb04c7d839c4 compiler/typecheck/TcAnnotations.hs | 11 ++- docs/users_guide/7.10.3-notes.xml | 84 ++++++++++++++++++++++ docs/users_guide/safe_haskell.xml | 6 ++ testsuite/tests/annotations/should_fail/T10826.hs | 7 ++ .../tests/annotations/should_fail/T10826.stderr | 6 ++ testsuite/tests/annotations/should_fail/all.T | 2 +- 6 files changed, 114 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs index 474630b..688a1e9 100644 --- a/compiler/typecheck/TcAnnotations.hs +++ b/compiler/typecheck/TcAnnotations.hs @@ -12,6 +12,8 @@ module TcAnnotations ( tcAnnotations, annCtxt ) where #ifdef GHCI import {-# SOURCE #-} TcSplice ( runAnnotation ) import Module +import DynFlags +import Control.Monad ( when ) #endif import HsSyn @@ -47,7 +49,14 @@ tcAnnotation (L loc ann@(HsAnnotation _ provenance expr)) = do let target = annProvenanceToTarget mod provenance -- Run that annotation and construct the full Annotation data structure - setSrcSpan loc $ addErrCtxt (annCtxt ann) $ runAnnotation target expr + setSrcSpan loc $ addErrCtxt (annCtxt ann) $ do + -- See #10826 -- Annotations allow one to bypass Safe Haskell. + dflags <- getDynFlags + when (safeLanguageOn dflags) $ failWithTc safeHsErr + runAnnotation target expr + where + safeHsErr = vcat [ ptext (sLit "Annotations are not compatible with Safe Haskell.") + , ptext (sLit "See https://ghc.haskell.org/trac/ghc/ticket/10826") ] annProvenanceToTarget :: Module -> AnnProvenance Name -> AnnTarget Name annProvenanceToTarget _ (ValueAnnProvenance (L _ name)) = NamedTarget name diff --git a/docs/users_guide/7.10.3-notes.xml b/docs/users_guide/7.10.3-notes.xml new file mode 100644 index 0000000..d75eb33 --- /dev/null +++ b/docs/users_guide/7.10.3-notes.xml @@ -0,0 +1,84 @@ + + + Release notes for version 7.10.3 + + + The 7.10.3 release is a bugfix release, with over 70+ bug fixes + relative to 7.10.1. The major fixes are listed below. For the full + list with more detail, see the GHC 7.10.3 + milestone on our bug tracker. + + + + GHC + + + + + Due to a + security issue + , Safe Haskell now forbids annotations in programs marked as + -XSafe + + + + + + + + Libraries + + + base + + + + Version number 4.8.1.0 (was 4.8.0.0) + + + + + The Lifetime datatype (and its + constructors) are now exported from + GHC.Event. + + + + + + + binary + + + + Version number 0.7.5.0 (was 0.7.3.0) + + + + + + + Cabal + + + + Version number 1.22.4.0 (was 1.22.2.0). + + + + + + + ghc + + + + + + + Known bugs + + + + diff --git a/docs/users_guide/safe_haskell.xml b/docs/users_guide/safe_haskell.xml index 634482a..16f2bbd 100644 --- a/docs/users_guide/safe_haskell.xml +++ b/docs/users_guide/safe_haskell.xml @@ -776,6 +776,12 @@ Wiki. + + Additionally, the use of annotations + is forbidden, as that would allow bypassing Safe Haskell restrictions. + See ticket #10826. + + diff --git a/testsuite/tests/annotations/should_fail/T10826.hs b/testsuite/tests/annotations/should_fail/T10826.hs new file mode 100644 index 0000000..cddf33c --- /dev/null +++ b/testsuite/tests/annotations/should_fail/T10826.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE Safe #-} +module Test (hook) where + +import System.IO.Unsafe + +{-# ANN hook (unsafePerformIO (putStrLn "Woops.")) #-} +hook = undefined diff --git a/testsuite/tests/annotations/should_fail/T10826.stderr b/testsuite/tests/annotations/should_fail/T10826.stderr new file mode 100644 index 0000000..0e2bed5 --- /dev/null +++ b/testsuite/tests/annotations/should_fail/T10826.stderr @@ -0,0 +1,6 @@ + +T10826.hs:6:1: error: + Annotations are not compatible with Safe Haskell. + See https://ghc.haskell.org/trac/ghc/ticket/10826 + In the annotation: + {-# ANN hook (unsafePerformIO (putStrLn "Woops.")) #-} diff --git a/testsuite/tests/annotations/should_fail/all.T b/testsuite/tests/annotations/should_fail/all.T index 21eaa76..0b10d83 100644 --- a/testsuite/tests/annotations/should_fail/all.T +++ b/testsuite/tests/annotations/should_fail/all.T @@ -18,7 +18,7 @@ test('annfail10', req_interp, compile_fail, ['']) test('annfail11', normal, compile_fail, ['']) test('annfail12', req_interp, compile_fail, ['-v0']) test('annfail13', normal, compile_fail, ['']) - +test('T10826', normal, compile_fail, ['']) """" Helpful things to C+P: From git at git.haskell.org Tue Sep 29 16:09:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:02 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Always generalise a partial type signature (2bb2a85) Message-ID: <20150929160902.65AEF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2bb2a85f92e4a15d7646b027fff2574dbbfe9d5e/ghc >--------------------------------------------------------------- commit 2bb2a85f92e4a15d7646b027fff2574dbbfe9d5e Author: Simon Peyton Jones Date: Mon Jan 5 10:39:46 2015 +0000 Always generalise a partial type signature This fixes an ASSERT failure in TcBinds. The problem was that we were generating NoGen plan for a function with a partial type signature, and that led to confusion and lost invariants. See Note [Partial type signatures and generalisation] in TcBinds >--------------------------------------------------------------- 2bb2a85f92e4a15d7646b027fff2574dbbfe9d5e compiler/typecheck/TcBinds.hs | 56 ++++++++++++++++++++++++++++++++----------- 1 file changed, 42 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 9d8c581..43e1f22 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -751,6 +751,29 @@ completeTheta inferred_theta , typeSigCtxt (idName poly_id) sig ] {- +Note [Partial type signatures and generalisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we have a partial type signature, like + f :: _ -> Int +then we *always* use the InferGen plan, and hence tcPolyInfer. +We do this even for a local binding with -XMonoLocalBinds. +Reasons: + * The TcSigInfo for 'f' has a unification variable for the '_', + whose TcLevel is one level deeper than the current level. + (See pushTcLevelM in tcTySig.) But NoGen doesn't increase + the TcLevel like InferGen, so we lose the level invariant. + + * The signature might be f :: forall a. _ -> a + so it really is polymorphic. It's not clear what it would + mean to use NoGen on this, and indeed the ASSERT in tcLhs, + in the (Just sig) case, checks that if there is a signature + then we are using LetLclBndr, and hence a nested AbsBinds with + increased TcLevel + +It might be possible to fix these difficulties somehow, but there +doesn't seem much point. Indeed, adding a partial type signature is a +way to get per-binding inferred generalisation. + Note [Validity of inferred types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We need to check inferred type for validity, in case it uses language @@ -1178,14 +1201,17 @@ tcLhs :: TcSigFun -> LetBndrSpec -> HsBind Name -> TcM TcMonoBind tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name, fun_infix = inf, fun_matches = matches }) | Just sig <- sig_fn name = ASSERT2( case no_gen of { LetLclBndr -> True; LetGblBndr {} -> False } - , ppr name ) -- { f :: ty; f x = e } is always done via CheckGen - -- which gives rise to LetLclBndr. It wouldn't make - -- sense to have a *polymorphic* function Id at this point + , ppr name ) + -- { f :: ty; f x = e } is always done via CheckGen (full signature) + -- or InferGen (partial signature) + -- see Note [Partial type signatures and generalisation] + -- Both InferGen and CheckGen gives rise to LetLclBndr do { mono_name <- newLocalName name ; let mono_id = mkLocalId mono_name (sig_tau sig) ; addErrCtxt (typeSigCtxt name sig) $ emitWildcardHoleConstraints (sig_nwcs sig) ; return (TcFunBind (name, Just sig, mono_id) nm_loc inf matches) } + | otherwise = do { mono_ty <- newFlexiTyVarTy openTypeKind ; mono_id <- newNoSigLetBndr no_gen name mono_ty @@ -1437,12 +1463,15 @@ decideGeneralisationPlan :: DynFlags -> TcTypeEnv -> [Name] -> [LHsBind Name] -> TcSigFun -> GeneralisationPlan decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn - | strict_pat_binds = NoGen - | Just (lbind, sig) <- one_funbind_with_sig lbinds = CheckGen lbind sig - | mono_local_binds = NoGen - | otherwise = InferGen mono_restriction closed_flag - + | strict_pat_binds = NoGen + | Just (lbind, sig) <- one_funbind_with_sig = if isPartialSig sig + -- See Note [Partial type signatures and generalisation] + then infer_plan + else CheckGen lbind sig + | mono_local_binds = NoGen + | otherwise = infer_plan where + infer_plan = InferGen mono_restriction closed_flag bndr_set = mkNameSet bndr_names binds = map unLoc lbinds @@ -1485,12 +1514,11 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn -- With OutsideIn, all nested bindings are monomorphic -- except a single function binding with a signature - one_funbind_with_sig [lbind@(L _ (FunBind { fun_id = v }))] - = case sig_fn (unLoc v) of - Nothing -> Nothing - Just sig | isPartialSig sig -> Nothing - Just sig | otherwise -> Just (lbind, sig) - one_funbind_with_sig _ + one_funbind_with_sig + | [lbind@(L _ (FunBind { fun_id = v }))] <- lbinds + , Just sig <- sig_fn (unLoc v) + = Just (lbind, sig) + | otherwise = Nothing -- The Haskell 98 monomorphism resetriction From git at git.haskell.org Tue Sep 29 16:09:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Testsuite: mark T6037 expect_fail on Windows (#6037) (1c7e13d) Message-ID: <20150929160905.4B3523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/1c7e13d206e5a51b73ed644a8bf7b1f0c7c2bbd0/ghc >--------------------------------------------------------------- commit 1c7e13d206e5a51b73ed644a8bf7b1f0c7c2bbd0 Author: Thomas Miedema Date: Sat Sep 12 23:34:12 2015 +0200 Testsuite: mark T6037 expect_fail on Windows (#6037) >--------------------------------------------------------------- 1c7e13d206e5a51b73ed644a8bf7b1f0c7c2bbd0 testsuite/tests/driver/Makefile | 4 ++-- testsuite/tests/driver/all.T | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index e12f3a5..52f0d9d 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -551,8 +551,8 @@ T7563: -"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -C T7563.hs # Below we set LC_ALL=C to request standard ASCII output in the resulting error -# messages. Unfortunately, Mac OS X still uses a Unicode encoding even with -# LC_ALL=C, so we expect these tests to fail there. +# messages. Unfortunately, Mac OS X and Windows still use a Unicode encoding +# even with LC_ALL=C, so we expect these tests to fail there. .PHONY: T6037 T6037: diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 6b07d47..4690ef1 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -384,7 +384,10 @@ test('T7060', test('T7130', normal, compile_fail, ['-fflul-laziness']) test('T7563', when(unregisterised(), skip), run_command, ['$MAKE -s --no-print-directory T7563']) -test('T6037', normal, run_command, +test('T6037', + # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X + [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)], + run_command, ['$MAKE -s --no-print-directory T6037']) test('T2507', From git at git.haskell.org Tue Sep 29 16:09:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:08 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Do not inline or apply rules on LHS of rules (db85cbc) Message-ID: <20150929160908.16F143A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/db85cbc689b50b52b08ae6326b51ff5d6f50932e/ghc >--------------------------------------------------------------- commit db85cbc689b50b52b08ae6326b51ff5d6f50932e Author: Simon Peyton Jones Date: Mon Jul 27 13:56:31 2015 +0100 Do not inline or apply rules on LHS of rules This is the right thing to do anyway, and fixes Trac #10528 >--------------------------------------------------------------- db85cbc689b50b52b08ae6326b51ff5d6f50932e compiler/simplCore/SimplCore.hs | 4 ++-- compiler/simplCore/SimplUtils.hs | 18 ++++++++++++++++-- compiler/simplCore/Simplify.hs | 36 +++++++++++++++++++++--------------- 3 files changed, 39 insertions(+), 19 deletions(-) diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 0a2f8e4..4789160 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -23,7 +23,7 @@ import CoreUtils ( coreBindsSize, coreBindsStats, exprSize, mkTicks, stripTicksTop ) import CoreLint ( showPass, endPass, lintPassResult, dumpPassResult, lintAnnots ) -import Simplify ( simplTopBinds, simplExpr, simplRule ) +import Simplify ( simplTopBinds, simplExpr, simplRules ) import SimplUtils ( simplEnvForGHCi, activeRule ) import SimplEnv import SimplMonad @@ -649,7 +649,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) -- for imported Ids. Eg RULE map my_f = blah -- If we have a substitution my_f :-> other_f, we'd better -- apply it to the rule to, or it'll never match - ; rules1 <- mapM (simplRule env1 Nothing) rules + ; rules1 <- simplRules env1 Nothing rules ; return (getFloatBinds env1, rules1) } ; diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index a768be4..6dbe870 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -14,7 +14,7 @@ module SimplUtils ( preInlineUnconditionally, postInlineUnconditionally, activeUnfolding, activeRule, getUnfoldingInRuleMatch, - simplEnvForGHCi, updModeForStableUnfoldings, + simplEnvForGHCi, updModeForStableUnfoldings, updModeForRuleLHS, -- The continuation type SimplCont(..), DupFlag(..), @@ -700,7 +700,21 @@ updModeForStableUnfoldings inline_rule_act current_mode phaseFromActivation (ActiveAfter n) = Phase n phaseFromActivation _ = InitialPhase -{- +updModeForRuleLHS :: SimplifierMode -> SimplifierMode +-- See Note [Simplifying RULE LHSs] +updModeForRuleLHS current_mode + = current_mode { sm_phase = InitialPhase + , sm_inline = False + , sm_rules = False + , sm_eta_expand = False } + +{- Note [Simplifying RULE LHSs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When simplifying on the LHS of a rule, refrain from all inlining and +all RULES. Doing anything to the LHS is plain confusing, because it +means that what the rule matches is not what the user wrote. +c.f. Trac #10595, and #10528. + Note [Inlining in gentle mode] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Something is inlined if diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 40a68d4..d816d3f 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -6,7 +6,7 @@ {-# LANGUAGE CPP #-} -module Simplify ( simplTopBinds, simplExpr, simplRule ) where +module Simplify ( simplTopBinds, simplExpr, simplRules ) where #include "HsVersions.h" @@ -2952,22 +2952,28 @@ addBndrRules env in_id out_id | null old_rules = return (env, out_id) | otherwise - = do { new_rules <- mapM (simplRule env (Just (idName out_id))) old_rules + = do { new_rules <- simplRules env (Just (idName out_id)) old_rules ; let final_id = out_id `setIdSpecialisation` mkSpecInfo new_rules ; return (modifyInScope env final_id, final_id) } where old_rules = specInfoRules (idSpecialisation in_id) -simplRule :: SimplEnv -> Maybe Name -> CoreRule -> SimplM CoreRule -simplRule _ _ rule@(BuiltinRule {}) = return rule -simplRule env mb_new_nm rule@(Rule { ru_bndrs = bndrs, ru_args = args - , ru_fn = fn_name, ru_rhs = rhs - , ru_act = act }) - = do { (env, bndrs') <- simplBinders env bndrs - ; let rule_env = updMode (updModeForStableUnfoldings act) env - ; args' <- mapM (simplExpr rule_env) args - ; rhs' <- simplExpr rule_env rhs - ; return (rule { ru_bndrs = bndrs' - , ru_fn = mb_new_nm `orElse` fn_name - , ru_args = args' - , ru_rhs = rhs' }) } +simplRules :: SimplEnv -> Maybe Name -> [CoreRule] -> SimplM [CoreRule] +simplRules env mb_new_nm rules + = mapM simpl_rule rules + where + simpl_rule rule@(BuiltinRule {}) + = return rule + + simpl_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args + , ru_fn = fn_name, ru_rhs = rhs + , ru_act = act }) + = do { (env, bndrs') <- simplBinders env bndrs + ; let lhs_env = updMode updModeForRuleLHS env + rhs_env = updMode (updModeForStableUnfoldings act) env + ; args' <- mapM (simplExpr lhs_env) args + ; rhs' <- simplExpr rhs_env rhs + ; return (rule { ru_bndrs = bndrs' + , ru_fn = mb_new_nm `orElse` fn_name + , ru_args = args' + , ru_rhs = rhs' }) } From git at git.haskell.org Tue Sep 29 16:09:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:11 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Deal with phantom type variables in rules (0269d37) Message-ID: <20150929160911.AB12B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/0269d37534eebaba2d5cd125a1ae4c60b9e89887/ghc >--------------------------------------------------------------- commit 0269d37534eebaba2d5cd125a1ae4c60b9e89887 Author: Simon Peyton Jones Date: Wed Jul 29 16:06:29 2015 +0100 Deal with phantom type variables in rules See Note [Unbound template type variables] in Rules.hs This fixes Trac #10689. The problem was a rule LHS that mentioned a type variable in a phantom argument to a type synonym. Then matching the LHS didn't bind the type variable, and the rule matcher complained. This patch fixes the problem, as described by the Note. I also went back to not-cloning the template varaibles during rule matching. I'm convinced that it's not necessary now (if it ever was), and cloning makes the fix for #10689 much more fiddly. >--------------------------------------------------------------- 0269d37534eebaba2d5cd125a1ae4c60b9e89887 compiler/specialise/Rules.hs | 120 +++++++++++++-------- testsuite/tests/simplCore/should_compile/T10689.hs | 11 ++ .../tests/simplCore/should_compile/T10689a.hs | 114 ++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 2 + 4 files changed, 205 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 0269d37534eebaba2d5cd125a1ae4c60b9e89887 From git at git.haskell.org Tue Sep 29 16:09:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:14 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Remove all references to sync-all (d8227f6) Message-ID: <20150929160914.62EEB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d8227f65c1baba29b30c87599f97a8e96648e1be/ghc >--------------------------------------------------------------- commit d8227f65c1baba29b30c87599f97a8e96648e1be Author: Thomas Miedema Date: Tue Jul 14 17:15:12 2015 +0200 Remove all references to sync-all >--------------------------------------------------------------- d8227f65c1baba29b30c87599f97a8e96648e1be HACKING.md | 11 ++++++++--- README.md | 31 +++++++++++-------------------- boot | 2 +- packages | 14 ++------------ 4 files changed, 22 insertions(+), 36 deletions(-) diff --git a/HACKING.md b/HACKING.md index edd1d12..b59e747 100644 --- a/HACKING.md +++ b/HACKING.md @@ -30,9 +30,14 @@ find an overview here: Next, clone the repository and all the associated libraries: ``` -$ git clone http://git.haskell.org/ghc.git -$ cd ghc -$ ./sync-all get +$ git clone --recursive git://git.haskell.org/ghc.git +``` + +On Windows, you need an extra repository containing some build tools: + +``` +$ cd ghc/ +$ git clone git://git.haskell.org/ghc-tarballs.git ``` First copy `mk/build.mk.sample` to `mk/build.mk` and ensure it has diff --git a/README.md b/README.md index 32234c0..5ad1adb 100644 --- a/README.md +++ b/README.md @@ -26,21 +26,18 @@ There are two ways to get a source tree: 2. *Check out the source code from git* - The official mirror for GHC on GitHub is located at https://github.com/ghc/ghc. + $ git clone --recursive git://git.haskell.org/ghc.git - $ git clone git://github.com/ghc/ghc.git - $ cd ghc - $ ./sync-all get + On Windows, you need an extra repository containing some build tools: - If you want to clone your own fork instead, add an argument to `sync-all` to - tell it where it can find the other repositories it needs. + $ cd ghc/ + $ git clone git://git.haskell.org/ghc-tarballs.git - $ git clone ghc - $ cd ghc - $ ./sync-all -r git://github.com/ghc get + Note: cloning GHC from Github requires a special setup. See [Getting a GHC + repository from Github] [7]. **DO NOT submit pull request directly to the github repo.** - *See the GHC developer team's working conventions re [contributing patches](http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions/Git#Contributingpatches "ghc.haskell.org/trac/ghc/wiki/WorkingConventions/Git#Contributingpatches").* + *See the GHC team's working conventions re [how to contribute a patch to GHC](http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions/FixingBugs "ghc.haskell.org/trac/ghc/wiki/WorkingConventions/FixingBug").* Building & Installing @@ -64,7 +61,7 @@ dblatex. **Quick start**: the following gives you a default build: - $ perl boot + $ ./boot $ ./configure $ make # can also say 'make -jX' for X number of jobs $ make install @@ -74,7 +71,7 @@ save you hours of build time depending on your system configuration, and is almost always a win regardless of how many cores you have. As a simple rule, you should have about N+1 jobs, where `N` is the amount of cores you have.) -The `perl boot` step is only necessary if this is a tree checked out +The `./boot` step is only necessary if this is a tree checked out from git. For source distributions downloaded from [GHC's web site] [1], this step has already been performed. @@ -82,12 +79,6 @@ These steps give you the default build, which includes everything optimised and built in various ways (eg. profiling libs are built). It can take a long time. To customise the build, see the file `HACKING`. -Once you have a build you need to keep it going. You need to keep all -repos in sync with the [sync-all script] [7]. To get the latest changes: - - $ ./sync-all pull - $ ./sync-all get - Filing bugs and feature requests ================================ @@ -125,8 +116,8 @@ you to join! [4]: http://www.haskell.org/happy/ "www.haskell.org/happy/" [5]: http://www.haskell.org/alex/ "www.haskell.org/alex/" [6]: http://www.haskell.org/haddock/ "www.haskell.org/haddock/" - [7]: http://ghc.haskell.org/trac/ghc/wiki/Building/SyncAll - "http://ghc.haskell.org/trac/ghc/wiki/Building/SyncAll" + [7]: https://ghc.haskell.org/trac/ghc/wiki/Building/GettingTheSources#GettingaGHCrepositoryfromGitHub + "https://ghc.haskell.org/trac/ghc/wiki/Building/GettingTheSources#GettingaGHCrepositoryfromGitHub" [8]: http://ghc.haskell.org/trac/ghc/wiki/Building/Preparation "http://ghc.haskell.org/trac/ghc/wiki/Building/Preparation" [9]: http://www.haskell.org/cabal/ "http://www.haskell.org/cabal/" diff --git a/boot b/boot index 8977eaf..e4a8c7b 100755 --- a/boot +++ b/boot @@ -72,7 +72,7 @@ sub sanity_check_tree { # has a LICENSE file instead. if (! -f "$dir/LICENSE") { print STDERR "Error: $dir/LICENSE doesn't exist.\n"; - die "Maybe you haven't done './sync-all get'?"; + die "Maybe you haven't done 'git submodule update --init'?"; } } } diff --git a/packages b/packages index 33137d6..c621a67 100644 --- a/packages +++ b/packages @@ -1,7 +1,6 @@ # Despite the name "package", this file contains the master list of # the *repositories* that make up GHC. It is parsed by # * boot -# * sync-all # * rules/foreachLibrary.mk # # Some of this information is duplicated elsewhere in the build system: @@ -30,17 +29,8 @@ # GitHub and GHC developers are granted push-rights for are denoted by # being specified with the `ssh://` scheme. Thus, `https://` # repo urls denote read-only access. -# -# * The 'tag' determines when "sync-all get" will get the -# repo. If the tag is "-" then it will always get it, but if there -# is a tag then a corresponding flag must be given to "sync-all", e.g. -# if you want to get the packages with an "extralibs" -# tag then you need to use "sync-all --extra get". -# Support for new tags must be manually added to the "sync-all" script. -# -# 'tag' is also used to determine which packages the build system -# deems to have the EXTRA_PACKAGE property: tags 'dph' and 'extra' -# both give this property +# * 'tag', in combination with the variables BUILD_DPH and BUILD_EXTRA_PKGS, +# determines which packages are build by default. # # Lines that start with a '#' are comments. # From git at git.haskell.org Tue Sep 29 16:09:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:17 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Add pprRuleName (aaa1ea8) Message-ID: <20150929160917.24C823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/aaa1ea838c8b4edc406a30a04d58cdcec4fda799/ghc >--------------------------------------------------------------- commit aaa1ea838c8b4edc406a30a04d58cdcec4fda799 Author: Ben Gamari Date: Thu Sep 24 01:17:27 2015 +0200 Add pprRuleName >--------------------------------------------------------------- aaa1ea838c8b4edc406a30a04d58cdcec4fda799 compiler/basicTypes/BasicTypes.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index ee34b21..cf1c6d1 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -37,7 +37,7 @@ module BasicTypes( RecFlag(..), isRec, isNonRec, boolToRecFlag, Origin(..), isGenerated, - RuleName, + RuleName, pprRuleName, TopLevelFlag(..), isTopLevel, isNotTopLevel, @@ -283,6 +283,9 @@ instance Outputable WarningTxt where type RuleName = FastString +pprRuleName :: RuleName -> SDoc +pprRuleName rn = doubleQuotes (ftext rn) + {- ************************************************************************ * * From git at git.haskell.org Tue Sep 29 16:09:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:20 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix #10495. (3340d30) Message-ID: <20150929160920.8F1573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/3340d3035afdc128e12fc64d3af97d76d19edda1/ghc >--------------------------------------------------------------- commit 3340d3035afdc128e12fc64d3af97d76d19edda1 Author: Richard Eisenberg Date: Mon Jun 8 15:57:33 2015 -0400 Fix #10495. This change means that the intricate reasoning in TcErrors around getting messages just right for nominal equalities is skipped for representational equalities. >--------------------------------------------------------------- 3340d3035afdc128e12fc64d3af97d76d19edda1 compiler/typecheck/TcErrors.hs | 19 +++++++++++++------ testsuite/tests/typecheck/should_fail/T10495.hs | 5 +++++ testsuite/tests/typecheck/should_fail/T10495.stderr | 6 ++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 25 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index b07fbf9..415346a 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -815,6 +815,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2 -- be oriented the other way round; -- see TcCanonical.canEqTyVarTyVar || isSigTyVar tv1 && not (isTyVarTy ty2) + || ctEqRel ct == ReprEq -- the cases below don't really apply to ReprEq = mkErrorMsg ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2 , extraTyVarInfo ctxt tv1 ty2 , extra ]) @@ -938,25 +939,31 @@ misMatchOrCND ctxt ct oriented ty1 ty2 isGivenCt ct -- If the equality is unconditionally insoluble -- or there is no context, don't report the context - = misMatchMsg oriented (ctEqRel ct) ty1 ty2 + = misMatchMsg oriented eq_rel ty1 ty2 | otherwise - = couldNotDeduce givens ([mkTcEqPred ty1 ty2], orig) + = couldNotDeduce givens ([eq_pred], orig) where + eq_rel = ctEqRel ct givens = [ given | given@(_, _, no_eqs, _) <- getUserGivens ctxt, not no_eqs] -- Keep only UserGivens that have some equalities - orig = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 } + + (eq_pred, orig) = case eq_rel of + NomEq -> ( mkTcEqPred ty1 ty2 + , TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 }) + ReprEq -> ( mkCoerciblePred ty1 ty2 + , CoercibleOrigin ty1 ty2 ) couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc couldNotDeduce givens (wanteds, orig) - = vcat [ addArising orig (ptext (sLit "Could not deduce") <+> pprTheta wanteds) + = vcat [ addArising orig (ptext (sLit "Could not deduce:") <+> pprTheta wanteds) , vcat (pp_givens givens)] pp_givens :: [UserGiven] -> [SDoc] pp_givens givens = case givens of [] -> [] - (g:gs) -> ppr_given (ptext (sLit "from the context")) g - : map (ppr_given (ptext (sLit "or from"))) gs + (g:gs) -> ppr_given (ptext (sLit "from the context:")) g + : map (ppr_given (ptext (sLit "or from:"))) gs where ppr_given herald (gs, skol_info, _, loc) = hang (herald <+> pprEvVarTheta gs) diff --git a/testsuite/tests/typecheck/should_fail/T10495.hs b/testsuite/tests/typecheck/should_fail/T10495.hs new file mode 100644 index 0000000..2573f51 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T10495.hs @@ -0,0 +1,5 @@ +module T10495 where + +import Data.Coerce + +foo = coerce diff --git a/testsuite/tests/typecheck/should_fail/T10495.stderr b/testsuite/tests/typecheck/should_fail/T10495.stderr new file mode 100644 index 0000000..6e92505 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T10495.stderr @@ -0,0 +1,6 @@ + +T10495.hs:5:7: error: + Couldn't match representation of type ?a0? with that of ?b0? + Relevant bindings include foo :: a0 -> b0 (bound at T10495.hs:5:1) + In the expression: coerce + In an equation for ?foo?: foo = coerce diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 95911d1..b6e5867 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -363,3 +363,4 @@ test('T9858b', normal, compile_fail, ['']) test('T9858e', normal, compile_fail, ['']) test('T10534', extra_clean(['T10534a.hi', 'T10534a.o']), multimod_compile_fail, ['T10534', '-v0']) +test('T10495', normal, compile_fail, ['']) From git at git.haskell.org Tue Sep 29 16:09:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix #10493. (d11412e) Message-ID: <20150929160923.D601F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d11412eb808d5c4ba0c643a819c629fad93de3e6/ghc >--------------------------------------------------------------- commit d11412eb808d5c4ba0c643a819c629fad93de3e6 Author: Richard Eisenberg Date: Mon Jun 8 16:46:46 2015 -0400 Fix #10493. Now, a Coercible (T1 ...) (T2 ...) constraint is insoluble only when both T1 and T2 say "yes" to isDistinctTyCon. Several comments also updated in this patch. >--------------------------------------------------------------- d11412eb808d5c4ba0c643a819c629fad93de3e6 compiler/typecheck/TcCanonical.hs | 11 +++++++++-- compiler/types/TyCon.hs | 2 +- compiler/types/Unify.hs | 11 +++++++++-- testsuite/tests/typecheck/should_compile/T10493.hs | 9 +++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 29 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 4310e35..66cfc36 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -721,7 +721,7 @@ canDecomposableTyConApp ev eq_rel tc1 tys1 tc2 tys2 -- Fail straight away for better error messages -- See Note [Use canEqFailure in canDecomposableTyConApp] - | isDataFamilyTyCon tc1 || isDataFamilyTyCon tc2 + | eq_rel == ReprEq && not (isDistinctTyCon tc1 && isDistinctTyCon tc2) = canEqFailure ev eq_rel ty1 ty2 | otherwise = canEqHardFailure ev eq_rel ty1 ty2 @@ -734,7 +734,7 @@ Note [Use canEqFailure in canDecomposableTyConApp] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We must use canEqFailure, not canEqHardFailure here, because there is the possibility of success if working with a representational equality. -Here is the case: +Here is one case: type family TF a where TF Char = Bool data family DF a @@ -744,6 +744,13 @@ Suppose we are canonicalising (Int ~R DF (T a)), where we don't yet know `a`. This is *not* a hard failure, because we might soon learn that `a` is, in fact, Char, and then the equality succeeds. +Here is another case: + + [G] Coercible Age Int + +where Age's constructor is not in scope. We don't want to report +an "inaccessible code" error in the context of this Given! + Note [Decomposing newtypes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ As explained in Note [NthCo and newtypes] in Coercion, we can't use diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 4b912f7..1a5bb8e 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -1220,7 +1220,7 @@ isDataTyCon (TupleTyCon {tyConTupleSort = sort}) = isBoxed (tupleSortBoxity sort isDataTyCon _ = False -- | 'isDistinctTyCon' is true of 'TyCon's that are equal only to --- themselves, even via coercions (except for unsafeCoerce). +-- themselves, even via representational coercions (except for unsafeCoerce). -- This excludes newtypes, type functions, type synonyms. -- It relates directly to the FC consistency story: -- If the axioms are consistent, diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 02d3792..768b4df 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -280,8 +280,8 @@ to 'Bool', in which case x::T Int, so Suppose x::T X. Then *in Haskell* it's impossible to construct a (non-bottom) value of type (T X) using T1. But *in FC* it's quite possible. The newtype gives a coercion - CoX :: X ~ Int -So (T CoX) :: T X ~ T Int; hence (T1 `cast` sym (T CoX)) is a non-bottom value + CoX :: X ~R Int +So (T CoX)_R :: T X ~R T Int; hence (T1 `cast` sym (T CoX)) is a non-bottom value of type (T X) constructed with T1. Hence ANSWER = NO we can't prune the T1 branch (surprisingly) @@ -317,6 +317,13 @@ drop more and more dead code. For now we implement a very simple test: type variables match anything, type functions (incl newtypes) match anything, and only distinct data types fail to match. We can elaborate later. + +NB: typesCantMatch is subtly different than the apartness checks +elsewhere in this module. It reasons over *representational* equality +(saying that a newtype is not distinct from its representation) whereas +the checks in, say, tcUnifyTysFG are about *nominal* equality. tcUnifyTysFG +also assumes that its inputs are type-family-free, whereas no such assumption +is in play here. -} typesCantMatch :: [(Type,Type)] -> Bool diff --git a/testsuite/tests/typecheck/should_compile/T10493.hs b/testsuite/tests/typecheck/should_compile/T10493.hs new file mode 100644 index 0000000..3e3caae --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10493.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} + +module T10493 where + +import Data.Coerce +import Data.Ord (Down) -- no constructor + +foo :: Coercible (Down Int) Int => Down Int -> Int +foo = coerce diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index bf0e0a0..8dfdd0e 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -446,3 +446,4 @@ test('T10109', normal, compile, ['']) test('T10335', normal, compile, ['']) test('T10489', normal, compile, ['']) test('T10564', normal, compile, ['']) +test('T10493', normal, compile, ['']) \ No newline at end of file From git at git.haskell.org Tue Sep 29 16:09:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:27 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Parenthesise TypeOperator in import hints (886a406) Message-ID: <20150929160927.3E3853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/886a40635f41b20224b34869712eaa6183cd53f0/ghc >--------------------------------------------------------------- commit 886a40635f41b20224b34869712eaa6183cd53f0 Author: Thomas Winant Date: Thu Jul 23 11:43:21 2015 +0200 Parenthesise TypeOperator in import hints When a constructor was mistakenly imported directly instead of as a constructor of a data type, a hint will be shown on how to correctly import it. Just like the constructor, the data type should be surrounded in parentheses if it is an operator (TypeOperator in this case). Instead of: error: In module ?Data.Type.Equality?: ?Refl? is a data constructor of ?:~:? To import it use ?import? Data.Type.Equality( :~:( Refl ) ) or ?import? Data.Type.Equality( :~:(..) ) Print: error: In module ?Data.Type.Equality?: ?Refl? is a data constructor of ?(:~:)? To import it use ?import? Data.Type.Equality( (:~:)( Refl ) ) or ?import? Data.Type.Equality( (:~:)(..) ) Test Plan: pass new test Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1093 GHC Trac Issues: #10668 >--------------------------------------------------------------- 886a40635f41b20224b34869712eaa6183cd53f0 compiler/rename/RnNames.hs | 9 +++++---- testsuite/tests/rename/should_fail/T10668.hs | 3 +++ testsuite/tests/rename/should_fail/T10668.stderr | 8 ++++++++ testsuite/tests/rename/should_fail/all.T | 1 + 4 files changed, 17 insertions(+), 4 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 2818db8..58a743e 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1631,25 +1631,26 @@ badImportItemErrDataCon :: OccName -> ImpDeclSpec -> IE RdrName -> SDoc -badImportItemErrDataCon dataType is_boot decl_spec ie +badImportItemErrDataCon dataType_occ is_boot decl_spec ie = vcat [ ptext (sLit "In module") <+> quotes (ppr (is_mod decl_spec)) <+> source_import <> colon , nest 2 $ quotes datacon <+> ptext (sLit "is a data constructor of") - <+> quotes (ppr dataType) + <+> quotes dataType , ptext (sLit "To import it use") , nest 2 $ quotes (ptext (sLit "import")) <+> ppr (is_mod decl_spec) - <> parens_sp (ppr dataType <> parens_sp datacon) + <> parens_sp (dataType <> parens_sp datacon) , ptext (sLit "or") , nest 2 $ quotes (ptext (sLit "import")) <+> ppr (is_mod decl_spec) - <> parens_sp (ppr dataType <> ptext (sLit "(..)")) + <> parens_sp (dataType <> ptext (sLit "(..)")) ] where datacon_occ = rdrNameOcc $ ieName ie datacon = parenSymOcc datacon_occ (ppr datacon_occ) + dataType = parenSymOcc dataType_occ (ppr dataType_occ) source_import | is_boot = ptext (sLit "(hi-boot interface)") | otherwise = Outputable.empty parens_sp d = parens (space <> d <> space) -- T( f,g ) diff --git a/testsuite/tests/rename/should_fail/T10668.hs b/testsuite/tests/rename/should_fail/T10668.hs new file mode 100644 index 0000000..111637b --- /dev/null +++ b/testsuite/tests/rename/should_fail/T10668.hs @@ -0,0 +1,3 @@ +module T10668 where + +import Data.Type.Equality(Refl) diff --git a/testsuite/tests/rename/should_fail/T10668.stderr b/testsuite/tests/rename/should_fail/T10668.stderr new file mode 100644 index 0000000..8c96fad --- /dev/null +++ b/testsuite/tests/rename/should_fail/T10668.stderr @@ -0,0 +1,8 @@ + +T10668.hs:3:27: error: + In module ?Data.Type.Equality?: + ?Refl? is a data constructor of ?(:~:)? + To import it use + ?import? Data.Type.Equality( (:~:)( Refl ) ) + or + ?import? Data.Type.Equality( (:~:)(..) ) diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 2aeee2f..69ad1a3 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -132,3 +132,4 @@ test('T9032', normal, run_command, ['$MAKE -s --no-print-directory T9032']) +test('T10668', normal, compile_fail, ['']) From git at git.haskell.org Tue Sep 29 16:09:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:29 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Export more types from GHC.RTS.Flags (#9970) (3d72709) Message-ID: <20150929160929.EE46B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/3d727092837cd7556865213a78285836467125a1/ghc >--------------------------------------------------------------- commit 3d727092837cd7556865213a78285836467125a1 Author: RyanGlScott Date: Tue Jul 7 21:20:07 2015 +0200 Export more types from GHC.RTS.Flags (#9970) Export the data types `GiveGCStats`, `DoCostCentres`, `DoHeapProfiles`, and `DoTrace`, as well as the type synonyms `Time` and `RtsNat`. The above data types appear as fields in the `-Stats` data types in `GHC.RTS.Flags`, but since they only have `Show` instances, it is practically impossible to due anything useful with the above types unless they are exported. Reviewers: hvr, ekmett, austin, ezyang, bgamari Reviewed By: bgamari Subscribers: thomie, bgamari Differential Revision: https://phabricator.haskell.org/D1030 GHC Trac Issues: #9970 >--------------------------------------------------------------- 3d727092837cd7556865213a78285836467125a1 libraries/base/GHC/RTS/Flags.hsc | 20 +++++++++++++------- libraries/base/changelog.md | 7 +++++++ 2 files changed, 20 insertions(+), 7 deletions(-) diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc index 16764e5..b8b2973 100644 --- a/libraries/base/GHC/RTS/Flags.hsc +++ b/libraries/base/GHC/RTS/Flags.hsc @@ -9,13 +9,19 @@ -- @since 4.8.0.0 -- module GHC.RTS.Flags - ( RTSFlags (..) + ( RtsTime + , RtsNat + , RTSFlags (..) + , GiveGCStats (..) , GCFlags (..) , ConcFlags (..) , MiscFlags (..) , DebugFlags (..) + , DoCostCentres (..) , CCFlags (..) + , DoHeapProfile (..) , ProfFlags (..) + , DoTrace (..) , TraceFlags (..) , TickyFlags (..) , getRTSFlags @@ -48,7 +54,7 @@ import GHC.Show import GHC.Word -- | @'Time'@ is defined as a @'StgWord64'@ in @stg/Types.h@ -type Time = Word64 +type RtsTime = Word64 -- | @'nat'@ defined in @rts/Types.h@ type Nat = #{type unsigned int} @@ -98,19 +104,19 @@ data GCFlags = GCFlags -- ^ use "mostly mark-sweep" instead of copying for the oldest generation , ringBell :: Bool , frontpanel :: Bool - , idleGCDelayTime :: Time + , idleGCDelayTime :: RtsTime , doIdleGC :: Bool , heapBase :: Word -- ^ address to ask the OS for memory , allocLimitGrace :: Word } deriving (Show) data ConcFlags = ConcFlags - { ctxtSwitchTime :: Time + { ctxtSwitchTime :: RtsTime , ctxtSwitchTicks :: Int } deriving (Show) data MiscFlags = MiscFlags - { tickInterval :: Time + { tickInterval :: RtsTime , installSignalHandlers :: Bool , machineReadable :: Bool , linkerMemBase :: Word @@ -198,8 +204,8 @@ instance Enum DoHeapProfile where data ProfFlags = ProfFlags { doHeapProfile :: DoHeapProfile - , heapProfileInterval :: Time -- ^ time between samples - , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) + , heapProfileInterval :: RtsTime -- ^ time between samples + , heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived) , includeTSOs :: Bool , showCCSOnException :: Bool , maxRetainerSetSize :: Word diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 8882c5a..4297b0a 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -1,5 +1,12 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.8.2.0 *Oct 2015* + + * Bundled with GHC 7.10.3 + + * Exported `GiveGCStats`, `DoCostCentres`, `DoHeapProfile`, `DoTrace`, + `RtsTime`, and `RtsNat` from `GHC.RTS.Flags` + ## 4.8.1.0 *Jul 2015* * Bundled with GHC 7.10.2 From git at git.haskell.org Tue Sep 29 16:09:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:33 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix #10713. (f221212) Message-ID: <20150929160933.289873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/f221212a10f7798f7248f97ea866d83f8117e44d/ghc >--------------------------------------------------------------- commit f221212a10f7798f7248f97ea866d83f8117e44d Author: Richard Eisenberg Date: Mon Aug 3 08:53:03 2015 -0400 Fix #10713. When doing the apartness/flattening thing, we really only need to eliminate non-generative tycons, not *all* families. (Data families are indeed generative!) >--------------------------------------------------------------- f221212a10f7798f7248f97ea866d83f8117e44d compiler/types/FamInstEnv.hs | 4 +++- testsuite/tests/indexed-types/should_compile/T10713.hs | 13 +++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 808dece..373dd5c 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -1020,7 +1020,9 @@ coreFlattenTy in_scope = go (m2, ty2') = go m1 ty2 in (m2, AppTy ty1' ty2') go m (TyConApp tc tys) - | isFamilyTyCon tc + -- NB: Don't just check if isFamilyTyCon: this catches *data* families, + -- which are generative and thus can be preserved during flattening + | not (isGenerativeTyCon tc Nominal) = let (m', tv) = coreFlattenTyFamApp in_scope m tc tys in (m', mkTyVarTy tv) diff --git a/testsuite/tests/indexed-types/should_compile/T10713.hs b/testsuite/tests/indexed-types/should_compile/T10713.hs new file mode 100644 index 0000000..cf4af28 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10713.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-} + +module T10713 where + +import Data.Proxy + +type family TEq t s where + TEq t t = 'True + TEq t s = 'False +data family T a + +foo :: Proxy (TEq (T Int) (T Bool)) -> Proxy 'False +foo = id diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index f4df933..181d3d0 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -252,3 +252,4 @@ test('T9582', normal, compile, ['']) test('T9090', normal, compile, ['']) test('T10020', normal, compile, ['']) test('T10079', normal, compile, ['']) +test('T10713', normal, compile, ['']) From git at git.haskell.org Tue Sep 29 16:09:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:35 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Build system: remove hack for Mac OSX in configure.ac (#10476) (089462c) Message-ID: <20150929160935.E457E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/089462c99e416f14d4722d2eb5c1f69a718f0eb4/ghc >--------------------------------------------------------------- commit 089462c99e416f14d4722d2eb5c1f69a718f0eb4 Author: Thomas Miedema Date: Mon Sep 7 15:58:33 2015 +0200 Build system: remove hack for Mac OSX in configure.ac (#10476) Cross-compilation on Mac OSX currently doesn't work. While building stage 1, the build system uses the `ar` for the target architecture instead of the `ar` for build/host architecture. The cause is a hack added in 24746fe78024a1edab843bc710c79c55998ab134 (2010), to supporting bootstrap compilers built with older versions of Xcode. Xcode 4.3 started installing command line tools in a different location. Assuming this all behind us now, and the paths didn't change again (you never now), we can delete the hack. Deleting the hack fixes the cross compilation issue. Tested by Trac user jakzale. Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1231 >--------------------------------------------------------------- 089462c99e416f14d4722d2eb5c1f69a718f0eb4 configure.ac | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/configure.ac b/configure.ac index 4a69db7..5e0ab79 100644 --- a/configure.ac +++ b/configure.ac @@ -115,20 +115,13 @@ if test "$WithGhc" != ""; then GhcMinVersion2=`echo "$GhcMinVersion" | sed 's/^\\(.\\)$/0\\1/'` GhcCanonVersion="$GhcMajVersion$GhcMinVersion2" - BOOTSTRAPPING_GHC_INFO_FIELD([OS_STAGE0],[target os]) BOOTSTRAPPING_GHC_INFO_FIELD([CC_STAGE0],[C compiler command]) dnl ToDo, once "ld command" is reliably available. dnl Then, we can remove the LD_STAGE0 hack in mk/build-package-date.mk dnl BOOTSTRAPPING_GHC_INFO_FIELD([LD_STAGE0],[ld command]) - if test "x$OS_STAGE0" != "xOSDarwin"; then - BOOTSTRAPPING_GHC_INFO_FIELD([AR_STAGE0],[ar command]) - BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags]) - BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file]) - else - AR_STAGE0='$(AR)' - AR_OPTS_STAGE0='$(AR_OPTS)' - ArSupportsAtFile_STAGE0='$(ArSupportsAtFile)' - fi + BOOTSTRAPPING_GHC_INFO_FIELD([AR_STAGE0],[ar command]) + BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags]) + BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file]) fi dnl ** Must have GHC to build GHC From git at git.haskell.org Tue Sep 29 16:09:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:38 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix trac #10413 (4a70e2f) Message-ID: <20150929160938.BB1FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/4a70e2f128c636e7ab4fb60733b853e34474045f/ghc >--------------------------------------------------------------- commit 4a70e2f128c636e7ab4fb60733b853e34474045f Author: Ben Gamari Date: Wed Sep 2 13:26:22 2015 +0200 Fix trac #10413 Test Plan: Validate. Reviewers: austin, tibbe, bgamari Reviewed By: tibbe, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1194 GHC Trac Issues: #10413 >--------------------------------------------------------------- 4a70e2f128c636e7ab4fb60733b853e34474045f compiler/codeGen/StgCmmPrim.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index e208318..55b4264 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -412,7 +412,9 @@ emitPrimOp _ [] WriteSmallArrayOp [obj,ix,v] = doWriteSmallPtrArrayOp obj -- Getting the size of pointer arrays emitPrimOp dflags [res] SizeofArrayOp [arg] - = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags + oFFSET_StgMutArrPtrs_ptrs dflags) (bWord dflags)) + = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg + (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgMutArrPtrs_ptrs dflags)) + (bWord dflags)) emitPrimOp dflags [res] SizeofMutableArrayOp [arg] = emitPrimOp dflags [res] SizeofArrayOp [arg] emitPrimOp dflags [res] SizeofArrayArrayOp [arg] @@ -423,7 +425,8 @@ emitPrimOp dflags [res] SizeofMutableArrayArrayOp [arg] emitPrimOp dflags [res] SizeofSmallArrayOp [arg] = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg - (fixedHdrSizeW dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags) (bWord dflags)) + (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgSmallMutArrPtrs_ptrs dflags)) + (bWord dflags)) emitPrimOp dflags [res] SizeofSmallMutableArrayOp [arg] = emitPrimOp dflags [res] SizeofSmallArrayOp [arg] From git at git.haskell.org Tue Sep 29 16:09:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:41 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Update user guide, fixing #10772 (45f7392) Message-ID: <20150929160941.8BDF83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/45f73924c36fb61f87413b18951b4b1121ea2bfa/ghc >--------------------------------------------------------------- commit 45f73924c36fb61f87413b18951b4b1121ea2bfa Author: Richard Eisenberg Date: Sat Sep 19 14:45:28 2015 -0400 Update user guide, fixing #10772 >--------------------------------------------------------------- 45f73924c36fb61f87413b18951b4b1121ea2bfa docs/users_guide/glasgow_exts.xml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index fb4837a..3dfd40a 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2840,8 +2840,11 @@ GHC allows type constructors, classes, and type variables to be operators, and to be written infix, very much like expressions. More specifically: - A type constructor or class can be an operator, beginning with a colon; e.g. :*:. - The lexical syntax is the same as that for data constructors. + A type constructor or class can be any non-reserved operator. + Symbols used in types are always like capitalized identifiers; they + are never variables. Note that this is different from the lexical + syntax of data constructors, which are required to begin with a + :. Data type and type-synonym declarations can be written infix, parenthesised From git at git.haskell.org Tue Sep 29 16:09:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:44 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: RTS.Flags: Rename Nat to RtsNat (10c61bf) Message-ID: <20150929160944.54D123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/10c61bfd6a6645da3ee896b3f04b960a308aa0dd/ghc >--------------------------------------------------------------- commit 10c61bfd6a6645da3ee896b3f04b960a308aa0dd Author: Ben Gamari Date: Thu Sep 24 01:25:06 2015 +0200 RTS.Flags: Rename Nat to RtsNat >--------------------------------------------------------------- 10c61bfd6a6645da3ee896b3f04b960a308aa0dd libraries/base/GHC/RTS/Flags.hsc | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc index b8b2973..d2afcab 100644 --- a/libraries/base/GHC/RTS/Flags.hsc +++ b/libraries/base/GHC/RTS/Flags.hsc @@ -57,7 +57,7 @@ import GHC.Word type RtsTime = Word64 -- | @'nat'@ defined in @rts/Types.h@ -type Nat = #{type unsigned int} +type RtsNat = #{type unsigned int} data GiveGCStats = NoGCStats @@ -84,19 +84,19 @@ instance Enum GiveGCStats where data GCFlags = GCFlags { statsFile :: Maybe FilePath , giveStats :: GiveGCStats - , maxStkSize :: Nat - , initialStkSize :: Nat - , stkChunkSize :: Nat - , stkChunkBufferSize :: Nat - , maxHeapSize :: Nat - , minAllocAreaSize :: Nat - , minOldGenSize :: Nat - , heapSizeSuggestion :: Nat + , maxStkSize :: RtsNat + , initialStkSize :: RtsNat + , stkChunkSize :: RtsNat + , stkChunkBufferSize :: RtsNat + , maxHeapSize :: RtsNat + , minAllocAreaSize :: RtsNat + , minOldGenSize :: RtsNat + , heapSizeSuggestion :: RtsNat , heapSizeSuggestionAuto :: Bool , oldGenFactor :: Double , pcFreeHeap :: Double - , generations :: Nat - , steps :: Nat + , generations :: RtsNat + , steps :: RtsNat , squeezeUpdFrames :: Bool , compact :: Bool -- ^ True <=> "compact all the time" , compactThreshold :: Double @@ -311,7 +311,7 @@ getGCFlags = do ptr <- getGcFlagsPtr GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr) <*> (toEnum . fromIntegral <$> - (#{peek GC_FLAGS, giveStats} ptr :: IO Nat)) + (#{peek GC_FLAGS, giveStats} ptr :: IO RtsNat)) <*> #{peek GC_FLAGS, maxStkSize} ptr <*> #{peek GC_FLAGS, initialStkSize} ptr <*> #{peek GC_FLAGS, stkChunkSize} ptr @@ -373,7 +373,7 @@ getCCFlags :: IO CCFlags getCCFlags = do ptr <- getCcFlagsPtr CCFlags <$> (toEnum . fromIntegral - <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO Nat)) + <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO RtsNat)) <*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr <*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr From git at git.haskell.org Tue Sep 29 16:09:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:48 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Slightly better `Coercible` errors. (00a7af6) Message-ID: <20150929160948.316B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/00a7af69f8ab22b50e3430f47b6c7a12b058e7bc/ghc >--------------------------------------------------------------- commit 00a7af69f8ab22b50e3430f47b6c7a12b058e7bc Author: Richard Eisenberg Date: Sun Sep 20 17:39:17 2015 -0400 Slightly better `Coercible` errors. This makes two real changes: - Equalities like (a ~R [a]) really *are* insoluble. Previously, GHC refused to give up when an occurs check bit on a representational equality. But for datatypes, it really should bail. - Now, GHC will sometimes report an occurs check error (in cases above) for representational equalities. Previously, it never did. This "fixes" #10715, where by "fix", I mean clarifies the error message. It's unclear how to do more to fix that ticket. Test cases: typecheck/should_fail/T10715{,b} >--------------------------------------------------------------- 00a7af69f8ab22b50e3430f47b6c7a12b058e7bc compiler/typecheck/TcCanonical.hs | 29 ++++++++++++++++++---- compiler/typecheck/TcErrors.hs | 14 +++++++---- compiler/typecheck/TcType.hs | 19 ++++++++++++++ testsuite/tests/typecheck/should_fail/T10715.hs | 10 ++++++++ .../tests/typecheck/should_fail/T10715.stderr | 15 +++++++++++ testsuite/tests/typecheck/should_fail/T10715b.hs | 7 ++++++ .../tests/typecheck/should_fail/T10715b.stderr | 8 ++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 93 insertions(+), 10 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 00a7af69f8ab22b50e3430f47b6c7a12b058e7bc From git at git.haskell.org Tue Sep 29 16:09:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Docs: make sure all libs are included in index.html (#10879) (f6a3df2) Message-ID: <20150929160950.F30663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/f6a3df2993f32a79f45e4bf112f46fab9bf75a67/ghc >--------------------------------------------------------------- commit f6a3df2993f32a79f45e4bf112f46fab9bf75a67 Author: Thomas Miedema Date: Tue Sep 15 21:37:38 2015 +0200 Docs: make sure all libs are included in index.html (#10879) During the build, when HADDOCK_DOCS=YES, the command 'cd libraries && sh gen_contents_index --intree' is run, which calls haddock to generate the haddock index at 'libraries/dist-haddock/index.html'. What it did before was check the ./packages file for all libraries. The problem is that 'base' and 'ghc-prim' were folded into the main repo some time ago, hence don't have an entry in the ./packages file anymore. As a result, 'base' and 'ghc-prim' were missing from the index.html file. It now simply runs haddock on all the all the `.haddock` files in the libraries directory. The only risk is that this could include the extra libraries in the index.html, if you ever built them in the past (with BUILD_EXTRA_PKGS=YES), even though now you want to exclude them (with BUILD_EXTRA_PKGS=NO). gen_contents_index doesn't have access to build system variables though (PACKAGES_STAGE1+PACKAGES_STAGE2), so fixing this would be a little bit fiddly. Test Plan: 'make libraries/dist-haddock/index.html && grep -q base libraries/dist-haddock/index.html && echo ok' Reviewed by: austin Differential Revision: https://phabricator.haskell.org/D1247 >--------------------------------------------------------------- f6a3df2993f32a79f45e4bf112f46fab9bf75a67 libraries/gen_contents_index | 18 ++---------------- 1 file changed, 2 insertions(+), 16 deletions(-) diff --git a/libraries/gen_contents_index b/libraries/gen_contents_index index 34e51f3..a9e58b7 100644 --- a/libraries/gen_contents_index +++ b/libraries/gen_contents_index @@ -33,22 +33,10 @@ then cd dist-haddock HADDOCK=../../inplace/bin/haddock + HADDOCK_FILES=`find ../ -name *.haddock | sort` HADDOCK_ARGS="-p ../prologue.txt" - for REPO in `grep '^libraries/[^ ]* *- ' ../../packages | sed -e 's#libraries/##' -e 's/ .*//'` + for HADDOCK_FILE in $HADDOCK_FILES do - if [ -f "../$REPO/ghc-packages" ] - then - LIBS="`cat ../$REPO/ghc-packages`" - LIBROOT="../$REPO" - else - LIBS="$REPO" - LIBROOT=".." - fi - for LIB in $LIBS - do - HADDOCK_FILE="$LIBROOT/$LIB/dist-install/doc/html/$LIB/$LIB.haddock" - if [ -f "$HADDOCK_FILE" ] - then LIBPATH=`echo "$HADDOCK_FILE" | sed 's#/dist-install.*##'` NAME=`echo "$HADDOCK_FILE" | sed 's#.*/##' | sed 's#\.haddock$##'` # It's easier to portably remove tabs with tr than to try to get @@ -56,8 +44,6 @@ then VERSION=`grep -i '^version:' $LIBPATH/$NAME.cabal | sed 's/.*://' | tr -d ' \t'` HADDOCK_ARG="--read-interface=${NAME}-${VERSION},$HADDOCK_FILE" HADDOCK_ARGS="$HADDOCK_ARGS $HADDOCK_ARG" - fi - done done else HADDOCK=../../../../../bin/haddock From git at git.haskell.org Tue Sep 29 16:09:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:54 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: fix EBADF unqueueing in select backend (Trac #10590) (d3a2843) Message-ID: <20150929160954.076843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d3a28430d89b256974ce09739f298ec68aa57a69/ghc >--------------------------------------------------------------- commit d3a28430d89b256974ce09739f298ec68aa57a69 Author: Sergei Trofimovich Date: Tue Jul 7 17:00:23 2015 +0200 fix EBADF unqueueing in select backend (Trac #10590) Alexander found a interesting case: 1. We have a queue of two waiters in a blocked_queue 2. first file descriptor changes state to RUNNABLE, second changes to INVALID 3. awaitEvent function dequeued RUNNABLE thread to a run queue and attempted to dequeue INVALID descriptor to a run queue. Unqueueing INVALID fails thusly: #3 0x000000000045cf1c in barf (s=0x4c1cb0 "removeThreadFromDeQueue: not found") at rts/RtsMessages.c:42 #4 0x000000000046848b in removeThreadFromDeQueue (...) at rts/Threads.c:249 #5 0x000000000049a120 in removeFromQueues (...) at rts/RaiseAsync.c:719 #6 0x0000000000499502 in throwToSingleThreaded__ (...) at rts/RaiseAsync.c:67 #7 0x0000000000499555 in throwToSingleThreaded (..) at rts/RaiseAsync.c:75 #8 0x000000000047c27d in awaitEvent (wait=rtsFalse) at rts/posix/Select.c:415 The problem here is a throwToSingleThreaded function that tries to unqueue a TSO from blocked_queue, but awaitEvent function leaves blocked_queue in a inconsistent state while traverses over blocked_queue: case RTS_FD_IS_READY: IF_DEBUG(scheduler, debugBelch("Waking up blocked thread %lu\n", (unsigned long)tso->id)); tso->why_blocked = NotBlocked; tso->_link = END_TSO_QUEUE; // Here we break the queue head pushOnRunQueue(&MainCapability,tso); break; Signed-off-by: Sergei Trofimovich Test Plan: tested on a sample from T10590 Reviewers: austin, bgamari, simonmar Reviewed By: bgamari, simonmar Subscribers: qnikst, thomie, bgamari Differential Revision: https://phabricator.haskell.org/D1024 GHC Trac Issues: #10590, #4934 >--------------------------------------------------------------- d3a28430d89b256974ce09739f298ec68aa57a69 rts/RaiseAsync.c | 8 +------- rts/RaiseAsync.h | 6 ++++++ rts/posix/Select.c | 10 ++++++++-- testsuite/tests/rts/T10590.hs | 37 +++++++++++++++++++++++++++++++++++++ testsuite/tests/rts/all.T | 5 +++++ 5 files changed, 57 insertions(+), 9 deletions(-) diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index 3b206ff..267707c 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -23,12 +23,6 @@ #include "win32/IOManager.h" #endif -static StgTSO* raiseAsync (Capability *cap, - StgTSO *tso, - StgClosure *exception, - rtsBool stop_at_atomically, - StgUpdateFrame *stop_here); - static void removeFromQueues(Capability *cap, StgTSO *tso); static void removeFromMVarBlockedQueue (StgTSO *tso); @@ -777,7 +771,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) * * -------------------------------------------------------------------------- */ -static StgTSO * +StgTSO * raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, rtsBool stop_at_atomically, StgUpdateFrame *stop_here) { diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h index 6bfed8d..1f939d4 100644 --- a/rts/RaiseAsync.h +++ b/rts/RaiseAsync.h @@ -19,6 +19,12 @@ void blockedThrowTo (Capability *cap, StgTSO *target, MessageThrowTo *msg); +StgTSO* raiseAsync (Capability *cap, + StgTSO *tso, + StgClosure *exception, + rtsBool stop_at_atomically, + StgUpdateFrame *stop_here); + void throwToSingleThreaded (Capability *cap, StgTSO *tso, StgClosure *exception); diff --git a/rts/posix/Select.c b/rts/posix/Select.c index 4b19235..d5c9b55 100644 --- a/rts/posix/Select.c +++ b/rts/posix/Select.c @@ -375,6 +375,12 @@ awaitEvent(rtsBool wait) prev = NULL; { + /* + * The queue is being rebuilt in this loop: + * 'blocked_queue_hd' will contain already + * traversed blocked TSOs. As a result you + * can't use functions accessing 'blocked_queue_hd'. + */ for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) { next = tso->_link; int fd; @@ -412,8 +418,8 @@ awaitEvent(rtsBool wait) IF_DEBUG(scheduler, debugBelch("Killing blocked thread %lu on bad fd=%i\n", (unsigned long)tso->id, fd)); - throwToSingleThreaded(&MainCapability, tso, - (StgClosure *)blockedOnBadFD_closure); + raiseAsync(&MainCapability, tso, + (StgClosure *)blockedOnBadFD_closure, rtsFalse, NULL); break; case RTS_FD_IS_READY: IF_DEBUG(scheduler, diff --git a/testsuite/tests/rts/T10590.hs b/testsuite/tests/rts/T10590.hs new file mode 100644 index 0000000..24198ab --- /dev/null +++ b/testsuite/tests/rts/T10590.hs @@ -0,0 +1,37 @@ +import Foreign.C +import Foreign.Marshal.Array +import Foreign.Storable +import Control.Concurrent + +-- The test works only on UNIX like. +-- unportable bits: +import qualified System.Posix.Internals as SPI +import qualified System.Posix.Types as SPT + +pipe :: IO (CInt, CInt) +pipe = allocaArray 2 $ \fds -> do + throwErrnoIfMinus1_ "pipe" $ SPI.c_pipe fds + rd <- peekElemOff fds 0 + wr <- peekElemOff fds 1 + return (rd, wr) + +main :: IO () +main = do + (r1, w1) <- pipe + (r2, _w2) <- pipe + _ <- forkIO $ do -- thread A + threadWaitRead (SPT.Fd r1) + _ <- forkIO $ do -- thread B + threadWaitRead (SPT.Fd r2) + yield -- switch to A, then B + -- now both are blocked + _ <- SPI.c_close w1 -- unblocking thread A fd + _ <- SPI.c_close r2 -- breaking thread B fd + yield -- kick RTS IO manager + +{- + Trac #10590 exposed a bug as: + T10590: internal error: removeThreadFromDeQueue: not found + (GHC version 7.11.20150702 for x86_64_unknown_linux) + Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug + -} diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 8e0e76e..e3b9da1 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -279,3 +279,8 @@ test('linker_error3', ignore_output ], run_command, ['$MAKE -s --no-print-directory linker_error3']) + +# ignore_output as RTS reports slightly different error messages +# in 'epoll' and 'select' backends on reading from EBADF +# mingw32 skip as UNIX pipe and close(fd) is used to exercise the problem +test('T10590', [ignore_output, when(opsys('mingw32'),skip)], compile_and_run, ['']) From git at git.haskell.org Tue Sep 29 16:09:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:56 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: TcErrors: mkErrorMsgFromCt is just mkErrorMsg (d70e0ed) Message-ID: <20150929160956.BBE7A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d70e0ede3b51c982e4a2032641d494f0066a8d78/ghc >--------------------------------------------------------------- commit d70e0ede3b51c982e4a2032641d494f0066a8d78 Author: Ben Gamari Date: Thu Sep 24 02:13:00 2015 +0200 TcErrors: mkErrorMsgFromCt is just mkErrorMsg >--------------------------------------------------------------- d70e0ede3b51c982e4a2032641d494f0066a8d78 compiler/typecheck/TcErrors.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 9272fc2..2af9c23 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -819,9 +819,9 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2 ppr (isTyVarUnderDatatype tv1 ty2)) (ctEqRel ct == ReprEq && not (isTyVarUnderDatatype tv1 ty2)) -- the cases below don't really apply to ReprEq (except occurs check) - = mkErrorMsgFromCt ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2 - , extraTyVarInfo ctxt tv1 ty2 - , extra ]) + = mkErrorMsg ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2 + , extraTyVarInfo ctxt tv1 ty2 + , extra ]) -- So tv is a meta tyvar (or started that way before we -- generalised it). So presumably it is an *untouchable* From git at git.haskell.org Tue Sep 29 16:09:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:09:59 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Clarify parsing infelicity. (6b8da22) Message-ID: <20150929160959.A131D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/6b8da220f918a190d1a716420cc2014ed229df2e/ghc >--------------------------------------------------------------- commit 6b8da220f918a190d1a716420cc2014ed229df2e Author: Richard Eisenberg Date: Sat Sep 19 16:44:29 2015 -0400 Clarify parsing infelicity. This fixes #10855. >--------------------------------------------------------------- 6b8da220f918a190d1a716420cc2014ed229df2e docs/users_guide/bugs.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 1d7903a..3eb5304 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -101,6 +101,18 @@ main = do args <- getArgs (let x = 42 in x == 42 == True) + + + The Haskell Report allows you to put a unary + - preceding certain expressions headed by + keywords, allowing constructs like - case x of + ... or - do { ... }. GHC does + not allow this. Instead, unary - is + allowed before only expressions that could potentially + be applied as a function. + + + From git at git.haskell.org Tue Sep 29 16:10:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:10:03 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix #10596 by looking up 'Int' not 'Maybe Int' in the map. (024d7c3) Message-ID: <20150929161003.2E9273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/024d7c33ea3f8eec9703c5de256f80de09a23578/ghc >--------------------------------------------------------------- commit 024d7c33ea3f8eec9703c5de256f80de09a23578 Author: Edward Z. Yang Date: Tue Jul 7 21:19:54 2015 +0200 Fix #10596 by looking up 'Int' not 'Maybe Int' in the map. Test Plan: validate Reviewers: goldfire, austin, simonpj, bgamari Reviewed By: bgamari Subscribers: simonpj, rwbarton, thomie, bgamari Differential Revision: https://phabricator.haskell.org/D1026 GHC Trac Issues: #10596 >--------------------------------------------------------------- 024d7c33ea3f8eec9703c5de256f80de09a23578 compiler/typecheck/TcSplice.hs | 15 +++++++++++---- testsuite/tests/th/T10596.hs | 11 +++++++++++ testsuite/tests/th/T10596.stderr | 1 + testsuite/tests/th/all.T | 1 + 4 files changed, 24 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 6c62060..d14d114 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -6,7 +6,11 @@ TcSplice: Template Haskell splices -} -{-# LANGUAGE CPP, FlexibleInstances, MagicHash, ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE InstanceSigs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module TcSplice( @@ -106,7 +110,7 @@ import GHC.Desugar ( AnnotationWrapper(..) ) import qualified Data.Map as Map import Data.Dynamic ( fromDynamic, toDyn ) -import Data.Typeable ( typeOf ) +import Data.Typeable ( typeOf, Typeable ) import Data.Data (Data) import GHC.Exts ( unsafeCoerce# ) #endif @@ -949,11 +953,14 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv updTcRef th_modfinalizers_var (\fins -> fin:fins) + qGetQ :: forall a. Typeable a => IOEnv (Env TcGblEnv TcLclEnv) (Maybe a) qGetQ = do th_state_var <- fmap tcg_th_state getGblEnv th_state <- readTcRef th_state_var - let x = Map.lookup (typeOf x) th_state >>= fromDynamic - return x + -- See #10596 for why we use a scoped type variable here. + -- ToDo: convert @undefined :: a@ to @proxy :: Proxy a@ when + -- we drop support for GHC 7.6. + return (Map.lookup (typeOf (undefined :: a)) th_state >>= fromDynamic) qPutQ x = do th_state_var <- fmap tcg_th_state getGblEnv diff --git a/testsuite/tests/th/T10596.hs b/testsuite/tests/th/T10596.hs new file mode 100644 index 0000000..c861156 --- /dev/null +++ b/testsuite/tests/th/T10596.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} +module T10596 where +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +do + putQ (100 :: Int) + x <- (getQ :: Q (Maybe Int)) + + -- It should print "Just 100" + runIO $ print x + return [] diff --git a/testsuite/tests/th/T10596.stderr b/testsuite/tests/th/T10596.stderr new file mode 100644 index 0000000..4b58162 --- /dev/null +++ b/testsuite/tests/th/T10596.stderr @@ -0,0 +1 @@ +Just 100 diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index bc6ca5d..ff0bc9b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -360,3 +360,4 @@ test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624']) test('TH_Lift', normal, compile, ['-v0']) test('T10019', normal, ghci_script, ['T10019.script']) test('T10279', normal, compile_fail, ['-v0']) +test('T10596', normal, compile, ['-v0']) From git at git.haskell.org Tue Sep 29 16:10:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:10:06 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: TcType: Add missing export (c99fc94) Message-ID: <20150929161006.1B8CF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/c99fc94deea24177c5c8837ee07c13ff3425687d/ghc >--------------------------------------------------------------- commit c99fc94deea24177c5c8837ee07c13ff3425687d Author: Ben Gamari Date: Thu Sep 24 02:11:49 2015 +0200 TcType: Add missing export >--------------------------------------------------------------- c99fc94deea24177c5c8837ee07c13ff3425687d 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 50b07d0..0d80efe3 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -68,7 +68,7 @@ module TcType ( isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isBoolTy, isUnitTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, - isPredTy, isTyVarClassPred, isTyVarExposed, + isPredTy, isTyVarClassPred, isTyVarExposed, isTyVarUnderDatatype, --------------------------------- -- Misc type manipulators From git at git.haskell.org Tue Sep 29 16:10:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:10:08 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: TyCon: Backport isGenerativeTyCon (34899db) Message-ID: <20150929161008.E87343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/34899db1f5087385fd30a5bccd038677c960ee94/ghc >--------------------------------------------------------------- commit 34899db1f5087385fd30a5bccd038677c960ee94 Author: Ben Gamari Date: Thu Sep 24 02:04:27 2015 +0200 TyCon: Backport isGenerativeTyCon >--------------------------------------------------------------- 34899db1f5087385fd30a5bccd038677c960ee94 compiler/types/TyCon.hs | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 1a5bb8e..43bdf7b 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -50,6 +50,7 @@ module TyCon( isBuiltInSynFamTyCon_maybe, isUnLiftedTyCon, isGadtSyntaxTyCon, isDistinctTyCon, isDistinctAlgRhs, + isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs, isTyConAssoc, tyConAssoc_maybe, isRecursiveTyCon, isImplicitTyCon, @@ -1219,6 +1220,42 @@ isDataTyCon (AlgTyCon {algTcRhs = rhs}) isDataTyCon (TupleTyCon {tyConTupleSort = sort}) = isBoxed (tupleSortBoxity sort) isDataTyCon _ = False +-- | 'isInjectiveTyCon' is true of 'TyCon's for which this property holds +-- (where X is the role passed in): +-- If (T a1 b1 c1) ~X (T a2 b2 c2), then (a1 ~X1 a2), (b1 ~X2 b2), and (c1 ~X3 c2) +-- (where X1, X2, and X3, are the roles given by tyConRolesX tc X) +-- See also Note [Decomposing equalities] in TcCanonical +isInjectiveTyCon :: TyCon -> Role -> Bool +isInjectiveTyCon _ Phantom = False +isInjectiveTyCon (FunTyCon {}) _ = True +isInjectiveTyCon (AlgTyCon {}) Nominal = True +isInjectiveTyCon (AlgTyCon {algTcRhs = rhs}) Representational + = isGenInjAlgRhs rhs +isInjectiveTyCon (TupleTyCon {}) _ = True +isInjectiveTyCon (SynonymTyCon {}) _ = False +isInjectiveTyCon (FamilyTyCon {}) _ = False +isInjectiveTyCon (PrimTyCon {}) _ = True +isInjectiveTyCon (PromotedDataCon {}) _ = True +isInjectiveTyCon (PromotedTyCon {ty_con = tc}) r + = isInjectiveTyCon tc r + +-- | 'isGenerativeTyCon' is true of 'TyCon's for which this property holds +-- (where X is the role passed in): +-- If (T tys ~X t), then (t's head ~X T). +-- See also Note [Decomposing equalities] in TcCanonical +isGenerativeTyCon :: TyCon -> Role -> Bool +isGenerativeTyCon = isInjectiveTyCon + -- as it happens, generativity and injectivity coincide, but there's + -- no a priori reason this must be the case + +-- | Is this an 'AlgTyConRhs' of a 'TyCon' that is generative and injective +-- with respect to representational equality? +isGenInjAlgRhs :: AlgTyConRhs -> Bool +isGenInjAlgRhs (DataTyCon {}) = True +isGenInjAlgRhs (DataFamilyTyCon {}) = False +isGenInjAlgRhs (AbstractTyCon distinct) = distinct +isGenInjAlgRhs (NewTyCon {}) = False + -- | 'isDistinctTyCon' is true of 'TyCon's that are equal only to -- themselves, even via representational coercions (except for unsafeCoerce). -- This excludes newtypes, type functions, type synonyms. From git at git.haskell.org Tue Sep 29 16:10:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:10:12 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Generate .dyn_o files for .hsig files with -dynamic-too (4596beb) Message-ID: <20150929161012.8AA5A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/4596beb46ab12c26f7da272355ee680c87603d2f/ghc >--------------------------------------------------------------- commit 4596beb46ab12c26f7da272355ee680c87603d2f Author: Michael Smith Date: Thu Jul 23 11:41:16 2015 +0200 Generate .dyn_o files for .hsig files with -dynamic-too With -dynamic-too, .dyn_o files were not being generated for .hsig files. Normally, this is handled in the pipeline; however, the branch for .hsig files called compileEmptyStub directly instead of going through runPipeline. When compiling a Cabal package that included .hsig files, this triggered a linker error later on, as it expected a .dyn_o file to have been generated for each .hsig. The fix is to use runPipeline for .hsig files, just as with .hs files. Alternately, one could duplicate the logic for handling -dynamic-too in the .hsig branch, but simply calling runPipeline ends up being much cleaner. Test Plan: validate Reviewers: austin, ezyang, bgamari, thomie Reviewed By: ezyang, thomie Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1084 GHC Trac Issues: #10660 >--------------------------------------------------------------- 4596beb46ab12c26f7da272355ee680c87603d2f compiler/main/DriverPipeline.hs | 13 ++++++++++++- .../tests/driver/dynamicToo/dynamicToo005/A005.hsig | 5 +++++ testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile | 16 ++++++++++++++++ testsuite/tests/driver/dynamicToo/dynamicToo005/test.T | 8 ++++++++ testsuite/tests/driver/dynamicToo/dynamicToo006/A.hsig | 5 +++++ testsuite/tests/driver/dynamicToo/dynamicToo006/B.hs | 8 ++++++++ .../dynamicToo/{dynamicToo002 => dynamicToo006}/Makefile | 15 ++++++--------- testsuite/tests/driver/dynamicToo/dynamicToo006/test.T | 9 +++++++++ 8 files changed, 69 insertions(+), 10 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 623f356..3079d1f 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -252,7 +252,18 @@ compileOne' m_tc_result mHscMessage do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash hscWriteIface dflags iface changed summary - compileEmptyStub dflags hsc_env basename location + + -- #10660: Use the pipeline instead of calling + -- compileEmptyStub directly, so -dynamic-too gets + -- handled properly + let mod_name = ms_mod_name summary + _ <- runPipeline StopLn hsc_env + (output_fn, + Just (HscOut src_flavour mod_name HscUpdateSig)) + (Just basename) + Persistent + (Just location) + Nothing -- Same as Hs o_time <- getModificationUTCTime object_filename diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hsig b/testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hsig new file mode 100644 index 0000000..75d621c --- /dev/null +++ b/testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hsig @@ -0,0 +1,5 @@ + +module A005 where + +data Maybe a = Nothing | Just a + diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile new file mode 100644 index 0000000..617510e --- /dev/null +++ b/testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile @@ -0,0 +1,16 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +checkExists = [ -f $1 ] || echo $1 missing + +.PHONY: dynamicToo005 +# Check that "-c -dynamic-too" works with .hsig +dynamicToo005: + "$(TEST_HC)" $(TEST_HC_OPTS) -dynamic-too -v0 \ + -sig-of A005=base:Prelude \ + -c A005.hsig + $(call checkExists,A005.o) + $(call checkExists,A005.hi) + $(call checkExists,A005.dyn_o) + $(call checkExists,A005.dyn_hi) diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo005/test.T b/testsuite/tests/driver/dynamicToo/dynamicToo005/test.T new file mode 100644 index 0000000..48460f5 --- /dev/null +++ b/testsuite/tests/driver/dynamicToo/dynamicToo005/test.T @@ -0,0 +1,8 @@ + +test('dynamicToo005', + [extra_clean(['A005.o', 'A005.hi', 'A005.dyn_o', 'A005.dyn_hi']), + unless(have_vanilla(), skip), + unless(have_dynamic(), skip)], + run_command, + ['$MAKE -s --no-print-directory dynamicToo005']) + diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/A.hsig b/testsuite/tests/driver/dynamicToo/dynamicToo006/A.hsig new file mode 100644 index 0000000..f79d5d3 --- /dev/null +++ b/testsuite/tests/driver/dynamicToo/dynamicToo006/A.hsig @@ -0,0 +1,5 @@ + +module A where + +data Maybe a = Nothing | Just a + diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/B.hs b/testsuite/tests/driver/dynamicToo/dynamicToo006/B.hs new file mode 100644 index 0000000..65900e7 --- /dev/null +++ b/testsuite/tests/driver/dynamicToo/dynamicToo006/B.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module B where + +import A + +b :: Maybe a +b = Nothing diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo002/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile similarity index 58% copy from testsuite/tests/driver/dynamicToo/dynamicToo002/Makefile copy to testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile index 8705c87..497f2c0 100644 --- a/testsuite/tests/driver/dynamicToo/dynamicToo002/Makefile +++ b/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile @@ -4,20 +4,17 @@ include $(TOP)/mk/test.mk checkExists = [ -f $1 ] || echo $1 missing -.PHONY: dynamicToo002 -# Check that "--make -dynamic-too" works -dynamicToo002: - "$(TEST_HC)" $(TEST_HC_OPTS) -dynamic-too -v0 --make C +.PHONY: dynamicToo006 +# Check that "--make -dynamic-too" works with .hsig +dynamicToo006: + "$(TEST_HC)" $(TEST_HC_OPTS) -dynamic-too -v0 \ + -sig-of A=base:Prelude \ + --make B $(call checkExists,A.o) $(call checkExists,B.o) - $(call checkExists,C.o) $(call checkExists,A.hi) $(call checkExists,B.hi) - $(call checkExists,C.hi) $(call checkExists,A.dyn_o) $(call checkExists,B.dyn_o) - $(call checkExists,C.dyn_o) $(call checkExists,A.dyn_hi) $(call checkExists,B.dyn_hi) - $(call checkExists,C.dyn_hi) - diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/test.T b/testsuite/tests/driver/dynamicToo/dynamicToo006/test.T new file mode 100644 index 0000000..72e06ca --- /dev/null +++ b/testsuite/tests/driver/dynamicToo/dynamicToo006/test.T @@ -0,0 +1,9 @@ + +test('dynamicToo006', + [extra_clean(['A.o', 'A.hi', 'A.dyn_o', 'A.dyn_hi', + 'B.o', 'B.hi', 'B.dyn_o', 'B.dyn_hi']), + unless(have_vanilla(), skip), + unless(have_dynamic(), skip)], + run_command, + ['$MAKE -s --no-print-directory dynamicToo006']) + From git at git.haskell.org Tue Sep 29 16:10:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:10:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Flush stdout in test case for #10596 (eea6557) Message-ID: <20150929161015.5BEC53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/eea6557769f6c805f6cd1772b86cbd2d62459cec/ghc >--------------------------------------------------------------- commit eea6557769f6c805f6cd1772b86cbd2d62459cec Author: Joachim Breitner Date: Wed Jul 15 10:29:26 2015 +0200 Flush stdout in test case for #10596 which might help, as it has helped with lots of other TH-related test cases in the past. >--------------------------------------------------------------- eea6557769f6c805f6cd1772b86cbd2d62459cec testsuite/tests/th/T10596.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/th/T10596.hs b/testsuite/tests/th/T10596.hs index c861156..35d59e9 100644 --- a/testsuite/tests/th/T10596.hs +++ b/testsuite/tests/th/T10596.hs @@ -2,10 +2,13 @@ module T10596 where import Language.Haskell.TH import Language.Haskell.TH.Syntax +import System.IO + do putQ (100 :: Int) x <- (getQ :: Q (Maybe Int)) -- It should print "Just 100" runIO $ print x + runIO $ hFlush stdout return [] From git at git.haskell.org Tue Sep 29 16:10:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:10:18 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix a bug with mallocForeignPtr and finalizers (#10904) (dfdb021) Message-ID: <20150929161018.A1A803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/dfdb02111abea24ae15b405ab54e768c75fc5093/ghc >--------------------------------------------------------------- commit dfdb02111abea24ae15b405ab54e768c75fc5093 Author: Simon Marlow Date: Wed Sep 23 10:01:23 2015 +0100 Fix a bug with mallocForeignPtr and finalizers (#10904) Summary: See Note [MallocPtr finalizers] Test Plan: validate; new test T10904 Reviewers: ezyang, bgamari, austin, hvr, rwbarton Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1275 >--------------------------------------------------------------- dfdb02111abea24ae15b405ab54e768c75fc5093 libraries/base/GHC/ForeignPtr.hs | 36 +++++++++++++++++++++--------------- rts/sm/MarkWeak.c | 5 +++++ testsuite/tests/rts/T10904.hs | 28 ++++++++++++++++++++++++++++ testsuite/tests/rts/T10904lib.c | 30 ++++++++++++++++++++++++++++++ testsuite/tests/rts/all.T | 4 ++++ 5 files changed, 88 insertions(+), 15 deletions(-) diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 448eaee..be730f8 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -250,11 +250,18 @@ addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO () -- finalizer will run /before/ all other finalizers for the same -- object which have already been registered. addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of - PlainForeignPtr r -> f r >> return () - MallocPtr _ r -> f r >> return () + PlainForeignPtr r -> insertCFinalizer r fp 0# nullAddr# p () + MallocPtr _ r -> insertCFinalizer r fp 0# nullAddr# p c _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer" - where - f r = insertCFinalizer r fp 0# nullAddr# p + +-- Note [MallocPtr finalizers] (#10904) +-- +-- When we have C finalizers for a MallocPtr, the memory is +-- heap-resident and would normally be recovered by the GC before the +-- finalizers run. To prevent the memory from being reused too early, +-- we attach the MallocPtr constructor to the "value" field of the +-- weak pointer when we call mkWeak# in ensureCFinalizerWeak below. +-- The GC will keep this field alive until the finalizers have run. addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO () @@ -263,11 +270,9 @@ addForeignPtrFinalizerEnv :: -- finalizer. The environment passed to the finalizer is fixed by the -- second argument to 'addForeignPtrFinalizerEnv' addForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of - PlainForeignPtr r -> f r >> return () - MallocPtr _ r -> f r >> return () + PlainForeignPtr r -> insertCFinalizer r fp 1# ep p () + MallocPtr _ r -> insertCFinalizer r fp 1# ep p c _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer" - where - f r = insertCFinalizer r fp 1# ep p addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO () -- ^This function adds a finalizer to the given @ForeignPtr at . The @@ -319,9 +324,9 @@ insertHaskellFinalizer r f = do data MyWeak = MyWeak (Weak# ()) insertCFinalizer :: - IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> IO () -insertCFinalizer r fp flag ep p = do - MyWeak w <- ensureCFinalizerWeak r + IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () +insertCFinalizer r fp flag ep p val = do + MyWeak w <- ensureCFinalizerWeak r val IO $ \s -> case addCFinalizerToWeak# fp p flag ep w s of (# s1, 1# #) -> (# s1, () #) @@ -329,16 +334,17 @@ insertCFinalizer r fp flag ep p = do -- has finalized w by calling foreignPtrFinalizer. We retry now. -- This won't be an infinite loop because that thread must have -- replaced the content of r before calling finalizeWeak#. - (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p) s1 + (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p val) s1 -ensureCFinalizerWeak :: IORef Finalizers -> IO MyWeak -ensureCFinalizerWeak ref@(IORef (STRef r#)) = do +ensureCFinalizerWeak :: IORef Finalizers -> value -> IO MyWeak +ensureCFinalizerWeak ref@(IORef (STRef r#)) value = do fin <- readIORef ref case fin of CFinalizers weak -> return (MyWeak weak) HaskellFinalizers{} -> noMixingError NoFinalizers -> IO $ \s -> - case mkWeakNoFinalizer# r# () s of { (# s1, w #) -> + case mkWeakNoFinalizer# r# (unsafeCoerce# value) s of { (# s1, w #) -> + -- See Note [MallocPtr finalizers] (#10904) case atomicModifyMutVar# r# (update w) s1 of { (# s2, (weak, needKill ) #) -> if needKill diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c index c5a107c..c44d4b9 100644 --- a/rts/sm/MarkWeak.c +++ b/rts/sm/MarkWeak.c @@ -191,6 +191,11 @@ static void collectDeadWeakPtrs (generation *gen) { StgWeak *w, *next_w; for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) { + // If we have C finalizers, keep the value alive for this GC. + // See Note [MallocPtr finalizers] in GHC.ForeignPtr, and #10904 + if (w->cfinalizers != &stg_NO_FINALIZER_closure) { + evacuate(&w->value); + } evacuate(&w->finalizer); next_w = w->link; w->link = dead_weak_ptr_list; diff --git a/testsuite/tests/rts/T10904.hs b/testsuite/tests/rts/T10904.hs new file mode 100644 index 0000000..264df3a --- /dev/null +++ b/testsuite/tests/rts/T10904.hs @@ -0,0 +1,28 @@ +import Control.Concurrent +import Control.Monad +import Foreign +import Foreign.C.Types +import System.Environment + + +foreign import ccall safe "finalizerlib.h init_value" + init_value :: Ptr CInt -> IO () + +foreign import ccall safe "finalizerlib.h &finalize_value" + finalize_value :: FinalizerPtr CInt + + +allocateValue :: IO () +allocateValue = do + fp <- mallocForeignPtrBytes 10000 + withForeignPtr fp init_value + addForeignPtrFinalizer finalize_value fp + + +main :: IO () +main = do + [n] <- fmap (fmap read) getArgs + _ <- forkIO (loop n) + loop n + where + loop n = replicateM_ n allocateValue diff --git a/testsuite/tests/rts/T10904lib.c b/testsuite/tests/rts/T10904lib.c new file mode 100644 index 0000000..bfed67b --- /dev/null +++ b/testsuite/tests/rts/T10904lib.c @@ -0,0 +1,30 @@ +#include +#include + + +#define MAGIC 0x11223344 + +void +init_value(int * p) +{ + *p = MAGIC; +} + + +void +finalize_value(int * p) +{ + static long counter = 0; + + counter += 1; + + if (counter % 1000000 == 0) { + fprintf(stderr, "finalize_value: %ld calls\n", counter); + } + + if (*p != MAGIC) { + fprintf(stderr, "finalize_value: %x != %x after %ld calls\n", + *p, MAGIC, counter); + abort(); + } +} diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index e3b9da1..3993006 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -284,3 +284,7 @@ test('linker_error3', # in 'epoll' and 'select' backends on reading from EBADF # mingw32 skip as UNIX pipe and close(fd) is used to exercise the problem test('T10590', [ignore_output, when(opsys('mingw32'),skip)], compile_and_run, ['']) + +# 20000 was easily enough to trigger the bug with 7.10 +test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ], + compile_and_run, ['T10904lib.c']) From git at git.haskell.org Tue Sep 29 16:11:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Sep 2015 16:11:28 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Add framework flags when linking a dynamic library (5a55ed7) Message-ID: <20150929161128.975D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/5a55ed772a990ede43eb6dfb1ce4838d3e0259df/ghc >--------------------------------------------------------------- commit 5a55ed772a990ede43eb6dfb1ce4838d3e0259df Author: Christiaan Baaij Date: Wed Aug 5 14:20:56 2015 +0200 Add framework flags when linking a dynamic library This fixes the GHC side of trac #10568. So `cabal install --ghc-options="-framework GLUT" GLUT` creates a correctly linked GLUT.dylib. We still need to explictly pass `--ghc-options="-framework GLUT"` because the Cabal side #10568 is not fixed. Update: the Cabal side of #10568 is fixed by [Cabal#2747](https://github.com/haskell/cabal/pull/2747) Test Plan: validate Reviewers: austin, rwbarton, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D1115 GHC Trac Issues: #10568 >--------------------------------------------------------------- 5a55ed772a990ede43eb6dfb1ce4838d3e0259df compiler/main/DriverPipeline.hs | 31 +++--------------------------- compiler/main/SysTools.hs | 42 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 44 insertions(+), 29 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 3079d1f..ff71cb4 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1903,32 +1903,9 @@ linkBinary' staticLink dflags o_files dep_packages = do -- This option must be placed before the library -- that defines the symbol." - pkg_framework_path_opts <- - if platformUsesFrameworks platform - then do pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages - return $ map ("-F" ++) pkg_framework_paths - else return [] - - framework_path_opts <- - if platformUsesFrameworks platform - then do let framework_paths = frameworkPaths dflags - return $ map ("-F" ++) framework_paths - else return [] - - pkg_framework_opts <- - if platformUsesFrameworks platform - then do pkg_frameworks <- getPackageFrameworks dflags dep_packages - return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ] - else return [] - - framework_opts <- - if platformUsesFrameworks platform - then do let frameworks = cmdlineFrameworks dflags - -- reverse because they're added in reverse order from - -- the cmd line: - return $ concat [ ["-framework", fw] - | fw <- reverse frameworks ] - else return [] + -- frameworks + pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages + let framework_opts = getFrameworkOpts dflags platform -- probably _stub.o files let extra_ld_inputs = ldInputs dflags @@ -2017,12 +1994,10 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ extra_ld_inputs ++ map SysTools.Option ( rc_objs - ++ framework_path_opts ++ framework_opts ++ pkg_lib_path_opts ++ extraLinkObj:noteLinkObjs ++ pkg_link_opts - ++ pkg_framework_path_opts ++ pkg_framework_opts ++ debug_opts ++ thread_opts diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index f84974b..5612cbd 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -44,7 +44,12 @@ module SysTools ( cleanTempDirs, cleanTempFiles, cleanTempFilesExcept, addFilesToClean, - Option(..) + Option(..), + + -- frameworks + getPkgFrameworkOpts, + getFrameworkOpts + ) where @@ -1570,6 +1575,11 @@ linkDynLib dflags0 o_files dep_packages -- and last temporary shared object file let extra_ld_inputs = ldInputs dflags + -- frameworks + pkg_framework_opts <- getPkgFrameworkOpts dflags platform + (map packageKey pkgs) + let framework_opts = getFrameworkOpts dflags platform + case os of OSMinGW32 -> do ------------------------------------------------------------- @@ -1655,8 +1665,10 @@ linkDynLib dflags0 o_files dep_packages ++ [ Option "-install_name", Option instName ] ++ map Option lib_path_opts ++ extra_ld_inputs + ++ map Option framework_opts ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts + ++ map Option pkg_framework_opts ) OSiOS -> throwGhcExceptionIO (ProgramError "dynamic libraries are not supported on iOS target") _ -> do @@ -1690,3 +1702,31 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ) + +getPkgFrameworkOpts :: DynFlags -> Platform -> [PackageKey] -> IO [String] +getPkgFrameworkOpts dflags platform dep_packages + | platformUsesFrameworks platform = do + pkg_framework_path_opts <- do + pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages + return $ map ("-F" ++) pkg_framework_paths + + pkg_framework_opts <- do + pkg_frameworks <- getPackageFrameworks dflags dep_packages + return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ] + + return (pkg_framework_path_opts ++ pkg_framework_opts) + + | otherwise = return [] + +getFrameworkOpts :: DynFlags -> Platform -> [String] +getFrameworkOpts dflags platform + | platformUsesFrameworks platform = framework_path_opts ++ framework_opts + | otherwise = [] + where + framework_paths = frameworkPaths dflags + framework_path_opts = map ("-F" ++) framework_paths + + frameworks = cmdlineFrameworks dflags + -- reverse because they're added in reverse order from the cmd line: + framework_opts = concat [ ["-framework", fw] + | fw <- reverse frameworks ] From git at git.haskell.org Wed Sep 30 19:47:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Sep 2015 19:47:18 +0000 (UTC) Subject: [commit: ghc] master: Lexer: delete dead code for binary character literals (2eddcd9) Message-ID: <20150930194718.13CD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2eddcd9b65b7baf70dd3cc5a0b02cf0076c75560/ghc >--------------------------------------------------------------- commit 2eddcd9b65b7baf70dd3cc5a0b02cf0076c75560 Author: Thomas Miedema Date: Tue Sep 29 17:54:32 2015 +0200 Lexer: delete dead code for binary character literals The Haskell 2010 report chapter 2.6 (Characters and String Literals) says: "Numeric escapes such as \137 are used to designate the character with decimal representation 137; octal (e.g. \o137) and hexadecimal (e.g. \x37) representations are also allowed." Commit 1c0b5fdc9f2b6ea8166cc565383d4cd20432343c added syntax for writing character literals using binary notation (e.g. '\b100100'). But this code can never be reached, because '\b' already represents "backspace". Turn on -fwarn-overlapping-patterns to catch such bugs in the future. Reviewed by: hvr Differential Revision: https://phabricator.haskell.org/D1291 >--------------------------------------------------------------- 2eddcd9b65b7baf70dd3cc5a0b02cf0076c75560 compiler/parser/Lexer.x | 2 -- 1 file changed, 2 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 7dce81c..ae2e966 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -50,7 +50,6 @@ {-# OPTIONS_GHC -fno-warn-tabs #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-} module Lexer ( @@ -1495,7 +1494,6 @@ lex_escape = do 'x' -> readNum is_hexdigit 16 hexDigit 'o' -> readNum is_octdigit 8 octDecDigit - 'b' -> readNum is_bindigit 2 octDecDigit x | is_decdigit x -> readNum2 is_decdigit 10 octDecDigit (octDecDigit x) c1 -> do From git at git.haskell.org Wed Sep 30 22:43:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Sep 2015 22:43:53 +0000 (UTC) Subject: [commit: ghc] master: .gitignore update for some test files. (23baa65) Message-ID: <20150930224353.118213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23baa652e639ad6849a3bce57fa48a39e43cef84/ghc >--------------------------------------------------------------- commit 23baa652e639ad6849a3bce57fa48a39e43cef84 Author: Edward Z. Yang Date: Fri Sep 18 22:30:12 2015 -0700 .gitignore update for some test files. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 23baa652e639ad6849a3bce57fa48a39e43cef84 testsuite/.gitignore | 93 +++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 66 insertions(+), 27 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 23baa652e639ad6849a3bce57fa48a39e43cef84