From git at git.haskell.org Fri May 1 07:30:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 May 2015 07:30:47 +0000 (UTC) Subject: [commit: ghc] master: Comments only (bbfa0ca) Message-ID: <20150501073047.3E5683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bbfa0caa20546aa2428c8a235862605762d0feee/ghc >--------------------------------------------------------------- commit bbfa0caa20546aa2428c8a235862605762d0feee Author: Simon Peyton Jones Date: Thu Apr 30 14:44:23 2015 +0100 Comments only >--------------------------------------------------------------- bbfa0caa20546aa2428c8a235862605762d0feee compiler/specialise/SpecConstr.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs index 42e9f52..7a4b402 100644 --- a/compiler/specialise/SpecConstr.hs +++ b/compiler/specialise/SpecConstr.hs @@ -413,7 +413,10 @@ This seeding is done in the binding for seed_calls in specRec. (a) the call patterns in the RHS (b) the call patterns in the rest of the top-level bindings NB: before Apr 15 we used (a) only, but Dimitrios had an example - where (b) was crucial, so I added that. + where (b) was crucial, so I added that. + Adding (b) also improved nofib allocation results: + multiplier: 4% better + minimax: 2.8% better Actually in case (2), instead of using the calls from the RHS, it would be better to specialise in the importing module. We'd need to From git at git.haskell.org Fri May 1 07:30:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 May 2015 07:30:50 +0000 (UTC) Subject: [commit: ghc] master: Refactor TyCon to eliminate TupleTyCon (f6ab0f2) Message-ID: <20150501073050.1F02E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6ab0f2d595b34f33716513c0bf71b30f8b8e015/ghc >--------------------------------------------------------------- commit f6ab0f2d595b34f33716513c0bf71b30f8b8e015 Author: Simon Peyton Jones Date: Thu Apr 30 23:33:42 2015 +0100 Refactor TyCon to eliminate TupleTyCon This makes TupleTyCon into an ordinary AlgTyCon, distinguished by its AlgTyConRhs, rather than a separate constructor of TyCon. It is preparatory work for making constraint tuples into classes, for which the ConstraintTuple tuples will have a TyConParent of a ClassTyCon. Tuples didn't have this possiblity before. The patch affects other modules because I eliminated the unsatisfactory partial functions tupleTyConBoxity and tupleTyConSort. And tupleTyConArity which is just tyConArity. >--------------------------------------------------------------- f6ab0f2d595b34f33716513c0bf71b30f8b8e015 compiler/coreSyn/PprCore.hs | 9 +- compiler/deSugar/Check.hs | 3 +- compiler/iface/BinIface.hs | 23 ++- compiler/iface/IfaceType.hs | 4 +- compiler/iface/MkIface.hs | 16 +- compiler/prelude/TysWiredIn.hs | 12 +- compiler/typecheck/TcGenDeriv.hs | 9 +- compiler/typecheck/TcTyDecls.hs | 15 +- compiler/types/TyCon.hs | 241 +++++++++++-------------- compiler/types/TypeRep.hs | 17 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 + 11 files changed, 176 insertions(+), 180 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 f6ab0f2d595b34f33716513c0bf71b30f8b8e015 From git at git.haskell.org Fri May 1 08:40:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 May 2015 08:40:05 +0000 (UTC) Subject: [commit: ghc] master: Update haddock submodule to track TyCon change (0d715db) Message-ID: <20150501084005.4398D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d715db801972b8119aef15bd63b869fad9d5f9d/ghc >--------------------------------------------------------------- commit 0d715db801972b8119aef15bd63b869fad9d5f9d Author: Simon Peyton Jones Date: Fri May 1 09:40:37 2015 +0100 Update haddock submodule to track TyCon change >--------------------------------------------------------------- 0d715db801972b8119aef15bd63b869fad9d5f9d utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index f9ae6aa..5bbae8b 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit f9ae6aaf269474228f368380966fc80b73587832 +Subproject commit 5bbae8b9bc17d2166c7e03d5f42f2b12fadf70b7 From git at git.haskell.org Fri May 1 08:41:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 May 2015 08:41:46 +0000 (UTC) Subject: [commit: ghc] master: Make Derived NomEq rewrite only Derived NomEq (b626cb0) Message-ID: <20150501084146.48CC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b626cb08b6b97965eec1ab63a890f8cbcfbcaa5b/ghc >--------------------------------------------------------------- commit b626cb08b6b97965eec1ab63a890f8cbcfbcaa5b Author: Simon Peyton Jones Date: Fri May 1 09:42:21 2015 +0100 Make Derived NomEq rewrite only Derived NomEq See Note [Deriveds do rewrite Deriveds]. The important point is that we want to maintain the Note [Can-rewrite relation] property, lest we risk loops. >--------------------------------------------------------------- b626cb08b6b97965eec1ab63a890f8cbcfbcaa5b compiler/typecheck/TcFlatten.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 65d260b..4c74ba9 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1528,7 +1528,7 @@ eqCanRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool -- See Note [Deriveds do rewrite Deriveds] eqCanRewriteFR (Given, NomEq) (_, _) = True eqCanRewriteFR (Given, ReprEq) (_, ReprEq) = True -eqCanRewriteFR (Derived, NomEq) (Derived, _) = True +eqCanRewriteFR (Derived, NomEq) (Derived, NomEq) = True eqCanRewriteFR _ _ = False canRewriteOrSame :: CtEvidence -> CtEvidence -> Bool @@ -1566,6 +1566,16 @@ Note [Deriveds do rewrite Deriveds] However we DO allow Deriveds to rewrite Deriveds, because that's how improvement works; see Note [The improvement story] in TcInteract. +However, for now at least I'm only letting (Derived,NomEq) rewrite +(Derived,NomEq) and not doing anything for ReprEq. If we have + eqCanRewriteFR (Derived, NomEq) (Derived, _) = True +then we lose the property of Note [Can-rewrite relation] + R2. If f1 >= f, and f2 >= f, + then either f1 >= f2 or f2 >= f1 +Consider f1 = (Given, ReprEq) + f2 = (Derived, NomEq) + f = (Derived, ReprEq) + Note [canRewriteOrSame] ~~~~~~~~~~~~~~~~~~~~~~~ canRewriteOrSame is similar but From git at git.haskell.org Fri May 1 14:42:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 May 2015 14:42:21 +0000 (UTC) Subject: [commit: ghc] master: Kill off the default types in ghc-prim (de5d022) Message-ID: <20150501144221.C41193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de5d022e1543283effd67c2a03598e2bcaf49930/ghc >--------------------------------------------------------------- commit de5d022e1543283effd67c2a03598e2bcaf49930 Author: Simon Peyton Jones Date: Fri May 1 15:06:00 2015 +0100 Kill off the default types in ghc-prim We were trying to load the type for Integer to do defaulting in ghc-prim, but it's simply not available at that time. >--------------------------------------------------------------- de5d022e1543283effd67c2a03598e2bcaf49930 compiler/typecheck/TcRnMonad.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index f3c16cb..f576e33 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -125,7 +125,9 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this tcg_rdr_env = emptyGlobalRdrEnv, tcg_fix_env = emptyNameEnv, tcg_field_env = RecFields emptyNameEnv emptyNameSet, - tcg_default = Nothing, + tcg_default = if modulePackageKey mod == primPackageKey + then Just [] -- See Note [Default types] + else Nothing, tcg_type_env = emptyNameEnv, tcg_type_env_var = type_env_var, tcg_inst_env = emptyInstEnv, @@ -225,7 +227,17 @@ initTcForLookup hsc_env thing_inside Nothing -> throwIO $ mkSrcErr $ snd msgs Just x -> return x } -{- +{- Note [Default types] +~~~~~~~~~~~~~~~~~~~~~~~ +The Integer type is simply not available in package ghc-prim (it is +declared in integer-gmp). So we set the defaulting types to (Just +[]), meaning there are no default types, rather then Nothing, which +means "use the default default types of Integer, Double". + +If you don't do this, attempted defaulting in package ghc-prim causes +an actual crash (attempting to look up the Integer type). + + ************************************************************************ * * Initialisation From git at git.haskell.org Fri May 1 14:42:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 May 2015 14:42:24 +0000 (UTC) Subject: [commit: ghc] master: Move IP, Symbol, Nat to ghc-prim (2f6a0ac) Message-ID: <20150501144224.9DB963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f6a0ac7061c59ed68a6dd5a2243e3e690acbd5f/ghc >--------------------------------------------------------------- commit 2f6a0ac7061c59ed68a6dd5a2243e3e690acbd5f Author: Simon Peyton Jones Date: Fri May 1 15:05:11 2015 +0100 Move IP, Symbol, Nat to ghc-prim This motivation is to declare class IP much earlier (in ghc-prim), so that implicit parameters (which depend on IP) is available to library code, notably the 'error' function. * Move class IP from base:GHC.IP to ghc-prim:GHC.Classes * Delete module GHC.IP from base * Move types Symbol and Nat from base:GHC.TypeLits to ghc-prim:GHC.Types There was a name clash in GHC.RTS.Flags, where I renamed the local type Nat to RtsNat. >--------------------------------------------------------------- 2f6a0ac7061c59ed68a6dd5a2243e3e690acbd5f compiler/prelude/PrelNames.hs | 5 ++--- compiler/prelude/TysWiredIn.hs | 4 ++-- libraries/base/GHC/IP.hs | 19 ------------------- libraries/base/GHC/RTS/Flags.hsc | 26 +++++++++++++------------- libraries/base/GHC/TypeLits.hs | 10 ++-------- libraries/base/base.cabal | 1 - libraries/ghc-prim/GHC/Classes.hs | 21 +++++++++++++++++++-- libraries/ghc-prim/GHC/Types.hs | 8 ++++++++ testsuite/tests/ghci/scripts/T9181.stdout | 4 ++-- 9 files changed, 48 insertions(+), 50 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 2f6a0ac7061c59ed68a6dd5a2243e3e690acbd5f From git at git.haskell.org Mon May 4 14:41:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 May 2015 14:41:28 +0000 (UTC) Subject: [commit: ghc] master: Permit empty closed type families (4efa421) Message-ID: <20150504144128.CEA3D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4efa421327cf127ebefde59b2eece693e37dc3c6/ghc >--------------------------------------------------------------- commit 4efa421327cf127ebefde59b2eece693e37dc3c6 Author: Adam Gundry Date: Mon May 4 15:30:37 2015 +0100 Permit empty closed type families Fixes #9840 and #10306, and includes an alternative resolution to #8028. This permits empty closed type families, and documents them in the user guide. It updates the Haddock submodule to support the API change. Test Plan: Added `indexed-types/should_compile/T9840` and updated `indexed-types/should_fail/ClosedFam4` and `th/T8028`. Reviewers: austin, simonpj, goldfire Reviewed By: goldfire Subscribers: bgamari, jstolarek, thomie, goldfire Differential Revision: https://phabricator.haskell.org/D841 GHC Trac Issues: #9840, #10306 >--------------------------------------------------------------- 4efa421327cf127ebefde59b2eece693e37dc3c6 compiler/deSugar/DsMeta.hs | 14 ++++---- compiler/hsSyn/Convert.hs | 5 +-- compiler/hsSyn/HsDecls.hs | 15 +++++---- compiler/iface/IfaceSyn.hs | 33 ++++++++++--------- compiler/iface/MkIface.hs | 5 ++- compiler/iface/TcIface.hs | 4 +-- compiler/main/HscTypes.hs | 2 +- compiler/parser/Parser.y | 13 ++++---- compiler/prelude/TysPrim.hs | 2 +- compiler/rename/RnSource.hs | 6 ++-- compiler/typecheck/TcRnDriver.hs | 7 ++-- compiler/typecheck/TcSplice.hs | 17 +++++----- compiler/typecheck/TcTyClsDecls.hs | 37 ++++++++++++---------- compiler/types/FamInstEnv.hs | 2 +- compiler/types/TyCon.hs | 22 ++++++++----- docs/users_guide/glasgow_exts.xml | 14 +++++++- .../tests/indexed-types/should_compile/T9840.hs | 12 +++++++ .../indexed-types/should_compile/T9840.hs-boot | 10 ++++++ .../tests/indexed-types/should_compile/T9840a.hs | 10 ++++++ testsuite/tests/indexed-types/should_compile/all.T | 4 +++ .../tests/indexed-types/should_fail/ClosedFam4.hs | 0 .../indexed-types/should_fail/ClosedFam4.stderr | 2 +- testsuite/tests/th/T10306.hs | 14 ++++++++ testsuite/tests/th/T8028.hs | 12 ++++++- testsuite/tests/th/T8028.stderr | 4 --- testsuite/tests/th/TH_abstractFamily.hs | 11 +++++++ testsuite/tests/th/TH_abstractFamily.stderr | 5 +++ testsuite/tests/th/all.T | 5 ++- utils/haddock | 2 +- 29 files changed, 199 insertions(+), 90 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4efa421327cf127ebefde59b2eece693e37dc3c6 From git at git.haskell.org Mon May 4 22:16:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 May 2015 22:16:29 +0000 (UTC) Subject: [commit: ghc] master: Fix safeHaskell test for llvm backend (f7dfcef) Message-ID: <20150504221629.4E3CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7dfcef47af9bf33837e0af3d391c45d12f17677/ghc >--------------------------------------------------------------- commit f7dfcef47af9bf33837e0af3d391c45d12f17677 Author: Erik de Castro Lopo Date: Mon May 4 08:19:04 2015 +1000 Fix safeHaskell test for llvm backend Test was failing (could not execute: pgmlc) for arm (which uses the llvm backend) due to the `-pgmlc pgmlc` in OPTIONS_GHC. It was also failing on amd64 in the same way when `-fllvm` was added to the command line. Its safe to remove because the compiler should already know which llvm tool to use. Test Plan: validate Reviewers: dterei, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D874 >--------------------------------------------------------------- f7dfcef47af9bf33837e0af3d391c45d12f17677 testsuite/tests/safeHaskell/flags/Flags02.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/safeHaskell/flags/Flags02.hs b/testsuite/tests/safeHaskell/flags/Flags02.hs index 525064d..072d450 100644 --- a/testsuite/tests/safeHaskell/flags/Flags02.hs +++ b/testsuite/tests/safeHaskell/flags/Flags02.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -pgmlc pgmlc, -pgmdll pgmdll, -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} +{-# OPTIONS_GHC -pgmdll pgmdll, -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} -- | These are all flags that should be allowed module Flags02 where From git at git.haskell.org Mon May 4 22:16:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 May 2015 22:16:32 +0000 (UTC) Subject: [commit: ghc] master: arm: Force non-executable stack (#10369) (63a10bb) Message-ID: <20150504221632.0B7413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63a10bbc42492c58feb377d79e05a185e6efcd5a/ghc >--------------------------------------------------------------- commit 63a10bbc42492c58feb377d79e05a185e6efcd5a Author: Erik de Castro Lopo Date: Fri May 1 20:33:03 2015 +1000 arm: Force non-executable stack (#10369) Test `T703` was found to be failing on arm/linux. The solution was to add a linker flag to explicitly set the stack to non-executable. Signed-off-by: Erik de Castro Lopo Test Plan: validate on x86_64 and arm linux Reviewers: ezyang, rwbarton, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D875 GHC Trac Issues: #10369 >--------------------------------------------------------------- 63a10bbc42492c58feb377d79e05a185e6efcd5a aclocal.m4 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index d6352cf..bb46fda 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -570,7 +570,8 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], # On arm/linux, aarch64/linux, arm/android and aarch64/android, tell # gcc to link using the gold linker. # Forcing LD to be ld.gold is done in FIND_LD m4 macro. - $3="$$3 -fuse-ld=gold" + $3="$$3 -fuse-ld=gold -Wl,-z,noexecstack" + $4="$$4 -z,noexecstack" ;; esac From git at git.haskell.org Mon May 4 22:20:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 May 2015 22:20:08 +0000 (UTC) Subject: [commit: ghc] master: Give a hint when a TH splice has a bad package key, partially fixes #10279 (bf4f3e6) Message-ID: <20150504222008.E968F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bf4f3e653407d02593a69618fb199b2e2d529c92/ghc >--------------------------------------------------------------- commit bf4f3e653407d02593a69618fb199b2e2d529c92 Author: Edward Z. Yang Date: Mon Apr 20 14:02:36 2015 -0700 Give a hint when a TH splice has a bad package key, partially fixes #10279 Previously, if we got a package key in our splice, we'd give a very unhelpful error message saying we couldn't find a package 'base-4.7.0.1', despite there being a package with that source package ID. Really, we couldn't find a package with that *key*, so clarify, and also tell the user what the real package key is. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- bf4f3e653407d02593a69618fb199b2e2d529c92 compiler/main/Finder.hs | 16 ++++++++++++++-- testsuite/tests/th/T10279.hs | 10 ++++++++++ testsuite/tests/th/T10279.stderr | 8 ++++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 33 insertions(+), 2 deletions(-) diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs index ac17fd2..d8aef57 100644 --- a/compiler/main/Finder.hs +++ b/compiler/main/Finder.hs @@ -577,8 +577,8 @@ cantFindErr cannot_find _ dflags mod_name find_result more_info = case find_result of NoPackage pkg - -> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+> - ptext (sLit "was found") + -> ptext (sLit "no package key matching") <+> quotes (ppr pkg) <+> + ptext (sLit "was found") $$ looks_like_srcpkgid pkg NotFound { fr_paths = files, fr_pkg = mb_pkg , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens @@ -640,6 +640,18 @@ cantFindErr cannot_find _ dflags mod_name find_result ptext (sLit "to the build-depends in your .cabal file.") | otherwise = Outputable.empty + looks_like_srcpkgid :: PackageKey -> SDoc + looks_like_srcpkgid pk + -- Unsafely coerce a package key FastString into a source package ID + -- FastString and see if it means anything. + | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (packageKeyFS pk)) + = parens (text "This package key looks like the source package ID;" $$ + text "the real package key is" <+> quotes (ftext (packageKeyFS (packageKey pkg))) $$ + (if null pkgs then Outputable.empty + else text "and" <+> int (length pkgs) <+> text "other candidates")) + -- Todo: also check if it looks like a package name! + | otherwise = Outputable.empty + mod_hidden pkg = ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg) diff --git a/testsuite/tests/th/T10279.hs b/testsuite/tests/th/T10279.hs new file mode 100644 index 0000000..fbc2dbb --- /dev/null +++ b/testsuite/tests/th/T10279.hs @@ -0,0 +1,10 @@ +module T10279 where +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +-- NB: rts-1.0 is used here because it doesn't change. +-- You do need to pick the right version number, otherwise the +-- error message doesn't recognize it as a source package ID, +-- (This is OK, since it will look obviously wrong when they +-- try to find the package in their package database.) +blah = $(conE (Name (mkOccName "Foo") (NameG VarName (mkPkgName "rts-1.0") (mkModName "A")))) diff --git a/testsuite/tests/th/T10279.stderr b/testsuite/tests/th/T10279.stderr new file mode 100644 index 0000000..c5f7834 --- /dev/null +++ b/testsuite/tests/th/T10279.stderr @@ -0,0 +1,8 @@ + +T10279.hs:10:10: error: + Failed to load interface for ?A? + no package key matching ?rts-1.0? was found + (This package key looks like the source package ID; + the real package key is ?rts?) + In the expression: (rts-1.0:A.Foo) + In an equation for ?blah?: blah = (rts-1.0:A.Foo) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index b7c2419..dda8274 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -360,6 +360,7 @@ test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624']) test('TH_Lift', normal, compile, ['-v0']) test('T10047', normal, ghci_script, ['T10047.script']) test('T10019', normal, ghci_script, ['T10019.script']) +test('T10279', normal, compile_fail, ['-v0']) test('T10306', normal, compile, ['-v0']) test('TH_abstractFamily', normal, compile_fail, ['']) From git at git.haskell.org Mon May 4 22:30:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 May 2015 22:30:53 +0000 (UTC) Subject: [commit: ghc] master: Documentation for Language.Haskell.TH.Quote. (cdba973) Message-ID: <20150504223053.22BFA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cdba9732179502652eaa001b01a5d2a330f63c5f/ghc >--------------------------------------------------------------- commit cdba9732179502652eaa001b01a5d2a330f63c5f Author: Edward Z. Yang Date: Fri Apr 17 12:24:33 2015 +0100 Documentation for Language.Haskell.TH.Quote. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D850 >--------------------------------------------------------------- cdba9732179502652eaa001b01a5d2a330f63c5f .../template-haskell/Language/Haskell/TH/Quote.hs | 48 ++++++++++++++++++---- 1 file changed, 41 insertions(+), 7 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Quote.hs b/libraries/template-haskell/Language/Haskell/TH/Quote.hs index 618906d..39cd2ba 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Quote.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Quote.hs @@ -1,4 +1,18 @@ {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} +{- | +Module : Language.Haskell.TH.Quote +Description : Quasi-quoting support for Template Haskell + +Template Haskell supports quasiquoting, which permits users to construct +program fragments by directly writing concrete syntax. A quasiquoter is +essentially a function with takes a string to a Template Haskell AST. +This module defines the 'QuasiQuoter' datatype, which specifies a +quasiquoter @q@ which can be invoked using the syntax +@[q| ... string to parse ... |]@ when the @QuasiQuotes@ language +extension is enabled, and some utility functions for manipulating +quasiquoters. Nota bene: this package does not define any parsers, +that is up to you. +-} module Language.Haskell.TH.Quote( QuasiQuoter(..), dataToQa, dataToExpQ, dataToPatQ, @@ -9,11 +23,28 @@ import Data.Data import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax -data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp, - quotePat :: String -> Q Pat, - quoteType :: String -> Q Type, - quoteDec :: String -> Q [Dec] } +-- | The 'QuasiQuoter' type, a value @q@ of this type can be used +-- in the syntax @[q| ... string to parse ...|]@. In fact, for +-- convenience, a 'QuasiQuoter' actually defines multiple quasiquoters +-- to be used in different splice contexts; if you are only interested +-- in defining a quasiquoter to be used for expressions, you would +-- define a 'QuasiQuoter' with only 'quoteExp', and leave the other +-- fields stubbed out with errors. +data QuasiQuoter = QuasiQuoter { + -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@ + quoteExp :: String -> Q Exp, + -- | Quasi-quoter for patterns, invoked by quotes like @f $[q|...] = rhs@ + quotePat :: String -> Q Pat, + -- | Quasi-quoter for types, invoked by quotes like @f :: $[q|...]@ + quoteType :: String -> Q Type, + -- | Quasi-quoter for declarations, invoked by top-level quotes + quoteDec :: String -> Q [Dec] + } +-- | 'dataToQa' is a generic utility function for constructing generic +-- conversion functions from types with 'Data' instances to various +-- quasi-quoting representations. It's used by 'dataToExpQ' and +-- 'dataToPatQ' dataToQa :: forall a k q. Data a => (Name -> k) -> (Lit -> Q q) @@ -55,8 +86,10 @@ dataToQa mkCon mkLit appCon antiQ t = Just y -> y --- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same --- value. It takes a function to handle type-specific cases. +-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the +-- same value, in the SYB style. It is generalized to take a function +-- override type-specific cases; a useful default is 'const Nothing' +-- for no overriding. dataToExpQ :: Data a => (forall b . Data b => b -> Maybe (Q Exp)) -> a @@ -64,7 +97,8 @@ dataToExpQ :: Data a dataToExpQ = dataToQa conE litE (foldl appE) -- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same --- value. It takes a function to handle type-specific cases. +-- value, in the SYB style. It takes a function to handle type-specific cases, +-- alternatively, pass @const Nothing@ to get default behavior. dataToPatQ :: Data a => (forall b . Data b => b -> Maybe (Q Pat)) -> a From git at git.haskell.org Tue May 5 02:50:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 May 2015 02:50:20 +0000 (UTC) Subject: [commit: ghc] master: arm: Force non-executable stack (part 2) (1a4374c) Message-ID: <20150505025020.959543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a4374c1e246d81a5c1d00a720919804093a8241/ghc >--------------------------------------------------------------- commit 1a4374c1e246d81a5c1d00a720919804093a8241 Author: Erik de Castro Lopo Date: Mon May 4 23:39:31 2015 +0000 arm: Force non-executable stack (part 2) This was supposed to be part of commit 63a10bbc42 but I pushed from the wrong machine. This fixes cross compiling to arm. Signed-off-by: Erik de Castro Lopo >--------------------------------------------------------------- 1a4374c1e246d81a5c1d00a720919804093a8241 aclocal.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index bb46fda..590edb0 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -571,7 +571,7 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], # gcc to link using the gold linker. # Forcing LD to be ld.gold is done in FIND_LD m4 macro. $3="$$3 -fuse-ld=gold -Wl,-z,noexecstack" - $4="$$4 -z,noexecstack" + $4="$$4 -z noexecstack" ;; esac From git at git.haskell.org Tue May 5 17:35:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 May 2015 17:35:25 +0000 (UTC) Subject: [commit: ghc] master: Doc: checkCrossStageLifting, RnSplice/TcExpr is untyped/typed brackets (#10384) (341a766) Message-ID: <20150505173525.8B7803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/341a76641426a452fc27d3b9383945b9744c600a/ghc >--------------------------------------------------------------- commit 341a76641426a452fc27d3b9383945b9744c600a Author: Edward Z. Yang Date: Tue May 5 10:34:33 2015 -0700 Doc: checkCrossStageLifting, RnSplice/TcExpr is untyped/typed brackets (#10384) Clarify that repeated checkCrossStageLifting in RnSplice/TcExpr check untyped/typed brackets, respectively. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 341a76641426a452fc27d3b9383945b9744c600a compiler/rename/RnSplice.hs | 3 +++ compiler/typecheck/TcExpr.hs | 11 +++++++---- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 930cea3..a20640b 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -595,6 +595,9 @@ checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM () -- Now we must check whether there's a cross-stage lift to do -- Examples \x -> [| x |] -- [| map |] +-- +-- This code is similar to checkCrossStageLifting in TcExpr, but +-- this is only run on *untyped* brackets. checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var)) | isTopLevel top_lvl diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 67b60c5..3fc5cf2 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1254,15 +1254,18 @@ checkThLocalId id -------------------------------------- checkCrossStageLifting :: Id -> ThStage -> TcM () --- If we are inside brackets, and (use_lvl > bind_lvl) +-- If we are inside typed brackets, and (use_lvl > bind_lvl) -- we must check whether there's a cross-stage lift to do --- Examples \x -> [| x |] --- [| map |] +-- Examples \x -> [|| x ||] +-- [|| map ||] -- There is no error-checking to do, because the renamer did that +-- +-- This is similar to checkCrossStageLifting in RnSplice, but +-- this code is applied to *typed* brackets. checkCrossStageLifting id (Brack _ (TcPending ps_var lie_var)) = -- Nested identifiers, such as 'x' in - -- E.g. \x -> [| h x |] + -- E.g. \x -> [|| h x ||] -- We must behave as if the reference to x was -- h $(lift x) -- We use 'x' itself as the splice proxy, used by From git at git.haskell.org Wed May 6 12:52:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:52:47 +0000 (UTC) Subject: [commit: ghc] master: Normalise type families in the type of an expression (f7daf5a) Message-ID: <20150506125247.ED5253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7daf5afe2ba4f60f60245fa82306b89a272ffa8/ghc >--------------------------------------------------------------- commit f7daf5afe2ba4f60f60245fa82306b89a272ffa8 Author: Christiaan Baaij Date: Wed May 6 07:46:00 2015 -0500 Normalise type families in the type of an expression Before, the type of an expression, and the type of a variable binding that expression used to be different in GHCi. The reason being that types of bound variables were already normalised. Now, both are normalised. This implements the suggestions as given in Trac #10321 Also adds an expected output for test T10321 Reviewed By: goldfire, simonpj Differential Revision: https://phabricator.haskell.org/D870 GHC Trac Issues: #10321 >--------------------------------------------------------------- f7daf5afe2ba4f60f60245fa82306b89a272ffa8 compiler/typecheck/TcRnDriver.hs | 10 +++++++++- testsuite/tests/ghci/scripts/T10321.stdout | 1 + testsuite/tests/ghci/scripts/all.T | 2 +- 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 311f7c8..30cd8fd 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1777,7 +1777,15 @@ tcRnExpr hsc_env rdr_expr _ <- simplifyInteractive (andWC stWC lie_top) ; let { all_expr_ty = mkForAllTys qtvs (mkPiTypes dicts res_ty) } ; - zonkTcType all_expr_ty + ty <- zonkTcType all_expr_ty ; + + -- We normalise type families, so that the type of an expression is the + -- same as of a bound expression (TcBinds.mkInferredPolyId). See Trac + -- #10321 for further discussion. + fam_envs <- tcGetFamInstEnvs ; + -- normaliseType returns a coercion which we discard, so the Role is + -- irrelevant + return (snd (normaliseType fam_envs Nominal ty)) } -------------------------- diff --git a/testsuite/tests/ghci/scripts/T10321.stdout b/testsuite/tests/ghci/scripts/T10321.stdout new file mode 100644 index 0000000..d74ca95 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10321.stdout @@ -0,0 +1 @@ +3 :> 4 :> 5 :> Nil :: Num a => Vec 3 a diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index c562903..e25c7ec 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -210,4 +210,4 @@ test('T10122', normal, ghci_script, ['T10122.script']) test('T10322', when(opsys('darwin'), expect_broken(10322)), ghci_script, ['T10322.script']) -test('T10321', expect_broken(10321), ghci_script, ['T10321.script']) +test('T10321', normal, ghci_script, ['T10321.script']) From git at git.haskell.org Wed May 6 12:52:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:52:50 +0000 (UTC) Subject: [commit: ghc] master: Fix typo: identifer -> identifier (458a97b) Message-ID: <20150506125250.DF63F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/458a97b86ad154812d08e0fe3548b88ac8412b4f/ghc >--------------------------------------------------------------- commit 458a97b86ad154812d08e0fe3548b88ac8412b4f Author: Vikraman Choudhury Date: Wed May 6 07:46:28 2015 -0500 Fix typo: identifer -> identifier I noticed this typo while using template haskell. Signed-off-by: Vikraman Choudhury Test Plan: ``` ?> :set -XTemplateHaskell ?> :m +Language.Haskell.TH ?> data Foo = Foo ?> $(conE ''Foo) :9:9: Type constructor ?Foo? used where a value identifier was expected In the expression: Foo In an equation for ?f?: f = Foo ``` Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D871 >--------------------------------------------------------------- 458a97b86ad154812d08e0fe3548b88ac8412b4f compiler/typecheck/TcExpr.hs | 2 +- testsuite/tests/rename/should_compile/rn040.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 3fc5cf2..353b2b7 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1109,7 +1109,7 @@ tc_infer_id orig id_name PatSynCon ps -> tcPatSynBuilderOcc orig ps _ -> failWithTc $ - ppr thing <+> ptext (sLit "used where a value identifer was expected") } + ppr thing <+> ptext (sLit "used where a value identifier was expected") } where inst_normal_id id = do { (wrap, rho) <- deeplyInstantiate orig (idType id) diff --git a/testsuite/tests/rename/should_compile/rn040.hs b/testsuite/tests/rename/should_compile/rn040.hs index 3a74abe..2ad49e1 100644 --- a/testsuite/tests/rename/should_compile/rn040.hs +++ b/testsuite/tests/rename/should_compile/rn040.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fwarn-unused-binds #-} module ShouldCompile where --- !!! should produce warnings about unused identifers +-- !!! should produce warnings about unused identifiers x :: [()] x = [ () | y <- [] ] From git at git.haskell.org Wed May 6 12:52:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:52:53 +0000 (UTC) Subject: [commit: ghc] master: Retain ic_monad and ic_int_print from external packages after load (03c4893) Message-ID: <20150506125253.D5CF83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/03c4893e355948fe865bc52c744359c42e4b06d7/ghc >--------------------------------------------------------------- commit 03c4893e355948fe865bc52c744359c42e4b06d7 Author: watashi Date: Wed May 6 07:47:04 2015 -0500 Retain ic_monad and ic_int_print from external packages after load Retain ic_monad and ic_int_print in InteractiveContext after load when they are defined in external packages. This is supposed to be the desired behavior that the interactive-print and setGHCiMonad will survive after :cd, :add, :load, :reload and :set in GHCi. Test Plan: Install a interactive-print function and GHCi monad from extenal pacakge. Try :cd, :load and other commands, make sure that the interactive-print function and GHCi monad always keep the same. Reviewed By: simonmar Differential Revision: https://phabricator.haskell.org/D867 >--------------------------------------------------------------- 03c4893e355948fe865bc52c744359c42e4b06d7 compiler/basicTypes/Name.hs | 13 ++++++++++++- compiler/main/GhcMake.hs | 26 ++++++++++++++++++++------ compiler/typecheck/TcRnDriver.hs | 11 +---------- 3 files changed, 33 insertions(+), 17 deletions(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 80b7cc8..88b6e68 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -61,7 +61,7 @@ module Name ( isValName, isVarName, isWiredInName, isBuiltInSyntax, wiredInNameTyThing_maybe, - nameIsLocalOrFrom, nameIsHomePackageImport, + nameIsLocalOrFrom, nameIsHomePackageImport, nameIsFromExternalPackage, stableNameCmp, -- * Class 'NamedThing' and overloaded friends @@ -256,6 +256,17 @@ nameIsHomePackageImport this_mod where this_pkg = modulePackageKey this_mod +-- | Returns True if the Name comes from some other package: neither this +-- pacakge nor the interactive package. +nameIsFromExternalPackage :: PackageKey -> Name -> Bool +nameIsFromExternalPackage this_pkg name + | Just mod <- nameModule_maybe name + , modulePackageKey mod /= this_pkg -- Not this package + , not (isInteractiveModule mod) -- Not the 'interactive' package + = True + | otherwise + = False + isTyVarName :: Name -> Bool isTyVarName name = isTvOcc (nameOccName name) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 7d44704..7dcf379 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -47,6 +47,7 @@ import Digraph import Exception ( tryIO, gbracket, gfinally ) import FastString import Maybes ( expectJust ) +import Name import MonadUtils ( allM, MonadIO ) import Outputable import Panic @@ -139,12 +140,12 @@ data LoadHowMuch -- possible. Depending on the target (see 'DynFlags.hscTarget') compilating -- and loading may result in files being created on disk. -- --- Calls the 'reportModuleCompilationResult' callback after each compiling --- each module, whether successful or not. +-- Calls the 'defaultWarnErrLogger' after each compiling each module, whether +-- successful or not. -- -- Throw a 'SourceError' if errors are encountered before the actual -- compilation starts (e.g., during dependency analysis). All other errors --- are reported using the callback. +-- are reported using the 'defaultWarnErrLogger'. -- load :: GhcMonad m => LoadHowMuch -> m SuccessFlag load how_much = do @@ -208,7 +209,7 @@ load how_much = do -- before we unload anything, make sure we don't leave an old -- interactive context around pointing to dead bindings. Also, -- write the pruned HPT to allow the old HPT to be GC'd. - modifySession $ \_ -> discardIC $ hsc_env { hsc_HPT = pruned_hpt } + setSession $ discardIC $ hsc_env { hsc_HPT = pruned_hpt } liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$ text "Stable BCO:" <+> ppr stable_bco) @@ -392,10 +393,23 @@ discardProg hsc_env = discardIC $ hsc_env { hsc_mod_graph = emptyMG , hsc_HPT = emptyHomePackageTable } --- | Discard the contents of the InteractiveContext, but keep the DynFlags +-- | Discard the contents of the InteractiveContext, but keep the DynFlags. +-- It will also keep ic_int_print and ic_monad if their names are from +-- external packages. discardIC :: HscEnv -> HscEnv discardIC hsc_env - = hsc_env { hsc_IC = emptyInteractiveContext (ic_dflags (hsc_IC hsc_env)) } + = hsc_env { hsc_IC = new_ic { ic_int_print = keep_external_name ic_int_print + , ic_monad = keep_external_name ic_monad } } + where + dflags = ic_dflags old_ic + old_ic = hsc_IC hsc_env + new_ic = emptyInteractiveContext dflags + keep_external_name ic_name + | nameIsFromExternalPackage this_pkg old_name = old_name + | otherwise = ic_name new_ic + where + this_pkg = thisPackage dflags + old_name = ic_name old_ic intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO () intermediateCleanTempFiles dflags summaries hsc_env diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 30cd8fd..ec22699 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2027,20 +2027,11 @@ loadUnqualIfaces hsc_env ictxt unqual_mods = [ nameModule name | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt) , let name = gre_name gre - , from_external_package name + , nameIsFromExternalPackage this_pkg name , isTcOcc (nameOccName name) -- Types and classes only , unQualOK gre ] -- In scope unqualified doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified") - from_external_package name -- True <=> the Name comes from some other package - -- (not the home package, not the interactive package) - | Just mod <- nameModule_maybe name - , modulePackageKey mod /= this_pkg -- Not the home package - , not (isInteractiveModule mod) -- Not the 'interactive' package - = True - | otherwise - = False - {- ************************************************************************ From git at git.haskell.org Wed May 6 12:52:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:52:57 +0000 (UTC) Subject: [commit: ghc] master: rts: add "-no-rtsopts-suggestions" option (477f514) Message-ID: <20150506125257.D25623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/477f514f6ebcf783810da93e2191e4b6ea65559b/ghc >--------------------------------------------------------------- commit 477f514f6ebcf783810da93e2191e4b6ea65559b Author: Javran Cheng Date: Wed May 6 07:47:20 2015 -0500 rts: add "-no-rtsopts-suggestions" option Depends on D767 Setting this flag prevents RTS from giving RTS suggestions like "Use `+RTS -Ksize -RTS' to increase it." According to the comment @rwbarton made in #9579, sometimes "+RTS" suggestions don't make sense (e.g. when the program is precompiled and installed through package managers), we can encourage people to distribute binaries with either "-no-rtsopts-suggestions" or "-rtsopts". Reviewed By: erikd, austin Differential Revision: https://phabricator.haskell.org/D809 GHC Trac Issues: #9579 >--------------------------------------------------------------- 477f514f6ebcf783810da93e2191e4b6ea65559b compiler/main/DriverPipeline.hs | 4 ++ compiler/main/DynFlags.hs | 4 ++ docs/users_guide/flags.xml | 8 +++ docs/users_guide/phases.xml | 21 ++++++++ includes/RtsAPI.h | 3 ++ rts/ProfHeap.c | 14 ++--- rts/RtsFlags.c | 1 + rts/hooks/OutOfHeap.c | 33 +++++++----- rts/hooks/StackOverflow.c | 19 ++++--- testsuite/tests/rts/T5644/T5644.stderr | 4 +- testsuite/tests/rts/T9579/.gitignore | 2 + testsuite/tests/rts/T9579/Makefile | 36 ++++++++----- .../tests/rts/T9579/T9579_outofheap_rtsall.stderr | 4 +- .../T9579_outofheap_rtsall_no_suggestions.stderr | 2 + .../tests/rts/T9579/T9579_outofheap_rtsnone.stderr | 4 +- .../tests/rts/T9579/T9579_outofheap_rtssome.stderr | 4 +- .../rts/T9579/T9579_stackoverflow_rtsall.stderr | 4 +- ...9579_stackoverflow_rtsall_no_suggestions.stderr | 1 + .../rts/T9579/T9579_stackoverflow_rtsnone.stderr | 4 +- .../rts/T9579/T9579_stackoverflow_rtssome.stderr | 4 +- testsuite/tests/rts/T9579/all.T | 59 +++++++++++++++++----- testsuite/tests/rts/outofmem.stderr | 2 +- .../tests/rts/outofmem.stderr-i386-unknown-mingw32 | 2 +- testsuite/tests/rts/outofmem2.stderr | 4 +- testsuite/tests/rts/overflow1.stderr | 3 +- testsuite/tests/rts/overflow2.stderr | 3 +- testsuite/tests/rts/overflow3.stderr | 3 +- .../tests/simplCore/should_run/simplrun010.stderr | 4 +- 28 files changed, 182 insertions(+), 74 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 477f514f6ebcf783810da93e2191e4b6ea65559b From git at git.haskell.org Wed May 6 12:53:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:53:00 +0000 (UTC) Subject: [commit: ghc] master: base: Fix confusing docs typo (fa0474d) Message-ID: <20150506125300.E94293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa0474da6954a3e57785fe703acc83e2fecef88f/ghc >--------------------------------------------------------------- commit fa0474da6954a3e57785fe703acc83e2fecef88f Author: Alexander Berntsen Date: Wed May 6 07:52:29 2015 -0500 base: Fix confusing docs typo Signed-off-by: Alexander Berntsen Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D872 >--------------------------------------------------------------- fa0474da6954a3e57785fe703acc83e2fecef88f libraries/base/Data/Traversable.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index aaea44b..cc72392 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -145,10 +145,9 @@ import qualified GHC.List as List ( foldr ) class (Functor t, Foldable t) => Traversable t where {-# MINIMAL traverse | sequenceA #-} - -- | Map each element of a structure to an action, evaluate these - -- these actions from left to right, and collect the results. - -- actions from left to right, and collect the results. For a - -- version that ignores the results see 'Data.Foldable.traverse_'. + -- | Map each element of a structure to an action, evaluate these actions + -- from left to right, and collect the results. For a version that ignores + -- the results see 'Data.Foldable.traverse_'. traverse :: Applicative f => (a -> f b) -> t a -> f (t b) traverse f = sequenceA . fmap f From git at git.haskell.org Wed May 6 12:57:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:57:21 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Make sure GHC.List.last is memory-efficient (7ea4e24) Message-ID: <20150506125721.AF81E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/7ea4e243b8a204cc2fff813249851e5242b40daf/ghc >--------------------------------------------------------------- commit 7ea4e243b8a204cc2fff813249851e5242b40daf Author: Joachim Breitner Date: Thu Apr 16 14:49:23 2015 +0200 Make sure GHC.List.last is memory-efficient by eta-expanding its definition so that GHC optmizes the foldl here. Also make sure that other uses of last go via foldl as well, to allow list fusion (tested in T9339). Fixes #10260. (cherry picked from commit 524ddbdad5816f77b7b719cac0671eebd3473616) >--------------------------------------------------------------- 7ea4e243b8a204cc2fff813249851e5242b40daf libraries/base/GHC/List.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index a712f9e..fcc89d3 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -84,8 +84,15 @@ last [x] = x last (_:xs) = last xs last [] = errorEmptyList "last" #else --- use foldl to allow fusion -last = foldl (\_ x -> x) (errorEmptyList "last") +-- Use foldl to make last a good consumer. +-- This will compile to good code for the actual GHC.List.last. +-- (At least as long it is eta-expaned, otherwise it does not, #10260.) +last xs = foldl (\_ x -> x) lastError xs +{-# INLINE last #-} +-- The inline pragma is required to make GHC remember the implementation via +-- foldl. +lastError :: a +lastError = errorEmptyList "last" #endif -- | Return all the elements of a list except the last one. From git at git.haskell.org Wed May 6 12:57:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:57:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix fundep coverage-condition check for poly-kinds (d5c0892) Message-ID: <20150506125725.038CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d5c089208735014a09d43b1ee757f52ddbfc92bf/ghc >--------------------------------------------------------------- commit d5c089208735014a09d43b1ee757f52ddbfc92bf Author: Simon Peyton Jones Date: Wed Apr 15 10:28:40 2015 +0100 Fix fundep coverage-condition check for poly-kinds See Note [Closing over kinds in coverage] in FunDeps. I'd already fixed this bug once, for Trac #8391, but I put the call to closeOverKinds in the wrong place, so Trac #10109 failed. (It checks the /liberal/ coverage condition, which The fix was easy: move the call to the right place! (cherry picked from commit 49d9b009a2affb6015b8f6e2f15e4660a53c0d9a) >--------------------------------------------------------------- d5c089208735014a09d43b1ee757f52ddbfc92bf compiler/typecheck/FunDeps.hs | 9 +++++---- testsuite/tests/typecheck/should_compile/T10109.hs | 10 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs index a55fa2e..a6e5552 100644 --- a/compiler/typecheck/FunDeps.hs +++ b/compiler/typecheck/FunDeps.hs @@ -395,11 +395,12 @@ checkInstCoverage be_liberal clas theta inst_taus = NotValid msg where (ls,rs) = instFD fd tyvars inst_taus - ls_tvs = closeOverKinds (tyVarsOfTypes ls) -- See Note [Closing over kinds in coverage] + ls_tvs = tyVarsOfTypes ls rs_tvs = tyVarsOfTypes rs - conservative_ok = rs_tvs `subVarSet` ls_tvs - liberal_ok = rs_tvs `subVarSet` oclose theta ls_tvs + conservative_ok = rs_tvs `subVarSet` closeOverKinds ls_tvs + liberal_ok = rs_tvs `subVarSet` closeOverKinds (oclose theta ls_tvs) + -- closeOverKinds: see Note [Closing over kinds in coverage] msg = vcat [ sep [ ptext (sLit "The") <+> ppWhen be_liberal (ptext (sLit "liberal")) @@ -432,7 +433,7 @@ Example (Trac #8391), using liberal coverage instance Bar a (Foo a) In the instance decl, (a:k) does fix (Foo k a), but only if we notice -that (a:k) fixes k. +that (a:k) fixes k. Trac #10109 is another example. Note [The liberal coverage condition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/typecheck/should_compile/T10109.hs b/testsuite/tests/typecheck/should_compile/T10109.hs new file mode 100644 index 0000000..a61b2bc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10109.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FunctionalDependencies, + UndecidableInstances, FlexibleInstances #-} + +module T10109 where + +data Succ a + +class Add (a :: k1) (b :: k2) (ab :: k3) | a b -> ab +instance (Add a b ab) => Add (Succ a) b (Succ ab) + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index de13ee3..e23f67c 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -442,3 +442,4 @@ test('T10031', normal, compile, ['']) test('T10072', normal, compile_fail, ['']) test('T10177', normal, compile, ['']) test('T10195', normal, compile, ['']) +test('T10109', normal, compile, ['']) From git at git.haskell.org Wed May 6 12:57:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:57:27 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Use the gold linker for aarch64/linux (#9673) (96c99d5) Message-ID: <20150506125727.C16893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/96c99d5cb38e16c7b81b5efc73caedd174e4e4bd/ghc >--------------------------------------------------------------- commit 96c99d5cb38e16c7b81b5efc73caedd174e4e4bd Author: Erik de Castro Lopo Date: Mon Apr 20 20:22:44 2015 +0000 Use the gold linker for aarch64/linux (#9673) Like 32 bit Arm, Aarch64 requires use of the gold linker. Signed-off-by: Erik de Castro Lopo Test Plan: 'make install' on aarch64, validate elsewhere Reviewers: rwbarton, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D858 GHC Trac Issues: #9673 (cherry picked from commit 0bbc2ac6dae9ce2838f23a75a6a989826c06f3f5) >--------------------------------------------------------------- 96c99d5cb38e16c7b81b5efc73caedd174e4e4bd aclocal.m4 | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index 63e21e5..c08a28e 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -565,9 +565,11 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], $3="$$3 -D_HPUX_SOURCE" $5="$$5 -D_HPUX_SOURCE" ;; - arm*linux*) - # On arm/linux and arm/android, tell gcc to link using the gold linker. - # Forcing LD to be ld.gold is done in configre.ac. + arm*linux* | \ + aarch64*linux* ) + # On arm/linux, aarch64/linux, arm/android and aarch64/android, tell + # gcc to link using the gold linker. + # Forcing LD to be ld.gold is done in FIND_LD m4 macro. $3="$$3 -fuse-ld=gold" ;; esac @@ -2123,10 +2125,12 @@ AC_DEFUN([FIND_LLVM_PROG],[ AC_DEFUN([FIND_LD],[ FP_ARG_WITH_PATH_GNU_PROG([LD], [ld], [ld]) case $target in - arm*linux*) - # Arm requires use of the binutils ld.gold linker. - # This case should catch at least arm-unknown-linux-gnueabihf and - # arm-linux-androideabi. + arm*linux* | \ + aarch64*linux* ) + # Arm and Aarch64 requires use of the binutils ld.gold linker. + # This case should catch at least arm-unknown-linux-gnueabihf, + # arm-linux-androideabi, arm64-unknown-linux and + # aarch64-linux-android FP_ARG_WITH_PATH_GNU_PROG([LD_GOLD], [ld.gold], [ld.gold]) $1="$LD_GOLD" ;; From git at git.haskell.org Wed May 6 12:57:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:57:30 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: arm: Force non-executable stack (#10369) (2d3d0cd) Message-ID: <20150506125730.9BD6A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2d3d0cd8a33b566c5c6263ee81442c0ef3c68785/ghc >--------------------------------------------------------------- commit 2d3d0cd8a33b566c5c6263ee81442c0ef3c68785 Author: Erik de Castro Lopo Date: Fri May 1 20:33:03 2015 +1000 arm: Force non-executable stack (#10369) Test `T703` was found to be failing on arm/linux. The solution was to add a linker flag to explicitly set the stack to non-executable. Signed-off-by: Erik de Castro Lopo Test Plan: validate on x86_64 and arm linux Reviewers: ezyang, rwbarton, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D875 GHC Trac Issues: #10369 (cherry picked from commit 63a10bbc42492c58feb377d79e05a185e6efcd5a) >--------------------------------------------------------------- 2d3d0cd8a33b566c5c6263ee81442c0ef3c68785 aclocal.m4 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index c08a28e..b275460 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -570,7 +570,8 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], # On arm/linux, aarch64/linux, arm/android and aarch64/android, tell # gcc to link using the gold linker. # Forcing LD to be ld.gold is done in FIND_LD m4 macro. - $3="$$3 -fuse-ld=gold" + $3="$$3 -fuse-ld=gold -Wl,-z,noexecstack" + $4="$$4 -z,noexecstack" ;; esac From git at git.haskell.org Wed May 6 12:57:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 12:57:33 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Teach DmdAnal that coercions are value arguments! (354f506) Message-ID: <20150506125733.82EE43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/354f5063bac6a91d06f5e37777d594b3140dc668/ghc >--------------------------------------------------------------- commit 354f5063bac6a91d06f5e37777d594b3140dc668 Author: Simon Peyton Jones Date: Mon Apr 20 15:43:32 2015 +0100 Teach DmdAnal that coercions are value arguments! The demand analyser was treating coercion args like type args, which meant that the arguments in a strictness signature got out of step with the arguments of a call. Result chaos and disaster. Trac #10288 showed it up. It's hard to get this bug to show up in practice because - functions abstracted over coercions are usually abstracted over *boxed* coercions - we don't currently unbox a boxed-coercion arg because it's GADT (I see how to fix this too) But after floating, optimisation, and so on, Trac #10288 did get a function abstracted over an unboxed coercion, and then the -flate-dmd-anal pass went wrong. I don't think I can come up with a test case, but I don't think it matters too much. Still to come - Fix a second bug, namely that coercion variables are wrongly marked as absent because DmdAnal doesn't check the the free variables of casts. I think this never bites in practice (see the follow-up commit) - Make GADT products work with strictness analysis (cherry picked from commit d5773a4939b1feea51ec0db6624c9462751e948a) >--------------------------------------------------------------- 354f5063bac6a91d06f5e37777d594b3140dc668 compiler/stranal/DmdAnal.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index c0ce1a7..b45fc2b 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -164,15 +164,13 @@ dmdAnal' env dmd (App fun (Type ty)) where (fun_ty, fun') = dmdAnal env dmd fun -dmdAnal' sigs dmd (App fun (Coercion co)) - = (fun_ty, App fun' (Coercion co)) - where - (fun_ty, fun') = dmdAnal sigs dmd fun - -- Lots of the other code is there to make this -- beautiful, compositional, application rule :-) -dmdAnal' env dmd (App fun arg) -- Non-type arguments - = let -- [Type arg handled above] +dmdAnal' env dmd (App fun arg) + = -- This case handles value arguments (type args handled above) + -- Crucially, coercions /are/ handled here, because they are + -- value arguments (Trac #10288) + = let call_dmd = mkCallDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty From git at git.haskell.org Wed May 6 13:02:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 13:02:14 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix typo: identifer -> identifier (6f31e97) Message-ID: <20150506130214.52DB13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/6f31e975aa571daeb5568cafbf8e468545d4ad4f/ghc >--------------------------------------------------------------- commit 6f31e975aa571daeb5568cafbf8e468545d4ad4f Author: Vikraman Choudhury Date: Wed May 6 07:46:28 2015 -0500 Fix typo: identifer -> identifier I noticed this typo while using template haskell. Signed-off-by: Vikraman Choudhury Test Plan: ``` ?> :set -XTemplateHaskell ?> :m +Language.Haskell.TH ?> data Foo = Foo ?> $(conE ''Foo) :9:9: Type constructor ?Foo? used where a value identifier was expected In the expression: Foo In an equation for ?f?: f = Foo ``` Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D871 (cherry picked from commit 458a97b86ad154812d08e0fe3548b88ac8412b4f) Conflicts: testsuite/tests/rename/should_compile/rn040.hs >--------------------------------------------------------------- 6f31e975aa571daeb5568cafbf8e468545d4ad4f compiler/typecheck/TcExpr.hs | 2 +- testsuite/tests/rename/should_compile/rn040.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 360cd08..0adeea4 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1114,7 +1114,7 @@ tc_infer_id orig id_name PatSynCon ps -> tcPatSynBuilderOcc orig ps _ -> failWithTc $ - ppr thing <+> ptext (sLit "used where a value identifer was expected") } + ppr thing <+> ptext (sLit "used where a value identifier was expected") } where inst_normal_id id = do { (wrap, rho) <- deeplyInstantiate orig (idType id) diff --git a/testsuite/tests/rename/should_compile/rn040.hs b/testsuite/tests/rename/should_compile/rn040.hs index 3b418f5..2765b13 100644 --- a/testsuite/tests/rename/should_compile/rn040.hs +++ b/testsuite/tests/rename/should_compile/rn040.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fwarn-unused-binds #-} module ShouldCompile where --- !!! should produce warnings about unused identifers +-- !!! should produce warnings about unused identifiers x :: [()] x = [ () | y <- [] ] From git at git.haskell.org Wed May 6 13:02:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 13:02:17 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: base: Fix confusing docs typo (d4cfe23) Message-ID: <20150506130217.1A55D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d4cfe23da37c85a2c550b7eebd16709114333172/ghc >--------------------------------------------------------------- commit d4cfe23da37c85a2c550b7eebd16709114333172 Author: Alexander Berntsen Date: Wed May 6 07:52:29 2015 -0500 base: Fix confusing docs typo Signed-off-by: Alexander Berntsen Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D872 (cherry picked from commit fa0474da6954a3e57785fe703acc83e2fecef88f) >--------------------------------------------------------------- d4cfe23da37c85a2c550b7eebd16709114333172 libraries/base/Data/Traversable.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index e7caf4e..350c5ac 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -144,10 +144,9 @@ import qualified GHC.List as List ( foldr ) class (Functor t, Foldable t) => Traversable t where {-# MINIMAL traverse | sequenceA #-} - -- | Map each element of a structure to an action, evaluate these - -- these actions from left to right, and collect the results. - -- actions from left to right, and collect the results. For a - -- version that ignores the results see 'Data.Foldable.traverse_'. + -- | Map each element of a structure to an action, evaluate these actions + -- from left to right, and collect the results. For a version that ignores + -- the results see 'Data.Foldable.traverse_'. traverse :: Applicative f => (a -> f b) -> t a -> f (t b) traverse f = sequenceA . fmap f From git at git.haskell.org Wed May 6 13:09:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 13:09:29 +0000 (UTC) Subject: [commit: ghc] master: API Annotations : add Locations in hsSyn were layout occurs (fb54b2c) Message-ID: <20150506130929.667453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb54b2c11cc7f2cfbafa35b6a1819d7443aa5494/ghc >--------------------------------------------------------------- commit fb54b2c11cc7f2cfbafa35b6a1819d7443aa5494 Author: Alan Zimmerman Date: Wed May 6 08:05:11 2015 -0500 API Annotations : add Locations in hsSyn were layout occurs At the moment ghc-exactprint, which uses the GHC API Annotations to provide a framework for roundtripping Haskell source code with optional AST edits, has to implement a horrible workaround to manage the points where layout needs to be captured. These are MatchGroup HsDo HsCmdDo HsLet LetStmt HsCmdLet GRHSs To provide a more natural representation, the contents subject to layout rules need to be wrapped in a SrcSpan. This commit does this. Trac ticket #10250 Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D815 GHC Trac Issues: #10250 >--------------------------------------------------------------- fb54b2c11cc7f2cfbafa35b6a1819d7443aa5494 compiler/deSugar/Coverage.hs | 56 ++++++++++---------- compiler/deSugar/DsArrows.hs | 30 ++++++----- compiler/deSugar/DsExpr.hs | 28 +++++----- compiler/deSugar/DsGRHSs.hs | 4 +- compiler/deSugar/DsListComp.hs | 8 +-- compiler/deSugar/DsMeta.hs | 35 +++++++------ compiler/deSugar/Match.hs | 2 +- compiler/hsSyn/Convert.hs | 12 ++--- compiler/hsSyn/HsExpr.hs | 44 ++++++++-------- compiler/hsSyn/HsUtils.hs | 47 ++++++++++------- compiler/parser/Parser.y | 20 ++++---- compiler/parser/RdrHsSyn.hs | 14 ++--- compiler/rename/RnBinds.hs | 8 +-- compiler/rename/RnExpr.hs | 60 +++++++++++----------- compiler/rename/RnTypes.hs | 2 +- compiler/typecheck/TcArrows.hs | 16 +++--- compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcExpr.hs | 4 +- compiler/typecheck/TcGenDeriv.hs | 6 +-- compiler/typecheck/TcHsSyn.hs | 30 ++++++----- compiler/typecheck/TcMatches.hs | 43 ++++++++-------- compiler/typecheck/TcPatSyn.hs | 19 +++---- compiler/typecheck/TcRnDriver.hs | 6 +-- testsuite/tests/ghc-api/T6145.hs | 2 +- testsuite/tests/ghc-api/annotations/T10255.stdout | 1 - .../tests/ghc-api/annotations/exampleTest.stdout | 2 - .../tests/ghc-api/annotations/listcomps.stdout | 10 ++-- testsuite/tests/ghc-api/landmines/landmines.stdout | 6 +-- 28 files changed, 271 insertions(+), 248 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 fb54b2c11cc7f2cfbafa35b6a1819d7443aa5494 From git at git.haskell.org Wed May 6 13:09:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 13:09:32 +0000 (UTC) Subject: [commit: ghc] master: Correct parsing of lifted empty list constructor (caeae1a) Message-ID: <20150506130932.3EC273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/caeae1a33e28745b51d952b034e253d3e51e0605/ghc >--------------------------------------------------------------- commit caeae1a33e28745b51d952b034e253d3e51e0605 Author: Matthew Pickering Date: Wed May 6 08:07:31 2015 -0500 Correct parsing of lifted empty list constructor See #10299 Previously `'[]` was parsed to a `HsTyVar` rather than a `HsExplicitListTy`. This patch fixes the shift-reduce conflict which caused this problem. Reviewed By: alanz, austin Differential Revision: https://phabricator.haskell.org/D840 >--------------------------------------------------------------- caeae1a33e28745b51d952b034e253d3e51e0605 compiler/parser/Parser.y | 38 ++++++++++++++++++--------------- testsuite/tests/th/TH_RichKinds2.stderr | 2 +- 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index aedfaf8..3f2dc78 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -254,16 +254,6 @@ TODO: Why? ------------------------------------------------------------------------------- -state 432 contains 1 shift/reduce conflicts. - - atype -> SIMPLEQUOTE '[' . comma_types0 ']' (rule 318) - sysdcon -> '[' . ']' (rule 613) - - Conflict: ']' (empty comma_types0 reudes) - -TODO: Why? - -------------------------------------------------------------------------------- state 462 contains 1 shift/reduce conflicts. @@ -1692,7 +1682,7 @@ atype :: { LHsType RdrName } | TH_ID_SPLICE { sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $ mkUnqual varName (getTH_ID_SPLICE $1) } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon { sLL $1 $> $ HsTyVar $ unLoc $2 } + | SIMPLEQUOTE qcon_nowiredlist { sLL $1 $> $ HsTyVar $ unLoc $2 } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $3) AnnComma (gl $4) >> ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5)) @@ -2768,11 +2758,22 @@ name_var : var { $1 } ----------------------------------------- -- Data constructors -qcon :: { Located RdrName } - : qconid { $1 } - | '(' qconsym ')' {% ams (sLL $1 $> (unLoc $2)) - [mop $1,mj AnnVal $2,mcp $3] } - | sysdcon { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } +-- There are two different productions here as lifted list constructors +-- are parsed differently. + +qcon_nowiredlist :: { Located RdrName } + : gen_qcon { $1 } + | sysdcon_nolist { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } + +qcon :: { Located RdrName } + : gen_qcon { $1} + | sysdcon { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } + +gen_qcon :: { Located RdrName } + : qconid { $1 } + | '(' qconsym ')' {% ams (sLL $1 $> (unLoc $2)) + [mop $1,mj AnnVal $2,mcp $3] } + -- The case of '[:' ':]' is part of the production `parr' con :: { Located RdrName } @@ -2786,13 +2787,16 @@ con_list : con { sL1 $1 [$1] } | con ',' con_list {% addAnnotation (gl $1) AnnComma (gl $2) >> return (sLL $1 $> ($1 : unLoc $3)) } -sysdcon :: { Located DataCon } -- Wired in data constructors +sysdcon_nolist :: { Located DataCon } -- Wired in data constructors : '(' ')' {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] } | '(' commas ')' {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1)) (mop $1:mcp $3:(mcommas (fst $2))) } | '(#' '#)' {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] } | '(#' commas '#)' {% ams (sLL $1 $> $ tupleCon UnboxedTuple (snd $2 + 1)) (mo $1:mc $3:(mcommas (fst $2))) } + +sysdcon :: { Located DataCon } + : sysdcon_nolist { $1 } | '[' ']' {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] } conop :: { Located RdrName } diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr index 45027d5..bb567a6 100644 --- a/testsuite/tests/th/TH_RichKinds2.stderr +++ b/testsuite/tests/th/TH_RichKinds2.stderr @@ -3,7 +3,7 @@ TH_RichKinds2.hs:23:4: Warning: data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: GHC.Base.Maybe k_0) = forall . t_3 ~ 'GHC.Base.Nothing => SNothing_4 | forall a_5 . t_3 ~ 'GHC.Base.Just a_5 => SJust_6 (t_1 a_5) -type instance TH_RichKinds2.Map f_7 'GHC.Types.[] = 'GHC.Types.[] +type instance TH_RichKinds2.Map f_7 '[] = '[] type instance TH_RichKinds2.Map f_8 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9) (TH_RichKinds2.Map f_8 t_10) From git at git.haskell.org Wed May 6 13:09:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 13:09:36 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : quoted type variables missing leading quote (15aafc7) Message-ID: <20150506130936.55C133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15aafc7fb61d2cbf95f2a564762399e82fe44e9c/ghc >--------------------------------------------------------------- commit 15aafc7fb61d2cbf95f2a564762399e82fe44e9c Author: Alan Zimmerman Date: Wed May 6 08:07:39 2015 -0500 ApiAnnotations : quoted type variables missing leading quote The HsOpTy can be constructed for a promoted type operator, in which case it has the following form | btype SIMPLEQUOTE qconop type { sLL $1 $> $ mkHsOpTy $1 $3 $4 } | btype SIMPLEQUOTE varop type { sLL $1 $> $ mkHsOpTy $1 $3 $4 } The SIMPLEQUOTE does not get an annotation, so cannot be reproduced via the API Annotations. Also, in splice_exp :: { LHsExpr RdrName } : TH_ID_SPLICE { sL1 $1 $ mkHsSpliceE (sL1 $1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))) } | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE $2) [mo $1,mc $3] } | TH_ID_TY_SPLICE { sL1 $1 $ mkHsSpliceTE (sL1 $1 $ HsVar (mkUnqual varName (getTH_ID_TY_SPLICE $1))) } | '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE $2) [mo $1,mc $3] } the TH_ID_SPLICE and TH_ID_TY_SPLICE positions are lost. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D825 GHC Trac Issues: #10268 >--------------------------------------------------------------- 15aafc7fb61d2cbf95f2a564762399e82fe44e9c compiler/parser/ApiAnnotation.hs | 4 ++ compiler/parser/Parser.y | 39 ++++++++------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 7 +++ testsuite/tests/ghc-api/annotations/T10268.stderr | 10 ++++ testsuite/tests/ghc-api/annotations/T10268.stdout | 55 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10268.hs | 11 +++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10255.hs => t10268.hs} | 3 +- 9 files changed, 114 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 15aafc7fb61d2cbf95f2a564762399e82fe44e9c From git at git.haskell.org Wed May 6 13:09:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 13:09:40 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : Nested forall loses forall annotation (81030ed) Message-ID: <20150506130940.17E333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/81030ede73c4e3783219b2a8d7463524e847cfce/ghc >--------------------------------------------------------------- commit 81030ede73c4e3783219b2a8d7463524e847cfce Author: Alan Zimmerman Date: Wed May 6 08:08:40 2015 -0500 ApiAnnotations : Nested forall loses forall annotation When parsing {-# LANGUAGE ScopedTypeVariables #-} extremumNewton :: forall tag. forall tag1. tag -> tag1 -> Int extremumNewton = undefined The parser attaches an AnnForall to the second forall, which appears as a nested HsForAllTy. Somewhere this nesting is flattened, and the tyvarbndrs are collapsed into a single HsForAllTy. In this process the second AnnForAll loses its anchor in the AST. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D833 GHC Trac Issues: #10278 >--------------------------------------------------------------- 81030ede73c4e3783219b2a8d7463524e847cfce compiler/parser/Parser.y | 83 ++++++++++--------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 5 ++ testsuite/tests/ghc-api/annotations/T10278.stderr | 16 ++++ testsuite/tests/ghc-api/annotations/T10278.stdout | 96 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10278.hs | 12 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10268.hs => t10278.hs} | 2 +- 8 files changed, 178 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 81030ede73c4e3783219b2a8d7463524e847cfce From git at git.haskell.org Wed May 6 13:18:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 13:18:45 +0000 (UTC) Subject: [commit: ghc] master: Revert "ApiAnnotations : Nested forall loses forall annotation" (f34c072) Message-ID: <20150506131845.EE0673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f34c072820f617f09c3d1c4e539c41fb2ab645b1/ghc >--------------------------------------------------------------- commit f34c072820f617f09c3d1c4e539c41fb2ab645b1 Author: Austin Seipp Date: Wed May 6 08:19:13 2015 -0500 Revert "ApiAnnotations : Nested forall loses forall annotation" This reverts commit 81030ede73c4e3783219b2a8d7463524e847cfce. Alan is abandoning this approach in favor of D836. >--------------------------------------------------------------- f34c072820f617f09c3d1c4e539c41fb2ab645b1 compiler/parser/Parser.y | 83 ++++++++--------- testsuite/tests/ghc-api/annotations/.gitignore | 1 - testsuite/tests/ghc-api/annotations/Makefile | 5 - testsuite/tests/ghc-api/annotations/T10278.stderr | 16 ---- testsuite/tests/ghc-api/annotations/T10278.stdout | 96 ------------------- testsuite/tests/ghc-api/annotations/Test10278.hs | 12 --- testsuite/tests/ghc-api/annotations/all.T | 1 - testsuite/tests/ghc-api/annotations/t10278.hs | 107 ---------------------- 8 files changed, 37 insertions(+), 284 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 f34c072820f617f09c3d1c4e539c41fb2ab645b1 From git at git.haskell.org Wed May 6 15:20:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 May 2015 15:20:15 +0000 (UTC) Subject: [commit: ghc] master: Revert "API Annotations : add Locations in hsSyn were layout occurs" (97d320f) Message-ID: <20150506152015.B63CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97d320f56b5848d6ba2c723c6e7f04f98e349a86/ghc >--------------------------------------------------------------- commit 97d320f56b5848d6ba2c723c6e7f04f98e349a86 Author: Austin Seipp Date: Wed May 6 10:20:26 2015 -0500 Revert "API Annotations : add Locations in hsSyn were layout occurs" This reverts commit fb54b2c11cc7f2cfbafa35b6a1819d7443aa5494. As Alan pointed out, this will make cherry picking a lot harder until 7.10.2, so lets back it out until after the release. >--------------------------------------------------------------- 97d320f56b5848d6ba2c723c6e7f04f98e349a86 compiler/deSugar/Coverage.hs | 56 ++++++++++---------- compiler/deSugar/DsArrows.hs | 30 +++++------ compiler/deSugar/DsExpr.hs | 28 +++++----- compiler/deSugar/DsGRHSs.hs | 4 +- compiler/deSugar/DsListComp.hs | 8 +-- compiler/deSugar/DsMeta.hs | 35 ++++++------- compiler/deSugar/Match.hs | 2 +- compiler/hsSyn/Convert.hs | 12 ++--- compiler/hsSyn/HsExpr.hs | 44 ++++++++-------- compiler/hsSyn/HsUtils.hs | 47 +++++++---------- compiler/parser/Parser.y | 20 ++++---- compiler/parser/RdrHsSyn.hs | 14 +++-- compiler/rename/RnBinds.hs | 8 +-- compiler/rename/RnExpr.hs | 60 +++++++++++----------- compiler/rename/RnTypes.hs | 2 +- compiler/typecheck/TcArrows.hs | 16 +++--- compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcExpr.hs | 4 +- compiler/typecheck/TcGenDeriv.hs | 6 +-- compiler/typecheck/TcHsSyn.hs | 30 +++++------ compiler/typecheck/TcMatches.hs | 43 ++++++++-------- compiler/typecheck/TcPatSyn.hs | 19 ++++--- compiler/typecheck/TcRnDriver.hs | 6 +-- testsuite/tests/ghc-api/T6145.hs | 2 +- testsuite/tests/ghc-api/annotations/T10255.stdout | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 + .../tests/ghc-api/annotations/listcomps.stdout | 10 ++-- testsuite/tests/ghc-api/landmines/landmines.stdout | 6 +-- 28 files changed, 248 insertions(+), 271 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 97d320f56b5848d6ba2c723c6e7f04f98e349a86 From git at git.haskell.org Thu May 7 08:08:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 08:08:21 +0000 (UTC) Subject: [commit: ghc] branch 'wip/spj-improvement' created Message-ID: <20150507080821.CD7F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/spj-improvement Referencing: 95e676dd91bf4975466c902901869c8eb4104dc1 From git at git.haskell.org Thu May 7 08:08:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 08:08:24 +0000 (UTC) Subject: [commit: ghc] wip/spj-improvement: Comments only (a67b20a) Message-ID: <20150507080824.7B5353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-improvement Link : http://ghc.haskell.org/trac/ghc/changeset/a67b20a3d15fff00184978df1f98b0ee520a51a4/ghc >--------------------------------------------------------------- commit a67b20a3d15fff00184978df1f98b0ee520a51a4 Author: Simon Peyton Jones Date: Fri May 1 15:51:10 2015 +0100 Comments only >--------------------------------------------------------------- a67b20a3d15fff00184978df1f98b0ee520a51a4 compiler/typecheck/TcFlatten.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 4c74ba9..09ed340 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1576,6 +1576,11 @@ Consider f1 = (Given, ReprEq) f2 = (Derived, NomEq) f = (Derived, ReprEq) +I thought maybe we could never get Derived ReprEq constraints, but +we can; straight from the Wanteds during improvment. And from a Derived +ReprEq we could conceivably get a Derived NomEq improvment (by decomposing +a type constructor with Nomninal role), and hence unify. + Note [canRewriteOrSame] ~~~~~~~~~~~~~~~~~~~~~~~ canRewriteOrSame is similar but From git at git.haskell.org Thu May 7 08:08:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 08:08:27 +0000 (UTC) Subject: [commit: ghc] wip/spj-improvement: A bit of refactoring RnSplice (7f6e931) Message-ID: <20150507080827.410203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-improvement Link : http://ghc.haskell.org/trac/ghc/changeset/7f6e931eee0856f08441cfac50c6dafdf858e489/ghc >--------------------------------------------------------------- commit 7f6e931eee0856f08441cfac50c6dafdf858e489 Author: Simon Peyton Jones Date: Tue May 5 12:17:21 2015 +0100 A bit of refactoring RnSplice ...to make clearer what the cross-stage lifting code applies to (c.f. Trac #10384) >--------------------------------------------------------------- 7f6e931eee0856f08441cfac50c6dafdf858e489 compiler/rename/RnSplice.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 930cea3..4a857fd 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -586,17 +586,25 @@ checkThLocalName name do { let use_lvl = thLevel use_stage ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl) - ; when (use_lvl > bind_lvl) $ - checkCrossStageLifting top_lvl name use_stage } } } + ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } } -------------------------------------- -checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM () +checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel + -> Name -> TcM () -- We are inside brackets, and (use_lvl > bind_lvl) -- Now we must check whether there's a cross-stage lift to do -- Examples \x -> [| x |] -- [| map |] -checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var)) +checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name + | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets + , use_lvl > bind_lvl -- Cross-stage condition + = check_cross_stage_lifting top_lvl name ps_var + | otherwise + = return () + +check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM () +check_cross_stage_lifting top_lvl name ps_var | isTopLevel top_lvl -- Top-level identifiers in this module, -- (which have External Names) @@ -627,8 +635,6 @@ checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var)) -- Update the pending splices ; ps <- readMutVar ps_var ; writeMutVar ps_var (pend_splice : ps) } - -checkCrossStageLifting _ _ _ = return () #endif /* GHCI */ {- From git at git.haskell.org Thu May 7 08:08:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 08:08:30 +0000 (UTC) Subject: [commit: ghc] wip/spj-improvement: Checkpoint on improving improvement (95e676d) Message-ID: <20150507080830.024183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-improvement Link : http://ghc.haskell.org/trac/ghc/changeset/95e676dd91bf4975466c902901869c8eb4104dc1/ghc >--------------------------------------------------------------- commit 95e676dd91bf4975466c902901869c8eb4104dc1 Author: Simon Peyton Jones Date: Thu May 7 09:07:51 2015 +0100 Checkpoint on improving improvement This patch allows unification variables to unify with fmvs, So that from, say alpha ~ fmv we get alpha := fmv But it iterates forever on F alpha ~ alpha because we flatten to F alpha ~ fmv alpha ~ fmv then unify to F fmv ~ fmv The unflatten F beta ~ beta and we are back to where we started. Dimitrios and I have new idas about saturation; I just wanted to commit this to a branch. >--------------------------------------------------------------- 95e676dd91bf4975466c902901869c8eb4104dc1 compiler/typecheck/TcCanonical.hs | 6 +++-- compiler/typecheck/TcFlatten.hs | 20 ++++++++++++----- compiler/typecheck/TcInteract.hs | 28 +++++++++++++++--------- compiler/typecheck/TcSMonad.hs | 46 ++++++++++++++++++++++++--------------- compiler/typecheck/TcSimplify.hs | 16 +++++++------- compiler/typecheck/TcType.hs | 9 ++++---- 6 files changed, 77 insertions(+), 48 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 95e676dd91bf4975466c902901869c8eb4104dc1 From git at git.haskell.org Thu May 7 09:02:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 09:02:24 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Wibble to DmdAnal (63205f7) Message-ID: <20150507090224.3D37F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/63205f719287cb011388b4beddf30d3229238b9f/ghc >--------------------------------------------------------------- commit 63205f719287cb011388b4beddf30d3229238b9f Author: Simon Peyton Jones Date: Tue Apr 21 09:29:13 2015 +0100 Wibble to DmdAnal This fixes a typo in d5773a4939b1feea51ec0db6624c9462751e948a Teach DmdAnal that coercions are value arguments! (Trac #10288) Sorry about that; I'm not sure how it slipped through. (cherry picked from commit 5c7e4db5ce84395eb0d727eb3b0f505a00191164) >--------------------------------------------------------------- 63205f719287cb011388b4beddf30d3229238b9f compiler/stranal/DmdAnal.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index b45fc2b..f1fe7f7 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -167,10 +167,10 @@ dmdAnal' env dmd (App fun (Type ty)) -- Lots of the other code is there to make this -- beautiful, compositional, application rule :-) dmdAnal' env dmd (App fun arg) - = -- This case handles value arguments (type args handled above) - -- Crucially, coercions /are/ handled here, because they are - -- value arguments (Trac #10288) - = let + = -- This case handles value arguments (type args handled above) + -- Crucially, coercions /are/ handled here, because they are + -- value arguments (Trac #10288) + let call_dmd = mkCallDmd dmd (fun_ty, fun') = dmdAnal env call_dmd fun (arg_dmd, res_ty) = splitDmdTy fun_ty From git at git.haskell.org Thu May 7 15:45:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 15:45:33 +0000 (UTC) Subject: [commit: ghc] master: Comments only (d1295da) Message-ID: <20150507154533.361813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1295da3a4031cd102de77ab65d6d5b9b452213c/ghc >--------------------------------------------------------------- commit d1295da3a4031cd102de77ab65d6d5b9b452213c Author: Simon Peyton Jones Date: Fri May 1 15:51:10 2015 +0100 Comments only >--------------------------------------------------------------- d1295da3a4031cd102de77ab65d6d5b9b452213c compiler/typecheck/TcFlatten.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 4c74ba9..09ed340 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1576,6 +1576,11 @@ Consider f1 = (Given, ReprEq) f2 = (Derived, NomEq) f = (Derived, ReprEq) +I thought maybe we could never get Derived ReprEq constraints, but +we can; straight from the Wanteds during improvment. And from a Derived +ReprEq we could conceivably get a Derived NomEq improvment (by decomposing +a type constructor with Nomninal role), and hence unify. + Note [canRewriteOrSame] ~~~~~~~~~~~~~~~~~~~~~~~ canRewriteOrSame is similar but From git at git.haskell.org Thu May 7 15:45:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 15:45:36 +0000 (UTC) Subject: [commit: ghc] master: A bit of refactoring RnSplice (931d014) Message-ID: <20150507154536.018DE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/931d014d4276d4213d8de4b1f5e51f0219b724dd/ghc >--------------------------------------------------------------- commit 931d014d4276d4213d8de4b1f5e51f0219b724dd Author: Simon Peyton Jones Date: Tue May 5 12:17:21 2015 +0100 A bit of refactoring RnSplice ...to make clearer what the cross-stage lifting code applies to (c.f. Trac #10384) >--------------------------------------------------------------- 931d014d4276d4213d8de4b1f5e51f0219b724dd compiler/rename/RnSplice.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index a20640b..5306b6e 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -586,11 +586,11 @@ checkThLocalName name do { let use_lvl = thLevel use_stage ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl) - ; when (use_lvl > bind_lvl) $ - checkCrossStageLifting top_lvl name use_stage } } } + ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } } -------------------------------------- -checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM () +checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel + -> Name -> TcM () -- We are inside brackets, and (use_lvl > bind_lvl) -- Now we must check whether there's a cross-stage lift to do -- Examples \x -> [| x |] @@ -599,7 +599,15 @@ checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM () -- This code is similar to checkCrossStageLifting in TcExpr, but -- this is only run on *untyped* brackets. -checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var)) +checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name + | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets + , use_lvl > bind_lvl -- Cross-stage condition + = check_cross_stage_lifting top_lvl name ps_var + | otherwise + = return () + +check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM () +check_cross_stage_lifting top_lvl name ps_var | isTopLevel top_lvl -- Top-level identifiers in this module, -- (which have External Names) @@ -630,8 +638,6 @@ checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var)) -- Update the pending splices ; ps <- readMutVar ps_var ; writeMutVar ps_var (pend_splice : ps) } - -checkCrossStageLifting _ _ _ = return () #endif /* GHCI */ {- From git at git.haskell.org Thu May 7 15:45:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 15:45:39 +0000 (UTC) Subject: [commit: ghc] master: Regression test for Trac #10390 (c3e6b3a) Message-ID: <20150507154539.373313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c3e6b3ac50e7cc061825d49d06fb4fc81e6d5bc1/ghc >--------------------------------------------------------------- commit c3e6b3ac50e7cc061825d49d06fb4fc81e6d5bc1 Author: Simon Peyton Jones Date: Thu May 7 16:46:02 2015 +0100 Regression test for Trac #10390 >--------------------------------------------------------------- c3e6b3ac50e7cc061825d49d06fb4fc81e6d5bc1 testsuite/tests/typecheck/should_compile/T10390.hs | 16 ++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 17 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T10390.hs b/testsuite/tests/typecheck/should_compile/T10390.hs new file mode 100644 index 0000000..e0648c9 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10390.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE RankNTypes #-} + +module T10390 where + +class ApPair r where + apPair :: (forall a . (ApPair a, Num a) => Maybe a) -> Maybe r + +instance (ApPair a, ApPair b) => ApPair (a,b) where + apPair = apPair' + +apPair' :: (ApPair b, ApPair c) + => (forall a . (Num a, ApPair a) => Maybe a) -> Maybe (b,c) + -- NB constraints in a different order to apPair +apPair' f = let (Just a) = apPair f + (Just b) = apPair f + in Just $ (a, b) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 72fe255..562acba 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -453,3 +453,4 @@ test('TcCustomSolverSuper', normal, compile, ['']) test('T10335', normal, compile, ['']) test('Improvement', normal, compile, ['']) test('T10009', normal, compile, ['']) +test('T10390', normal, compile, ['']) From git at git.haskell.org Thu May 7 21:44:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 May 2015 21:44:56 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : RdrHsSyn.isFunLhs discards parentheses (5bde9f7) Message-ID: <20150507214456.E8E783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5bde9f7c1834ab4da1fad1838afec1a578c26530/ghc >--------------------------------------------------------------- commit 5bde9f7c1834ab4da1fad1838afec1a578c26530 Author: Alan Zimmerman Date: Thu May 7 23:45:44 2015 +0200 ApiAnnotations : RdrHsSyn.isFunLhs discards parentheses Summary: The RdrHsSyn.isFunLhs function has the following isFunLhs e = go e [] where go (L loc (HsVar f)) es | not (isRdrDataCon f) = return (Just (L loc f, False, es)) go (L _ (HsApp f e)) es = go f (e:es) go (L _ (HsPar e)) es@(_:_) = go e es The treatment of HsPar means that any parentheses around an infix function will be discarded. e.g. (f =*= g) sa i = f (toF sa i) =^= g (toG sa i) will lose the ( before f and the closing one after g Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D832 GHC Trac Issues: #10269 >--------------------------------------------------------------- 5bde9f7c1834ab4da1fad1838afec1a578c26530 compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 46 ++++++++++++---------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++++ testsuite/tests/ghc-api/annotations/T10269.stdout | 36 +++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10269.hs | 4 ++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10268.hs => t10269.hs} | 2 +- 8 files changed, 78 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5bde9f7c1834ab4da1fad1838afec1a578c26530 From git at git.haskell.org Fri May 8 00:29:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 00:29:31 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: meditate on AvailTC with four examples. (cc9b788) Message-ID: <20150508002931.0E1EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc9b788e701f4bd3b97bfaec8ee78169ede0fa49/ghc >--------------------------------------------------------------- commit cc9b788e701f4bd3b97bfaec8ee78169ede0fa49 Author: Edward Z. Yang Date: Thu May 7 17:30:08 2015 -0700 Backpack docs: meditate on AvailTC with four examples. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- cc9b788e701f4bd3b97bfaec8ee78169ede0fa49 docs/backpack/algorithm.pdf | Bin 237551 -> 245874 bytes docs/backpack/algorithm.tex | 259 +++++++++++++++++++++++++++++++++++++++----- 2 files changed, 233 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cc9b788e701f4bd3b97bfaec8ee78169ede0fa49 From git at git.haskell.org Fri May 8 07:37:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 07:37:49 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : AnnComma missing in TupleSection (225df19) Message-ID: <20150508073749.C893D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/225df19a87d8de8245db84d558618f4824631acc/ghc >--------------------------------------------------------------- commit 225df19a87d8de8245db84d558618f4824631acc Author: Alan Zimmerman Date: Fri May 8 09:38:39 2015 +0200 ApiAnnotations : AnnComma missing in TupleSection Summary: For the following code {-# LANGUAGE TupleSections #-} foo = do liftIO $ atomicModifyIORef ciTokens ((,()) . f) the annotation is missing for the comma. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D834 GHC Trac Issues: #10280 >--------------------------------------------------------------- 225df19a87d8de8245db84d558618f4824631acc compiler/parser/Parser.y | 4 +-- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 5 +++ testsuite/tests/ghc-api/annotations/T10280.stderr | 6 ++++ testsuite/tests/ghc-api/annotations/T10280.stdout | 36 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10280.hs | 4 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10268.hs => t10280.hs} | 2 +- 8 files changed, 56 insertions(+), 3 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 2b57b5a..98d8714 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2385,10 +2385,10 @@ texp :: { LHsExpr RdrName } tup_exprs :: { [LHsTupArg RdrName] } : texp commas_tup_tail {% do { addAnnotation (gl $1) AnnComma (fst $2) - ; return ((L (gl $1) (Present $1)) : snd $2) } } + ; return ((sL1 $1 (Present $1)) : snd $2) } } | commas tup_tail - {% do { mapM_ (\ll -> addAnnotation (gl ll) AnnComma (gl ll)) $2 + {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1) ; return (let tt = if null $2 then [noLoc missingTupArg] diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 2280a5a..fc9760f 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -6,6 +6,7 @@ listcomps t10255 t10268 t10269 +t10280 *.hi *.o *.run.* diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 898db5f..44b2889 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -44,6 +44,11 @@ T10268: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10268 ./t10268 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" +T10280: + rm -f t10280.o t10280.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10280 + ./t10280 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + .PHONY: clean annotations parseTree comments exampleTest listcomps T10269: diff --git a/testsuite/tests/ghc-api/annotations/T10280.stderr b/testsuite/tests/ghc-api/annotations/T10280.stderr new file mode 100644 index 0000000..114b95b --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10280.stderr @@ -0,0 +1,6 @@ + +Test10280.hs:4:8: Not in scope: ?atomicModifyIORef? + +Test10280.hs:4:26: Not in scope: ?ciTokens? + +Test10280.hs:4:44: Not in scope: ?f? diff --git a/testsuite/tests/ghc-api/annotations/T10280.stdout b/testsuite/tests/ghc-api/annotations/T10280.stdout new file mode 100644 index 0000000..82a0eb2 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10280.stdout @@ -0,0 +1,36 @@ +---Problems--------------------- +[ +(AK AnnEofPos = [Test10280.hs:5:1]) +] + +-------------------------------- +[ +(AK Test10280.hs:1:1 AnnModule = [Test10280.hs:2:1-6]) + +(AK Test10280.hs:1:1 AnnWhere = [Test10280.hs:2:18-22]) + +(AK Test10280.hs:4:1-45 AnnEqual = [Test10280.hs:4:6]) + +(AK Test10280.hs:4:1-45 AnnFunId = [Test10280.hs:4:1-4]) + +(AK Test10280.hs:4:1-45 AnnSemi = [Test10280.hs:5:1]) + +(AK Test10280.hs:4:35-45 AnnCloseP = [Test10280.hs:4:45]) + +(AK Test10280.hs:4:35-45 AnnOpenP = [Test10280.hs:4:35]) + +(AK Test10280.hs:4:36-40 AnnCloseP = [Test10280.hs:4:40]) + +(AK Test10280.hs:4:36-40 AnnOpenP = [Test10280.hs:4:36]) + +(AK Test10280.hs:4:36-44 AnnVal = [Test10280.hs:4:42]) + +(AK Test10280.hs:4:37 AnnComma = [Test10280.hs:4:37]) + +(AK Test10280.hs:4:38-39 AnnCloseP = [Test10280.hs:4:39]) + +(AK Test10280.hs:4:38-39 AnnOpenP = [Test10280.hs:4:38]) + +(AK AnnEofPos = [Test10280.hs:5:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10280.hs b/testsuite/tests/ghc-api/annotations/Test10280.hs new file mode 100644 index 0000000..08e4186 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10280.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TupleSections #-} +module Test10280 where + +foo2 = atomicModifyIORef ciTokens ((,()) . f) diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 29e22c6..e0834af 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -6,3 +6,4 @@ test('listcomps', normal, run_command, ['$MAKE -s --no-print-directory listcom test('T10255', normal, run_command, ['$MAKE -s --no-print-directory t10255']) test('T10268', normal, run_command, ['$MAKE -s --no-print-directory T10268']) test('T10269', normal, run_command, ['$MAKE -s --no-print-directory T10269']) +test('T10280', normal, run_command, ['$MAKE -s --no-print-directory T10280']) diff --git a/testsuite/tests/ghc-api/annotations/t10268.hs b/testsuite/tests/ghc-api/annotations/t10280.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10268.hs copy to testsuite/tests/ghc-api/annotations/t10280.hs index f956ef1..5ed78af 100644 --- a/testsuite/tests/ghc-api/annotations/t10268.hs +++ b/testsuite/tests/ghc-api/annotations/t10280.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10268" + testOneFile libdir "Test10280" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Fri May 8 09:17:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 09:17:39 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations: misplaced AnnComma for squals production (7136126) Message-ID: <20150508091739.AB31F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/713612674634754edd17264e688f0479d943d8d2/ghc >--------------------------------------------------------------- commit 713612674634754edd17264e688f0479d943d8d2 Author: Alan Zimmerman Date: Fri May 8 11:18:28 2015 +0200 ApiAnnotations: misplaced AnnComma for squals production Summary: The parser production for squals has : squals ',' transformqual {% addAnnotation (gl $ last $ unLoc $1) AnnComma (gl $2) >> ams (sLL $1 $> ()) (fst $ unLoc $3) >> return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) } This attaches the comma to the wrong part of the squals, as it is generated in reverse order. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D846 GHC Trac Issues: #10312 >--------------------------------------------------------------- 713612674634754edd17264e688f0479d943d8d2 compiler/parser/Parser.y | 2 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + testsuite/tests/ghc-api/annotations/T10312.stderr | 8 + testsuite/tests/ghc-api/annotations/T10312.stdout | 485 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10312.hs | 79 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10255.hs => t10312.hs} | 2 +- 8 files changed, 584 insertions(+), 2 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 713612674634754edd17264e688f0479d943d8d2 From git at git.haskell.org Fri May 8 17:01:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:01:58 +0000 (UTC) Subject: [commit: ghc] branch 'wip/7.10-api-annots' created Message-ID: <20150508170158.E9BDF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/7.10-api-annots Referencing: 3aca63a3e31078246c111fbf385cf0fb84e5ff04 From git at git.haskell.org Fri May 8 17:02:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:01 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: parser: opt_kind_sig has incorrect SrcSpan (ad6059f) Message-ID: <20150508170201.C0F423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/ad6059f67491b1f9b90df276bea781160fee1308/ghc >--------------------------------------------------------------- commit ad6059f67491b1f9b90df276bea781160fee1308 Author: Alan Zimmerman Date: Tue Apr 14 01:16:48 2015 -0500 parser: opt_kind_sig has incorrect SrcSpan The production for opt_kind_sig is opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) } : { noLoc Nothing } | '::' kind {% ajl (sLL $1 $> (Just $2)) AnnDcolon (gl $1) } The outer Location is used only to get the full span for the enclosing declration, and is then stripped. The inner LHsKind then has a SrcSpan that does not include the '::' Extend the SrcSpan on $2 to include $1 Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D813 GHC Trac Issues: #10209 (cherry picked from commit 8aefc9b746512e91891879ad546e850e8a427d23) >--------------------------------------------------------------- ad6059f67491b1f9b90df276bea781160fee1308 compiler/hsSyn/HsDecls.hs | 7 ++-- compiler/hsSyn/HsTypes.hs | 3 ++ compiler/parser/Parser.y | 38 +++++++++++----------- .../tests/ghc-api/annotations/AnnotationTuple.hs | 5 ++- .../tests/ghc-api/annotations/exampleTest.stdout | 16 +++++++-- .../tests/ghc-api/annotations/parseTree.stdout | 14 ++++++-- 6 files changed, 56 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 ad6059f67491b1f9b90df276bea781160fee1308 From git at git.haskell.org Fri May 8 17:02:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:04 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: parser: API Annotations : guardquals1 does not annotate commas properly (f05bf38) Message-ID: <20150508170204.8D68B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/f05bf384758be27cc41573da457e7d09606fcd66/ghc >--------------------------------------------------------------- commit f05bf384758be27cc41573da457e7d09606fcd66 Author: Alan Zimmerman Date: Tue Apr 14 01:17:48 2015 -0500 parser: API Annotations : guardquals1 does not annotate commas properly The `guardquals1` production includes : guardquals1 ',' qual {% addAnnotation (gl $ last $ unLoc $1) AnnComma (gl $2) >> return (sLL $1 $> ($3 : unLoc $1)) } The AnnComma should be attached to `(gl $ head $ unLoc $1)`, rather than `last`. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D818 GHC Trac Issues: #10256 (cherry picked from commit 9eab6feed44ad8beb6703d2e27ce47a8f79d0f49) >--------------------------------------------------------------- f05bf384758be27cc41573da457e7d09606fcd66 compiler/parser/Parser.y | 2 +- .../tests/ghc-api/annotations/AnnotationTuple.hs | 8 +- .../tests/ghc-api/annotations/exampleTest.stdout | 138 ++++++++++-------- .../tests/ghc-api/annotations/parseTree.stdout | 158 ++++++++++++--------- 4 files changed, 174 insertions(+), 132 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f05bf384758be27cc41573da457e7d09606fcd66 From git at git.haskell.org Fri May 8 17:02:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:07 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: parser : the API annotation on opt_sig is being discarded (9c11848) Message-ID: <20150508170207.5E9733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/9c11848b92a6e24de743c1f083a7ebe3f09096df/ghc >--------------------------------------------------------------- commit 9c11848b92a6e24de743c1f083a7ebe3f09096df Author: Alan Zimmerman Date: Tue Apr 14 01:17:58 2015 -0500 parser : the API annotation on opt_sig is being discarded The opt_sig production is defined as opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) } : {- empty -} { ([],Nothing) } | '::' sigtype { ([mj AnnDcolon $1],Just $2) } It is used in the alt and decl_no_th productions, but neither of them add the returned annotations. This commit captures the annotations in the calling productions. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D822 GHC Trac Issues: #10254 (cherry picked from commit 919b51174163907d2bc3bb41aadf56aa8bb42e9b) >--------------------------------------------------------------- 9c11848b92a6e24de743c1f083a7ebe3f09096df compiler/parser/Parser.y | 6 +++--- testsuite/tests/ghc-api/annotations/AnnotationTuple.hs | 4 +++- testsuite/tests/ghc-api/annotations/exampleTest.stdout | 12 +++++++++--- testsuite/tests/ghc-api/annotations/parseTree.stdout | 10 ++++++++-- 4 files changed, 23 insertions(+), 9 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 2fb5639..9d794c9 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1857,9 +1857,9 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } let { l = comb2 $1 $> }; case r of { (FunBind n _ _ _ _ _) -> - ams (L l ()) [mj AnnFunId n] >> return () ; + ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ; _ -> return () } ; - _ <- ams (L l ()) (fst $ unLoc $3); + _ <- ams (L l ()) ((fst $2) ++ (fst $ unLoc $3)); return $! (sL l (unitOL $! (sL l $ ValD r))) } } | pattern_synonym_decl { sLL $1 $> $ unitOL $1 } | docdecl { sLL $1 $> $ unitOL $1 } @@ -2431,7 +2431,7 @@ alts1 :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) } alt :: { LMatch RdrName (LHsExpr RdrName) } : pat opt_sig alt_rhs {%ams (sLL $1 $> (Match Nothing [$1] (snd $2) (snd $ unLoc $3))) - (fst $ unLoc $3)} + ((fst $2) ++ (fst $ unLoc $3))} alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) } : ralt wherebinds { sLL $1 $> (fst $ unLoc $2, diff --git a/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs b/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs index 5df7cf7..73015a6 100644 --- a/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs +++ b/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TupleSections,TypeFamilies #-} -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternGuards,ScopedTypeVariables #-} module AnnotationTuple (foo) where { @@ -22,6 +22,8 @@ match n , Just 6 <- Nothing , Just 7 <- Just 9 = Just 8 +; +boo :: Int = 3 } -- Note: the trailing whitespace in this file is used to check that we -- have an annotation for it. diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout index 1c3eed5..128b70a 100644 --- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout +++ b/testsuite/tests/ghc-api/annotations/exampleTest.stdout @@ -2,12 +2,12 @@ [ (AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39]) -(AK AnnEofPos = [AnnotationTuple.hs:30:1]) +(AK AnnEofPos = [AnnotationTuple.hs:32:1]) ] -------------------------------- [ -(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:25:1]) +(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) (AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) @@ -133,6 +133,8 @@ (AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) +(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) + (AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) (AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) @@ -147,6 +149,10 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnEofPos = [AnnotationTuple.hs:30:1]) +(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) + +(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) + +(AK AnnEofPos = [AnnotationTuple.hs:32:1]) ] diff --git a/testsuite/tests/ghc-api/annotations/parseTree.stdout b/testsuite/tests/ghc-api/annotations/parseTree.stdout index 90f9d8c..9965fd2 100644 --- a/testsuite/tests/ghc-api/annotations/parseTree.stdout +++ b/testsuite/tests/ghc-api/annotations/parseTree.stdout @@ -11,7 +11,7 @@ (AnnotationTuple.hs:16:25, [m], ()), (AnnotationTuple.hs:16:26, [m], ())] [ -(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:25:1]) +(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) (AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) @@ -137,6 +137,8 @@ (AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) +(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) + (AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) (AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) @@ -151,6 +153,10 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnEofPos = [AnnotationTuple.hs:30:1]) +(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) + +(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) + +(AK AnnEofPos = [AnnotationTuple.hs:32:1]) ] From git at git.haskell.org Fri May 8 17:02:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:14 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: ApiAnnotations : lexer discards comment close in nested comment (a3dfa17) Message-ID: <20150508170214.083BC3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/a3dfa1742223585ca77acbd58dc60a3eadcb9ee0/ghc >--------------------------------------------------------------- commit a3dfa1742223585ca77acbd58dc60a3eadcb9ee0 Author: Alan Zimmerman Date: Tue Apr 14 07:32:52 2015 -0500 ApiAnnotations : lexer discards comment close in nested comment When parsing a nested comment, such as {- {- nested comment -} {-# nested pragma #-} -} The lexer returns the comment annotation as {- {- nested comment {-# nested pragma # -} Restore the missing comment end markers in the annotation. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D829 GHC Trac Issues: #10277 (cherry picked from commit 5fded20c51ae61770f909351c851aaca3d3e331c) >--------------------------------------------------------------- a3dfa1742223585ca77acbd58dc60a3eadcb9ee0 compiler/parser/Lexer.x | 6 +++--- .../ghc-api/annotations-literals/literals.stdout | 2 +- .../tests/ghc-api/annotations/CommentsTest.hs | 2 ++ .../tests/ghc-api/annotations/comments.stdout | 22 +++++++++++----------- 4 files changed, 17 insertions(+), 15 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index abb2477..432686e 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -970,7 +970,7 @@ lineCommentToken span buf len = do nested_comment :: P (RealLocated Token) -> Action nested_comment cont span buf len = do input <- getInput - go (reverse $ drop 2 $ lexemeToString buf len) (1::Int) input + go (reverse $ lexemeToString buf len) (1::Int) input where go commentAcc 0 input = do setInput input @@ -982,9 +982,9 @@ nested_comment cont span buf len = do Nothing -> errBrace input span Just ('-',input) -> case alexGetChar' input of Nothing -> errBrace input span - Just ('\125',input) -> go commentAcc (n-1) input + Just ('\125',input) -> go ('\125':'-':commentAcc) (n-1) input -- '}' Just (_,_) -> go ('-':commentAcc) n input - Just ('\123',input) -> case alexGetChar' input of + Just ('\123',input) -> case alexGetChar' input of -- '{' char Nothing -> errBrace input span Just ('-',input) -> go ('-':'\123':commentAcc) (n+1) input Just (_,_) -> go ('\123':commentAcc) n input diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.stdout b/testsuite/tests/ghc-api/annotations-literals/literals.stdout index 2d3b6b1..249874c 100644 --- a/testsuite/tests/ghc-api/annotations-literals/literals.stdout +++ b/testsuite/tests/ghc-api/annotations-literals/literals.stdout @@ -1,4 +1,4 @@ -(LiteralsTest.hs:1:1-26,ITblockComment "# LANGUAGE MagicHash #",[{-# LANGUAGE MagicHash #-}]), +(LiteralsTest.hs:1:1-26,ITblockComment "{-# LANGUAGE MagicHash #-}",[{-# LANGUAGE MagicHash #-}]), (LiteralsTest.hs:2:1-6,ITmodule,[module]), diff --git a/testsuite/tests/ghc-api/annotations/CommentsTest.hs b/testsuite/tests/ghc-api/annotations/CommentsTest.hs index ce0f336..c6cf79c 100644 --- a/testsuite/tests/ghc-api/annotations/CommentsTest.hs +++ b/testsuite/tests/ghc-api/annotations/CommentsTest.hs @@ -2,6 +2,8 @@ module CommentsTest (foo) where {- An opening comment + {- with a nested one -} + {-# nested PRAGMA #-} -} import qualified Data.List as DL diff --git a/testsuite/tests/ghc-api/annotations/comments.stdout b/testsuite/tests/ghc-api/annotations/comments.stdout index 25cf555..06273ba 100644 --- a/testsuite/tests/ghc-api/annotations/comments.stdout +++ b/testsuite/tests/ghc-api/annotations/comments.stdout @@ -1,25 +1,25 @@ [ -( CommentsTest.hs:9:1-33 = -[(CommentsTest.hs:9:1-33,AnnDocCommentNext " The function @foo@ does blah")]) +( CommentsTest.hs:11:1-33 = +[(CommentsTest.hs:11:1-33,AnnDocCommentNext " The function @foo@ does blah")]) -( CommentsTest.hs:(10,7)-(13,14) = -[(CommentsTest.hs:12:15-24,AnnLineComment "-- value 2")]) +( CommentsTest.hs:(12,7)-(15,14) = +[(CommentsTest.hs:14:15-24,AnnLineComment "-- value 2")]) ( = -[(CommentsTest.hs:(3,1)-(5,2),AnnBlockComment "\nAn opening comment\n"), +[(CommentsTest.hs:(3,1)-(7,2),AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}"), -(CommentsTest.hs:1:1-31,AnnBlockComment "# LANGUAGE DeriveFoldable #")]) +(CommentsTest.hs:1:1-31,AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}")]) ] [ -( CommentsTest.hs:(10,7)-(13,14) = -[(CommentsTest.hs:12:15-24,AnnLineComment "-- value 2")]) +( CommentsTest.hs:(12,7)-(15,14) = +[(CommentsTest.hs:14:15-24,AnnLineComment "-- value 2")]) ( = -[(CommentsTest.hs:9:1-33,AnnLineComment "-- | The function @foo@ does blah"), +[(CommentsTest.hs:11:1-33,AnnLineComment "-- | The function @foo@ does blah"), -(CommentsTest.hs:(3,1)-(5,2),AnnBlockComment "\nAn opening comment\n"), +(CommentsTest.hs:(3,1)-(7,2),AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}"), -(CommentsTest.hs:1:1-31,AnnBlockComment "# LANGUAGE DeriveFoldable #")]) +(CommentsTest.hs:1:1-31,AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}")]) ] From git at git.haskell.org Fri May 8 17:02:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:11 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: API Annotations : ExprWithTySig processing discards annotated spans (56e5b75) Message-ID: <20150508170211.31BB73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/56e5b751588ca6ffa7038b9ac2631c11363dc791/ghc >--------------------------------------------------------------- commit 56e5b751588ca6ffa7038b9ac2631c11363dc791 Author: Alan Zimmerman Date: Tue Apr 14 07:32:40 2015 -0500 API Annotations : ExprWithTySig processing discards annotated spans In RdrHsSyn.checkAPat the processing for ExprWithTySig is defined as ExprWithTySig e t _ -> do e <- checkLPat msg e -- Pattern signatures are parsed as sigtypes, -- but they aren't explicit forall points. Hence -- we have to remove the implicit forall here. let t' = case t of L _ (HsForAllTy Implicit _ _ (L _ []) ty) -> ty other -> other return (SigPatIn e (mkHsWithBndrs t')) The t' variable ends up losing its original SrcSpan in the first case branch. This results in annotations becoming detached from the AST. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D823 GHC Trac Issues: #10255 (cherry picked from commit 8dc294487fdaf102349c373c7db4796693573310) Conflicts: testsuite/tests/ghc-api/annotations/Makefile >--------------------------------------------------------------- 56e5b751588ca6ffa7038b9ac2631c11363dc791 compiler/parser/RdrHsSyn.hs | 3 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 7 ++++- testsuite/tests/ghc-api/annotations/T10255.stderr | 3 ++ testsuite/tests/ghc-api/annotations/T10255.stdout | 36 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10255.hs | 7 +++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../annotations/{exampleTest.hs => t10255.hs} | 8 +---- 8 files changed, 57 insertions(+), 9 deletions(-) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 52462f0..228f3c5 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -849,7 +849,8 @@ checkAPat msg loc e0 = do L _ (HsForAllTy Implicit _ _ (L _ []) ty) -> ty other -> other - return (SigPatIn e (mkHsWithBndrs t')) + return (SigPatIn e (mkHsWithBndrs + (L (getLoc t) (HsParTy t')))) -- n+k patterns OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index ba31dbb..d142368 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -3,6 +3,7 @@ parseTree comments exampleTest listcomps +t10255 *.hi *.o *.run.* diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 6f0ef46..08a6d49 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -31,4 +31,9 @@ listcomps: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc listcomps ./listcomps "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -.PHONY: clean +t10255: + rm -f t10255.o t10255.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 + ./t10255 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: clean annotations parseTree comments exampleTest listcomps t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10255.stderr b/testsuite/tests/ghc-api/annotations/T10255.stderr new file mode 100644 index 0000000..be1a915 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10255.stderr @@ -0,0 +1,3 @@ + +Test10255.hs:1:14: Warning: + -XPatternSignatures is deprecated: use -XScopedTypeVariables or pragma {-# LANGUAGE ScopedTypeVariables #-} instead diff --git a/testsuite/tests/ghc-api/annotations/T10255.stdout b/testsuite/tests/ghc-api/annotations/T10255.stdout new file mode 100644 index 0000000..099ef54 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10255.stdout @@ -0,0 +1,36 @@ +---Problems--------------------- +[ +(AK AnnEofPos = [Test10255.hs:8:1]) +] + +-------------------------------- +[ +(AK Test10255.hs:1:1 AnnModule = [Test10255.hs:2:1-6]) + +(AK Test10255.hs:1:1 AnnWhere = [Test10255.hs:2:18-22]) + +(AK Test10255.hs:4:1-17 AnnImport = [Test10255.hs:4:1-6]) + +(AK Test10255.hs:4:1-17 AnnSemi = [Test10255.hs:6:1]) + +(AK Test10255.hs:(6,1)-(7,11) AnnEqual = [Test10255.hs:6:29]) + +(AK Test10255.hs:(6,1)-(7,11) AnnFunId = [Test10255.hs:6:1-3]) + +(AK Test10255.hs:(6,1)-(7,11) AnnSemi = [Test10255.hs:8:1]) + +(AK Test10255.hs:6:5-27 AnnCloseP = [Test10255.hs:6:27]) + +(AK Test10255.hs:6:5-27 AnnOpenP = [Test10255.hs:6:5]) + +(AK Test10255.hs:6:6-26 AnnDcolon = [Test10255.hs:6:8-9]) + +(AK Test10255.hs:6:11-26 AnnCloseP = [Test10255.hs:6:26]) + +(AK Test10255.hs:6:11-26 AnnOpenP = [Test10255.hs:6:11]) + +(AK Test10255.hs:6:12-25 AnnRarrow = [Test10255.hs:6:20-21]) + +(AK AnnEofPos = [Test10255.hs:8:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10255.hs b/testsuite/tests/ghc-api/annotations/Test10255.hs new file mode 100644 index 0000000..386452d --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10255.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSignatures #-} +module Test10255 where + +import Data.Maybe + +fob (f :: (Maybe t -> Int)) = + undefined diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 9dadf7a..ed888a3 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -3,3 +3,4 @@ test('parseTree', normal, run_command, ['$MAKE -s --no-print-directory parseTr test('comments', normal, run_command, ['$MAKE -s --no-print-directory comments']) test('exampleTest', normal, run_command, ['$MAKE -s --no-print-directory exampleTest']) test('listcomps', normal, run_command, ['$MAKE -s --no-print-directory listcomps']) +test('T10255', normal, run_command, ['$MAKE -s --no-print-directory t10255']) diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.hs b/testsuite/tests/ghc-api/annotations/t10255.hs similarity index 91% copy from testsuite/tests/ghc-api/annotations/exampleTest.hs copy to testsuite/tests/ghc-api/annotations/t10255.hs index 0b6c224..49c68e2 100644 --- a/testsuite/tests/ghc-api/annotations/exampleTest.hs +++ b/testsuite/tests/ghc-api/annotations/t10255.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "AnnotationTuple" + testOneFile libdir "Test10255" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do @@ -37,16 +37,10 @@ testOneFile libdir fileName = do load LoadAllTargets modSum <- getModSummary mn p <- parseModule modSum - t <- typecheckModule p - d <- desugarModule t - l <- loadModule d - let ts=typecheckedSource l - r =renamedSource l return (pm_annotations p,p) let spans = Set.fromList $ getAllSrcSpans (pm_parsed_source p) - -- putStrLn (pp spans) problems = filter (\(s,a) -> not (Set.member s spans)) $ getAnnSrcSpans (anns,cs) putStrLn "---Problems---------------------" From git at git.haskell.org Fri May 8 17:02:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:16 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: Correct parsing of lifted empty list constructor (ad0551c) Message-ID: <20150508170216.C64583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/ad0551c66bb7e8135e1b116a111f37176955e9f4/ghc >--------------------------------------------------------------- commit ad0551c66bb7e8135e1b116a111f37176955e9f4 Author: Matthew Pickering Date: Wed May 6 08:07:31 2015 -0500 Correct parsing of lifted empty list constructor See #10299 Previously `'[]` was parsed to a `HsTyVar` rather than a `HsExplicitListTy`. This patch fixes the shift-reduce conflict which caused this problem. Reviewed By: alanz, austin Differential Revision: https://phabricator.haskell.org/D840 (cherry picked from commit caeae1a33e28745b51d952b034e253d3e51e0605) Conflicts: compiler/parser/Parser.y >--------------------------------------------------------------- ad0551c66bb7e8135e1b116a111f37176955e9f4 compiler/parser/Parser.y | 28 +++++++++++++++++++++------- testsuite/tests/th/TH_RichKinds2.stderr | 2 +- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 9d794c9..9845791 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1549,7 +1549,7 @@ atype :: { LHsType RdrName } | TH_ID_SPLICE { sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $ mkUnqual varName (getTH_ID_SPLICE $1) } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon { sLL $1 $> $ HsTyVar $ unLoc $2 } + | SIMPLEQUOTE qcon_nowiredlist { sLL $1 $> $ HsTyVar $ unLoc $2 } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $3) AnnComma (gl $4) >> ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5)) @@ -2625,11 +2625,22 @@ name_var : var { $1 } ----------------------------------------- -- Data constructors -qcon :: { Located RdrName } - : qconid { $1 } - | '(' qconsym ')' {% ams (sLL $1 $> (unLoc $2)) - [mop $1,mj AnnVal $2,mcp $3] } - | sysdcon { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } +-- There are two different productions here as lifted list constructors +-- are parsed differently. + +qcon_nowiredlist :: { Located RdrName } + : gen_qcon { $1 } + | sysdcon_nolist { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } + +qcon :: { Located RdrName } + : gen_qcon { $1} + | sysdcon { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } + +gen_qcon :: { Located RdrName } + : qconid { $1 } + | '(' qconsym ')' {% ams (sLL $1 $> (unLoc $2)) + [mop $1,mj AnnVal $2,mcp $3] } + -- The case of '[:' ':]' is part of the production `parr' con :: { Located RdrName } @@ -2643,13 +2654,16 @@ con_list : con { sL1 $1 [$1] } | con ',' con_list {% addAnnotation (gl $1) AnnComma (gl $2) >> return (sLL $1 $> ($1 : unLoc $3)) } -sysdcon :: { Located DataCon } -- Wired in data constructors +sysdcon_nolist :: { Located DataCon } -- Wired in data constructors : '(' ')' {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] } | '(' commas ')' {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1)) (mop $1:mcp $3:(mcommas (fst $2))) } | '(#' '#)' {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] } | '(#' commas '#)' {% ams (sLL $1 $> $ tupleCon UnboxedTuple (snd $2 + 1)) (mo $1:mc $3:(mcommas (fst $2))) } + +sysdcon :: { Located DataCon } + : sysdcon_nolist { $1 } | '[' ']' {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] } conop :: { Located RdrName } diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr index 45027d5..bb567a6 100644 --- a/testsuite/tests/th/TH_RichKinds2.stderr +++ b/testsuite/tests/th/TH_RichKinds2.stderr @@ -3,7 +3,7 @@ TH_RichKinds2.hs:23:4: Warning: data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: GHC.Base.Maybe k_0) = forall . t_3 ~ 'GHC.Base.Nothing => SNothing_4 | forall a_5 . t_3 ~ 'GHC.Base.Just a_5 => SJust_6 (t_1 a_5) -type instance TH_RichKinds2.Map f_7 'GHC.Types.[] = 'GHC.Types.[] +type instance TH_RichKinds2.Map f_7 '[] = '[] type instance TH_RichKinds2.Map f_8 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9) (TH_RichKinds2.Map f_8 t_10) From git at git.haskell.org Fri May 8 17:02:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:20 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: ApiAnnotations : quoted type variables missing leading quote (d4596ef) Message-ID: <20150508170220.BD3233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/d4596efab84153d65f285c75f1e20f3556830ea2/ghc >--------------------------------------------------------------- commit d4596efab84153d65f285c75f1e20f3556830ea2 Author: Alan Zimmerman Date: Wed May 6 08:07:39 2015 -0500 ApiAnnotations : quoted type variables missing leading quote The HsOpTy can be constructed for a promoted type operator, in which case it has the following form | btype SIMPLEQUOTE qconop type { sLL $1 $> $ mkHsOpTy $1 $3 $4 } | btype SIMPLEQUOTE varop type { sLL $1 $> $ mkHsOpTy $1 $3 $4 } The SIMPLEQUOTE does not get an annotation, so cannot be reproduced via the API Annotations. Also, in splice_exp :: { LHsExpr RdrName } : TH_ID_SPLICE { sL1 $1 $ mkHsSpliceE (sL1 $1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))) } | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE $2) [mo $1,mc $3] } | TH_ID_TY_SPLICE { sL1 $1 $ mkHsSpliceTE (sL1 $1 $ HsVar (mkUnqual varName (getTH_ID_TY_SPLICE $1))) } | '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE $2) [mo $1,mc $3] } the TH_ID_SPLICE and TH_ID_TY_SPLICE positions are lost. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D825 GHC Trac Issues: #10268 (cherry picked from commit 15aafc7fb61d2cbf95f2a564762399e82fe44e9c) >--------------------------------------------------------------- d4596efab84153d65f285c75f1e20f3556830ea2 compiler/parser/ApiAnnotation.hs | 4 ++ compiler/parser/Parser.y | 39 ++++++++------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 7 +++ testsuite/tests/ghc-api/annotations/T10268.stderr | 10 ++++ testsuite/tests/ghc-api/annotations/T10268.stdout | 55 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10268.hs | 11 +++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10255.hs => t10268.hs} | 3 +- 9 files changed, 114 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 d4596efab84153d65f285c75f1e20f3556830ea2 From git at git.haskell.org Fri May 8 17:02:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:24 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: ApiAnnotations : RdrHsSyn.isFunLhs discards parentheses (ec6c9ad) Message-ID: <20150508170224.864183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/ec6c9adf369eb705a4dbd45f8823d3d21556b5f9/ghc >--------------------------------------------------------------- commit ec6c9adf369eb705a4dbd45f8823d3d21556b5f9 Author: Alan Zimmerman Date: Thu May 7 23:45:44 2015 +0200 ApiAnnotations : RdrHsSyn.isFunLhs discards parentheses Summary: The RdrHsSyn.isFunLhs function has the following isFunLhs e = go e [] where go (L loc (HsVar f)) es | not (isRdrDataCon f) = return (Just (L loc f, False, es)) go (L _ (HsApp f e)) es = go f (e:es) go (L _ (HsPar e)) es@(_:_) = go e es The treatment of HsPar means that any parentheses around an infix function will be discarded. e.g. (f =*= g) sa i = f (toF sa i) =^= g (toG sa i) will lose the ( before f and the closing one after g Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D832 GHC Trac Issues: #10269 (cherry picked from commit 5bde9f7c1834ab4da1fad1838afec1a578c26530) >--------------------------------------------------------------- ec6c9adf369eb705a4dbd45f8823d3d21556b5f9 compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 46 ++++++++++++---------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++++ testsuite/tests/ghc-api/annotations/T10269.stdout | 36 +++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10269.hs | 4 ++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10268.hs => t10269.hs} | 2 +- 8 files changed, 78 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ec6c9adf369eb705a4dbd45f8823d3d21556b5f9 From git at git.haskell.org Fri May 8 17:02:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:28 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: ApiAnnotations : AnnComma missing in TupleSection (2f463c7) Message-ID: <20150508170228.478FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/2f463c75ca0ef019d65e7528f8546e46a29bb5b6/ghc >--------------------------------------------------------------- commit 2f463c75ca0ef019d65e7528f8546e46a29bb5b6 Author: Alan Zimmerman Date: Fri May 8 09:38:39 2015 +0200 ApiAnnotations : AnnComma missing in TupleSection Summary: For the following code {-# LANGUAGE TupleSections #-} foo = do liftIO $ atomicModifyIORef ciTokens ((,()) . f) the annotation is missing for the comma. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D834 GHC Trac Issues: #10280 (cherry picked from commit 225df19a87d8de8245db84d558618f4824631acc) >--------------------------------------------------------------- 2f463c75ca0ef019d65e7528f8546e46a29bb5b6 compiler/parser/Parser.y | 4 +-- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 5 +++ testsuite/tests/ghc-api/annotations/T10280.stderr | 6 ++++ testsuite/tests/ghc-api/annotations/T10280.stdout | 36 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10280.hs | 4 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10269.hs => t10280.hs} | 2 +- 8 files changed, 56 insertions(+), 3 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index b2f702d..9645e3a 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2252,10 +2252,10 @@ texp :: { LHsExpr RdrName } tup_exprs :: { [LHsTupArg RdrName] } : texp commas_tup_tail {% do { addAnnotation (gl $1) AnnComma (fst $2) - ; return ((L (gl $1) (Present $1)) : snd $2) } } + ; return ((sL1 $1 (Present $1)) : snd $2) } } | commas tup_tail - {% do { mapM_ (\ll -> addAnnotation (gl ll) AnnComma (gl ll)) $2 + {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1) ; return (let tt = if null $2 then [noLoc missingTupArg] diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 2280a5a..fc9760f 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -6,6 +6,7 @@ listcomps t10255 t10268 t10269 +t10280 *.hi *.o *.run.* diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 898db5f..44b2889 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -44,6 +44,11 @@ T10268: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10268 ./t10268 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" +T10280: + rm -f t10280.o t10280.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10280 + ./t10280 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + .PHONY: clean annotations parseTree comments exampleTest listcomps T10269: diff --git a/testsuite/tests/ghc-api/annotations/T10280.stderr b/testsuite/tests/ghc-api/annotations/T10280.stderr new file mode 100644 index 0000000..114b95b --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10280.stderr @@ -0,0 +1,6 @@ + +Test10280.hs:4:8: Not in scope: ?atomicModifyIORef? + +Test10280.hs:4:26: Not in scope: ?ciTokens? + +Test10280.hs:4:44: Not in scope: ?f? diff --git a/testsuite/tests/ghc-api/annotations/T10280.stdout b/testsuite/tests/ghc-api/annotations/T10280.stdout new file mode 100644 index 0000000..82a0eb2 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10280.stdout @@ -0,0 +1,36 @@ +---Problems--------------------- +[ +(AK AnnEofPos = [Test10280.hs:5:1]) +] + +-------------------------------- +[ +(AK Test10280.hs:1:1 AnnModule = [Test10280.hs:2:1-6]) + +(AK Test10280.hs:1:1 AnnWhere = [Test10280.hs:2:18-22]) + +(AK Test10280.hs:4:1-45 AnnEqual = [Test10280.hs:4:6]) + +(AK Test10280.hs:4:1-45 AnnFunId = [Test10280.hs:4:1-4]) + +(AK Test10280.hs:4:1-45 AnnSemi = [Test10280.hs:5:1]) + +(AK Test10280.hs:4:35-45 AnnCloseP = [Test10280.hs:4:45]) + +(AK Test10280.hs:4:35-45 AnnOpenP = [Test10280.hs:4:35]) + +(AK Test10280.hs:4:36-40 AnnCloseP = [Test10280.hs:4:40]) + +(AK Test10280.hs:4:36-40 AnnOpenP = [Test10280.hs:4:36]) + +(AK Test10280.hs:4:36-44 AnnVal = [Test10280.hs:4:42]) + +(AK Test10280.hs:4:37 AnnComma = [Test10280.hs:4:37]) + +(AK Test10280.hs:4:38-39 AnnCloseP = [Test10280.hs:4:39]) + +(AK Test10280.hs:4:38-39 AnnOpenP = [Test10280.hs:4:38]) + +(AK AnnEofPos = [Test10280.hs:5:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10280.hs b/testsuite/tests/ghc-api/annotations/Test10280.hs new file mode 100644 index 0000000..08e4186 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10280.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TupleSections #-} +module Test10280 where + +foo2 = atomicModifyIORef ciTokens ((,()) . f) diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 29e22c6..e0834af 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -6,3 +6,4 @@ test('listcomps', normal, run_command, ['$MAKE -s --no-print-directory listcom test('T10255', normal, run_command, ['$MAKE -s --no-print-directory t10255']) test('T10268', normal, run_command, ['$MAKE -s --no-print-directory T10268']) test('T10269', normal, run_command, ['$MAKE -s --no-print-directory T10269']) +test('T10280', normal, run_command, ['$MAKE -s --no-print-directory T10280']) diff --git a/testsuite/tests/ghc-api/annotations/t10269.hs b/testsuite/tests/ghc-api/annotations/t10280.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10269.hs copy to testsuite/tests/ghc-api/annotations/t10280.hs index e71cd3b..5ed78af 100644 --- a/testsuite/tests/ghc-api/annotations/t10269.hs +++ b/testsuite/tests/ghc-api/annotations/t10280.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10269" + testOneFile libdir "Test10280" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Fri May 8 17:02:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:32 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: ApiAnnotations: misplaced AnnComma for squals production (bd2bfe2) Message-ID: <20150508170232.8FBBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/bd2bfe29480fe3f845bea1fafd1d9787cc14eed8/ghc >--------------------------------------------------------------- commit bd2bfe29480fe3f845bea1fafd1d9787cc14eed8 Author: Alan Zimmerman Date: Fri May 8 11:18:28 2015 +0200 ApiAnnotations: misplaced AnnComma for squals production Summary: The parser production for squals has : squals ',' transformqual {% addAnnotation (gl $ last $ unLoc $1) AnnComma (gl $2) >> ams (sLL $1 $> ()) (fst $ unLoc $3) >> return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) } This attaches the comma to the wrong part of the squals, as it is generated in reverse order. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D846 GHC Trac Issues: #10312 (cherry picked from commit 713612674634754edd17264e688f0479d943d8d2) >--------------------------------------------------------------- bd2bfe29480fe3f845bea1fafd1d9787cc14eed8 compiler/parser/Parser.y | 2 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + testsuite/tests/ghc-api/annotations/T10312.stderr | 8 + testsuite/tests/ghc-api/annotations/T10312.stdout | 485 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10312.hs | 79 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10255.hs => t10312.hs} | 2 +- 8 files changed, 584 insertions(+), 2 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 bd2bfe29480fe3f845bea1fafd1d9787cc14eed8 From git at git.haskell.org Fri May 8 17:02:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 17:02:35 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots: Fix failing API Annotations tests from master cherry pick (3aca63a) Message-ID: <20150508170235.6A5D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/3aca63a3e31078246c111fbf385cf0fb84e5ff04/ghc >--------------------------------------------------------------- commit 3aca63a3e31078246c111fbf385cf0fb84e5ff04 Author: Alan Zimmerman Date: Fri May 8 19:01:43 2015 +0200 Fix failing API Annotations tests from master cherry pick >--------------------------------------------------------------- 3aca63a3e31078246c111fbf385cf0fb84e5ff04 testsuite/tests/ghc-api/annotations/T10268.stderr | 9 ++++++++- testsuite/tests/ghc-api/annotations/T10312.stderr | 6 +++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/ghc-api/annotations/T10268.stderr b/testsuite/tests/ghc-api/annotations/T10268.stderr index de983a2..0fe0427 100644 --- a/testsuite/tests/ghc-api/annotations/T10268.stderr +++ b/testsuite/tests/ghc-api/annotations/T10268.stderr @@ -1,7 +1,14 @@ Test10268.hs:5:6: Not in scope: ?footemplate? - In the untyped splice: $footemplate + In the splice: $footemplate + +Test10268.hs:5:6: + GHC stage restriction: + ?footemplate? is used in a top-level splice or annotation, + and must be imported, not defined locally + In the expression: footemplate + In the splice: $footemplate Test10268.hs:7:14: Not in scope: type constructor or class ?Pattern? diff --git a/testsuite/tests/ghc-api/annotations/T10312.stderr b/testsuite/tests/ghc-api/annotations/T10312.stderr index 08f3bec..939823c 100644 --- a/testsuite/tests/ghc-api/annotations/T10312.stderr +++ b/testsuite/tests/ghc-api/annotations/T10312.stderr @@ -1,8 +1,8 @@ -Test10312.hs:77:38: error: Not in scope: data constructor ?Fixity? +Test10312.hs:77:38: Not in scope: data constructor ?Fixity? -Test10312.hs:77:53: error: +Test10312.hs:77:53: Not in scope: ?fs? Perhaps you meant ?fst? (imported from Prelude) -Test10312.hs:78:47: error: Not in scope: ?ppDir? +Test10312.hs:78:47: Not in scope: ?ppDir? From git at git.haskell.org Fri May 8 20:55:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 May 2015 20:55:38 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: AvailInfo plan, and why selectors are hard. (2601a43) Message-ID: <20150508205538.89AEC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2601a436b3a52f52cec08599041b665b9887baa2/ghc >--------------------------------------------------------------- commit 2601a436b3a52f52cec08599041b665b9887baa2 Author: Edward Z. Yang Date: Fri May 8 13:56:21 2015 -0700 Backpack docs: AvailInfo plan, and why selectors are hard. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 2601a436b3a52f52cec08599041b665b9887baa2 docs/backpack/algorithm.pdf | Bin 245874 -> 257231 bytes docs/backpack/algorithm.tex | 123 +++++++++++++++++++++++++++++++++++++++----- 2 files changed, 109 insertions(+), 14 deletions(-) diff --git a/docs/backpack/algorithm.pdf b/docs/backpack/algorithm.pdf index 2ac126d..8207286 100644 Binary files a/docs/backpack/algorithm.pdf and b/docs/backpack/algorithm.pdf differ diff --git a/docs/backpack/algorithm.tex b/docs/backpack/algorithm.tex index 8cc8cce..7674050 100644 --- a/docs/backpack/algorithm.tex +++ b/docs/backpack/algorithm.tex @@ -458,7 +458,7 @@ proceeds as follows: if there is a duplicate that doesn't have the same identity. \end{enumerate} % -To merge two sets of names, take each pair of names with matching \verb|OccName|s $n$ and $m$. +To merge two sets of names, union the two sets, handling each pair of names with matching \verb|OccName|s $n$ and $m$ as follows: \begin{enumerate} \item If both are from holes, pick a canonical representative $m$ and substitute $n$ with $m$. @@ -750,9 +750,35 @@ key from the identifiers. Previously, we stated that we simply merged $Name$s based on their $OccName$s. We now must consider what it means to merge $AvailInfo$s. -\subsection{Algorithim} - -\Red{to write up} +\subsection{Algorithm} + +Our merging algorithm takes two sets of $AvailInfo$s and merges them +into one set. In the degenerate case where every $AvailInfo$ is a +$Name$, this algorithm operates the same as the original algorithm. +Merging proceeds in two steps: unification and then simple union. + +Unification proceeds as follows: for each pair of $Name$s with +matching $OccName$s, unify the names. For each pair of $Name\, \verb|{|\, +Name_0\verb|,|\, \ldots\verb|,|\, Name_n\, \verb|}|$, where there +exists some pair of child names with matching $OccName$s, unify the +parent $Name$s. (A single $AvailInfo$ may participate in multiple such +pairs.) A simple identifier and a type constructor $AvailInfo$ with +overlapping in-scope names fails to unify. After unification, +the simple union combines entries with matching \verb|availName|s (parent +name in the case of a type constructor), recursively unioning the child +names of type constructor $AvailInfo$s. + +Unification of $Name$s results in a substitution, and a $Name$ substitution +on $AvailInfo$ is a little unconventional. Specifically, substitution on $Name\, \verb|{|\, +Name_0\verb|,|\, \ldots\verb|,|\, Name_n\, \verb|}|$ proceeds specially: +a substitution from $Name$ to $Name'$ induces a substitution from +$Module$ to $Module'$ (as the $OccName$s of the $Name$s are guaranteed +to be equal), so for each child $Name_i$, perform the $Module$ +substitution. So for example, the substitution \verb|HOLE:A.T| to \verb|THIS:A.T| +takes the $AvailInfo$ \verb|HOLE:A.T { HOLE:A.B, HOLE:A.foo }| to +\verb|THIS:A.T { THIS:A.B, THIS:A.foo }|. In particular, substitution +on children $Name$s is \emph{only} carried out by substituting on the outer name; +we will never directly substitute children. \subsection{Examples} @@ -786,7 +812,9 @@ The answer is no! Consider these implementations: Here, \verb|module A1| implements \verb|signature A1|, \verb|module A2| implements \verb|signature A2|, and \verb|module A| implements \verb|signature A1| and \verb|signature A2| individually -and should certainly implement their merge. +and should certainly implement their merge. This is why we cannot simply +merge type constructors based on the $OccName$ of their top-level type; +merging only occurs between in-scope identifiers. \paragraph{Does merging a selector merge the type constructor?} @@ -803,9 +831,8 @@ and should certainly implement their merge. % Does the last signature, which is written in the style of a sharing constraint on \verb|foo|, also cause \verb|bar| and the type and constructor \verb|A| to be unified? -It doesn't seem to be too harmful if we don't unify the rest, and arranging -for the other children to be unified introduces a bit of complexity, so -for now we say no. +Because a merge of a child name results in a substitution on the parent name, +the answer is yes. \paragraph{Incomplete data declarations} @@ -834,7 +861,7 @@ equivalent to the shapes for these which should merge: data A = A { foo :: Int, bar :: Bool } \end{verbatim} -\paragraph{Record selectors and functions} +\subsection{Subtyping record selectors as functions} \begin{verbatim} signature H(foo) where @@ -848,22 +875,90 @@ equivalent to the shapes for these which should merge: Does \verb|M| successfully fill \verb|H|? If so, it means that anywhere a signature requests a function \verb|foo|, we can instead validly provide a record selector. This capability seems quite attractive -but actually it is quite complicated! We'll discuss this in the next -section. +but actually it is quite complicated, because we can no longer assume +that every child name is associated with a parent name. As a workaround, \verb|H| can equivalently be written as: \begin{verbatim} - module H(foo) where + signature H(foo) where data A = A { foo :: Int, bar :: Bool } \end{verbatim} % This is suboptimal, however, as the otherwise irrelevant \verb|bar| must be mentioned in the definition. -\subsection{Subtyping record selectors as functions} +So what if we actually want to write the original signature \verb|H|? +The technical difficulty is that we now need to unify a plain identifier +$AvailInfo$ (from the signature) with a type constructor $AvailInfo$ +(from a module.) It is not clear what this should mean. +Consider this situation: + +\begin{verbatim} + package p where + signature H(A, foo, bar) where + data A + foo :: A -> Int + bar :: A -> Bool + module X(A, foo) where + import H + package q where + include p + signature H(bar) where + data A = A { foo :: Int, bar :: Bool } + module Y where + import X(A(..)) -- ??? +\end{verbatim} + +Should the wildcard import on \verb|X| be allowed? Probably not? +How about this situation: + +\begin{verbatim} + package p where + -- define without record selectors + signature X1(A, foo) where + data A + foo :: A -> Int + module M1(A, foo) where + import X1 + + package q where + -- define with record selectors (X1s unify) + signature X1(A(..)) where + data A = A { foo :: Int, bar :: Bool } + signature X2(A(..)) where + data A = A { foo :: Int, bar :: Bool } + + -- export some record selectors + signature Y1(bar) where + import X1 + signature Y2(bar) where + import X2 + + package r where + include p + include q + + -- sharing constraint + signature Y2(bar) where + import Y1(bar) + + -- the payload + module Test where + import M1(foo) + import X2(foo) + ... foo ... -- conflict? +\end{verbatim} -\Red{to write} +Without the sharing constraint, the \verb|foo|s from \verb|M1| and \verb|X2| +should conflict. With it, however, we should conclude that the \verb|foo|s +are the same, even though the \verb|foo| from \verb|M1| is \emph{not} +considered a child of \verb|A|, and even though in the sharing constraint +we \emph{only} unified \verb|bar| (and its parent \verb|A|). To know that +\verb|foo| from \verb|M1| should also be unified, we have to know a bit +more about \verb|A| when the sharing constraint performs unification; +however, the $AvailInfo$ will only tell us about what is in-scope, which +is \emph{not} enough information. %\newpage From git at git.haskell.org Sat May 9 08:25:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 08:25:15 +0000 (UTC) Subject: [commit: ghc] master: Support stage 1 Template Haskell (non-quasi) quotes, fixes #10382. (28257ca) Message-ID: <20150509082515.0A4503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28257cae77023f2ccc4cc1c0cd1fbbd329947a00/ghc >--------------------------------------------------------------- commit 28257cae77023f2ccc4cc1c0cd1fbbd329947a00 Author: Edward Z. Yang Date: Mon May 4 16:10:05 2015 -0700 Support stage 1 Template Haskell (non-quasi) quotes, fixes #10382. Summary: This commit adds stage 1 support for Template Haskell quoting, e.g. [| ... expr ... |], which is useful for authors of quasiquoter libraries that do not actually need splices. The TemplateHaskell extension now does not unconditionally fail; it only fails if the renamer encounters a splice that it can't run. In order to make sure the referenced data structures are consistent, template-haskell is now a boot library. In the following patches, there are: - A few extra safety checks which should be enabled in stage1 - Separation of the th/ testsuite into quotes/ which can be run on stage1 Note for reviewer: big diff changes are simply code being moved out of an ifdef; there was no other substantive change to that code. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, goldfire Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D876 GHC Trac Issues: #10382 >--------------------------------------------------------------- 28257cae77023f2ccc4cc1c0cd1fbbd329947a00 compiler/deSugar/DsExpr.hs | 8 -- compiler/ghc.cabal.in | 4 +- compiler/main/DynFlags.hs | 27 +--- compiler/main/HscMain.hs | 4 +- compiler/rename/RnSplice.hs | 295 +++++++++++++++++++------------------- compiler/typecheck/TcSplice.hs | 173 +++++++++++----------- docs/users_guide/7.12.1-notes.xml | 7 +- docs/users_guide/glasgow_exts.xml | 4 +- ghc.mk | 2 +- mk/warnings.mk | 1 + 10 files changed, 251 insertions(+), 274 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 28257cae77023f2ccc4cc1c0cd1fbbd329947a00 From git at git.haskell.org Sat May 9 08:25:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 08:25:17 +0000 (UTC) Subject: [commit: ghc] master: Split off quotes/ from th/ for tests that can be done on stage1 compiler. (21c72e7) Message-ID: <20150509082517.E8E203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21c72e7d38c96ac80d31addf67ae4b3c7a6c3bbb/ghc >--------------------------------------------------------------- commit 21c72e7d38c96ac80d31addf67ae4b3c7a6c3bbb Author: Edward Z. Yang Date: Mon May 4 17:06:24 2015 -0700 Split off quotes/ from th/ for tests that can be done on stage1 compiler. Signed-off-by: Edward Z. Yang Test Plan: run these tests with stage1 Reviewers: simonpj, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D877 GHC Trac Issues: #10382 >--------------------------------------------------------------- 21c72e7d38c96ac80d31addf67ae4b3c7a6c3bbb testsuite/tests/quotes/.gitignore | 4 +++ testsuite/tests/{annotations => quotes}/Makefile | 0 testsuite/tests/{th => quotes}/T2632.hs | 2 -- testsuite/tests/{th => quotes}/T2931.hs | 1 - testsuite/tests/{th => quotes}/T3572.hs | 0 testsuite/tests/{th => quotes}/T3572.stdout | 0 testsuite/tests/{th => quotes}/T4056.hs | 2 +- testsuite/tests/{th => quotes}/T4169.hs | 2 -- testsuite/tests/{th => quotes}/T4170.hs | 1 - testsuite/tests/{th => quotes}/T5721.hs | 2 +- testsuite/tests/{th => quotes}/T6062.hs | 1 - testsuite/tests/quotes/T8455.hs | 5 ++++ testsuite/tests/{th => quotes}/T8633.hs | 0 testsuite/tests/{th => quotes}/T8759a.hs | 2 +- testsuite/tests/{th => quotes}/T8759a.stderr | 0 testsuite/tests/{th => quotes}/T9824.hs | 1 - .../tests/{th => quotes}/TH_abstractFamily.hs | 0 .../tests/{th => quotes}/TH_abstractFamily.stderr | 0 testsuite/tests/{th => quotes}/TH_bracket1.hs | 0 testsuite/tests/{th => quotes}/TH_bracket2.hs | 0 testsuite/tests/{th => quotes}/TH_bracket3.hs | 0 testsuite/tests/{th => quotes}/TH_ppr1.hs | 0 testsuite/tests/{th => quotes}/TH_ppr1.stdout | 0 testsuite/tests/{th => quotes}/TH_reifyType1.hs | 0 testsuite/tests/{th => quotes}/TH_reifyType2.hs | 0 testsuite/tests/{th => quotes}/TH_repE1.hs | 0 testsuite/tests/{th => quotes}/TH_repE3.hs | 0 testsuite/tests/{th => quotes}/TH_scope.hs | 0 .../tests/{th => quotes}/TH_spliceViewPat/A.hs | 0 .../tests/{th => quotes}/TH_spliceViewPat/Main.hs | 0 .../tests/{th => quotes}/TH_spliceViewPat/Makefile | 0 .../TH_spliceViewPat/TH_spliceViewPat.stdout | 0 .../tests/{th => quotes}/TH_spliceViewPat/test.T | 5 ---- testsuite/tests/{th => quotes}/TH_tf2.hs | 0 testsuite/tests/quotes/all.T | 29 ++++++++++++++++++++ testsuite/tests/th/T8455.hs | 5 ---- testsuite/tests/th/all.T | 31 ++++------------------ 37 files changed, 46 insertions(+), 47 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 21c72e7d38c96ac80d31addf67ae4b3c7a6c3bbb From git at git.haskell.org Sat May 9 08:25:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 08:25:21 +0000 (UTC) Subject: [commit: ghc] master: RnSplice's staging test should be applied for quotes in stage1. (eb0ed40) Message-ID: <20150509082521.35E643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eb0ed4030374af542c0a459480d32c8d4525e48d/ghc >--------------------------------------------------------------- commit eb0ed4030374af542c0a459480d32c8d4525e48d Author: Edward Z. Yang Date: Mon May 4 17:28:11 2015 -0700 RnSplice's staging test should be applied for quotes in stage1. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D878 GHC Trac Issues: #10382 >--------------------------------------------------------------- eb0ed4030374af542c0a459480d32c8d4525e48d compiler/rename/RnSplice.hs | 17 ++++++----------- testsuite/tests/quotes/TH_localname.hs | 3 +++ testsuite/tests/quotes/TH_localname.stderr | 22 ++++++++++++++++++++++ testsuite/tests/quotes/all.T | 1 + 4 files changed, 32 insertions(+), 11 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 4f55477..5d12720 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -35,11 +35,14 @@ import Control.Monad ( unless, when ) import {-# SOURCE #-} RnExpr ( rnLExpr ) +import PrelNames ( isUnboundName ) +import TcEnv ( checkWellStaged ) +import DsMeta ( liftName ) + #ifdef GHCI import ErrUtils ( dumpIfSet_dyn_printer ) -import DsMeta ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, liftName ) -import PrelNames ( isUnboundName ) -import TcEnv ( checkWellStaged, tcMetaTy ) +import DsMeta ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, ) +import TcEnv ( tcMetaTy ) import Hooks import Var ( Id ) import DsMeta ( quoteExpName, quotePatName, quoteDecName, quoteTypeName ) @@ -565,13 +568,6 @@ illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brac #endif checkThLocalName :: Name -> RnM () -#ifndef GHCI /* GHCI and TH is off */ --------------------------------------- --- Check for cross-stage lifting -checkThLocalName _name - = return () - -#else /* GHCI and TH is on */ checkThLocalName name | isUnboundName name -- Do not report two errors for = return () -- $(not_in_scope args) @@ -637,7 +633,6 @@ check_cross_stage_lifting top_lvl name ps_var -- Update the pending splices ; ps <- readMutVar ps_var ; writeMutVar ps_var (pend_splice : ps) } -#endif /* GHCI */ {- Note [Keeping things alive for Template Haskell] diff --git a/testsuite/tests/quotes/TH_localname.hs b/testsuite/tests/quotes/TH_localname.hs new file mode 100644 index 0000000..5bc0e96 --- /dev/null +++ b/testsuite/tests/quotes/TH_localname.hs @@ -0,0 +1,3 @@ +module TH_localname where + +x = \y -> [| y |] diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr new file mode 100644 index 0000000..a83c606 --- /dev/null +++ b/testsuite/tests/quotes/TH_localname.stderr @@ -0,0 +1,22 @@ + +TH_localname.hs:3:11: error: + No instance for (Lift t0) arising from a use of ?lift? + The type variable ?t0? is ambiguous + Relevant bindings include + y :: t0 (bound at TH_localname.hs:3:6) + x :: t0 -> ExpQ (bound at TH_localname.hs:3:1) + Note: there are several potential instances: + instance (Lift a, Lift b) => Lift (Either a b) + -- Defined in ?Language.Haskell.TH.Syntax? + instance Lift a => Lift (Maybe a) + -- Defined in ?Language.Haskell.TH.Syntax? + instance Lift Int16 -- Defined in ?Language.Haskell.TH.Syntax? + ...plus 24 others + In the expression: lift y + In the expression: + [| y |] + pending(rn) [] + In the expression: + \ y + -> [| y |] + pending(rn) [] diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T index 2688391..a3dfb8b 100644 --- a/testsuite/tests/quotes/all.T +++ b/testsuite/tests/quotes/all.T @@ -27,3 +27,4 @@ test('TH_reifyType2', normal, compile, ['']) test('TH_repE1', normal, compile, ['']) test('TH_repE3', normal, compile, ['']) test('TH_abstractFamily', normal, compile_fail, ['']) +test('TH_localname', normal, compile_fail, ['']) From git at git.haskell.org Sat May 9 08:25:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 08:25:24 +0000 (UTC) Subject: [commit: ghc] master: Always do polymorphic typed quote check, c.f. #10384 (9a43b2c) Message-ID: <20150509082524.AE01E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a43b2c1f78b3cf684646af64b9b67dc8079f58f/ghc >--------------------------------------------------------------- commit 9a43b2c1f78b3cf684646af64b9b67dc8079f58f Author: Edward Z. Yang Date: Tue May 5 10:53:00 2015 -0700 Always do polymorphic typed quote check, c.f. #10384 Summary: Since quotes are enabled in stage1, we need to do the staging check. This also "fixes" #10384 by adding a test for the polymorphic local variable test. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D880 GHC Trac Issues: #10384 >--------------------------------------------------------------- 9a43b2c1f78b3cf684646af64b9b67dc8079f58f compiler/typecheck/TcExpr.hs | 10 ---------- testsuite/tests/quotes/T10384.hs | 3 +++ testsuite/tests/quotes/T10384.stderr | 6 ++++++ testsuite/tests/quotes/all.T | 1 + 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 353b2b7..155cdb4 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -16,9 +16,7 @@ module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC, #include "HsVersions.h" import {-# SOURCE #-} TcSplice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket ) -#ifdef GHCI import DsMeta( liftStringName, liftName ) -#endif import HsSyn import TcHsSyn @@ -1234,13 +1232,6 @@ tcTagToEnum loc fun_name arg res_ty -} checkThLocalId :: Id -> TcM () -#ifndef GHCI /* GHCI and TH is off */ --------------------------------------- --- Check for cross-stage lifting -checkThLocalId _id - = return () - -#else /* GHCI and TH is on */ checkThLocalId id = do { mb_local_use <- getStageAndBindLevel (idName id) ; case mb_local_use of @@ -1303,7 +1294,6 @@ checkCrossStageLifting _ _ = return () polySpliceErr :: Id -> SDoc polySpliceErr id = ptext (sLit "Can't splice the polymorphic local variable") <+> quotes (ppr id) -#endif /* GHCI */ {- Note [Lifting strings] diff --git a/testsuite/tests/quotes/T10384.hs b/testsuite/tests/quotes/T10384.hs new file mode 100644 index 0000000..773deb0 --- /dev/null +++ b/testsuite/tests/quotes/T10384.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE TemplateHaskell, RankNTypes, ScopedTypeVariables #-} +module A where +x = \(y :: forall a. a -> a) -> [|| y ||] diff --git a/testsuite/tests/quotes/T10384.stderr b/testsuite/tests/quotes/T10384.stderr new file mode 100644 index 0000000..f2360fd --- /dev/null +++ b/testsuite/tests/quotes/T10384.stderr @@ -0,0 +1,6 @@ + +T10384.hs:3:37: error: + Can't splice the polymorphic local variable ?y? + In the Template Haskell quotation [|| y ||] + In the expression: [|| y ||] + In the expression: \ (y :: forall a. a -> a) -> [|| y ||] diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T index a3dfb8b..a56a50c 100644 --- a/testsuite/tests/quotes/all.T +++ b/testsuite/tests/quotes/all.T @@ -15,6 +15,7 @@ test('T8455', normal, compile, ['-v0']) test('T8633', normal, compile_and_run, ['']) test('T8759a', normal, compile_fail, ['-v0']) test('T9824', normal, compile, ['-v0']) +test('T10384', normal, compile_fail, ['']) test('TH_tf2', normal, compile, ['-v0']) test('TH_ppr1', normal, compile_and_run, ['']) From git at git.haskell.org Sat May 9 14:17:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:17:36 +0000 (UTC) Subject: [commit: ghc] branch 'wip/api-annots' created Message-ID: <20150509141736.BE4C03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/api-annots Referencing: 36896826a78d4e7eb003295e6136bd8619695714 From git at git.haskell.org Sat May 9 14:17:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:17:40 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. (4d290ad) Message-ID: <20150509141740.CF53B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/4d290ad44ee56d7da9d6c780ce581c64e11331e9/ghc >--------------------------------------------------------------- commit 4d290ad44ee56d7da9d6c780ce581c64e11331e9 Author: Alan Zimmerman Date: Fri May 8 11:22:47 2015 +0200 Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. Summary: The code for mkAtDefault is as follows. mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e })) | TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs } <- e = do { tvs <- checkTyVars (ptext (sLit "default")) equalsDots tc (hswb_cts pats) ; return (L loc (TyFamEqn { tfe_tycon = tc , tfe_pats = tvs , tfe_rhs = rhs })) } An associated type in a class of the form type FoldableConstraint t x = () has an AnnEqual attached to the location in tfid_eqn. Since the location is discarded, this annotation is then disconnected from the AST. Test Plan: ./validate Reviewers: hvr, austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D842 GHC Trac Issues: #10307 Conflicts: testsuite/tests/ghc-api/annotations/.gitignore testsuite/tests/ghc-api/annotations/Makefile testsuite/tests/ghc-api/annotations/all.T >--------------------------------------------------------------- 4d290ad44ee56d7da9d6c780ce581c64e11331e9 compiler/parser/Parser.y | 32 +++++++++++-------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10307.stdout | 36 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10307.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10312.hs => t10307.hs} | 2 +- 7 files changed, 72 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4d290ad44ee56d7da9d6c780ce581c64e11331e9 From git at git.haskell.org Sat May 9 14:17:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:17:44 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: ApiAnnotations : mkGadtDecl discards annotations for HsFunTy (2f3bfec) Message-ID: <20150509141744.844C43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/2f3bfec0337b05ba5175925f7561238edb5d352c/ghc >--------------------------------------------------------------- commit 2f3bfec0337b05ba5175925f7561238edb5d352c Author: Alan Zimmerman Date: Fri May 8 12:00:33 2015 +0200 ApiAnnotations : mkGadtDecl discards annotations for HsFunTy Summary: When mkGadtDecl is presented wih a HsFunTy it discards the SrcSpan, thus disconnecting any annotations on the HsFunTy. ``` mkGadtDecl names (L ls (HsForAllTy imp Nothing qvars cxt tau)) = return $ mk_gadt_con names where (details, res_ty) -- See Note [Sorting out the result type] = case tau of L _ (HsFunTy (L l (HsRecTy flds)) res_ty) -> (RecCon (L l flds), res_ty) _other -> (PrefixCon [], tau) ... ``` This can be triggered by the following ``` {-# LANGUAGE GADTs #-} module GADTRecords2 (H1(..)) where -- | h1 data H1 a b where C3 :: (Num a) => { field :: a -- ^ hello docs } -> H1 Int Int ``` Test Plan: ./validate Reviewers: hvr, austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D848 GHC Trac Issues: #10309 Conflicts: testsuite/tests/ghc-api/annotations/Makefile testsuite/tests/ghc-api/annotations/all.T >--------------------------------------------------------------- 2f3bfec0337b05ba5175925f7561238edb5d352c compiler/parser/Parser.y | 3 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10255.stdout | 2 ++ testsuite/tests/ghc-api/annotations/T10309.stdout | 38 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10309.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10307.hs => t10309.hs} | 2 +- 8 files changed, 59 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 1baf606..3d9b2a3 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1621,7 +1621,8 @@ type :: { LHsType RdrName } : btype { $1 } | btype qtyconop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } | btype tyvarop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } - | btype '->' ctype {% ams (sLL $1 $> $ HsFunTy $1 $3) + | btype '->' ctype {% ams $1 [mj AnnRarrow $2] + >> ams (sLL $1 $> $ HsFunTy $1 $3) [mj AnnRarrow $2] } | btype '~' btype {% ams (sLL $1 $> $ HsEqTy $1 $3) [mj AnnTilde $2] } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 8b7f082..8ff93b4 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -3,6 +3,7 @@ parseTree comments exampleTest listcomps +t10309 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 15c3bc4..c7aa1e5 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -8,6 +8,7 @@ clean: rm -f t10269 rm -f t10255 t10312 rm -f t1037 + rm -f t10309 annotations: rm -f annotations.o annotations.hi @@ -73,3 +74,10 @@ t10307: ./t10307 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" .PHONY: t10307 + +t10309: + rm -f t10309.o t10309.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10309 + ./t10309 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10309 diff --git a/testsuite/tests/ghc-api/annotations/T10255.stdout b/testsuite/tests/ghc-api/annotations/T10255.stdout index 099ef54..50e9bb7 100644 --- a/testsuite/tests/ghc-api/annotations/T10255.stdout +++ b/testsuite/tests/ghc-api/annotations/T10255.stdout @@ -29,6 +29,8 @@ (AK Test10255.hs:6:11-26 AnnOpenP = [Test10255.hs:6:11]) +(AK Test10255.hs:6:12-18 AnnRarrow = [Test10255.hs:6:20-21]) + (AK Test10255.hs:6:12-25 AnnRarrow = [Test10255.hs:6:20-21]) (AK AnnEofPos = [Test10255.hs:8:1]) diff --git a/testsuite/tests/ghc-api/annotations/T10309.stdout b/testsuite/tests/ghc-api/annotations/T10309.stdout new file mode 100644 index 0000000..1423466 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10309.stdout @@ -0,0 +1,38 @@ +---Problems--------------------- +[ +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) +] + +-------------------------------- +[ +(AK Test10309.hs:1:1 AnnModule = [Test10309.hs:2:1-6]) + +(AK Test10309.hs:1:1 AnnWhere = [Test10309.hs:2:18-22]) + +(AK Test10309.hs:(4,1)-(6,34) AnnData = [Test10309.hs:4:1-4]) + +(AK Test10309.hs:(4,1)-(6,34) AnnSemi = [Test10309.hs:7:1]) + +(AK Test10309.hs:(4,1)-(6,34) AnnWhere = [Test10309.hs:4:13-17]) + +(AK Test10309.hs:(5,3)-(6,34) AnnDcolon = [Test10309.hs:5:6-7]) + +(AK Test10309.hs:5:9-15 AnnCloseP = [Test10309.hs:5:15]) + +(AK Test10309.hs:5:9-15 AnnDarrow = [Test10309.hs:5:17-18]) + +(AK Test10309.hs:5:9-15 AnnOpenP = [Test10309.hs:5:9]) + +(AK Test10309.hs:(5,20)-(6,20) AnnCloseC = [Test10309.hs:6:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnOpenC = [Test10309.hs:5:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:5:22-31 AnnDcolon = [Test10309.hs:5:28-29]) + +(AK AnnEofPos = [Test10309.hs:7:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10309.hs b/testsuite/tests/ghc-api/annotations/Test10309.hs new file mode 100644 index 0000000..75f18a9 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10309.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} +module Test10309 where + +data H1 a b where + C3 :: (Num a) => { field :: a -- ^ hello docs + } -> H1 Int Int diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 3e145b9..81aec52 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -9,3 +9,4 @@ test('T10269', normal, run_command, ['$MAKE -s --no-print-directory T10269' test('T10280', normal, run_command, ['$MAKE -s --no-print-directory T10280']) test('T10312', normal, run_command, ['$MAKE -s --no-print-directory t10312']) test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307']) +test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) diff --git a/testsuite/tests/ghc-api/annotations/t10307.hs b/testsuite/tests/ghc-api/annotations/t10309.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10307.hs copy to testsuite/tests/ghc-api/annotations/t10309.hs index 5c6f233..ebce40e 100644 --- a/testsuite/tests/ghc-api/annotations/t10307.hs +++ b/testsuite/tests/ghc-api/annotations/t10309.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10307" + testOneFile libdir "Test10309" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Sat May 9 14:17:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:17:48 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: ApiAnnotations : BooleanFormula construction discards original (3e655d5) Message-ID: <20150509141748.580393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/3e655d52aebe87f957eb1ffd5697bd4f3300cd21/ghc >--------------------------------------------------------------- commit 3e655d52aebe87f957eb1ffd5697bd4f3300cd21 Author: Alan Zimmerman Date: Fri May 8 12:05:06 2015 +0200 ApiAnnotations : BooleanFormula construction discards original Summary: The MINIMAL pragma is captured in the parser using a BooleanFormula. The constructors (mkBool,mkAnd,mkOr) are smart and try to minimise the boolean formula as it is constructed. This discards the original information, making round tripping impossible. Note: there is another version which provides a more API Annotations friendly version of the MINIMAL pragma, but this requires changes to haddock, which will cause problems for 7.10.2. See https://github.com/alanz/ghc/tree/wip/10287 Test Plan: ./validate Reviewers: hvr, austin Subscribers: Fuuzetsu, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D837 GHC Trac Issues: #10287 Conflicts: testsuite/tests/ghc-api/annotations/.gitignore testsuite/tests/ghc-api/annotations/Makefile testsuite/tests/ghc-api/annotations/all.T >--------------------------------------------------------------- 3e655d52aebe87f957eb1ffd5697bd4f3300cd21 compiler/parser/Parser.y | 10 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + .../tests/ghc-api/annotations/TestBoolFormula.hs | 26 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../annotations/{t10268.hs => boolFormula.hs} | 2 +- .../tests/ghc-api/annotations/boolFormula.stderr | 17 +++ .../tests/ghc-api/annotations/boolFormula.stdout | 163 +++++++++++++++++++++ 8 files changed, 222 insertions(+), 6 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3e655d52aebe87f957eb1ffd5697bd4f3300cd21 From git at git.haskell.org Sat May 9 14:17:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:17:52 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: ApiAnnotations : pquals production adds AnnVbar in the wrong place (3e6f170) Message-ID: <20150509141752.D6F5B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/3e6f17090ade0a5acc83fa8cfcf45cd3e31860ba/ghc >--------------------------------------------------------------- commit 3e6f17090ade0a5acc83fa8cfcf45cd3e31860ba Author: Alan Zimmerman Date: Fri May 8 12:08:22 2015 +0200 ApiAnnotations : pquals production adds AnnVbar in the wrong place Summary: The Parser.y production for pquals is pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] } : squals '|' pquals {% addAnnotation (gl $ last $ unLoc $1) AnnVbar (gl $2) >> return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) } | squals { L (getLoc $1) [reverse (unLoc $1)] } The squals are returned in reverse order, so the AnnVbar should be attached to the head of the list, not the last. Test Plan: ./validate Reviewers: hvr, austin Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D869 GHC Trac Issues: #10357 Conflicts: testsuite/tests/ghc-api/annotations/.gitignore testsuite/tests/ghc-api/annotations/Makefile testsuite/tests/ghc-api/annotations/all.T >--------------------------------------------------------------- 3e6f17090ade0a5acc83fa8cfcf45cd3e31860ba compiler/parser/Parser.y | 2 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10357.stderr | 30 ++++++ testsuite/tests/ghc-api/annotations/T10357.stdout | 110 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10357.hs | 13 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../annotations/{exampleTest.hs => t10357.hs} | 20 ++-- 8 files changed, 177 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 3e6f17090ade0a5acc83fa8cfcf45cd3e31860ba From git at git.haskell.org Sat May 9 14:17:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:17:56 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. (c25168b) Message-ID: <20150509141756.BB2F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/c25168bd9a4fd5d0acb8c83cad07d56c36cd8f6f/ghc >--------------------------------------------------------------- commit c25168bd9a4fd5d0acb8c83cad07d56c36cd8f6f Author: Alan Zimmerman Date: Fri May 8 12:10:28 2015 +0200 ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. Summary: The production for decl_no_th starts decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; ... The e value should be just the pattern, excluding the rhs, but the span created includes the rhs. Test Plan: ./validate Reviewers: hvr, austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D873 GHC Trac Issues: #10358 Conflicts: testsuite/tests/ghc-api/annotations/.gitignore testsuite/tests/ghc-api/annotations/all.T >--------------------------------------------------------------- c25168bd9a4fd5d0acb8c83cad07d56c36cd8f6f compiler/parser/Parser.y | 4 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 7 +++ testsuite/tests/ghc-api/annotations/T10358.stdout | 58 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10358.hs | 8 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10357.hs => t10358.hs} | 2 +- 7 files changed, 78 insertions(+), 3 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 51b20a0..eb2aa0c 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1986,10 +1986,10 @@ docdecld :: { LDocDecl } decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } - | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; + | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; _ <- ams (sLL $1 $> ()) - (mj AnnBang $1:(fst $ unLoc $3)); + (fst $ unLoc $3); return $ sLL $1 $> $ unitOL $ sLL $1 $> $ ValD $ PatBind pat (snd $ unLoc $3) placeHolderType diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 4f6f3be..b8bba4f 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -5,6 +5,7 @@ exampleTest listcomps t10309 t10357 +t10358 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 0cebeaf..7cf7baf 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -37,6 +37,13 @@ listcomps: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc listcomps ./listcomps "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" +t10358: + rm -f t10358.o t10358.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10358 + ./t10358 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10358 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10358.stdout b/testsuite/tests/ghc-api/annotations/T10358.stdout new file mode 100644 index 0000000..02dcb7a --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10358.stdout @@ -0,0 +1,58 @@ +---Problems--------------------- +[ +(AK AnnEofPos = [Test10358.hs:9:1]) +] + +---Problems'-------------------- +[(AnnEofPos, Test10358.hs:9:1)] +-------------------------------- +[ +(AK Test10358.hs:1:1 AnnModule = [Test10358.hs:2:1-6]) + +(AK Test10358.hs:1:1 AnnWhere = [Test10358.hs:2:18-22]) + +(AK Test10358.hs:(4,1)-(8,6) AnnEqual = [Test10358.hs:4:13]) + +(AK Test10358.hs:(4,1)-(8,6) AnnFunId = [Test10358.hs:4:1-7]) + +(AK Test10358.hs:(4,1)-(8,6) AnnSemi = [Test10358.hs:9:1]) + +(AK Test10358.hs:(5,3)-(8,6) AnnIn = [Test10358.hs:8:3-4]) + +(AK Test10358.hs:(5,3)-(8,6) AnnLet = [Test10358.hs:5:3-5]) + +(AK Test10358.hs:5:7-10 AnnBang = [Test10358.hs:5:7]) + +(AK Test10358.hs:5:7-16 AnnEqual = [Test10358.hs:5:12]) + +(AK Test10358.hs:5:7-16 AnnSemi = [Test10358.hs:5:17]) + +(AK Test10358.hs:5:14-16 AnnVal = [Test10358.hs:5:15]) + +(AK Test10358.hs:5:19-22 AnnBang = [Test10358.hs:5:19]) + +(AK Test10358.hs:5:19-32 AnnEqual = [Test10358.hs:5:24]) + +(AK Test10358.hs:5:19-32 AnnSemi = [Test10358.hs:6:7]) + +(AK Test10358.hs:5:26-32 AnnVal = [Test10358.hs:5:29]) + +(AK Test10358.hs:6:7-16 AnnEqual = [Test10358.hs:6:10]) + +(AK Test10358.hs:6:7-16 AnnFunId = [Test10358.hs:6:7-8]) + +(AK Test10358.hs:6:7-16 AnnSemi = [Test10358.hs:7:7]) + +(AK Test10358.hs:6:12-14 AnnVal = [Test10358.hs:6:13]) + +(AK Test10358.hs:6:12-16 AnnVal = [Test10358.hs:6:15]) + +(AK Test10358.hs:7:7-17 AnnEqual = [Test10358.hs:7:10]) + +(AK Test10358.hs:7:7-17 AnnFunId = [Test10358.hs:7:7-8]) + +(AK Test10358.hs:7:12-17 AnnVal = [Test10358.hs:7:14]) + +(AK AnnEofPos = [Test10358.hs:9:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10358.hs b/testsuite/tests/ghc-api/annotations/Test10358.hs new file mode 100644 index 0000000..9badab2 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10358.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE BangPatterns #-} +module Test10358 where + +mtGamma a b = + let !x_2 = x*x; !x_4 = x_2*x_2 + v3 = v*v*v + dv = d * v3 + in 5 diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 5614127..b60f0bc 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -12,3 +12,4 @@ test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307' test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) test('boolFormula', normal, run_command, ['$MAKE -s --no-print-directory boolFormula']) test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357']) +test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) diff --git a/testsuite/tests/ghc-api/annotations/t10357.hs b/testsuite/tests/ghc-api/annotations/t10358.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10357.hs copy to testsuite/tests/ghc-api/annotations/t10358.hs index 93a1f70..82994cc 100644 --- a/testsuite/tests/ghc-api/annotations/t10357.hs +++ b/testsuite/tests/ghc-api/annotations/t10358.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10357" + testOneFile libdir "Test10358" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Sat May 9 14:18:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:18:00 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: ApiAnnotations : AST version of nested forall loses forall annotation (1c3e7af) Message-ID: <20150509141800.E78853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/1c3e7af71b01395fa961fcc519559ddc6e27b046/ghc >--------------------------------------------------------------- commit 1c3e7af71b01395fa961fcc519559ddc6e27b046 Author: Alan Zimmerman Date: Fri May 8 12:12:05 2015 +0200 ApiAnnotations : AST version of nested forall loses forall annotation Summary: When parsing {-# LANGUAGE ScopedTypeVariables #-} extremumNewton :: forall tag. forall tag1. tag -> tag1 -> Int extremumNewton = undefined the parser creates nested HsForAllTy's for the two forall statements. These get flattened into a single one in `HsTypes.mk_forall_ty` This patch removes the flattening, so that API Annotations are not lost in the process. Test Plan: ./validate Reviewers: goldfire, austin, simonpj Subscribers: bgamari, mpickering, thomie, goldfire Differential Revision: https://phabricator.haskell.org/D836 GHC Trac Issues: #10278, #10315, #10354, #10363 Conflicts: testsuite/tests/ghc-api/annotations/.gitignore testsuite/tests/ghc-api/annotations/Makefile testsuite/tests/ghc-api/annotations/all.T >--------------------------------------------------------------- 1c3e7af71b01395fa961fcc519559ddc6e27b046 compiler/hsSyn/Convert.hs | 5 +- compiler/hsSyn/HsSyn.hs | 2 +- compiler/hsSyn/HsTypes.hs | 59 +++++++------- compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 8 +- compiler/rename/RnTypes.hs | 21 +++++ compiler/typecheck/TcHsType.hs | 12 +++ testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 9 +++ testsuite/tests/ghc-api/annotations/T10278.stderr | 16 ++++ testsuite/tests/ghc-api/annotations/T10278.stdout | 91 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/T10312.stdout | 2 + testsuite/tests/ghc-api/annotations/T10358.stderr | 12 +++ testsuite/tests/ghc-api/annotations/Test10278.hs | 12 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/boolFormula.stderr | 17 ---- .../ghc-api/annotations/{t10357.hs => t10278.hs} | 2 +- .../tests/rename/should_fail/rnfail026.stderr | 4 +- testsuite/tests/typecheck/should_fail/T3540.stderr | 10 +-- 19 files changed, 229 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 1c3e7af71b01395fa961fcc519559ddc6e27b046 From git at git.haskell.org Sat May 9 14:18:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:18:04 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: Manually patch D868, temporary for integration test (cfef477) Message-ID: <20150509141804.F3E8D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/cfef4776d4d508c2fd3eec7bf6137882089745ac/ghc >--------------------------------------------------------------- commit cfef4776d4d508c2fd3eec7bf6137882089745ac Author: Alan Zimmerman Date: Fri May 8 13:18:45 2015 +0200 Manually patch D868, temporary for integration test >--------------------------------------------------------------- cfef4776d4d508c2fd3eec7bf6137882089745ac compiler/hsSyn/HsTypes.hs | 4 +- compiler/parser/Parser.y | 10 +-- compiler/parser/RdrHsSyn.hs | 18 ++--- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++ testsuite/tests/ghc-api/annotations/T10278.stdout | 4 +- testsuite/tests/ghc-api/annotations/T10354.stdout | 81 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10354.hs | 11 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10278.hs => t10354.hs} | 2 +- 10 files changed, 122 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cfef4776d4d508c2fd3eec7bf6137882089745ac From git at git.haskell.org Sat May 9 14:18:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 14:18:08 +0000 (UTC) Subject: [commit: ghc] wip/api-annots: ApiAnnotatons : AnnDcolon in wrong place for PatBind (3689682) Message-ID: <20150509141808.BD8793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots Link : http://ghc.haskell.org/trac/ghc/changeset/36896826a78d4e7eb003295e6136bd8619695714/ghc >--------------------------------------------------------------- commit 36896826a78d4e7eb003295e6136bd8619695714 Author: Alan Zimmerman Date: Sat May 9 15:51:01 2015 +0200 ApiAnnotatons : AnnDcolon in wrong place for PatBind Summary: In the following code fragment let ls :: Int = undefined the `::` is attached to the ls function as a whole, rather than to the pattern on the LHS. Test Plan: ./validate Reviewers: hvr, austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D883 GHC Trac Issues: #10396 Conflicts: testsuite/tests/ghc-api/annotations/.gitignore testsuite/tests/ghc-api/annotations/Makefile testsuite/tests/ghc-api/annotations/all.T >--------------------------------------------------------------- 36896826a78d4e7eb003295e6136bd8619695714 compiler/parser/Parser.y | 5 ++- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++++ testsuite/tests/ghc-api/annotations/T10396.stdout | 43 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10396.hs | 7 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 +- .../tests/ghc-api/annotations/parseTree.stdout | 2 +- .../ghc-api/annotations/{t10278.hs => t10396.hs} | 2 +- 9 files changed, 66 insertions(+), 5 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 8093769..7e4faae 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2003,8 +2003,9 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } case r of { (FunBind n _ _ _ _ _) -> ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ; - _ -> return () } ; - _ <- ams (L l ()) (ann ++ (fst $2) ++ (fst $ unLoc $3)); + (PatBind (L lh _lhs) _rhs _ _ _) -> + ams (L lh ()) (fst $2) >> return () } ; + _ <- ams (L l ()) (ann ++ (fst $ unLoc $3)); return $! (sL l (unitOL $! (sL l $ ValD r))) } } | pattern_synonym_decl { sLL $1 $> $ unitOL $1 } | docdecl { sLL $1 $> $ unitOL $1 } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 9b3f80a..8ba37ab 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -15,6 +15,7 @@ t10280 t10312 t10307 boolFormula +t10396 *.hi *.o *.run.* diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index bc0795e..d5bdb5b 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -14,6 +14,7 @@ clean: rm -f t10255 rm -f t10278 rm -f t10354 + rm -f t10396 annotations: rm -f annotations.o annotations.hi @@ -54,6 +55,13 @@ t10278: .PHONY: t10278 +T10396: + rm -f T10396.o T10396.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10396 + ./t10396 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10396 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10396.stdout b/testsuite/tests/ghc-api/annotations/T10396.stdout new file mode 100644 index 0000000..61d0399 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10396.stdout @@ -0,0 +1,43 @@ +---Problems--------------------- +[ +] + +---Problems'-------------------- +[] +-------------------------------- +[ +(AK Test10396.hs:1:1 AnnModule = [Test10396.hs:2:1-6]) + +(AK Test10396.hs:1:1 AnnWhere = [Test10396.hs:2:18-22]) + +(AK Test10396.hs:4:1-15 AnnDcolon = [Test10396.hs:4:8-9]) + +(AK Test10396.hs:4:1-15 AnnSemi = [Test10396.hs:5:1]) + +(AK Test10396.hs:4:14-15 AnnCloseP = [Test10396.hs:4:15]) + +(AK Test10396.hs:4:14-15 AnnOpenP = [Test10396.hs:4:14]) + +(AK Test10396.hs:(5,1)-(7,11) AnnEqual = [Test10396.hs:5:7]) + +(AK Test10396.hs:(5,1)-(7,11) AnnFunId = [Test10396.hs:5:1-6]) + +(AK Test10396.hs:(5,1)-(7,11) AnnSemi = [Test10396.hs:8:1]) + +(AK Test10396.hs:(5,9)-(7,11) AnnDo = [Test10396.hs:5:9-10]) + +(AK Test10396.hs:6:3-27 AnnLet = [Test10396.hs:6:3-5]) + +(AK Test10396.hs:6:3-27 AnnSemi = [Test10396.hs:7:3]) + +(AK Test10396.hs:6:7-15 AnnDcolon = [Test10396.hs:6:10-11]) + +(AK Test10396.hs:6:7-27 AnnEqual = [Test10396.hs:6:17]) + +(AK Test10396.hs:7:10-11 AnnCloseP = [Test10396.hs:7:11]) + +(AK Test10396.hs:7:10-11 AnnOpenP = [Test10396.hs:7:10]) + +(AK AnnEofPos = [Test10396.hs:8:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10396.hs b/testsuite/tests/ghc-api/annotations/Test10396.hs new file mode 100644 index 0000000..71b18a8 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10396.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Test10396 where + +errors :: IO () +errors= do + let ls :: Int = undefined + return () diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 0c285b0..ad536f7 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -15,3 +15,4 @@ test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357' test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) test('T10278', normal, run_command, ['$MAKE -s --no-print-directory t10278']) test('T10354', normal, run_command, ['$MAKE -s --no-print-directory t10354']) +test('T10396', normal, run_command, ['$MAKE -s --no-print-directory T10396']) diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout index 128b70a..706d858 100644 --- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout +++ b/testsuite/tests/ghc-api/annotations/exampleTest.stdout @@ -149,7 +149,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/parseTree.stdout b/testsuite/tests/ghc-api/annotations/parseTree.stdout index 9965fd2..4986ddf 100644 --- a/testsuite/tests/ghc-api/annotations/parseTree.stdout +++ b/testsuite/tests/ghc-api/annotations/parseTree.stdout @@ -153,7 +153,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/t10278.hs b/testsuite/tests/ghc-api/annotations/t10396.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10278.hs copy to testsuite/tests/ghc-api/annotations/t10396.hs index 9d13548..5ece668 100644 --- a/testsuite/tests/ghc-api/annotations/t10278.hs +++ b/testsuite/tests/ghc-api/annotations/t10396.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10278" + testOneFile libdir "Test10396" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Sat May 9 16:34:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 16:34:44 +0000 (UTC) Subject: [commit: ghc] master: Quick fix: drop base bound on template-haskell. (3c70ae0) Message-ID: <20150509163444.4E3CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c70ae032e4361b203dfcf22b0a424e8838a5037/ghc >--------------------------------------------------------------- commit 3c70ae032e4361b203dfcf22b0a424e8838a5037 Author: Edward Z. Yang Date: Sat May 9 09:35:38 2015 -0700 Quick fix: drop base bound on template-haskell. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 3c70ae032e4361b203dfcf22b0a424e8838a5037 libraries/template-haskell/template-haskell.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index 1c53af3..60a800c 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -48,7 +48,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base == 4.8.*, + base, pretty == 1.1.* -- We need to set the package key to template-haskell (without a From git at git.haskell.org Sat May 9 16:44:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 May 2015 16:44:48 +0000 (UTC) Subject: [commit: ghc] master: Revert stage 1 template-haskell. This is a combination of 5 commits. (5c459ee) Message-ID: <20150509164448.5ACD43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5c459eefcb17ff97beebdc08ccfca21bd8fa5201/ghc >--------------------------------------------------------------- commit 5c459eefcb17ff97beebdc08ccfca21bd8fa5201 Author: Edward Z. Yang Date: Sat May 9 09:43:18 2015 -0700 Revert stage 1 template-haskell. This is a combination of 5 commits. Revert "Quick fix: drop base bound on template-haskell." This reverts commit 3c70ae032e4361b203dfcf22b0a424e8838a5037. Revert "Always do polymorphic typed quote check, c.f. #10384" This reverts commit 9a43b2c1f78b3cf684646af64b9b67dc8079f58f. Revert "RnSplice's staging test should be applied for quotes in stage1." This reverts commit eb0ed4030374af542c0a459480d32c8d4525e48d. Revert "Split off quotes/ from th/ for tests that can be done on stage1 compiler." This reverts commit 21c72e7d38c96ac80d31addf67ae4b3c7a6c3bbb. Revert "Support stage 1 Template Haskell (non-quasi) quotes, fixes #10382." This reverts commit 28257cae77023f2ccc4cc1c0cd1fbbd329947a00. >--------------------------------------------------------------- 5c459eefcb17ff97beebdc08ccfca21bd8fa5201 compiler/deSugar/DsExpr.hs | 8 + compiler/ghc.cabal.in | 4 +- compiler/main/DynFlags.hs | 27 +- compiler/main/HscMain.hs | 4 +- compiler/rename/RnSplice.hs | 308 +++++++++++---------- compiler/typecheck/TcExpr.hs | 10 + compiler/typecheck/TcSplice.hs | 173 ++++++------ docs/users_guide/7.12.1-notes.xml | 7 +- docs/users_guide/glasgow_exts.xml | 4 +- ghc.mk | 2 +- libraries/template-haskell/template-haskell.cabal | 2 +- mk/warnings.mk | 1 - testsuite/tests/quotes/.gitignore | 4 - testsuite/tests/quotes/Makefile | 3 - testsuite/tests/quotes/T10384.hs | 3 - testsuite/tests/quotes/T10384.stderr | 6 - testsuite/tests/quotes/T8455.hs | 5 - testsuite/tests/quotes/TH_localname.hs | 3 - testsuite/tests/quotes/TH_localname.stderr | 22 -- testsuite/tests/quotes/all.T | 31 --- testsuite/tests/{quotes => th}/T2632.hs | 2 + testsuite/tests/{quotes => th}/T2931.hs | 1 + testsuite/tests/{quotes => th}/T3572.hs | 0 testsuite/tests/{quotes => th}/T3572.stdout | 0 testsuite/tests/{quotes => th}/T4056.hs | 2 +- testsuite/tests/{quotes => th}/T4169.hs | 2 + testsuite/tests/{quotes => th}/T4170.hs | 1 + testsuite/tests/{quotes => th}/T5721.hs | 2 +- testsuite/tests/{quotes => th}/T6062.hs | 1 + testsuite/tests/th/T8455.hs | 5 + testsuite/tests/{quotes => th}/T8633.hs | 0 testsuite/tests/{quotes => th}/T8759a.hs | 2 +- testsuite/tests/{quotes => th}/T8759a.stderr | 0 testsuite/tests/{quotes => th}/T9824.hs | 1 + .../tests/{quotes => th}/TH_abstractFamily.hs | 0 .../tests/{quotes => th}/TH_abstractFamily.stderr | 0 testsuite/tests/{quotes => th}/TH_bracket1.hs | 0 testsuite/tests/{quotes => th}/TH_bracket2.hs | 0 testsuite/tests/{quotes => th}/TH_bracket3.hs | 0 testsuite/tests/{quotes => th}/TH_ppr1.hs | 0 testsuite/tests/{quotes => th}/TH_ppr1.stdout | 0 testsuite/tests/{quotes => th}/TH_reifyType1.hs | 0 testsuite/tests/{quotes => th}/TH_reifyType2.hs | 0 testsuite/tests/{quotes => th}/TH_repE1.hs | 0 testsuite/tests/{quotes => th}/TH_repE3.hs | 0 testsuite/tests/{quotes => th}/TH_scope.hs | 0 .../tests/{quotes => th}/TH_spliceViewPat/A.hs | 0 .../tests/{quotes => th}/TH_spliceViewPat/Main.hs | 0 .../tests/{quotes => th}/TH_spliceViewPat/Makefile | 0 .../TH_spliceViewPat/TH_spliceViewPat.stdout | 0 .../tests/{quotes => th}/TH_spliceViewPat/test.T | 5 + testsuite/tests/{quotes => th}/TH_tf2.hs | 0 testsuite/tests/th/all.T | 31 ++- 53 files changed, 341 insertions(+), 341 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5c459eefcb17ff97beebdc08ccfca21bd8fa5201 From git at git.haskell.org Mon May 11 07:33:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 07:33:35 +0000 (UTC) Subject: [commit: ghc] master: Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. (811b72a) Message-ID: <20150511073335.614DE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/811b72adedcd12149783eac19ebccff1dd72bc1c/ghc >--------------------------------------------------------------- commit 811b72adedcd12149783eac19ebccff1dd72bc1c Author: Alan Zimmerman Date: Mon May 11 09:34:27 2015 +0200 Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. Summary: The code for mkAtDefault is as follows. mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e })) | TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs } <- e = do { tvs <- checkTyVars (ptext (sLit "default")) equalsDots tc (hswb_cts pats) ; return (L loc (TyFamEqn { tfe_tycon = tc , tfe_pats = tvs , tfe_rhs = rhs })) } An associated type in a class of the form type FoldableConstraint t x = () has an AnnEqual attached to the location in tfid_eqn. Since the location is discarded, this annotation is then disconnected from the AST. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D842 GHC Trac Issues: #10307 >--------------------------------------------------------------- 811b72adedcd12149783eac19ebccff1dd72bc1c compiler/parser/Parser.y | 32 +++++++++++-------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10307.stdout | 36 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10307.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10312.hs => t10307.hs} | 2 +- 7 files changed, 72 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 811b72adedcd12149783eac19ebccff1dd72bc1c From git at git.haskell.org Mon May 11 08:56:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 08:56:33 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : mkGadtDecl discards annotations for HsFunTy (e4032b1) Message-ID: <20150511085633.6D9CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e4032b1951a35d8df63a74ebfee7449988b5ef40/ghc >--------------------------------------------------------------- commit e4032b1951a35d8df63a74ebfee7449988b5ef40 Author: Alan Zimmerman Date: Mon May 11 10:57:25 2015 +0200 ApiAnnotations : mkGadtDecl discards annotations for HsFunTy Summary: When mkGadtDecl is presented wih a HsFunTy it discards the SrcSpan, thus disconnecting any annotations on the HsFunTy. ``` mkGadtDecl names (L ls (HsForAllTy imp Nothing qvars cxt tau)) = return $ mk_gadt_con names where (details, res_ty) -- See Note [Sorting out the result type] = case tau of L _ (HsFunTy (L l (HsRecTy flds)) res_ty) -> (RecCon (L l flds), res_ty) _other -> (PrefixCon [], tau) ... ``` This can be triggered by the following ``` {-# LANGUAGE GADTs #-} module GADTRecords2 (H1(..)) where -- | h1 data H1 a b where C3 :: (Num a) => { field :: a -- ^ hello docs } -> H1 Int Int ``` Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D848 GHC Trac Issues: #10309 >--------------------------------------------------------------- e4032b1951a35d8df63a74ebfee7449988b5ef40 compiler/parser/Parser.y | 3 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10255.stdout | 2 ++ testsuite/tests/ghc-api/annotations/T10309.stdout | 38 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/T10312.stdout | 2 ++ testsuite/tests/ghc-api/annotations/Test10309.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10307.hs => t10309.hs} | 2 +- 9 files changed, 61 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 1baf606..3d9b2a3 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1621,7 +1621,8 @@ type :: { LHsType RdrName } : btype { $1 } | btype qtyconop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } | btype tyvarop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } - | btype '->' ctype {% ams (sLL $1 $> $ HsFunTy $1 $3) + | btype '->' ctype {% ams $1 [mj AnnRarrow $2] + >> ams (sLL $1 $> $ HsFunTy $1 $3) [mj AnnRarrow $2] } | btype '~' btype {% ams (sLL $1 $> $ HsEqTy $1 $3) [mj AnnTilde $2] } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 8b7f082..8ff93b4 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -3,6 +3,7 @@ parseTree comments exampleTest listcomps +t10309 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 15c3bc4..c7aa1e5 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -8,6 +8,7 @@ clean: rm -f t10269 rm -f t10255 t10312 rm -f t1037 + rm -f t10309 annotations: rm -f annotations.o annotations.hi @@ -73,3 +74,10 @@ t10307: ./t10307 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" .PHONY: t10307 + +t10309: + rm -f t10309.o t10309.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10309 + ./t10309 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10309 diff --git a/testsuite/tests/ghc-api/annotations/T10255.stdout b/testsuite/tests/ghc-api/annotations/T10255.stdout index 099ef54..50e9bb7 100644 --- a/testsuite/tests/ghc-api/annotations/T10255.stdout +++ b/testsuite/tests/ghc-api/annotations/T10255.stdout @@ -29,6 +29,8 @@ (AK Test10255.hs:6:11-26 AnnOpenP = [Test10255.hs:6:11]) +(AK Test10255.hs:6:12-18 AnnRarrow = [Test10255.hs:6:20-21]) + (AK Test10255.hs:6:12-25 AnnRarrow = [Test10255.hs:6:20-21]) (AK AnnEofPos = [Test10255.hs:8:1]) diff --git a/testsuite/tests/ghc-api/annotations/T10309.stdout b/testsuite/tests/ghc-api/annotations/T10309.stdout new file mode 100644 index 0000000..1423466 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10309.stdout @@ -0,0 +1,38 @@ +---Problems--------------------- +[ +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) +] + +-------------------------------- +[ +(AK Test10309.hs:1:1 AnnModule = [Test10309.hs:2:1-6]) + +(AK Test10309.hs:1:1 AnnWhere = [Test10309.hs:2:18-22]) + +(AK Test10309.hs:(4,1)-(6,34) AnnData = [Test10309.hs:4:1-4]) + +(AK Test10309.hs:(4,1)-(6,34) AnnSemi = [Test10309.hs:7:1]) + +(AK Test10309.hs:(4,1)-(6,34) AnnWhere = [Test10309.hs:4:13-17]) + +(AK Test10309.hs:(5,3)-(6,34) AnnDcolon = [Test10309.hs:5:6-7]) + +(AK Test10309.hs:5:9-15 AnnCloseP = [Test10309.hs:5:15]) + +(AK Test10309.hs:5:9-15 AnnDarrow = [Test10309.hs:5:17-18]) + +(AK Test10309.hs:5:9-15 AnnOpenP = [Test10309.hs:5:9]) + +(AK Test10309.hs:(5,20)-(6,20) AnnCloseC = [Test10309.hs:6:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnOpenC = [Test10309.hs:5:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:5:22-31 AnnDcolon = [Test10309.hs:5:28-29]) + +(AK AnnEofPos = [Test10309.hs:7:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/T10312.stdout b/testsuite/tests/ghc-api/annotations/T10312.stdout index 5e4fd1c..70af815 100644 --- a/testsuite/tests/ghc-api/annotations/T10312.stdout +++ b/testsuite/tests/ghc-api/annotations/T10312.stdout @@ -334,6 +334,8 @@ (AK Test10312.hs:68:28-51 AnnRarrow = [Test10312.hs:68:37-38]) +(AK Test10312.hs:68:29 AnnRarrow = [Test10312.hs:68:31-32]) + (AK Test10312.hs:68:29-34 AnnRarrow = [Test10312.hs:68:31-32]) (AK Test10312.hs:68:40-42 AnnCloseS = [Test10312.hs:68:42]) diff --git a/testsuite/tests/ghc-api/annotations/Test10309.hs b/testsuite/tests/ghc-api/annotations/Test10309.hs new file mode 100644 index 0000000..75f18a9 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10309.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} +module Test10309 where + +data H1 a b where + C3 :: (Num a) => { field :: a -- ^ hello docs + } -> H1 Int Int diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 3e145b9..81aec52 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -9,3 +9,4 @@ test('T10269', normal, run_command, ['$MAKE -s --no-print-directory T10269' test('T10280', normal, run_command, ['$MAKE -s --no-print-directory T10280']) test('T10312', normal, run_command, ['$MAKE -s --no-print-directory t10312']) test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307']) +test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) diff --git a/testsuite/tests/ghc-api/annotations/t10307.hs b/testsuite/tests/ghc-api/annotations/t10309.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10307.hs copy to testsuite/tests/ghc-api/annotations/t10309.hs index 5c6f233..ebce40e 100644 --- a/testsuite/tests/ghc-api/annotations/t10307.hs +++ b/testsuite/tests/ghc-api/annotations/t10309.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10307" + testOneFile libdir "Test10309" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Mon May 11 09:03:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 09:03:57 +0000 (UTC) Subject: [commit: ghc] ghc-7.10's head updated: Fix failing API Annotations tests from master cherry pick (3aca63a) Message-ID: <20150511090357.1D1E13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-7.10' now includes: ad6059f parser: opt_kind_sig has incorrect SrcSpan f05bf38 parser: API Annotations : guardquals1 does not annotate commas properly 9c11848 parser : the API annotation on opt_sig is being discarded 56e5b75 API Annotations : ExprWithTySig processing discards annotated spans a3dfa17 ApiAnnotations : lexer discards comment close in nested comment ad0551c Correct parsing of lifted empty list constructor d4596ef ApiAnnotations : quoted type variables missing leading quote ec6c9ad ApiAnnotations : RdrHsSyn.isFunLhs discards parentheses 2f463c7 ApiAnnotations : AnnComma missing in TupleSection bd2bfe2 ApiAnnotations: misplaced AnnComma for squals production 3aca63a Fix failing API Annotations tests from master cherry pick From git at git.haskell.org Mon May 11 09:06:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 09:06:28 +0000 (UTC) Subject: [commit: ghc] master: IdInfo comment update (27aa733) Message-ID: <20150511090628.19E8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27aa733a7a9854802b4622317c75d36c237c9067/ghc >--------------------------------------------------------------- commit 27aa733a7a9854802b4622317c75d36c237c9067 Author: Joachim Breitner Date: Mon May 11 11:04:43 2015 +0200 IdInfo comment update occInfo and callArityInfo is like demandInfo and oneShotInfo: Data about how the Id is used. [skip ci] >--------------------------------------------------------------- 27aa733a7a9854802b4622317c75d36c237c9067 compiler/basicTypes/IdInfo.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index 4c069ea..eb89789 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -173,9 +173,9 @@ pprIdDetails other = brackets (pp other) -- 'Unique' (and are hence the same 'Id'); for example, one might lack -- the properties attached to the other. -- --- The 'IdInfo' gives information about the value, or definition, of the --- 'Id'. It does not contain information about the 'Id''s usage, --- except for 'demandInfo' and 'oneShotInfo'. +-- Most of the 'IdInfo' gives information about the value, or definition, of +-- the 'Id', independent of its usage. Exceptions to this +-- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'. data IdInfo = IdInfo { arityInfo :: !ArityInfo, -- ^ 'Id' arity From git at git.haskell.org Mon May 11 10:07:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:14 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Rename role annotations w.r.t only local decls. (4e14780) Message-ID: <20150511100714.6842E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/4e147807b3d4f51b4fb7aa593cc444e86349ad8f/ghc >--------------------------------------------------------------- commit 4e147807b3d4f51b4fb7aa593cc444e86349ad8f Author: Richard Eisenberg Date: Fri Apr 10 22:25:29 2015 +0100 Rename role annotations w.r.t only local decls. Fix #10263. (cherry picked from commit 6ab5da9913e4f8a8dcc8bda3c77d4e896fd67352) >--------------------------------------------------------------- 4e147807b3d4f51b4fb7aa593cc444e86349ad8f compiler/rename/RnEnv.hs | 15 +++++++++++++-- compiler/rename/RnSource.hs | 19 ++++++++++++------- testsuite/tests/ghci/scripts/T8485.stderr | 6 +++--- testsuite/tests/roles/should_compile/T10263.hs | 5 +++++ testsuite/tests/roles/should_compile/all.T | 1 + 5 files changed, 34 insertions(+), 12 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index d422fbe..6f9ae93 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -17,6 +17,7 @@ module RnEnv ( reportUnboundName, HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, + lookupSigCtxtOccRn, lookupFixityRn, lookupTyFixityRn, lookupInstDeclBndr, lookupSubBndrOcc, lookupFamInstName, @@ -1064,13 +1065,22 @@ data HsSigCtxt | ClsDeclCtxt Name -- Class decl for this class | InstDeclCtxt Name -- Intsance decl for this class | HsBootCtxt -- Top level of a hs-boot file + | RoleAnnotCtxt NameSet -- A role annotation, with the names of all types + -- in the group lookupSigOccRn :: HsSigCtxt -> Sig RdrName -> Located RdrName -> RnM (Located Name) -lookupSigOccRn ctxt sig +lookupSigOccRn ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig) + +-- | Lookup a name in relation to the names in a 'HsSigCtxt' +lookupSigCtxtOccRn :: HsSigCtxt + -> SDoc -- ^ description of thing we're looking up, + -- like "type family" + -> Located RdrName -> RnM (Located Name) +lookupSigCtxtOccRn ctxt what = wrapLocM $ \ rdr_name -> - do { mb_name <- lookupBindGroupOcc ctxt (hsSigDoc sig) rdr_name + do { mb_name <- lookupBindGroupOcc ctxt what rdr_name ; case mb_name of Left err -> do { addErr err; return (mkUnboundName rdr_name) } Right name -> return name } @@ -1098,6 +1108,7 @@ lookupBindGroupOcc ctxt what rdr_name = case ctxt of HsBootCtxt -> lookup_top (const True) True TopSigCtxt ns meth_ok -> lookup_top (`elemNameSet` ns) meth_ok + RoleAnnotCtxt ns -> lookup_top (`elemNameSet` ns) False LocalBindCtxt ns -> lookup_group ns ClsDeclCtxt cls -> lookup_cls_op cls InstDeclCtxt cls -> lookup_cls_op cls diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 11ea659..b4117e8 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -943,7 +943,8 @@ rnTyClDecls :: [Name] -> [TyClGroup RdrName] -- Rename the declarations and do depedency analysis on them rnTyClDecls extra_deps tycl_ds = do { ds_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (tyClGroupConcat tycl_ds) - ; role_annot_env <- rnRoleAnnots (concatMap group_roles tycl_ds) + ; let decl_names = mkNameSet (map (tcdName . unLoc . fst) ds_w_fvs) + ; role_annot_env <- rnRoleAnnots decl_names (concatMap group_roles tycl_ds) ; thisPkg <- fmap thisPackage getDynFlags ; let add_boot_deps :: FreeVars -> FreeVars -- See Note [Extra dependencies from .hs-boot files] @@ -1082,13 +1083,14 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls, rnTySyn :: HsDocContext -> LHsType RdrName -> RnM (LHsType Name, FreeVars) rnTySyn doc rhs = rnLHsType doc rhs --- Renames role annotations, returning them as the values in a NameEnv +-- | Renames role annotations, returning them as the values in a NameEnv -- and checks for duplicate role annotations. -- It is quite convenient to do both of these in the same place. -- See also Note [Role annotations in the renamer] -rnRoleAnnots :: [LRoleAnnotDecl RdrName] - -> RnM (NameEnv (LRoleAnnotDecl Name)) -rnRoleAnnots role_annots +rnRoleAnnots :: NameSet -- ^ of the decls in this group + -> [LRoleAnnotDecl RdrName] + -> RnM (NameEnv (LRoleAnnotDecl Name)) +rnRoleAnnots decl_names role_annots = do { -- check for duplicates *before* renaming, to avoid lumping -- together all the unboundNames let (no_dups, dup_annots) = removeDups role_annots_cmp role_annots @@ -1104,8 +1106,11 @@ rnRoleAnnots role_annots , not (isUnboundName name) ] } where rn_role_annot1 (RoleAnnotDecl tycon roles) - = do { -- the name is an *occurrence* - tycon' <- wrapLocM lookupGlobalOccRn tycon + = do { -- the name is an *occurrence*, but look it up only in the + -- decls defined in this group (see #10263) + tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt decl_names) + (text "role annotation") + tycon ; return $ RoleAnnotDecl tycon' roles } dupRoleAnnotErr :: [LRoleAnnotDecl RdrName] -> RnM () diff --git a/testsuite/tests/ghci/scripts/T8485.stderr b/testsuite/tests/ghci/scripts/T8485.stderr index 6635882..bbef720 100644 --- a/testsuite/tests/ghci/scripts/T8485.stderr +++ b/testsuite/tests/ghci/scripts/T8485.stderr @@ -1,4 +1,4 @@ -:3:1: - Role annotation for a type previously declared: type role X nominal - (The role annotation must be given where ?X? is declared.) +:3:11: error: + The role annotation for ?X? lacks an accompanying binding + (The role annotation must be given where ?X? is declared) diff --git a/testsuite/tests/roles/should_compile/T10263.hs b/testsuite/tests/roles/should_compile/T10263.hs new file mode 100644 index 0000000..d12a3a4 --- /dev/null +++ b/testsuite/tests/roles/should_compile/T10263.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE RoleAnnotations #-} +module T10263 where + +data Maybe a = AF +type role Maybe representational diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T index 0bd779f..2e0d8ea 100644 --- a/testsuite/tests/roles/should_compile/all.T +++ b/testsuite/tests/roles/should_compile/all.T @@ -5,3 +5,4 @@ test('Roles4', only_ways('normal'), compile, ['-ddump-tc']) test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques']) test('Roles14', only_ways('normal'), compile, ['-ddump-tc']) test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques']) +test('T10263', normal, compile, ['']) From git at git.haskell.org Mon May 11 10:07:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:17 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Test #10321 in ghci/scripts/T10321 (b7287b2) Message-ID: <20150511100717.96C333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/b7287b25ac4f7c9f7190e23a068e5d72ae071651/ghc >--------------------------------------------------------------- commit b7287b25ac4f7c9f7190e23a068e5d72ae071651 Author: Richard Eisenberg Date: Thu Apr 23 16:57:34 2015 -0400 Test #10321 in ghci/scripts/T10321 (cherry picked from commit d4cf5591e51e2b91b3877a05f8153db1f5328994) >--------------------------------------------------------------- b7287b25ac4f7c9f7190e23a068e5d72ae071651 testsuite/tests/ghci/scripts/T10321.hs | 14 ++++++++++++++ testsuite/tests/ghci/scripts/T10321.script | 2 ++ testsuite/tests/ghci/scripts/all.T | 2 ++ 3 files changed, 18 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T10321.hs b/testsuite/tests/ghci/scripts/T10321.hs new file mode 100644 index 0000000..44d264a --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10321.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} + +module T10321 where + +import GHC.TypeLits + +data Vec :: Nat -> * -> * where + Nil :: Vec 0 a + (:>) :: a -> Vec n a -> Vec (n + 1) a + +infixr 5 :> diff --git a/testsuite/tests/ghci/scripts/T10321.script b/testsuite/tests/ghci/scripts/T10321.script new file mode 100644 index 0000000..1ec4792 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10321.script @@ -0,0 +1,2 @@ +:load T10321 +:t 3 :> 4 :> 5 :> Nil diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index fbcdb25..3d2fd67 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -206,3 +206,5 @@ test('T9878b', [ extra_run_opts('-fobject-code'), extra_clean(['T9878.hi','T9878.o'])], ghci_script, ['T9878b.script']) + +test('T10321', expect_broken(10321), ghci_script, ['T10321.script']) From git at git.haskell.org Mon May 11 10:07:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:20 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Normalise type families in the type of an expression (768f848) Message-ID: <20150511100720.79D303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/768f848a50899bbccb53a253388a847879f9792b/ghc >--------------------------------------------------------------- commit 768f848a50899bbccb53a253388a847879f9792b Author: Christiaan Baaij Date: Wed May 6 07:46:00 2015 -0500 Normalise type families in the type of an expression Before, the type of an expression, and the type of a variable binding that expression used to be different in GHCi. The reason being that types of bound variables were already normalised. Now, both are normalised. This implements the suggestions as given in Trac #10321 Also adds an expected output for test T10321 Reviewed By: goldfire, simonpj Differential Revision: https://phabricator.haskell.org/D870 GHC Trac Issues: #10321 (cherry picked from commit f7daf5afe2ba4f60f60245fa82306b89a272ffa8) >--------------------------------------------------------------- 768f848a50899bbccb53a253388a847879f9792b compiler/typecheck/TcRnDriver.hs | 10 +++++++++- testsuite/tests/ghci/scripts/T10321.stdout | 1 + testsuite/tests/ghci/scripts/all.T | 2 +- 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index b6e2973..ed88c2d 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1770,7 +1770,15 @@ tcRnExpr hsc_env rdr_expr _ <- simplifyInteractive (andWC stWC lie_top) ; let { all_expr_ty = mkForAllTys qtvs (mkPiTypes dicts res_ty) } ; - zonkTcType all_expr_ty + ty <- zonkTcType all_expr_ty ; + + -- We normalise type families, so that the type of an expression is the + -- same as of a bound expression (TcBinds.mkInferredPolyId). See Trac + -- #10321 for further discussion. + fam_envs <- tcGetFamInstEnvs ; + -- normaliseType returns a coercion which we discard, so the Role is + -- irrelevant + return (snd (normaliseType fam_envs Nominal ty)) } -------------------------- diff --git a/testsuite/tests/ghci/scripts/T10321.stdout b/testsuite/tests/ghci/scripts/T10321.stdout new file mode 100644 index 0000000..d74ca95 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10321.stdout @@ -0,0 +1 @@ +3 :> 4 :> 5 :> Nil :: Num a => Vec 3 a diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 3d2fd67..270e3ae 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -207,4 +207,4 @@ test('T9878b', extra_clean(['T9878.hi','T9878.o'])], ghci_script, ['T9878b.script']) -test('T10321', expect_broken(10321), ghci_script, ['T10321.script']) +test('T10321', normal, ghci_script, ['T10321.script']) From git at git.haskell.org Mon May 11 10:07:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Tiny refactoring; no change in behaviour (f424118) Message-ID: <20150511100723.2C8873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/f424118036618b6ca0de822cc987833b316e5f47/ghc >--------------------------------------------------------------- commit f424118036618b6ca0de822cc987833b316e5f47 Author: Simon Peyton Jones Date: Thu Feb 12 15:31:15 2015 +0000 Tiny refactoring; no change in behaviour (cherry picked from commit 6be91ddaffe8b4d3796cb78b261b318c9c380f4b) >--------------------------------------------------------------- f424118036618b6ca0de822cc987833b316e5f47 compiler/typecheck/TcCanonical.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 8df7ee1..1511885 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -709,22 +709,23 @@ canDecomposableTyConApp :: CtEvidence -> EqRel -> TcS (StopOrContinue Ct) -- See Note [Decomposing TyConApps] canDecomposableTyConApp ev eq_rel tc1 tys1 tc2 tys2 - | tc1 /= tc2 || length tys1 /= length tys2 - -- Fail straight away for better error messages - = let eq_failure - | isDataFamilyTyCon tc1 || isDataFamilyTyCon tc2 - -- See Note [Use canEqFailure in canDecomposableTyConApp] - = canEqFailure - | otherwise - = canEqHardFailure in - eq_failure ev eq_rel (mkTyConApp tc1 tys1) (mkTyConApp tc2 tys2) - - | otherwise + | tc1 == tc2 + , length tys1 == length tys2 -- Success: decompose! = do { traceTcS "canDecomposableTyConApp" (ppr ev $$ ppr eq_rel $$ ppr tc1 $$ ppr tys1 $$ ppr tys2) ; canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 ; stopWith ev "Decomposed TyConApp" } + -- Fail straight away for better error messages + -- See Note [Use canEqFailure in canDecomposableTyConApp] + | isDataFamilyTyCon tc1 || isDataFamilyTyCon tc2 + = canEqFailure ev eq_rel ty1 ty2 + | otherwise + = canEqHardFailure ev eq_rel ty1 ty2 + where + ty1 = mkTyConApp tc1 tys1 + ty2 = mkTyConApp tc2 tys2 + {- Note [Use canEqFailure in canDecomposableTyConApp] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Mon May 11 10:07:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:26 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix #10285 by refusing to use NthCo on a newtype. (43e682b) Message-ID: <20150511100726.8A84A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/43e682bc6a3ce86047b46e18866b87658c3ed456/ghc >--------------------------------------------------------------- commit 43e682bc6a3ce86047b46e18866b87658c3ed456 Author: Richard Eisenberg Date: Thu Apr 23 15:31:37 2015 -0400 Fix #10285 by refusing to use NthCo on a newtype. During this commit, I tested to make sure that CoreLint actually catches the Core error if the typechecker doesn't. Test case: typecheck/should_fail/T10285 (cherry picked from commit a8d39a7255df187b742fecc049f0de6528b9acad) >--------------------------------------------------------------- 43e682bc6a3ce86047b46e18866b87658c3ed456 compiler/coreSyn/CoreLint.hs | 2 ++ compiler/typecheck/TcCanonical.hs | 25 ++++++++++++++--- compiler/types/Coercion.hs | 31 +++++++++++++++++++++- testsuite/tests/typecheck/should_fail/T10285.hs | 11 ++++++++ .../tests/typecheck/should_fail/T10285.stderr | 20 ++++++++++++++ testsuite/tests/typecheck/should_fail/T10285a.hs | 11 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 4 +++ 7 files changed, 99 insertions(+), 5 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 5ae7a59..ead384c 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1150,6 +1150,8 @@ lintCoercion the_co@(NthCo n co) ; case (splitTyConApp_maybe s, splitTyConApp_maybe t) of (Just (tc_s, tys_s), Just (tc_t, tys_t)) | tc_s == tc_t + , isDistinctTyCon tc_s || r /= Representational + -- see Note [NthCo and newtypes] in Coercion , tys_s `equalLength` tys_t , n < length tys_s -> return (ks, ts, tt, tr) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 1511885..4310e35 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -710,11 +710,14 @@ canDecomposableTyConApp :: CtEvidence -> EqRel -- See Note [Decomposing TyConApps] canDecomposableTyConApp ev eq_rel tc1 tys1 tc2 tys2 | tc1 == tc2 - , length tys1 == length tys2 -- Success: decompose! - = do { traceTcS "canDecomposableTyConApp" + , length tys1 == length tys2 + = if eq_rel == NomEq || ctEvFlavour ev /= Given || isDistinctTyCon tc1 + -- See Note [Decomposing newtypes] + then do { traceTcS "canDecomposableTyConApp" (ppr ev $$ ppr eq_rel $$ ppr tc1 $$ ppr tys1 $$ ppr tys2) - ; canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 - ; stopWith ev "Decomposed TyConApp" } + ; canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 + ; stopWith ev "Decomposed TyConApp" } + else canEqFailure ev eq_rel ty1 ty2 -- Fail straight away for better error messages -- See Note [Use canEqFailure in canDecomposableTyConApp] @@ -740,6 +743,20 @@ Here is the case: 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. + +Note [Decomposing newtypes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As explained in Note [NthCo and newtypes] in Coercion, we can't use +NthCo on representational coercions over newtypes. So we avoid doing +so. + +But is it sensible to decompose *Wanted* constraints over newtypes? +Yes. By the time we reach canDecomposableTyConApp, we know that any +newtypes that can be unwrapped have been. So, without importing more +constructors, say, we know there is no way forward other than decomposition. +So we take the one route we have available. This *does* mean that +importing a newtype's constructor might make code that previously +compiled fail to do so. (If that newtype is perversely recursive, say.) -} canDecomposableTyConAppOK :: CtEvidence -> EqRel diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 8bdb2e6..2a3da3b 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -190,6 +190,8 @@ data Coercion | NthCo Int Coercion -- Zero-indexed; decomposes (T t0 ... tn) -- :: _ -> e -> ?? (inverse of TyConAppCo, see Note [TyConAppCo roles]) + -- See Note [NthCo and newtypes] + | LRCo LeftOrRight Coercion -- Decomposes (t_left t_right) -- :: _ -> N -> N | InstCo Coercion Type @@ -491,6 +493,34 @@ necessary for soundness, but this choice removes ambiguity. The rules here also dictate what the parameters to mkTyConAppCo. +Note [NthCo and newtypes] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + + newtype N a = MkN Int + type role N representational + +This yields axiom + + NTCo:N :: forall a. N a ~R Int + +We can then build + + co :: forall a b. N a ~R N b + co = NTCo:N a ; sym (NTCo:N b) + +for any `a` and `b`. Because of the role annotation on N, if we use +NthCo, we'll get out a representational coercion. That is: + + NthCo 0 co :: forall a b. a ~R b + +Yikes! Clearly, this is terrible. The solution is simple: forbid +NthCo to be used on newtypes if the internal coercion is representational. + +This is not just some corner case discovered by a segfault somewhere; +it was discovered in the proof of soundness of roles and described +in the "Safe Coercions" paper (ICFP '14). + ************************************************************************ * * \subsection{Coercion variables} @@ -1980,4 +2010,3 @@ Kind coercions are only of the form: Refl kind. They are only used to instantiate kind polymorphic type constructors in TyConAppCo. Remember that kind instantiation only happens with TyConApp, not AppTy. -} - diff --git a/testsuite/tests/typecheck/should_fail/T10285.hs b/testsuite/tests/typecheck/should_fail/T10285.hs new file mode 100644 index 0000000..cebdfe1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T10285.hs @@ -0,0 +1,11 @@ +module T10285 where + +import T10285a +import Data.Type.Coercion +import Data.Coerce + +oops :: Coercion (N a) (N b) -> a -> b +oops Coercion = coerce + +unsafeCoerce :: a -> b +unsafeCoerce = oops coercion diff --git a/testsuite/tests/typecheck/should_fail/T10285.stderr b/testsuite/tests/typecheck/should_fail/T10285.stderr new file mode 100644 index 0000000..b56f124 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T10285.stderr @@ -0,0 +1,20 @@ + +T10285.hs:8:17: error: + Could not deduce: a ~ b + from the context: Coercible (N a) (N b) + bound by a pattern with constructor: + Coercion :: forall (k :: BOX) (a :: k) (b :: k). + Coercible a b => + Coercion a b, + in an equation for ?oops? + at T10285.hs:8:6-13 + ?a? is a rigid type variable bound by + the type signature for: oops :: Coercion (N a) (N b) -> a -> b + at T10285.hs:7:9 + ?b? is a rigid type variable bound by + the type signature for: oops :: Coercion (N a) (N b) -> a -> b + at T10285.hs:7:9 + Relevant bindings include + oops :: Coercion (N a) (N b) -> a -> b (bound at T10285.hs:8:1) + In the expression: coerce + In an equation for ?oops?: oops Coercion = coerce diff --git a/testsuite/tests/typecheck/should_fail/T10285a.hs b/testsuite/tests/typecheck/should_fail/T10285a.hs new file mode 100644 index 0000000..53a468b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T10285a.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RoleAnnotations #-} + +module T10285a (N, coercion) where + +import Data.Type.Coercion + +newtype N a = MkN Int +type role N representational + +coercion :: Coercion (N a) (N b) +coercion = Coercion diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 8ae6410..c4a9fc8 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -355,3 +355,7 @@ test('T4921', normal, compile_fail, ['']) test('T9605', normal, compile_fail, ['']) test('T9999', normal, compile_fail, ['']) test('T10194', normal, compile_fail, ['']) + +test('T10285', + extra_clean(['T10285a.hi', 'T10285a.o']), + multimod_compile_fail, ['T10285', '-v0']) From git at git.haskell.org Mon May 11 10:07:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:29 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: LlvmCodeGen cross-compiling fixes (#9895) (95921e6) Message-ID: <20150511100729.377683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/95921e6c0f5660d7837d05bd05364a83a0224310/ghc >--------------------------------------------------------------- commit 95921e6c0f5660d7837d05bd05364a83a0224310 Author: Erik de Castro Lopo Date: Sat Dec 27 21:11:52 2014 +1100 LlvmCodeGen cross-compiling fixes (#9895) Summary: * Throw an error when cross-compiling without a target definition. When cross compiling via LLVM, a target 'datalayout' and 'triple' must be defined or LLVM will generate code for the compile host instead of the compile target. * Add aarch64-unknown-linux-gnu target. The datalayout and triple lines were found by using clang to compile a small C program and -emit-llvm to get the LLVM IR output. Signed-off-by: Erik de Castro Lopo Test Plan: validate Reviewers: rwbarton, carter, hvr, bgamari, austin Reviewed By: austin Subscribers: carter, thomie, garious Differential Revision: https://phabricator.haskell.org/D585 GHC Trac Issues: #9895 (cherry picked from commit 58ac9c8f6e986bac817ad08d5a2fd11cd167f029) >--------------------------------------------------------------- 95921e6c0f5660d7837d05bd05364a83a0224310 compiler/llvmGen/LlvmCodeGen/Ppr.hs | 14 ++++++++++++-- compiler/main/SysTools.hs | 4 +++- compiler/utils/Platform.hs | 3 ++- settings.in | 1 + 4 files changed, 18 insertions(+), 4 deletions(-) diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index ed21685..5dd27ab 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -68,9 +68,19 @@ moduleLayout = sdocWithPlatform $ \platform -> Platform { platformArch = ArchARM64, platformOS = OSiOS } -> text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-n32:64-S128\"" $+$ text "target triple = \"arm64-apple-ios7.0.0\"" + Platform { platformArch = ArchARM64, platformOS = OSLinux } -> + text "target datalayout = \"e-m:e-i64:64-i128:128-n32:64-S128\"" + $+$ text "target triple = \"aarch64-unknown-linux-gnu\"" _ -> - -- FIX: Other targets - empty + if platformIsCrossCompiling platform + then panic "LlvmCodeGen.Ppr: Cross compiling without valid target info." + else empty + -- If you see the above panic, GHC is missing the required target datalayout + -- and triple information. You can obtain this info by compiling a simple + -- 'hello world' C program with the clang C compiler eg: + -- clang hello.c -emit-llvm -o hello.ll + -- and the first two lines of hello.ll should provide the 'target datalayout' + -- and 'target triple' lines required. -- | Pretty print LLVM data code diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 8fa947c..540d7c4 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -221,6 +221,7 @@ initSysTools mbMinusB Just v -> return v Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs) Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile) + crossCompiling <- getBooleanSetting "cross compiling" targetArch <- readSetting "target arch" targetOS <- readSetting "target os" targetWordSize <- readSetting "target word size" @@ -309,7 +310,8 @@ initSysTools mbMinusB platformUnregisterised = targetUnregisterised, platformHasGnuNonexecStack = targetHasGnuNonexecStack, platformHasIdentDirective = targetHasIdentDirective, - platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols + platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols, + platformIsCrossCompiling = crossCompiling } return $ Settings { diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs index 39903ea..8f9a8de 100644 --- a/compiler/utils/Platform.hs +++ b/compiler/utils/Platform.hs @@ -31,7 +31,8 @@ data Platform platformUnregisterised :: Bool, platformHasGnuNonexecStack :: Bool, platformHasIdentDirective :: Bool, - platformHasSubsectionsViaSymbols :: Bool + platformHasSubsectionsViaSymbols :: Bool, + platformIsCrossCompiling :: Bool } deriving (Read, Show, Eq) diff --git a/settings.in b/settings.in index 1bcb4ae..e8cdad3 100644 --- a/settings.in +++ b/settings.in @@ -18,6 +18,7 @@ ("windres command", "@SettingsWindresCommand@"), ("libtool command", "@SettingsLibtoolCommand@"), ("perl command", "@SettingsPerlCommand@"), + ("cross compiling", "@CrossCompiling@"), ("target os", "@HaskellTargetOs@"), ("target arch", "@HaskellTargetArch@"), ("target word size", "@WordSize@"), From git at git.haskell.org Mon May 11 10:07:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:31 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: arm: Force non-executable stack (part 2) (f84df20) Message-ID: <20150511100731.DAFB83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/f84df20e219ce0e56008c34cacd3b17872a2371d/ghc >--------------------------------------------------------------- commit f84df20e219ce0e56008c34cacd3b17872a2371d Author: Erik de Castro Lopo Date: Mon May 4 23:39:31 2015 +0000 arm: Force non-executable stack (part 2) This was supposed to be part of commit 63a10bbc42 but I pushed from the wrong machine. This fixes cross compiling to arm. Signed-off-by: Erik de Castro Lopo (cherry picked from commit 1a4374c1e246d81a5c1d00a720919804093a8241) >--------------------------------------------------------------- f84df20e219ce0e56008c34cacd3b17872a2371d aclocal.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index b275460..c17a7d5 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -571,7 +571,7 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], # gcc to link using the gold linker. # Forcing LD to be ld.gold is done in FIND_LD m4 macro. $3="$$3 -fuse-ld=gold -Wl,-z,noexecstack" - $4="$$4 -z,noexecstack" + $4="$$4 -z noexecstack" ;; esac From git at git.haskell.org Mon May 11 10:07:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:34 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Improve Call Arity performance (3389562) Message-ID: <20150511100734.8C2E03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/3389562148153186261cb4d9771bbb7b5172b615/ghc >--------------------------------------------------------------- commit 3389562148153186261cb4d9771bbb7b5172b615 Author: Joachim Breitner Date: Wed Apr 15 13:32:32 2015 +0200 Improve Call Arity performance This improves how the Call Arity deals with "boring" variables. Boring variables are those where it does not bother to include in the analysis result, so whenever something is looked up in the analysis result, we have to make a conservative assumption about them. Previously, we extended the result with such conservative information about them, to keep the code uniform, but that could blow up the amount of data passed around, even if only temporarily, and slowed things down. We now pass around an explicit list (well, set) of variable that are boring and take that into account whenever we use the result. Not as pretty, but noticably faster. (cherry picked from commit a9ca67f6bfb45d13944ba15452d3af613ec84d8b) >--------------------------------------------------------------- 3389562148153186261cb4d9771bbb7b5172b615 compiler/simplCore/CallArity.hs | 127 +++++++++++---------- testsuite/tests/callarity/unittest/CallArity1.hs | 5 + .../tests/callarity/unittest/CallArity1.stderr | 6 +- 3 files changed, 78 insertions(+), 60 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 3389562148153186261cb4d9771bbb7b5172b615 From git at git.haskell.org Mon May 11 10:07:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:07:37 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Call Arity: Trade precision for performance in large mutually recursive groups (97bd6d6) Message-ID: <20150511100737.341033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/97bd6d6b70273e221b6d03aa865a5ed84953aca7/ghc >--------------------------------------------------------------- commit 97bd6d6b70273e221b6d03aa865a5ed84953aca7 Author: Joachim Breitner Date: Wed Apr 15 16:25:13 2015 +0200 Call Arity: Trade precision for performance in large mutually recursive groups Sometimes (especial with derived Data instances, it seems), one can have very large mutually recursive bindings. Calculating the Call Arity analysis result with full precision is an expensive operation in these case. So above a certain threshold (25, for no good reason besides intuition), skip this calculation and assume the recursion is not linear, which is a conservative result. With this, the Call Arity analysis accounts for 3.7% of the compile time of haskell-src-exts. Fixes #10293 Differential Revision: https://phabricator.haskell.org/D843 (cherry picked from commit 9654a7cf8580bc3a027bf8b39c06d916050c446d) >--------------------------------------------------------------- 97bd6d6b70273e221b6d03aa865a5ed84953aca7 compiler/simplCore/CallArity.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 3007d70..c606ece 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -632,6 +632,9 @@ callArityRecEnv any_boring ae_rhss ae_body cross_calls -- See Note [Taking boring variables into account] | any_boring = completeGraph (domRes ae_combined) + -- Also, calculating cross_calls is expensive. Simply be conservative + -- if the mutually recursive group becomes too large. + | length ae_rhss > 25 = completeGraph (domRes ae_combined) | otherwise = unionUnVarGraphs $ map cross_call ae_rhss cross_call (v, ae_rhs) = completeBipartiteGraph called_by_v called_with_v where From git at git.haskell.org Mon May 11 10:12:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:12:20 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: Fix #10210 (8ae3768) Message-ID: <20150511101220.DC30E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/8ae3768b3185db307fb911dda83e84f440bd048e/ghc >--------------------------------------------------------------- commit 8ae3768b3185db307fb911dda83e84f440bd048e Author: Austin Seipp Date: Mon May 11 05:13:00 2015 -0500 docs: Fix #10210 For some reason, I used 'href' instead of 'url'. Oops. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8ae3768b3185db307fb911dda83e84f440bd048e docs/users_guide/7.10.1-notes.xml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index fe430a5..92f125e 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -24,7 +24,7 @@ is a breaking change and your programs will need to be updated. Please see the GHC + url="https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10">GHC 7.10 Migration Guide on the GHC wiki. @@ -38,7 +38,7 @@ custom, less-generic versions. This is a change that may require updates to your program. Please see the GHC + url="https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10">GHC 7.10 Migration Guide on the GHC wiki. @@ -878,7 +878,7 @@ echo "[]" > package.conf For issues dealing with language changes, please see the GHC + url="https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10">GHC 7.10 Migration Guide on the GHC wiki. @@ -888,21 +888,21 @@ echo "[]" > package.conf Collector currently suffers from a large performance penalty due to a lack of system-specific optimization (issue #7602). + url="https://ghc.haskell.org/trac/ghc/ticket/7602">issue #7602). GHC's LLVM backend is currently incompatible with LLVM 3.4 (issue #9929). + url="https://ghc.haskell.org/trac/ghc/ticket/9929">issue #9929). GHCi fails to appropriately load .dyn_o files (issue #8736). + url="https://ghc.haskell.org/trac/ghc/ticket/8736">issue #8736). @@ -912,13 +912,13 @@ echo "[]" > package.conf means that GHC might hang, but it should do so only when the program is ill-typed (due to non-terminating type-level features). The bugs are reported as #7788 + url="https://ghc.haskell.org/trac/ghc/ticket/7788">#7788 and #10139. + url="https://ghc.haskell.org/trac/ghc/ticket/10139">#10139. There also remain certain obscure scenarios where the solver for Coercible instances is known to be still incomplete. See comments in #10079. + url="https://ghc.haskell.org/trac/ghc/ticket/10079">#10079. From git at git.haskell.org Mon May 11 10:59:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 10:59:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: Fix #10302 - only LLVM 3.5 is supported for 7.10 (1915e7f) Message-ID: <20150511105905.B00D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/1915e7f3ab4b801bec5557709a18368c20b0036d/ghc >--------------------------------------------------------------- commit 1915e7f3ab4b801bec5557709a18368c20b0036d Author: Austin Seipp Date: Mon May 11 05:59:42 2015 -0500 docs: Fix #10302 - only LLVM 3.5 is supported for 7.10 Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1915e7f3ab4b801bec5557709a18368c20b0036d docs/users_guide/7.10.1-notes.xml | 6 ++++++ docs/users_guide/codegens.xml | 8 ++++---- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 92f125e..43b2366 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -884,6 +884,12 @@ echo "[]" > package.conf + GHC's LLVM backend does not support LLVM 3.4 (issue #9929) + + + + On Mac OS X, the -threaded Garbage Collector currently suffers from a large performance penalty due to a lack of system-specific optimization diff --git a/docs/users_guide/codegens.xml b/docs/users_guide/codegens.xml index d2a805a..b54d7be 100644 --- a/docs/users_guide/codegens.xml +++ b/docs/users_guide/codegens.xml @@ -32,14 +32,14 @@ much faster code. This is especially true for numeric, array heavy code using packages like vector. The penalty is a significant increase in compilation times. Select the LLVM backend with the - flag. Currently LLVM 2.8 and - later are supported. + flag. Currently only LLVM 3.5 + is supported. You must install and have LLVM available on your PATH for the LLVM code generator to work. Specifically GHC needs to be able to call the opt and llc tools. Secondly, if you - are running Mac OS X with LLVM 3.0 or greater then + are running Mac OS X with LLVM 3.5 or greater then you also need the Clang c compiler compiler available on your PATH. @@ -54,7 +54,7 @@ order to use the LLVM based code generator, you should install the Homebrew - package manager for OS X. Alternatively you can download + package manager for OS X and then install LLVM 3.5. Alternatively you can download binaries for LLVM and Clang from here. From git at git.haskell.org Mon May 11 11:02:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:02:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix merge-o in testsuite output that I missed (5753910) Message-ID: <20150511110250.E60C63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/5753910079649a6b6d0e004c0ccb1c3ed0676289/ghc >--------------------------------------------------------------- commit 5753910079649a6b6d0e004c0ccb1c3ed0676289 Author: Austin Seipp Date: Mon May 11 06:03:43 2015 -0500 Fix merge-o in testsuite output that I missed Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5753910079649a6b6d0e004c0ccb1c3ed0676289 testsuite/tests/ghci/scripts/T8485.stderr | 2 +- testsuite/tests/typecheck/should_fail/T10285.stderr | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/ghci/scripts/T8485.stderr b/testsuite/tests/ghci/scripts/T8485.stderr index bbef720..5edf696 100644 --- a/testsuite/tests/ghci/scripts/T8485.stderr +++ b/testsuite/tests/ghci/scripts/T8485.stderr @@ -1,4 +1,4 @@ -:3:11: error: +:3:11: The role annotation for ?X? lacks an accompanying binding (The role annotation must be given where ?X? is declared) diff --git a/testsuite/tests/typecheck/should_fail/T10285.stderr b/testsuite/tests/typecheck/should_fail/T10285.stderr index b56f124..47cfbec 100644 --- a/testsuite/tests/typecheck/should_fail/T10285.stderr +++ b/testsuite/tests/typecheck/should_fail/T10285.stderr @@ -1,18 +1,18 @@ -T10285.hs:8:17: error: - Could not deduce: a ~ b - from the context: Coercible (N a) (N b) - bound by a pattern with constructor: +T10285.hs:8:17: + Could not deduce (a ~ b) + from the context (Coercible (N a) (N b)) + bound by a pattern with constructor Coercion :: forall (k :: BOX) (a :: k) (b :: k). Coercible a b => Coercion a b, in an equation for ?oops? at T10285.hs:8:6-13 ?a? is a rigid type variable bound by - the type signature for: oops :: Coercion (N a) (N b) -> a -> b + the type signature for oops :: Coercion (N a) (N b) -> a -> b at T10285.hs:7:9 ?b? is a rigid type variable bound by - the type signature for: oops :: Coercion (N a) (N b) -> a -> b + the type signature for oops :: Coercion (N a) (N b) -> a -> b at T10285.hs:7:9 Relevant bindings include oops :: Coercion (N a) (N b) -> a -> b (bound at T10285.hs:8:1) From git at git.haskell.org Mon May 11 11:31:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:31:46 +0000 (UTC) Subject: [commit: ghc] master: haddock: update submodule to fix #10206 (2666ba3) Message-ID: <20150511113146.B97AB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2666ba369f8d3e7d187876b7b602d42f2d6db381/ghc >--------------------------------------------------------------- commit 2666ba369f8d3e7d187876b7b602d42f2d6db381 Author: Austin Seipp Date: Mon May 11 06:31:45 2015 -0500 haddock: update submodule to fix #10206 Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2666ba369f8d3e7d187876b7b602d42f2d6db381 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 26a590c..2380f07 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 26a590c009005d77fbee9e2c79286bd93f7955f5 +Subproject commit 2380f07c430c525b205ce2eae6dab23c8388d899 From git at git.haskell.org Mon May 11 11:36:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:36:35 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: haddock: update submodule (340b54b) Message-ID: <20150511113635.6CD203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/340b54b1df12e0790a0a805da857ed09df116af7/ghc >--------------------------------------------------------------- commit 340b54b1df12e0790a0a805da857ed09df116af7 Author: Austin Seipp Date: Mon May 11 06:37:02 2015 -0500 haddock: update submodule This should fix #10206, and also updates Haddock to a newer release with several other bugfixes. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 340b54b1df12e0790a0a805da857ed09df116af7 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 0fc494f..bf31846 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 0fc494f2015b7d9cc2cd80e87d67c430e9842777 +Subproject commit bf31846b9f7280b5e75f09e91ca18c4ced37af08 From git at git.haskell.org Mon May 11 11:47:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:47:17 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Do not allow Typeable on constraints (Trac #9858) (6b24d26) Message-ID: <20150511114717.BF3E83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/6b24d2664ec7453fc2ae41a3850d33385dee5c1b/ghc >--------------------------------------------------------------- commit 6b24d2664ec7453fc2ae41a3850d33385dee5c1b Author: Simon Peyton Jones Date: Tue Apr 14 15:39:01 2015 +0100 Do not allow Typeable on constraints (Trac #9858) The astonishingly-ingenious trio of Shachaf Ben-Kiki, ?rjan Johansen and Nathan van Doorn managed to persuade GHC 7.10.1 to cough up unsafeCoerce. That is very bad. This patch fixes it by no allowing Typable on Constraint-kinded things. And that seems right, since it is, in effect, a form of impredicative polymorphism, which Typeable definitely doesn't support. We may want to creep back in the direction of allowing Typeable on constraints one day, but this is a good fix for now, and closes a terrible hole. (cherry picked from commit 7b042d5adabdb0fc06286db1a7f9cbf1e9fd1fbf) >--------------------------------------------------------------- 6b24d2664ec7453fc2ae41a3850d33385dee5c1b compiler/typecheck/TcInteract.hs | 40 ++++++++++++++++++++-- compiler/types/TypeRep.hs | 14 ++++++-- testsuite/tests/typecheck/should_fail/T9858a.hs | 35 +++++++++++++++++++ .../tests/typecheck/should_fail/T9858a.stderr | 12 +++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + testsuite/tests/typecheck/should_run/T9858b.hs | 8 +++++ .../tests/typecheck/should_run/T9858b.stdout | 0 testsuite/tests/typecheck/should_run/all.T | 1 + 8 files changed, 107 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index e520240..7c03e46 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -12,7 +12,7 @@ import TcCanonical import TcFlatten import VarSet import Type -import Kind (isKind) +import Kind (isKind, isConstraintKind) import Unify import InstEnv( lookupInstEnv, instanceDFunId ) import CoAxiom(sfInteractTop, sfInteractInert) @@ -2131,7 +2131,9 @@ Other notes: -- and it was applied to the correc arugment. matchTypeableClass :: Class -> Kind -> Type -> CtLoc -> TcS LookupInstResult matchTypeableClass clas k t loc - | isForAllTy k = return NoInstance + | isForAllTy t = return NoInstance + | isConstraintKind k = return NoInstance + -- See Note [No Typeable for qualified types] | Just (tc, ks) <- splitTyConApp_maybe t , all isKind ks = doTyCon tc ks | Just (f,kt) <- splitAppTy_maybe t = doTyApp f kt @@ -2178,3 +2180,37 @@ matchTypeableClass clas k t loc newWantedEvVar loc goal mkSimpEv ev = return (GenInst [] (EvTypeable ev)) + +{- Note [No Typeable for polytype or for constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We do not support impredicative typeable, such as + Typeable (forall a. a->a) + Typeable (Eq a => a -> a) + Typeable (Eq a) + Typeable (() :: Constraint) + Typeable (() => Int) + Typeable (((),()) => Int) + +See Trac #9858. For forall's the case is clear: we simply don't have +a TypeRep for them. For qualified but not polymorphic types, like +(Eq a => a -> a), things are murkier. But: + + * We don't need a TypeRep for these things. TypeReps are for + monotypes only. + + * The types (Eq a, Show a) => ...blah... + and Eq a => Show a => ...blah... + are represented the same way, as a curried function; + that is, the tuple before the '=>' is just syntactic + sugar. But since we can abstract over tuples of constraints, + we really do have tuples of constraints as well. + + This dichotomy is not well worked out, and Trac #9858 comment:76 + shows that Typeable treated it one way, while newtype instance + matching treated it another. Or maybe it was the fact that + '*' and Constraint are distinct to the type checker, but are + the same afterwards. Anyway, the result was a function of + type (forall ab. a -> b), which is pretty dire. + +So the simple solution is not to attempt Typable for constraints. +-} diff --git a/compiler/types/TypeRep.hs b/compiler/types/TypeRep.hs index e4982b2..8e35373 100644 --- a/compiler/types/TypeRep.hs +++ b/compiler/types/TypeRep.hs @@ -730,8 +730,7 @@ pprTcApp _ pp tc [ty] pprTcApp p pp tc tys | isTupleTyCon tc && tyConArity tc == length tys - = pprPromotionQuote tc <> - tupleParens (tupleTyConSort tc) (sep (punctuate comma (map (pp TopPrec) tys))) + = pprTupleApp p pp tc tys | Just dc <- isPromotedDataCon_maybe tc , let dc_tc = dataConTyCon dc @@ -746,6 +745,17 @@ pprTcApp p pp tc tys | otherwise = sdocWithDynFlags (pprTcApp_help p pp tc tys) +pprTupleApp :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> SDoc +-- Print a saturated tuple +pprTupleApp p pp tc tys + | null tys + , ConstraintTuple <- tupleTyConSort tc + = maybeParen p TopPrec $ + ppr tc <+> dcolon <+> ppr (tyConKind tc) + | otherwise + = pprPromotionQuote tc <> + tupleParens (tupleTyConSort tc) (sep (punctuate comma (map (pp TopPrec) tys))) + pprTcApp_help :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc -- This one has accss to the DynFlags pprTcApp_help p pp tc tys dflags diff --git a/testsuite/tests/typecheck/should_fail/T9858a.hs b/testsuite/tests/typecheck/should_fail/T9858a.hs new file mode 100644 index 0000000..fda55c2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9858a.hs @@ -0,0 +1,35 @@ +-- From comment:76 in Trac #9858 +-- This exploit still works in GHC 7.10.1. +-- By Shachaf Ben-Kiki, ?rjan Johansen and Nathan van Doorn + +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ImpredicativeTypes #-} + +module T9858a where + +import Data.Typeable + +type E = (:~:) +type PX = Proxy (((),()) => ()) +type PY = Proxy (() -> () -> ()) + +data family F p a b + +newtype instance F a b PX = ID (a -> a) +newtype instance F a b PY = UC (a -> b) + +{-# NOINLINE ecast #-} +ecast :: E p q -> f p -> f q +ecast Refl = id + +supercast :: F a b PX -> F a b PY +supercast = case cast e of + Just e' -> ecast e' + where + e = Refl + e :: E PX PX + +uc :: a -> b +uc = case supercast (ID id) of UC f -> f diff --git a/testsuite/tests/typecheck/should_fail/T9858a.stderr b/testsuite/tests/typecheck/should_fail/T9858a.stderr new file mode 100644 index 0000000..72b72e9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9858a.stderr @@ -0,0 +1,12 @@ + +T9858a.hs:28:18: error: + No instance for (Typeable (() :: Constraint)) + arising from a use of ?cast? + In the expression: cast e + In the expression: case cast e of { Just e' -> ecast e' } + In an equation for ?supercast?: + supercast + = case cast e of { Just e' -> ecast e' } + where + e = Refl + e :: E PX PX diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index c4a9fc8..482b622 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -359,3 +359,4 @@ test('T10194', normal, compile_fail, ['']) test('T10285', extra_clean(['T10285a.hi', 'T10285a.o']), multimod_compile_fail, ['T10285', '-v0']) +test('T9858a', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_run/T9858b.hs b/testsuite/tests/typecheck/should_run/T9858b.hs new file mode 100644 index 0000000..3c680c2 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T9858b.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} +module Main where + +import Data.Typeable + +data A = A + +main = print $ typeRep (Proxy :: Proxy A) == typeRep (Proxy :: Proxy 'A) diff --git a/libraries/base/tests/dynamic003.stdout b/testsuite/tests/typecheck/should_run/T9858b.stdout similarity index 100% copy from libraries/base/tests/dynamic003.stdout copy to testsuite/tests/typecheck/should_run/T9858b.stdout diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 5b20034..1301c17 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -115,3 +115,4 @@ test('T8739', normal, compile_and_run, ['']) test('T9497a-run', [exit_code(1)], compile_and_run, ['-fdefer-typed-holes']) test('T9497b-run', [exit_code(1)], compile_and_run, ['-fdefer-typed-holes -fno-warn-typed-holes']) test('T9497c-run', [exit_code(1)], compile_and_run, ['-fdefer-type-errors -fno-warn-typed-holes']) +test('T9858b', normal, compile_and_run, ['']) From git at git.haskell.org Mon May 11 11:47:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:47:21 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fixes (hopefully!) T9858 (7adecba) Message-ID: <20150511114721.14A443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/7adecba752789f4a20ea0acf91720d3fb53e6007/ghc >--------------------------------------------------------------- commit 7adecba752789f4a20ea0acf91720d3fb53e6007 Author: Iavor S. Diatchki Date: Thu Apr 16 11:13:24 2015 -0700 Fixes (hopefully!) T9858 The changes are: 1. No impredicative types in `Typeable` 2. Distinguish normal tuples, from tuples of constraints. (cherry picked from commit d8d541d85defcf3bbbddaeee8cfac70b74f47ffc) >--------------------------------------------------------------- 7adecba752789f4a20ea0acf91720d3fb53e6007 compiler/deSugar/DsBinds.hs | 6 +++- compiler/typecheck/TcInteract.hs | 34 +++++++++------------- testsuite/tests/typecheck/should_fail/T9858b.hs | 10 +++++++ .../tests/typecheck/should_fail/T9858b.stderr | 8 +++++ testsuite/tests/typecheck/should_fail/all.T | 1 + testsuite/tests/typecheck/should_run/T9858c.hs | 19 ++++++++++++ testsuite/tests/typecheck/should_run/T9858c.stdout | 1 + testsuite/tests/typecheck/should_run/all.T | 1 + 8 files changed, 58 insertions(+), 22 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 51679a8..72f0801 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -41,10 +41,11 @@ import Module import PrelNames import TysPrim ( mkProxyPrimTy ) import TyCon ( isTupleTyCon, tyConDataCons_maybe - , tyConName, isPromotedTyCon, isPromotedDataCon ) + , tyConName, isPromotedTyCon, isPromotedDataCon, tyConKind ) import TcEvidence import TcType import Type +import Kind (returnsConstraintKind) import Coercion hiding (substCo) import TysWiredIn ( eqBoxDataCon, coercibleDataCon, tupleCon ) import Id @@ -1014,6 +1015,9 @@ dsEvTypeable ev = hash_name_fs | isPromotedTyCon tc = appendFS (mkFastString "$k") name_fs | isPromotedDataCon tc = appendFS (mkFastString "$c") name_fs + | isTupleTyCon tc && + returnsConstraintKind (tyConKind tc) + = appendFS (mkFastString "$p") name_fs | otherwise = name_fs hashThis = unwords $ map unpackFS [pkg_fs, modl_fs, hash_name_fs] diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 7c03e46..62e106c 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -12,7 +12,7 @@ import TcCanonical import TcFlatten import VarSet import Type -import Kind (isKind, isConstraintKind) +import Kind (isKind, isConstraintKind ) import Unify import InstEnv( lookupInstEnv, instanceDFunId ) import CoAxiom(sfInteractTop, sfInteractInert) @@ -2130,10 +2130,14 @@ Other notes: -- | Assumes that we've checked that this is the 'Typeable' class, -- and it was applied to the correc arugment. matchTypeableClass :: Class -> Kind -> Type -> CtLoc -> TcS LookupInstResult -matchTypeableClass clas k t loc +matchTypeableClass clas _k t loc + + -- See Note [No Typeable for qualified types] | isForAllTy t = return NoInstance - | isConstraintKind k = return NoInstance - -- See Note [No Typeable for qualified types] + -- Is the type of the form `C => t`? + | Just (t1,_) <- splitFunTy_maybe t, + isConstraintKind (typeKind t1) = return NoInstance + | Just (tc, ks) <- splitTyConApp_maybe t , all isKind ks = doTyCon tc ks | Just (f,kt) <- splitAppTy_maybe t = doTyApp f kt @@ -2186,8 +2190,6 @@ matchTypeableClass clas k t loc We do not support impredicative typeable, such as Typeable (forall a. a->a) Typeable (Eq a => a -> a) - Typeable (Eq a) - Typeable (() :: Constraint) Typeable (() => Int) Typeable (((),()) => Int) @@ -2198,19 +2200,9 @@ a TypeRep for them. For qualified but not polymorphic types, like * We don't need a TypeRep for these things. TypeReps are for monotypes only. - * The types (Eq a, Show a) => ...blah... - and Eq a => Show a => ...blah... - are represented the same way, as a curried function; - that is, the tuple before the '=>' is just syntactic - sugar. But since we can abstract over tuples of constraints, - we really do have tuples of constraints as well. - - This dichotomy is not well worked out, and Trac #9858 comment:76 - shows that Typeable treated it one way, while newtype instance - matching treated it another. Or maybe it was the fact that - '*' and Constraint are distinct to the type checker, but are - the same afterwards. Anyway, the result was a function of - type (forall ab. a -> b), which is pretty dire. - -So the simple solution is not to attempt Typable for constraints. + * Perhaps we could treat `=>` as another type constructor for `Typeable` + purposes, and thus support things like `Eq Int => Int`, however, + at the current state of affairs this would be an odd exception as + no other class works with impredicative types. + For now we leave it off, until we have a better story for impredicativity. -} diff --git a/testsuite/tests/typecheck/should_fail/T9858b.hs b/testsuite/tests/typecheck/should_fail/T9858b.hs new file mode 100644 index 0000000..643002f --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9858b.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE FlexibleContexts #-} + +module T9858b where +import Data.Typeable + +test = typeRep (Proxy :: Proxy (Eq Int => Int)) + + + diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr new file mode 100644 index 0000000..b57098e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr @@ -0,0 +1,8 @@ + +T9858b.hs:7:8: error: + No instance for (Typeable (Eq Int => Int)) + (maybe you haven't applied a function to enough arguments?) + arising from a use of ?typeRep? + 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/all.T b/testsuite/tests/typecheck/should_fail/all.T index 482b622..de01268 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -360,3 +360,4 @@ test('T10285', extra_clean(['T10285a.hi', 'T10285a.o']), multimod_compile_fail, ['T10285', '-v0']) test('T9858a', normal, compile_fail, ['']) +test('T9858b', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_run/T9858c.hs b/testsuite/tests/typecheck/should_run/T9858c.hs new file mode 100644 index 0000000..7120715 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T9858c.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE KindSignatures #-} +module Main(main) where + +import Data.Typeable +import GHC.Exts + +test1 :: Bool +test1 = typeRep (Proxy :: Proxy (() :: *)) == + typeRep (Proxy :: Proxy (() :: Constraint)) + +test2 :: Bool +test2 = typeRepTyCon (typeRep (Proxy :: Proxy (Int,Int))) == + typeRepTyCon (typeRep (Proxy :: Proxy (Eq Int, Eq Int))) + +main :: IO () +main = print (test1,test2) + + + diff --git a/testsuite/tests/typecheck/should_run/T9858c.stdout b/testsuite/tests/typecheck/should_run/T9858c.stdout new file mode 100644 index 0000000..78a8f06 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T9858c.stdout @@ -0,0 +1 @@ +(False,False) diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 1301c17..990688f 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -116,3 +116,4 @@ test('T9497a-run', [exit_code(1)], compile_and_run, ['-fdefer-typed-holes']) test('T9497b-run', [exit_code(1)], compile_and_run, ['-fdefer-typed-holes -fno-warn-typed-holes']) test('T9497c-run', [exit_code(1)], compile_and_run, ['-fdefer-type-errors -fno-warn-typed-holes']) test('T9858b', normal, compile_and_run, ['']) +test('T9858c', normal, compile_and_run, ['']) From git at git.haskell.org Mon May 11 11:47:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:47:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Do not decompose => (Trac #9858) (ff2aa3f) Message-ID: <20150511114723.B52023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/ff2aa3f934d8f7ae7ae37ecdf28030b7cf14acb5/ghc >--------------------------------------------------------------- commit ff2aa3f934d8f7ae7ae37ecdf28030b7cf14acb5 Author: Simon Peyton Jones Date: Wed Apr 22 09:45:52 2015 +0100 Do not decompose => (Trac #9858) We really don't want to unify (a b) with (Eq a => ty). The ever-ingenious Oerjan discovered this problem; see comment:101 in Trac #9858. See Note [Decomposing fat arrow c=>t] in Type.hs (cherry picked from commit c0b5adbd1a04dd1c7916c1240e50a936e826136d) >--------------------------------------------------------------- ff2aa3f934d8f7ae7ae37ecdf28030b7cf14acb5 compiler/types/Type.hs | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index edc3067..854776c 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -337,6 +337,26 @@ allDistinctTyVars tkvs = go emptyVarSet tkvs We need to be pretty careful with AppTy to make sure we obey the invariant that a TyConApp is always visibly so. mkAppTy maintains the invariant: use it. + +Note [Decomposing fat arrow c=>t] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Can we unify (a b) with (Eq a => ty)? If we do so, we end up with +a partial application like ((=>) Eq a) which doesn't make sense in +source Haskell. In constrast, we *can* unify (a b) with (t1 -> t2). +Here's an example (Trac #9858) of how you might do it: + i :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep + i p = typeRep p + + j = i (Proxy :: Proxy (Eq Int => Int)) +The type (Proxy (Eq Int => Int)) is only accepted with -XImpredicativeTypes, +but suppose we want that. But then in the call to 'i', we end +up decomposing (Eq Int => Int), and we definitely don't want that. + +This really only applies to the type checker; in Core, '=>' and '->' +are the same, as are 'Constraint' and '*'. But for now I've put +the test in repSplitAppTy_maybe, which applies throughout, because +the other calls to splitAppTy are in Unify, which is also used by +the type checker (e.g. when matching type-function equations). -} -- | Applies a type to another, as in e.g. @k a@ @@ -370,7 +390,9 @@ splitAppTy_maybe ty = repSplitAppTy_maybe ty repSplitAppTy_maybe :: Type -> Maybe (Type,Type) -- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that -- any Core view stuff is already done -repSplitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2) +repSplitAppTy_maybe (FunTy ty1 ty2) + | isConstraintKind (typeKind ty1) = Nothing -- See Note [Decomposing fat arrow c=>t] + | otherwise = Just (TyConApp funTyCon [ty1], ty2) repSplitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2) repSplitAppTy_maybe (TyConApp tc tys) | isDecomposableTyCon tc || tys `lengthExceeds` tyConArity tc From git at git.haskell.org Mon May 11 11:47:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:47:26 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Test Trac #9858 comment:101 (da6199d) Message-ID: <20150511114726.F10693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/da6199d0f6d7589224b420f81b33ac03388b09b5/ghc >--------------------------------------------------------------- commit da6199d0f6d7589224b420f81b33ac03388b09b5 Author: Simon Peyton Jones Date: Wed Apr 22 14:18:56 2015 +0100 Test Trac #9858 comment:101 (cherry picked from commit 932f08677ca07f1793398e4c3456b81359728483) >--------------------------------------------------------------- da6199d0f6d7589224b420f81b33ac03388b09b5 testsuite/tests/typecheck/should_fail/T9858c.hs | 9 +++++++++ testsuite/tests/typecheck/should_fail/T9858c.stderr | 9 +++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 19 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T9858c.hs b/testsuite/tests/typecheck/should_fail/T9858c.hs new file mode 100644 index 0000000..116a50b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9858c.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ImpredicativeTypes, FlexibleContexts #-} + +module T9858b where +import Data.Typeable + +i :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep +i p = typeRep p + +j = i (Proxy :: Proxy (Eq Int => Int)) diff --git a/testsuite/tests/typecheck/should_fail/T9858c.stderr b/testsuite/tests/typecheck/should_fail/T9858c.stderr new file mode 100644 index 0000000..c2d0f22 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9858c.stderr @@ -0,0 +1,9 @@ + +T9858c.hs:9:8: error: + Couldn't match type ?Eq Int => Int? with ?a0 b0? + Expected type: Proxy (a0 b0) + Actual type: Proxy (Eq Int => Int) + In the first argument of ?i?, namely + ?(Proxy :: Proxy (Eq Int => Int))? + In the expression: i (Proxy :: Proxy (Eq Int => Int)) + In an equation for ?j?: j = i (Proxy :: Proxy (Eq Int => Int)) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index de01268..6402dc4 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -361,3 +361,4 @@ test('T10285', multimod_compile_fail, ['T10285', '-v0']) test('T9858a', normal, compile_fail, ['']) test('T9858b', normal, compile_fail, ['']) +test('T9858c', normal, compile_fail, ['']) From git at git.haskell.org Mon May 11 11:51:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 11:51:37 +0000 (UTC) Subject: [commit: ghc] master: More accurate allocation stats for :set +s (cf7573b) Message-ID: <20150511115137.604B83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf7573b8207bbb17c58612f3345e0b17d74cfb58/ghc >--------------------------------------------------------------- commit cf7573b8207bbb17c58612f3345e0b17d74cfb58 Author: Simon Marlow Date: Fri May 8 15:28:40 2015 +0100 More accurate allocation stats for :set +s The point of this commit is to make the memory allocation statistic from :set +s in GHCi a lot more accurate. Currently it uses the total allocation figure calculated by the RTS, which is only updated during GC, so can be wrong by an arbitrary amount. The fix is to the the per-thread allocation counter that was introduced for allocation limits. This required changes to the GHC API, because we now have to return the allocation value from each evaluation. Rather than just change the API, I introduced a new API and deprecated the old one. The new one is simpler and more extensible, so hopefully we won't need to make this transition in the future. See GHC.hs for details. >--------------------------------------------------------------- cf7573b8207bbb17c58612f3345e0b17d74cfb58 compiler/main/GHC.hs | 62 +++++++----- compiler/main/InteractiveEval.hs | 131 ++++++++++++++++++-------- compiler/main/InteractiveEvalTypes.hs | 37 ++++++-- ghc/GhciMonad.hs | 37 ++++---- ghc/InteractiveUI.hs | 65 ++++++++----- testsuite/tests/ghc-api/T8628.hs | 8 +- testsuite/tests/ghc-api/T8639_api.hs | 4 +- testsuite/tests/ghc-api/apirecomp001/myghc.hs | 8 +- 8 files changed, 234 insertions(+), 118 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 cf7573b8207bbb17c58612f3345e0b17d74cfb58 From git at git.haskell.org Mon May 11 12:13:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 12:13:56 +0000 (UTC) Subject: [commit: ghc] master: compiler: make sure we reject -O + HscInterpreted (9736c04) Message-ID: <20150511121356.5F6CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9736c042f4292b4fb94ca9faca6a010372a0f92f/ghc >--------------------------------------------------------------- commit 9736c042f4292b4fb94ca9faca6a010372a0f92f Author: Austin Seipp Date: Mon May 11 07:10:22 2015 -0500 compiler: make sure we reject -O + HscInterpreted When using GHCi, we explicitly reject optimization, because the compilers optimization passes can introduce unboxed tuples, which the interpreter is not able to handle. But this goes the other way too: using GHCi on optimized code may cause the optimizer to float out breakpoints that the interpreter introduces. This manifests itself in weird ways, particularly if you as an API client use custom DynFlags to introduce optimization in combination with HscInterpreted. It turns out we weren't checking for consistent DynFlag settings when doing `setSessionDynFlags`, as #10052 showed. While the main driver handled it in `DynFlags` via `parseDynamicFlags`, we didn't check this elsewhere. This does a little refactoring to split out some of the common code, and immunizes the various `DynFlags` utilities in the `GHC` module from this particular bug. We should probably be checking other general invariants too. This fixes #10052, and adds some notes about the behavior in `GHC` and `FloatOut` As a bonus, expose `warningMsg` from `ErrUtils` as a helper since it didn't exist (somehow). Signed-off-by: Austin Seipp Reviewed By: edsko Differential Revision: https://phabricator.haskell.org/D727 GHC Trac Issues: #10052 >--------------------------------------------------------------- 9736c042f4292b4fb94ca9faca6a010372a0f92f compiler/main/DynFlags.hs | 19 +++++----- compiler/main/ErrUtils.hs | 6 +++- compiler/main/GHC.hs | 41 ++++++++++++++++++---- compiler/simplCore/FloatOut.hs | 27 ++++++++++++++ testsuite/.gitignore | 1 + testsuite/tests/ghc-api/T10052/Makefile | 12 +++++++ testsuite/tests/ghc-api/T10052/T10052-input.hs | 1 + testsuite/tests/ghc-api/T10052/T10052.hs | 30 ++++++++++++++++ .../T10052/T10052.stderr} | 0 testsuite/tests/ghc-api/T10052/T10052.stdout | 1 + testsuite/tests/ghc-api/T10052/all.T | 2 ++ 11 files changed, 123 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 9736c042f4292b4fb94ca9faca6a010372a0f92f From git at git.haskell.org Mon May 11 12:18:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 12:18:23 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : BooleanFormula construction discards original (24707d7) Message-ID: <20150511121823.91DFA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/24707d72d6137cb970878ef243c090a6bf6601e0/ghc >--------------------------------------------------------------- commit 24707d72d6137cb970878ef243c090a6bf6601e0 Author: Alan Zimmerman Date: Mon May 11 14:19:14 2015 +0200 ApiAnnotations : BooleanFormula construction discards original Summary: The MINIMAL pragma is captured in the parser using a BooleanFormula. The constructors (mkBool,mkAnd,mkOr) are smart and try to minimise the boolean formula as it is constructed. This discards the original information, making round tripping impossible. Note: there is another version which provides a more API Annotations friendly version of the MINIMAL pragma, but this requires changes to haddock, which will cause problems for 7.10.2. See https://github.com/alanz/ghc/tree/wip/10287 Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, Fuuzetsu, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D837 GHC Trac Issues: #10287 >--------------------------------------------------------------- 24707d72d6137cb970878ef243c090a6bf6601e0 compiler/parser/Parser.y | 10 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + .../tests/ghc-api/annotations/TestBoolFormula.hs | 26 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../annotations/{t10268.hs => boolFormula.hs} | 2 +- .../tests/ghc-api/annotations/boolFormula.stderr | 17 +++ .../tests/ghc-api/annotations/boolFormula.stdout | 163 +++++++++++++++++++++ 8 files changed, 222 insertions(+), 6 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 24707d72d6137cb970878ef243c090a6bf6601e0 From git at git.haskell.org Mon May 11 12:45:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 12:45:44 +0000 (UTC) Subject: [commit: ghc] master: Fix build breakage from 9736c042 (f35d621) Message-ID: <20150511124544.615313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f35d621de401bea74d42b28ff9a1d8c5d963a92d/ghc >--------------------------------------------------------------- commit f35d621de401bea74d42b28ff9a1d8c5d963a92d Author: Austin Seipp Date: Mon May 11 07:45:03 2015 -0500 Fix build breakage from 9736c042 This was a snaffu caused by my in-tree patch actually differing from the Phab one slightly. Whoops. Signed-off-by: Austin Seipp >--------------------------------------------------------------- f35d621de401bea74d42b28ff9a1d8c5d963a92d compiler/main/DynFlags.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index f8f72b1..6e55622 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2564,11 +2564,11 @@ dynamic_flags = [ , defGhcFlag "fplugin" (hasArg addPluginModuleName) ------ Optimisation flags ------------------------------------------ - , defGhcFlag "O" (noArgM (updOptLevel 1)) + , defGhcFlag "O" (noArgM (setOptLevel 1)) , defGhcFlag "Onot" (noArgM (\dflags -> do deprecate "Use -O0 instead" - updOptLevel 0 dflags)) + setOptLevel 0 dflags)) , defGhcFlag "Odph" (noArgM setDPHOpt) - , defGhcFlag "O" (optIntSuffixM (\mb_n -> updOptLevel (mb_n `orElse` 1))) + , defGhcFlag "O" (optIntSuffixM (\mb_n -> setOptLevel (mb_n `orElse` 1))) -- If the number is missing, use 1 @@ -3863,6 +3863,9 @@ setObjTarget l = updM set = return $ dflags { hscTarget = l } | otherwise = return dflags +setOptLevel :: Int -> DynFlags -> DynP DynFlags +setOptLevel n dflags = return (updOptLevel n dflags) + checkOptLevel :: Int -> DynFlags -> Either String DynFlags checkOptLevel n dflags | hscTarget dflags == HscInterpreted && n > 0 @@ -3877,7 +3880,7 @@ checkOptLevel n dflags -- -fsimplifier-phases=3 we use an additional simplifier phase for fusion -- setDPHOpt :: DynFlags -> DynP DynFlags -setDPHOpt dflags = updOptLevel 2 (dflags { maxSimplIterations = 20 +setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 , simplPhases = 3 }) From git at git.haskell.org Mon May 11 13:28:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 13:28:04 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : pquals production adds AnnVbar in the wrong place (fe38195) Message-ID: <20150511132804.68ED43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe38195eb783fc2f2f2d5ef50fb665b06fd15e82/ghc >--------------------------------------------------------------- commit fe38195eb783fc2f2f2d5ef50fb665b06fd15e82 Author: Alan Zimmerman Date: Mon May 11 15:28:55 2015 +0200 ApiAnnotations : pquals production adds AnnVbar in the wrong place Summary: The Parser.y production for pquals is pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] } : squals '|' pquals {% addAnnotation (gl $ last $ unLoc $1) AnnVbar (gl $2) >> return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) } | squals { L (getLoc $1) [reverse (unLoc $1)] } The squals are returned in reverse order, so the AnnVbar should be attached to the head of the list, not the last. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D869 GHC Trac Issues: #10357 >--------------------------------------------------------------- fe38195eb783fc2f2f2d5ef50fb665b06fd15e82 compiler/parser/Parser.y | 2 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10357.stderr | 30 ++++++ testsuite/tests/ghc-api/annotations/T10357.stdout | 110 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10357.hs | 13 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../annotations/{exampleTest.hs => t10357.hs} | 20 ++-- 8 files changed, 177 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 fe38195eb783fc2f2f2d5ef50fb665b06fd15e82 From git at git.haskell.org Mon May 11 15:56:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 15:56:13 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. (ecc3d6b) Message-ID: <20150511155613.85E6B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ecc3d6be218b1c7a36ee3f2f36c4f3ac4f45c34f/ghc >--------------------------------------------------------------- commit ecc3d6be218b1c7a36ee3f2f36c4f3ac4f45c34f Author: Alan Zimmerman Date: Mon May 11 17:57:05 2015 +0200 ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. Summary: The production for decl_no_th starts decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; ... The e value should be just the pattern, excluding the rhs, but the span created includes the rhs. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D873 GHC Trac Issues: #10358 >--------------------------------------------------------------- ecc3d6be218b1c7a36ee3f2f36c4f3ac4f45c34f compiler/parser/Parser.y | 4 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 7 +++ testsuite/tests/ghc-api/annotations/T10358.stderr | 12 +++++ testsuite/tests/ghc-api/annotations/T10358.stdout | 58 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10358.hs | 8 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/boolFormula.stderr | 17 ------- .../ghc-api/annotations/{t10357.hs => t10358.hs} | 2 +- 9 files changed, 90 insertions(+), 20 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 51b20a0..eb2aa0c 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1986,10 +1986,10 @@ docdecld :: { LDocDecl } decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } - | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; + | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; _ <- ams (sLL $1 $> ()) - (mj AnnBang $1:(fst $ unLoc $3)); + (fst $ unLoc $3); return $ sLL $1 $> $ unitOL $ sLL $1 $> $ ValD $ PatBind pat (snd $ unLoc $3) placeHolderType diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 4f6f3be..b8bba4f 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -5,6 +5,7 @@ exampleTest listcomps t10309 t10357 +t10358 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 0cebeaf..7cf7baf 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -37,6 +37,13 @@ listcomps: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc listcomps ./listcomps "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" +t10358: + rm -f t10358.o t10358.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10358 + ./t10358 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10358 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10358.stderr b/testsuite/tests/ghc-api/annotations/T10358.stderr new file mode 100644 index 0000000..96daaad --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10358.stderr @@ -0,0 +1,12 @@ + +Test10358.hs:5:14: error: Not in scope: ?x? + +Test10358.hs:5:16: error: Not in scope: ?x? + +Test10358.hs:6:12: error: Not in scope: ?v? + +Test10358.hs:6:14: error: Not in scope: ?v? + +Test10358.hs:6:16: error: Not in scope: ?v? + +Test10358.hs:7:12: error: Not in scope: ?d? diff --git a/testsuite/tests/ghc-api/annotations/T10358.stdout b/testsuite/tests/ghc-api/annotations/T10358.stdout new file mode 100644 index 0000000..02dcb7a --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10358.stdout @@ -0,0 +1,58 @@ +---Problems--------------------- +[ +(AK AnnEofPos = [Test10358.hs:9:1]) +] + +---Problems'-------------------- +[(AnnEofPos, Test10358.hs:9:1)] +-------------------------------- +[ +(AK Test10358.hs:1:1 AnnModule = [Test10358.hs:2:1-6]) + +(AK Test10358.hs:1:1 AnnWhere = [Test10358.hs:2:18-22]) + +(AK Test10358.hs:(4,1)-(8,6) AnnEqual = [Test10358.hs:4:13]) + +(AK Test10358.hs:(4,1)-(8,6) AnnFunId = [Test10358.hs:4:1-7]) + +(AK Test10358.hs:(4,1)-(8,6) AnnSemi = [Test10358.hs:9:1]) + +(AK Test10358.hs:(5,3)-(8,6) AnnIn = [Test10358.hs:8:3-4]) + +(AK Test10358.hs:(5,3)-(8,6) AnnLet = [Test10358.hs:5:3-5]) + +(AK Test10358.hs:5:7-10 AnnBang = [Test10358.hs:5:7]) + +(AK Test10358.hs:5:7-16 AnnEqual = [Test10358.hs:5:12]) + +(AK Test10358.hs:5:7-16 AnnSemi = [Test10358.hs:5:17]) + +(AK Test10358.hs:5:14-16 AnnVal = [Test10358.hs:5:15]) + +(AK Test10358.hs:5:19-22 AnnBang = [Test10358.hs:5:19]) + +(AK Test10358.hs:5:19-32 AnnEqual = [Test10358.hs:5:24]) + +(AK Test10358.hs:5:19-32 AnnSemi = [Test10358.hs:6:7]) + +(AK Test10358.hs:5:26-32 AnnVal = [Test10358.hs:5:29]) + +(AK Test10358.hs:6:7-16 AnnEqual = [Test10358.hs:6:10]) + +(AK Test10358.hs:6:7-16 AnnFunId = [Test10358.hs:6:7-8]) + +(AK Test10358.hs:6:7-16 AnnSemi = [Test10358.hs:7:7]) + +(AK Test10358.hs:6:12-14 AnnVal = [Test10358.hs:6:13]) + +(AK Test10358.hs:6:12-16 AnnVal = [Test10358.hs:6:15]) + +(AK Test10358.hs:7:7-17 AnnEqual = [Test10358.hs:7:10]) + +(AK Test10358.hs:7:7-17 AnnFunId = [Test10358.hs:7:7-8]) + +(AK Test10358.hs:7:12-17 AnnVal = [Test10358.hs:7:14]) + +(AK AnnEofPos = [Test10358.hs:9:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10358.hs b/testsuite/tests/ghc-api/annotations/Test10358.hs new file mode 100644 index 0000000..9badab2 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10358.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE BangPatterns #-} +module Test10358 where + +mtGamma a b = + let !x_2 = x*x; !x_4 = x_2*x_2 + v3 = v*v*v + dv = d * v3 + in 5 diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 5614127..b60f0bc 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -12,3 +12,4 @@ test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307' test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) test('boolFormula', normal, run_command, ['$MAKE -s --no-print-directory boolFormula']) test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357']) +test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) diff --git a/testsuite/tests/ghc-api/annotations/boolFormula.stderr b/testsuite/tests/ghc-api/annotations/boolFormula.stderr deleted file mode 100644 index 65cbf26..0000000 --- a/testsuite/tests/ghc-api/annotations/boolFormula.stderr +++ /dev/null @@ -1,17 +0,0 @@ - -TestBoolFormula.hs:3:1: Warning: - The MINIMAL pragma does not require: - ?aOp?, ?bOp?, ?cOp?, ?dOp?, ?eOp?, and ?fOp? - but there is no default implementation. - In the class declaration for ?ManyOps? - -TestBoolFormula.hs:15:1: Warning: - The MINIMAL pragma does not require: - ?baq?, ?baz?, and ?quux? - but there is no default implementation. - In the class declaration for ?Foo? - -TestBoolFormula.hs:23:10: Warning: - No explicit implementation for - either (?foo? and ?baq?) or ?foo? - In the instance declaration for ?Foo Int? diff --git a/testsuite/tests/ghc-api/annotations/t10357.hs b/testsuite/tests/ghc-api/annotations/t10358.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10357.hs copy to testsuite/tests/ghc-api/annotations/t10358.hs index 93a1f70..82994cc 100644 --- a/testsuite/tests/ghc-api/annotations/t10357.hs +++ b/testsuite/tests/ghc-api/annotations/t10358.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10357" + testOneFile libdir "Test10358" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Mon May 11 16:08:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 16:08:32 +0000 (UTC) Subject: [commit: ghc] master: Support stage 1 Template Haskell (non-quasi) quotes, fixes #10382. (f16ddce) Message-ID: <20150511160832.1A2EB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f16ddcee0c64a92ab911a7841a8cf64e3ac671fd/ghc >--------------------------------------------------------------- commit f16ddcee0c64a92ab911a7841a8cf64e3ac671fd Author: Edward Z. Yang Date: Mon May 4 16:10:05 2015 -0700 Support stage 1 Template Haskell (non-quasi) quotes, fixes #10382. Summary: This commit adds stage 1 support for Template Haskell quoting, e.g. [| ... expr ... |], which is useful for authors of quasiquoter libraries that do not actually need splices. The TemplateHaskell extension now does not unconditionally fail; it only fails if the renamer encounters a splice that it can't run. In order to make sure the referenced data structures are consistent, template-haskell is now a boot library. There are some minor BC changes to template-haskell to make it boot on GHC 7.8. Note for reviewer: big diff changes are simply code being moved out of an ifdef; there was no other substantive change to that code. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, goldfire Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D876 GHC Trac Issues: #10382 >--------------------------------------------------------------- f16ddcee0c64a92ab911a7841a8cf64e3ac671fd compiler/deSugar/DsExpr.hs | 8 - compiler/ghc.cabal.in | 4 +- compiler/main/DynFlags.hs | 27 +- compiler/main/HscMain.hs | 4 +- compiler/rename/RnSplice.hs | 308 ++++++++++----------- compiler/typecheck/TcExpr.hs | 10 - compiler/typecheck/TcSplice.hs | 173 ++++++------ docs/users_guide/7.12.1-notes.xml | 7 +- docs/users_guide/glasgow_exts.xml | 4 +- ghc.mk | 2 +- .../template-haskell/Language/Haskell/TH/PprLib.hs | 5 +- .../template-haskell/Language/Haskell/TH/Syntax.hs | 13 +- libraries/template-haskell/template-haskell.cabal | 9 +- mk/warnings.mk | 1 + testsuite/tests/quotes/.gitignore | 4 + testsuite/tests/{annotations => quotes}/Makefile | 0 testsuite/tests/quotes/T10384.hs | 3 + testsuite/tests/quotes/T10384.stderr | 6 + testsuite/tests/{th => quotes}/T2632.hs | 2 - testsuite/tests/{th => quotes}/T2931.hs | 1 - testsuite/tests/{th => quotes}/T3572.hs | 0 testsuite/tests/{th => quotes}/T3572.stdout | 0 testsuite/tests/{th => quotes}/T4056.hs | 2 +- testsuite/tests/{th => quotes}/T4169.hs | 2 - testsuite/tests/{th => quotes}/T4170.hs | 1 - testsuite/tests/{th => quotes}/T5721.hs | 2 +- testsuite/tests/{th => quotes}/T6062.hs | 1 - testsuite/tests/quotes/T8455.hs | 5 + testsuite/tests/{th => quotes}/T8633.hs | 0 testsuite/tests/{th => quotes}/T8759a.hs | 2 +- testsuite/tests/{th => quotes}/T8759a.stderr | 0 testsuite/tests/{th => quotes}/T9824.hs | 1 - .../tests/{th => quotes}/TH_abstractFamily.hs | 0 .../tests/{th => quotes}/TH_abstractFamily.stderr | 0 testsuite/tests/{th => quotes}/TH_bracket1.hs | 0 testsuite/tests/{th => quotes}/TH_bracket2.hs | 0 testsuite/tests/{th => quotes}/TH_bracket3.hs | 0 testsuite/tests/quotes/TH_localname.hs | 3 + testsuite/tests/quotes/TH_localname.stderr | 22 ++ testsuite/tests/{th => quotes}/TH_ppr1.hs | 0 testsuite/tests/{th => quotes}/TH_ppr1.stdout | 0 testsuite/tests/{th => quotes}/TH_reifyType1.hs | 0 testsuite/tests/{th => quotes}/TH_reifyType2.hs | 0 testsuite/tests/{th => quotes}/TH_repE1.hs | 0 testsuite/tests/{th => quotes}/TH_repE3.hs | 0 testsuite/tests/{th => quotes}/TH_scope.hs | 0 .../tests/{th => quotes}/TH_spliceViewPat/A.hs | 0 .../tests/{th => quotes}/TH_spliceViewPat/Main.hs | 0 .../tests/{th => quotes}/TH_spliceViewPat/Makefile | 0 .../TH_spliceViewPat/TH_spliceViewPat.stdout | 0 .../tests/{th => quotes}/TH_spliceViewPat/test.T | 5 - testsuite/tests/{th => quotes}/TH_tf2.hs | 0 testsuite/tests/quotes/all.T | 31 +++ testsuite/tests/th/T8455.hs | 5 - testsuite/tests/th/all.T | 31 +-- 55 files changed, 359 insertions(+), 345 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 f16ddcee0c64a92ab911a7841a8cf64e3ac671fd From git at git.haskell.org Mon May 11 21:36:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 21:36:50 +0000 (UTC) Subject: [commit: ghc] branch 'wip/7.10-api-annots2' created Message-ID: <20150511213650.0F49F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/7.10-api-annots2 Referencing: ded5ae9472cec407138f50d72bac7111c532aa3b From git at git.haskell.org Mon May 11 21:36:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 21:36:54 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots2: Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. (9e1e4ee) Message-ID: <20150511213654.46BD83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots2 Link : http://ghc.haskell.org/trac/ghc/changeset/9e1e4eecd00cbdd791970f3226e99c82ef1d9ec1/ghc >--------------------------------------------------------------- commit 9e1e4eecd00cbdd791970f3226e99c82ef1d9ec1 Author: Alan Zimmerman Date: Mon May 11 09:34:27 2015 +0200 Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. Summary: The code for mkAtDefault is as follows. mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e })) | TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs } <- e = do { tvs <- checkTyVars (ptext (sLit "default")) equalsDots tc (hswb_cts pats) ; return (L loc (TyFamEqn { tfe_tycon = tc , tfe_pats = tvs , tfe_rhs = rhs })) } An associated type in a class of the form type FoldableConstraint t x = () has an AnnEqual attached to the location in tfid_eqn. Since the location is discarded, this annotation is then disconnected from the AST. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D842 GHC Trac Issues: #10307 (cherry picked from commit 811b72adedcd12149783eac19ebccff1dd72bc1c) Conflicts: compiler/parser/Parser.y >--------------------------------------------------------------- 9e1e4eecd00cbdd791970f3226e99c82ef1d9ec1 compiler/parser/Parser.y | 32 +++++++++++-------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10307.stdout | 36 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10307.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10312.hs => t10307.hs} | 2 +- 7 files changed, 72 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9e1e4eecd00cbdd791970f3226e99c82ef1d9ec1 From git at git.haskell.org Mon May 11 21:36:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 21:36:57 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots2: ApiAnnotations : mkGadtDecl discards annotations for HsFunTy (0a42b31) Message-ID: <20150511213657.D3E0C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots2 Link : http://ghc.haskell.org/trac/ghc/changeset/0a42b31c8fb7b59a31833d1b6a4a45db7cd13df2/ghc >--------------------------------------------------------------- commit 0a42b31c8fb7b59a31833d1b6a4a45db7cd13df2 Author: Alan Zimmerman Date: Mon May 11 10:57:25 2015 +0200 ApiAnnotations : mkGadtDecl discards annotations for HsFunTy Summary: When mkGadtDecl is presented wih a HsFunTy it discards the SrcSpan, thus disconnecting any annotations on the HsFunTy. ``` mkGadtDecl names (L ls (HsForAllTy imp Nothing qvars cxt tau)) = return $ mk_gadt_con names where (details, res_ty) -- See Note [Sorting out the result type] = case tau of L _ (HsFunTy (L l (HsRecTy flds)) res_ty) -> (RecCon (L l flds), res_ty) _other -> (PrefixCon [], tau) ... ``` This can be triggered by the following ``` {-# LANGUAGE GADTs #-} module GADTRecords2 (H1(..)) where -- | h1 data H1 a b where C3 :: (Num a) => { field :: a -- ^ hello docs } -> H1 Int Int ``` Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D848 GHC Trac Issues: #10309 (cherry picked from commit e4032b1951a35d8df63a74ebfee7449988b5ef40) >--------------------------------------------------------------- 0a42b31c8fb7b59a31833d1b6a4a45db7cd13df2 compiler/parser/Parser.y | 3 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10255.stdout | 2 ++ testsuite/tests/ghc-api/annotations/T10309.stdout | 38 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/T10312.stdout | 2 ++ testsuite/tests/ghc-api/annotations/Test10309.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10307.hs => t10309.hs} | 2 +- 9 files changed, 61 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 602af19..4728df5 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1488,7 +1488,8 @@ type :: { LHsType RdrName } : btype { $1 } | btype qtyconop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } | btype tyvarop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } - | btype '->' ctype {% ams (sLL $1 $> $ HsFunTy $1 $3) + | btype '->' ctype {% ams $1 [mj AnnRarrow $2] + >> ams (sLL $1 $> $ HsFunTy $1 $3) [mj AnnRarrow $2] } | btype '~' btype {% ams (sLL $1 $> $ HsEqTy $1 $3) [mj AnnTilde $2] } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 8b7f082..8ff93b4 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -3,6 +3,7 @@ parseTree comments exampleTest listcomps +t10309 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 15c3bc4..c7aa1e5 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -8,6 +8,7 @@ clean: rm -f t10269 rm -f t10255 t10312 rm -f t1037 + rm -f t10309 annotations: rm -f annotations.o annotations.hi @@ -73,3 +74,10 @@ t10307: ./t10307 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" .PHONY: t10307 + +t10309: + rm -f t10309.o t10309.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10309 + ./t10309 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10309 diff --git a/testsuite/tests/ghc-api/annotations/T10255.stdout b/testsuite/tests/ghc-api/annotations/T10255.stdout index 099ef54..50e9bb7 100644 --- a/testsuite/tests/ghc-api/annotations/T10255.stdout +++ b/testsuite/tests/ghc-api/annotations/T10255.stdout @@ -29,6 +29,8 @@ (AK Test10255.hs:6:11-26 AnnOpenP = [Test10255.hs:6:11]) +(AK Test10255.hs:6:12-18 AnnRarrow = [Test10255.hs:6:20-21]) + (AK Test10255.hs:6:12-25 AnnRarrow = [Test10255.hs:6:20-21]) (AK AnnEofPos = [Test10255.hs:8:1]) diff --git a/testsuite/tests/ghc-api/annotations/T10309.stdout b/testsuite/tests/ghc-api/annotations/T10309.stdout new file mode 100644 index 0000000..1423466 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10309.stdout @@ -0,0 +1,38 @@ +---Problems--------------------- +[ +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) +] + +-------------------------------- +[ +(AK Test10309.hs:1:1 AnnModule = [Test10309.hs:2:1-6]) + +(AK Test10309.hs:1:1 AnnWhere = [Test10309.hs:2:18-22]) + +(AK Test10309.hs:(4,1)-(6,34) AnnData = [Test10309.hs:4:1-4]) + +(AK Test10309.hs:(4,1)-(6,34) AnnSemi = [Test10309.hs:7:1]) + +(AK Test10309.hs:(4,1)-(6,34) AnnWhere = [Test10309.hs:4:13-17]) + +(AK Test10309.hs:(5,3)-(6,34) AnnDcolon = [Test10309.hs:5:6-7]) + +(AK Test10309.hs:5:9-15 AnnCloseP = [Test10309.hs:5:15]) + +(AK Test10309.hs:5:9-15 AnnDarrow = [Test10309.hs:5:17-18]) + +(AK Test10309.hs:5:9-15 AnnOpenP = [Test10309.hs:5:9]) + +(AK Test10309.hs:(5,20)-(6,20) AnnCloseC = [Test10309.hs:6:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnOpenC = [Test10309.hs:5:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:5:22-31 AnnDcolon = [Test10309.hs:5:28-29]) + +(AK AnnEofPos = [Test10309.hs:7:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/T10312.stdout b/testsuite/tests/ghc-api/annotations/T10312.stdout index 5e4fd1c..70af815 100644 --- a/testsuite/tests/ghc-api/annotations/T10312.stdout +++ b/testsuite/tests/ghc-api/annotations/T10312.stdout @@ -334,6 +334,8 @@ (AK Test10312.hs:68:28-51 AnnRarrow = [Test10312.hs:68:37-38]) +(AK Test10312.hs:68:29 AnnRarrow = [Test10312.hs:68:31-32]) + (AK Test10312.hs:68:29-34 AnnRarrow = [Test10312.hs:68:31-32]) (AK Test10312.hs:68:40-42 AnnCloseS = [Test10312.hs:68:42]) diff --git a/testsuite/tests/ghc-api/annotations/Test10309.hs b/testsuite/tests/ghc-api/annotations/Test10309.hs new file mode 100644 index 0000000..75f18a9 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10309.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} +module Test10309 where + +data H1 a b where + C3 :: (Num a) => { field :: a -- ^ hello docs + } -> H1 Int Int diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 3e145b9..81aec52 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -9,3 +9,4 @@ test('T10269', normal, run_command, ['$MAKE -s --no-print-directory T10269' test('T10280', normal, run_command, ['$MAKE -s --no-print-directory T10280']) test('T10312', normal, run_command, ['$MAKE -s --no-print-directory t10312']) test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307']) +test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) diff --git a/testsuite/tests/ghc-api/annotations/t10307.hs b/testsuite/tests/ghc-api/annotations/t10309.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10307.hs copy to testsuite/tests/ghc-api/annotations/t10309.hs index 5c6f233..ebce40e 100644 --- a/testsuite/tests/ghc-api/annotations/t10307.hs +++ b/testsuite/tests/ghc-api/annotations/t10309.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10307" + testOneFile libdir "Test10309" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Mon May 11 21:37:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 21:37:01 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots2: ApiAnnotations : BooleanFormula construction discards original (aa23b24) Message-ID: <20150511213701.9570E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots2 Link : http://ghc.haskell.org/trac/ghc/changeset/aa23b2446d3241391bbfad7ea1e811e67ec0b17d/ghc >--------------------------------------------------------------- commit aa23b2446d3241391bbfad7ea1e811e67ec0b17d Author: Alan Zimmerman Date: Mon May 11 14:19:14 2015 +0200 ApiAnnotations : BooleanFormula construction discards original Summary: The MINIMAL pragma is captured in the parser using a BooleanFormula. The constructors (mkBool,mkAnd,mkOr) are smart and try to minimise the boolean formula as it is constructed. This discards the original information, making round tripping impossible. Note: there is another version which provides a more API Annotations friendly version of the MINIMAL pragma, but this requires changes to haddock, which will cause problems for 7.10.2. See https://github.com/alanz/ghc/tree/wip/10287 Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, Fuuzetsu, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D837 GHC Trac Issues: #10287 (cherry picked from commit 24707d72d6137cb970878ef243c090a6bf6601e0) >--------------------------------------------------------------- aa23b2446d3241391bbfad7ea1e811e67ec0b17d compiler/parser/Parser.y | 10 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + .../tests/ghc-api/annotations/TestBoolFormula.hs | 26 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../annotations/{t10269.hs => boolFormula.hs} | 2 +- .../tests/ghc-api/annotations/boolFormula.stderr | 17 +++ .../tests/ghc-api/annotations/boolFormula.stdout | 163 +++++++++++++++++++++ 8 files changed, 222 insertions(+), 6 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc aa23b2446d3241391bbfad7ea1e811e67ec0b17d From git at git.haskell.org Mon May 11 21:37:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 21:37:05 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots2: ApiAnnotations : pquals production adds AnnVbar in the wrong place (6b862e3) Message-ID: <20150511213705.A06503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots2 Link : http://ghc.haskell.org/trac/ghc/changeset/6b862e3baed1100ee90fc8bfad0612d468a3937e/ghc >--------------------------------------------------------------- commit 6b862e3baed1100ee90fc8bfad0612d468a3937e Author: Alan Zimmerman Date: Mon May 11 15:28:55 2015 +0200 ApiAnnotations : pquals production adds AnnVbar in the wrong place Summary: The Parser.y production for pquals is pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] } : squals '|' pquals {% addAnnotation (gl $ last $ unLoc $1) AnnVbar (gl $2) >> return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) } | squals { L (getLoc $1) [reverse (unLoc $1)] } The squals are returned in reverse order, so the AnnVbar should be attached to the head of the list, not the last. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D869 GHC Trac Issues: #10357 (cherry picked from commit fe38195eb783fc2f2f2d5ef50fb665b06fd15e82) >--------------------------------------------------------------- 6b862e3baed1100ee90fc8bfad0612d468a3937e compiler/parser/Parser.y | 2 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10357.stderr | 30 ++++++ testsuite/tests/ghc-api/annotations/T10357.stdout | 110 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10357.hs | 13 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10255.hs => t10357.hs} | 14 ++- 8 files changed, 177 insertions(+), 2 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 6b862e3baed1100ee90fc8bfad0612d468a3937e From git at git.haskell.org Mon May 11 21:37:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 21:37:09 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots2: ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. (d60da70) Message-ID: <20150511213709.70C5D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots2 Link : http://ghc.haskell.org/trac/ghc/changeset/d60da70144711f62412a21de923c25000dd1f0a0/ghc >--------------------------------------------------------------- commit d60da70144711f62412a21de923c25000dd1f0a0 Author: Alan Zimmerman Date: Mon May 11 17:57:05 2015 +0200 ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. Summary: The production for decl_no_th starts decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; ... The e value should be just the pattern, excluding the rhs, but the span created includes the rhs. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D873 GHC Trac Issues: #10358 (cherry picked from commit ecc3d6be218b1c7a36ee3f2f36c4f3ac4f45c34f) >--------------------------------------------------------------- d60da70144711f62412a21de923c25000dd1f0a0 compiler/parser/Parser.y | 4 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 7 +++ testsuite/tests/ghc-api/annotations/T10358.stderr | 12 +++++ testsuite/tests/ghc-api/annotations/T10358.stdout | 58 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10358.hs | 8 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/boolFormula.stderr | 17 ------- .../ghc-api/annotations/{t10357.hs => t10358.hs} | 2 +- 9 files changed, 90 insertions(+), 20 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index be193b3..623bcaa 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1853,10 +1853,10 @@ docdecld :: { LDocDecl } decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } - | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; + | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; _ <- ams (sLL $1 $> ()) - (mj AnnBang $1:(fst $ unLoc $3)); + (fst $ unLoc $3); return $ sLL $1 $> $ unitOL $ sLL $1 $> $ ValD $ PatBind pat (snd $ unLoc $3) placeHolderType diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 4f6f3be..b8bba4f 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -5,6 +5,7 @@ exampleTest listcomps t10309 t10357 +t10358 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 0cebeaf..7cf7baf 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -37,6 +37,13 @@ listcomps: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc listcomps ./listcomps "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" +t10358: + rm -f t10358.o t10358.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10358 + ./t10358 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10358 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10358.stderr b/testsuite/tests/ghc-api/annotations/T10358.stderr new file mode 100644 index 0000000..96daaad --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10358.stderr @@ -0,0 +1,12 @@ + +Test10358.hs:5:14: error: Not in scope: ?x? + +Test10358.hs:5:16: error: Not in scope: ?x? + +Test10358.hs:6:12: error: Not in scope: ?v? + +Test10358.hs:6:14: error: Not in scope: ?v? + +Test10358.hs:6:16: error: Not in scope: ?v? + +Test10358.hs:7:12: error: Not in scope: ?d? diff --git a/testsuite/tests/ghc-api/annotations/T10358.stdout b/testsuite/tests/ghc-api/annotations/T10358.stdout new file mode 100644 index 0000000..02dcb7a --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10358.stdout @@ -0,0 +1,58 @@ +---Problems--------------------- +[ +(AK AnnEofPos = [Test10358.hs:9:1]) +] + +---Problems'-------------------- +[(AnnEofPos, Test10358.hs:9:1)] +-------------------------------- +[ +(AK Test10358.hs:1:1 AnnModule = [Test10358.hs:2:1-6]) + +(AK Test10358.hs:1:1 AnnWhere = [Test10358.hs:2:18-22]) + +(AK Test10358.hs:(4,1)-(8,6) AnnEqual = [Test10358.hs:4:13]) + +(AK Test10358.hs:(4,1)-(8,6) AnnFunId = [Test10358.hs:4:1-7]) + +(AK Test10358.hs:(4,1)-(8,6) AnnSemi = [Test10358.hs:9:1]) + +(AK Test10358.hs:(5,3)-(8,6) AnnIn = [Test10358.hs:8:3-4]) + +(AK Test10358.hs:(5,3)-(8,6) AnnLet = [Test10358.hs:5:3-5]) + +(AK Test10358.hs:5:7-10 AnnBang = [Test10358.hs:5:7]) + +(AK Test10358.hs:5:7-16 AnnEqual = [Test10358.hs:5:12]) + +(AK Test10358.hs:5:7-16 AnnSemi = [Test10358.hs:5:17]) + +(AK Test10358.hs:5:14-16 AnnVal = [Test10358.hs:5:15]) + +(AK Test10358.hs:5:19-22 AnnBang = [Test10358.hs:5:19]) + +(AK Test10358.hs:5:19-32 AnnEqual = [Test10358.hs:5:24]) + +(AK Test10358.hs:5:19-32 AnnSemi = [Test10358.hs:6:7]) + +(AK Test10358.hs:5:26-32 AnnVal = [Test10358.hs:5:29]) + +(AK Test10358.hs:6:7-16 AnnEqual = [Test10358.hs:6:10]) + +(AK Test10358.hs:6:7-16 AnnFunId = [Test10358.hs:6:7-8]) + +(AK Test10358.hs:6:7-16 AnnSemi = [Test10358.hs:7:7]) + +(AK Test10358.hs:6:12-14 AnnVal = [Test10358.hs:6:13]) + +(AK Test10358.hs:6:12-16 AnnVal = [Test10358.hs:6:15]) + +(AK Test10358.hs:7:7-17 AnnEqual = [Test10358.hs:7:10]) + +(AK Test10358.hs:7:7-17 AnnFunId = [Test10358.hs:7:7-8]) + +(AK Test10358.hs:7:12-17 AnnVal = [Test10358.hs:7:14]) + +(AK AnnEofPos = [Test10358.hs:9:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10358.hs b/testsuite/tests/ghc-api/annotations/Test10358.hs new file mode 100644 index 0000000..9badab2 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10358.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE BangPatterns #-} +module Test10358 where + +mtGamma a b = + let !x_2 = x*x; !x_4 = x_2*x_2 + v3 = v*v*v + dv = d * v3 + in 5 diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 5614127..b60f0bc 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -12,3 +12,4 @@ test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307' test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) test('boolFormula', normal, run_command, ['$MAKE -s --no-print-directory boolFormula']) test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357']) +test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) diff --git a/testsuite/tests/ghc-api/annotations/boolFormula.stderr b/testsuite/tests/ghc-api/annotations/boolFormula.stderr deleted file mode 100644 index 65cbf26..0000000 --- a/testsuite/tests/ghc-api/annotations/boolFormula.stderr +++ /dev/null @@ -1,17 +0,0 @@ - -TestBoolFormula.hs:3:1: Warning: - The MINIMAL pragma does not require: - ?aOp?, ?bOp?, ?cOp?, ?dOp?, ?eOp?, and ?fOp? - but there is no default implementation. - In the class declaration for ?ManyOps? - -TestBoolFormula.hs:15:1: Warning: - The MINIMAL pragma does not require: - ?baq?, ?baz?, and ?quux? - but there is no default implementation. - In the class declaration for ?Foo? - -TestBoolFormula.hs:23:10: Warning: - No explicit implementation for - either (?foo? and ?baq?) or ?foo? - In the instance declaration for ?Foo Int? diff --git a/testsuite/tests/ghc-api/annotations/t10357.hs b/testsuite/tests/ghc-api/annotations/t10358.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10357.hs copy to testsuite/tests/ghc-api/annotations/t10358.hs index 93a1f70..82994cc 100644 --- a/testsuite/tests/ghc-api/annotations/t10357.hs +++ b/testsuite/tests/ghc-api/annotations/t10358.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10357" + testOneFile libdir "Test10358" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Mon May 11 21:37:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 21:37:12 +0000 (UTC) Subject: [commit: ghc] wip/7.10-api-annots2: Update stderrs for tests after cherry pick from master (ded5ae9) Message-ID: <20150511213712.3DC303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/7.10-api-annots2 Link : http://ghc.haskell.org/trac/ghc/changeset/ded5ae9472cec407138f50d72bac7111c532aa3b/ghc >--------------------------------------------------------------- commit ded5ae9472cec407138f50d72bac7111c532aa3b Author: Alan Zimmerman Date: Mon May 11 23:32:40 2015 +0200 Update stderrs for tests after cherry pick from master >--------------------------------------------------------------- ded5ae9472cec407138f50d72bac7111c532aa3b testsuite/tests/ghc-api/annotations/T10357.stderr | 24 +++++++++++------------ testsuite/tests/ghc-api/annotations/T10358.stderr | 12 ++++++------ 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/testsuite/tests/ghc-api/annotations/T10357.stderr b/testsuite/tests/ghc-api/annotations/T10357.stderr index a418490..bec379a 100644 --- a/testsuite/tests/ghc-api/annotations/T10357.stderr +++ b/testsuite/tests/ghc-api/annotations/T10357.stderr @@ -1,30 +1,30 @@ -Test10357.hs:4:13: error: Not in scope: ?one? +Test10357.hs:4:13: Not in scope: ?one? -Test10357.hs:4:19: error: Not in scope: ?x? +Test10357.hs:4:19: Not in scope: ?x? -Test10357.hs:5:7: error: Not in scope: ?multPoly? +Test10357.hs:5:7: Not in scope: ?multPoly? -Test10357.hs:6:10: error: Not in scope: ?poly? +Test10357.hs:6:10: Not in scope: ?poly? -Test10357.hs:6:15: error: +Test10357.hs:6:15: Not in scope: data constructor ?LE? Perhaps you meant ?LT? (imported from Prelude) -Test10357.hs:7:10: error: Not in scope: ?addPoly? +Test10357.hs:7:10: Not in scope: ?addPoly? -Test10357.hs:7:19: error: Not in scope: ?poly? +Test10357.hs:7:19: Not in scope: ?poly? -Test10357.hs:7:24: error: +Test10357.hs:7:24: Not in scope: data constructor ?LE? Perhaps you meant ?LT? (imported from Prelude) -Test10357.hs:7:43: error: Not in scope: ?multPoly? +Test10357.hs:7:43: Not in scope: ?multPoly? -Test10357.hs:8:19: error: Not in scope: ?poly? +Test10357.hs:8:19: Not in scope: ?poly? -Test10357.hs:8:24: error: +Test10357.hs:8:24: Not in scope: data constructor ?LE? Perhaps you meant ?LT? (imported from Prelude) -Test10357.hs:8:43: error: Not in scope: ?multPoly? +Test10357.hs:8:43: Not in scope: ?multPoly? diff --git a/testsuite/tests/ghc-api/annotations/T10358.stderr b/testsuite/tests/ghc-api/annotations/T10358.stderr index 96daaad..1fe64db 100644 --- a/testsuite/tests/ghc-api/annotations/T10358.stderr +++ b/testsuite/tests/ghc-api/annotations/T10358.stderr @@ -1,12 +1,12 @@ -Test10358.hs:5:14: error: Not in scope: ?x? +Test10358.hs:5:14: Not in scope: ?x? -Test10358.hs:5:16: error: Not in scope: ?x? +Test10358.hs:5:16: Not in scope: ?x? -Test10358.hs:6:12: error: Not in scope: ?v? +Test10358.hs:6:12: Not in scope: ?v? -Test10358.hs:6:14: error: Not in scope: ?v? +Test10358.hs:6:14: Not in scope: ?v? -Test10358.hs:6:16: error: Not in scope: ?v? +Test10358.hs:6:16: Not in scope: ?v? -Test10358.hs:7:12: error: Not in scope: ?d? +Test10358.hs:7:12: Not in scope: ?d? From git at git.haskell.org Mon May 11 22:30:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:30:01 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix more merge-o's from earlier cherry-picks (d260ce3) Message-ID: <20150511223001.070773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d260ce3e4ff483705bfc9725a137161b8bd99d92/ghc >--------------------------------------------------------------- commit d260ce3e4ff483705bfc9725a137161b8bd99d92 Author: Austin Seipp Date: Mon May 11 17:29:03 2015 -0500 Fix more merge-o's from earlier cherry-picks Some error message wibbles that are to be expected. (The 'error:' prefix thing is getting slightly annoying now, but should be fixable by cherry picking the needed testsuite driver patch...) Signed-off-by: Austin Seipp >--------------------------------------------------------------- d260ce3e4ff483705bfc9725a137161b8bd99d92 testsuite/tests/typecheck/should_fail/T9858a.stderr | 6 ++++-- testsuite/tests/typecheck/should_fail/T9858b.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/T9858c.stderr | 2 +- testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr | 3 ++- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/T9858a.stderr b/testsuite/tests/typecheck/should_fail/T9858a.stderr index 72b72e9..eb3cc22 100644 --- a/testsuite/tests/typecheck/should_fail/T9858a.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858a.stderr @@ -1,6 +1,8 @@ -T9858a.hs:28:18: error: - No instance for (Typeable (() :: Constraint)) +T9858a.hs:28:18: + No instance for (Typeable + (((() :: GHC.Prim.Constraint), (() :: GHC.Prim.Constraint)) => ())) + (maybe you haven't applied enough arguments to a function?) arising from a use of ?cast? In the expression: cast e In the expression: case cast e of { Just e' -> ecast e' } diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr index b57098e..f7b54a5 100644 --- a/testsuite/tests/typecheck/should_fail/T9858b.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr @@ -1,7 +1,7 @@ -T9858b.hs:7:8: error: +T9858b.hs:7:8: No instance for (Typeable (Eq Int => Int)) - (maybe you haven't applied a function to enough arguments?) + (maybe you haven't applied enough arguments to a function?) arising from a use of ?typeRep? In the expression: typeRep (Proxy :: Proxy (Eq Int => Int)) In an equation for ?test?: diff --git a/testsuite/tests/typecheck/should_fail/T9858c.stderr b/testsuite/tests/typecheck/should_fail/T9858c.stderr index c2d0f22..2f235005 100644 --- a/testsuite/tests/typecheck/should_fail/T9858c.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858c.stderr @@ -1,5 +1,5 @@ -T9858c.hs:9:8: error: +T9858c.hs:9:8: Couldn't match type ?Eq Int => Int? with ?a0 b0? Expected type: Proxy (a0 b0) Actual type: Proxy (Eq Int => Int) diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index 8e37acf..e900101 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -7,7 +7,8 @@ TcStaticPointersFail02.hs:9:6: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: - No instance for (Data.Typeable.Internal.Typeable m) + No instance for (Data.Typeable.Internal.Typeable + (Monad m => a -> m a)) (maybe you haven't applied enough arguments to a function?) arising from a static form In the expression: static return From git at git.haskell.org Mon May 11 22:30:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:30:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. (bc4968f) Message-ID: <20150511223005.1BFF03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/bc4968f40da5ac6764623466915175377fa6f4dc/ghc >--------------------------------------------------------------- commit bc4968f40da5ac6764623466915175377fa6f4dc Author: Alan Zimmerman Date: Mon May 11 09:34:27 2015 +0200 Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. Summary: The code for mkAtDefault is as follows. mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e })) | TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs } <- e = do { tvs <- checkTyVars (ptext (sLit "default")) equalsDots tc (hswb_cts pats) ; return (L loc (TyFamEqn { tfe_tycon = tc , tfe_pats = tvs , tfe_rhs = rhs })) } An associated type in a class of the form type FoldableConstraint t x = () has an AnnEqual attached to the location in tfid_eqn. Since the location is discarded, this annotation is then disconnected from the AST. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D842 GHC Trac Issues: #10307 (cherry picked from commit 811b72adedcd12149783eac19ebccff1dd72bc1c) Conflicts: compiler/parser/Parser.y >--------------------------------------------------------------- bc4968f40da5ac6764623466915175377fa6f4dc compiler/parser/Parser.y | 32 +++++++++++-------- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10307.stdout | 36 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10307.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10312.hs => t10307.hs} | 2 +- 7 files changed, 72 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bc4968f40da5ac6764623466915175377fa6f4dc From git at git.haskell.org Mon May 11 22:30:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:30:08 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotations : BooleanFormula construction discards original (168e6db) Message-ID: <20150511223008.CECD13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/168e6db3e3099e5557f4732fb5998bd592f3dfa5/ghc >--------------------------------------------------------------- commit 168e6db3e3099e5557f4732fb5998bd592f3dfa5 Author: Alan Zimmerman Date: Mon May 11 14:19:14 2015 +0200 ApiAnnotations : BooleanFormula construction discards original Summary: The MINIMAL pragma is captured in the parser using a BooleanFormula. The constructors (mkBool,mkAnd,mkOr) are smart and try to minimise the boolean formula as it is constructed. This discards the original information, making round tripping impossible. Note: there is another version which provides a more API Annotations friendly version of the MINIMAL pragma, but this requires changes to haddock, which will cause problems for 7.10.2. See https://github.com/alanz/ghc/tree/wip/10287 Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, Fuuzetsu, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D837 GHC Trac Issues: #10287 (cherry picked from commit 24707d72d6137cb970878ef243c090a6bf6601e0) >--------------------------------------------------------------- 168e6db3e3099e5557f4732fb5998bd592f3dfa5 compiler/parser/Parser.y | 10 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + .../tests/ghc-api/annotations/TestBoolFormula.hs | 26 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../annotations/{t10269.hs => boolFormula.hs} | 2 +- .../tests/ghc-api/annotations/boolFormula.stderr | 17 +++ .../tests/ghc-api/annotations/boolFormula.stdout | 163 +++++++++++++++++++++ 8 files changed, 222 insertions(+), 6 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 168e6db3e3099e5557f4732fb5998bd592f3dfa5 From git at git.haskell.org Mon May 11 22:30:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:30:11 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Update stderrs for tests after cherry pick from master (f8a001a) Message-ID: <20150511223011.9E5853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/f8a001a8443fc5d694c58cdfacad7fa9a06cbfa1/ghc >--------------------------------------------------------------- commit f8a001a8443fc5d694c58cdfacad7fa9a06cbfa1 Author: Alan Zimmerman Date: Mon May 11 23:32:40 2015 +0200 Update stderrs for tests after cherry pick from master >--------------------------------------------------------------- f8a001a8443fc5d694c58cdfacad7fa9a06cbfa1 testsuite/tests/ghc-api/annotations/T10357.stderr | 24 +++++++++++------------ testsuite/tests/ghc-api/annotations/T10358.stderr | 12 ++++++------ 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/testsuite/tests/ghc-api/annotations/T10357.stderr b/testsuite/tests/ghc-api/annotations/T10357.stderr index a418490..bec379a 100644 --- a/testsuite/tests/ghc-api/annotations/T10357.stderr +++ b/testsuite/tests/ghc-api/annotations/T10357.stderr @@ -1,30 +1,30 @@ -Test10357.hs:4:13: error: Not in scope: ?one? +Test10357.hs:4:13: Not in scope: ?one? -Test10357.hs:4:19: error: Not in scope: ?x? +Test10357.hs:4:19: Not in scope: ?x? -Test10357.hs:5:7: error: Not in scope: ?multPoly? +Test10357.hs:5:7: Not in scope: ?multPoly? -Test10357.hs:6:10: error: Not in scope: ?poly? +Test10357.hs:6:10: Not in scope: ?poly? -Test10357.hs:6:15: error: +Test10357.hs:6:15: Not in scope: data constructor ?LE? Perhaps you meant ?LT? (imported from Prelude) -Test10357.hs:7:10: error: Not in scope: ?addPoly? +Test10357.hs:7:10: Not in scope: ?addPoly? -Test10357.hs:7:19: error: Not in scope: ?poly? +Test10357.hs:7:19: Not in scope: ?poly? -Test10357.hs:7:24: error: +Test10357.hs:7:24: Not in scope: data constructor ?LE? Perhaps you meant ?LT? (imported from Prelude) -Test10357.hs:7:43: error: Not in scope: ?multPoly? +Test10357.hs:7:43: Not in scope: ?multPoly? -Test10357.hs:8:19: error: Not in scope: ?poly? +Test10357.hs:8:19: Not in scope: ?poly? -Test10357.hs:8:24: error: +Test10357.hs:8:24: Not in scope: data constructor ?LE? Perhaps you meant ?LT? (imported from Prelude) -Test10357.hs:8:43: error: Not in scope: ?multPoly? +Test10357.hs:8:43: Not in scope: ?multPoly? diff --git a/testsuite/tests/ghc-api/annotations/T10358.stderr b/testsuite/tests/ghc-api/annotations/T10358.stderr index 96daaad..1fe64db 100644 --- a/testsuite/tests/ghc-api/annotations/T10358.stderr +++ b/testsuite/tests/ghc-api/annotations/T10358.stderr @@ -1,12 +1,12 @@ -Test10358.hs:5:14: error: Not in scope: ?x? +Test10358.hs:5:14: Not in scope: ?x? -Test10358.hs:5:16: error: Not in scope: ?x? +Test10358.hs:5:16: Not in scope: ?x? -Test10358.hs:6:12: error: Not in scope: ?v? +Test10358.hs:6:12: Not in scope: ?v? -Test10358.hs:6:14: error: Not in scope: ?v? +Test10358.hs:6:14: Not in scope: ?v? -Test10358.hs:6:16: error: Not in scope: ?v? +Test10358.hs:6:16: Not in scope: ?v? -Test10358.hs:7:12: error: Not in scope: ?d? +Test10358.hs:7:12: Not in scope: ?d? From git at git.haskell.org Mon May 11 22:30:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:30:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotations : mkGadtDecl discards annotations for HsFunTy (2a0fb5d) Message-ID: <20150511223015.41BA63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2a0fb5d19500b7d9f0a595ebe08788b675258362/ghc >--------------------------------------------------------------- commit 2a0fb5d19500b7d9f0a595ebe08788b675258362 Author: Alan Zimmerman Date: Mon May 11 10:57:25 2015 +0200 ApiAnnotations : mkGadtDecl discards annotations for HsFunTy Summary: When mkGadtDecl is presented wih a HsFunTy it discards the SrcSpan, thus disconnecting any annotations on the HsFunTy. ``` mkGadtDecl names (L ls (HsForAllTy imp Nothing qvars cxt tau)) = return $ mk_gadt_con names where (details, res_ty) -- See Note [Sorting out the result type] = case tau of L _ (HsFunTy (L l (HsRecTy flds)) res_ty) -> (RecCon (L l flds), res_ty) _other -> (PrefixCon [], tau) ... ``` This can be triggered by the following ``` {-# LANGUAGE GADTs #-} module GADTRecords2 (H1(..)) where -- | h1 data H1 a b where C3 :: (Num a) => { field :: a -- ^ hello docs } -> H1 Int Int ``` Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D848 GHC Trac Issues: #10309 (cherry picked from commit e4032b1951a35d8df63a74ebfee7449988b5ef40) >--------------------------------------------------------------- 2a0fb5d19500b7d9f0a595ebe08788b675258362 compiler/parser/Parser.y | 3 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 +++++ testsuite/tests/ghc-api/annotations/T10255.stdout | 2 ++ testsuite/tests/ghc-api/annotations/T10309.stdout | 38 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/T10312.stdout | 2 ++ testsuite/tests/ghc-api/annotations/Test10309.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10307.hs => t10309.hs} | 2 +- 9 files changed, 61 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 602af19..4728df5 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1488,7 +1488,8 @@ type :: { LHsType RdrName } : btype { $1 } | btype qtyconop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } | btype tyvarop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 } - | btype '->' ctype {% ams (sLL $1 $> $ HsFunTy $1 $3) + | btype '->' ctype {% ams $1 [mj AnnRarrow $2] + >> ams (sLL $1 $> $ HsFunTy $1 $3) [mj AnnRarrow $2] } | btype '~' btype {% ams (sLL $1 $> $ HsEqTy $1 $3) [mj AnnTilde $2] } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 8b7f082..8ff93b4 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -3,6 +3,7 @@ parseTree comments exampleTest listcomps +t10309 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 15c3bc4..c7aa1e5 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -8,6 +8,7 @@ clean: rm -f t10269 rm -f t10255 t10312 rm -f t1037 + rm -f t10309 annotations: rm -f annotations.o annotations.hi @@ -73,3 +74,10 @@ t10307: ./t10307 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" .PHONY: t10307 + +t10309: + rm -f t10309.o t10309.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10309 + ./t10309 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10309 diff --git a/testsuite/tests/ghc-api/annotations/T10255.stdout b/testsuite/tests/ghc-api/annotations/T10255.stdout index 099ef54..50e9bb7 100644 --- a/testsuite/tests/ghc-api/annotations/T10255.stdout +++ b/testsuite/tests/ghc-api/annotations/T10255.stdout @@ -29,6 +29,8 @@ (AK Test10255.hs:6:11-26 AnnOpenP = [Test10255.hs:6:11]) +(AK Test10255.hs:6:12-18 AnnRarrow = [Test10255.hs:6:20-21]) + (AK Test10255.hs:6:12-25 AnnRarrow = [Test10255.hs:6:20-21]) (AK AnnEofPos = [Test10255.hs:8:1]) diff --git a/testsuite/tests/ghc-api/annotations/T10309.stdout b/testsuite/tests/ghc-api/annotations/T10309.stdout new file mode 100644 index 0000000..1423466 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10309.stdout @@ -0,0 +1,38 @@ +---Problems--------------------- +[ +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) +] + +-------------------------------- +[ +(AK Test10309.hs:1:1 AnnModule = [Test10309.hs:2:1-6]) + +(AK Test10309.hs:1:1 AnnWhere = [Test10309.hs:2:18-22]) + +(AK Test10309.hs:(4,1)-(6,34) AnnData = [Test10309.hs:4:1-4]) + +(AK Test10309.hs:(4,1)-(6,34) AnnSemi = [Test10309.hs:7:1]) + +(AK Test10309.hs:(4,1)-(6,34) AnnWhere = [Test10309.hs:4:13-17]) + +(AK Test10309.hs:(5,3)-(6,34) AnnDcolon = [Test10309.hs:5:6-7]) + +(AK Test10309.hs:5:9-15 AnnCloseP = [Test10309.hs:5:15]) + +(AK Test10309.hs:5:9-15 AnnDarrow = [Test10309.hs:5:17-18]) + +(AK Test10309.hs:5:9-15 AnnOpenP = [Test10309.hs:5:9]) + +(AK Test10309.hs:(5,20)-(6,20) AnnCloseC = [Test10309.hs:6:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnOpenC = [Test10309.hs:5:20]) + +(AK Test10309.hs:(5,20)-(6,20) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:(5,20)-(6,34) AnnRarrow = [Test10309.hs:6:22-23]) + +(AK Test10309.hs:5:22-31 AnnDcolon = [Test10309.hs:5:28-29]) + +(AK AnnEofPos = [Test10309.hs:7:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/T10312.stdout b/testsuite/tests/ghc-api/annotations/T10312.stdout index 5e4fd1c..70af815 100644 --- a/testsuite/tests/ghc-api/annotations/T10312.stdout +++ b/testsuite/tests/ghc-api/annotations/T10312.stdout @@ -334,6 +334,8 @@ (AK Test10312.hs:68:28-51 AnnRarrow = [Test10312.hs:68:37-38]) +(AK Test10312.hs:68:29 AnnRarrow = [Test10312.hs:68:31-32]) + (AK Test10312.hs:68:29-34 AnnRarrow = [Test10312.hs:68:31-32]) (AK Test10312.hs:68:40-42 AnnCloseS = [Test10312.hs:68:42]) diff --git a/testsuite/tests/ghc-api/annotations/Test10309.hs b/testsuite/tests/ghc-api/annotations/Test10309.hs new file mode 100644 index 0000000..75f18a9 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10309.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} +module Test10309 where + +data H1 a b where + C3 :: (Num a) => { field :: a -- ^ hello docs + } -> H1 Int Int diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 3e145b9..81aec52 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -9,3 +9,4 @@ test('T10269', normal, run_command, ['$MAKE -s --no-print-directory T10269' test('T10280', normal, run_command, ['$MAKE -s --no-print-directory T10280']) test('T10312', normal, run_command, ['$MAKE -s --no-print-directory t10312']) test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307']) +test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) diff --git a/testsuite/tests/ghc-api/annotations/t10307.hs b/testsuite/tests/ghc-api/annotations/t10309.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10307.hs copy to testsuite/tests/ghc-api/annotations/t10309.hs index 5c6f233..ebce40e 100644 --- a/testsuite/tests/ghc-api/annotations/t10307.hs +++ b/testsuite/tests/ghc-api/annotations/t10309.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10307" + testOneFile libdir "Test10309" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Mon May 11 22:30:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:30:19 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotations : pquals production adds AnnVbar in the wrong place (6fea082) Message-ID: <20150511223019.0E1263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/6fea0826ee73e72aedff3b7aca57855b197c0655/ghc >--------------------------------------------------------------- commit 6fea0826ee73e72aedff3b7aca57855b197c0655 Author: Alan Zimmerman Date: Mon May 11 15:28:55 2015 +0200 ApiAnnotations : pquals production adds AnnVbar in the wrong place Summary: The Parser.y production for pquals is pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] } : squals '|' pquals {% addAnnotation (gl $ last $ unLoc $1) AnnVbar (gl $2) >> return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) } | squals { L (getLoc $1) [reverse (unLoc $1)] } The squals are returned in reverse order, so the AnnVbar should be attached to the head of the list, not the last. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D869 GHC Trac Issues: #10357 (cherry picked from commit fe38195eb783fc2f2f2d5ef50fb665b06fd15e82) >--------------------------------------------------------------- 6fea0826ee73e72aedff3b7aca57855b197c0655 compiler/parser/Parser.y | 2 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10357.stderr | 30 ++++++ testsuite/tests/ghc-api/annotations/T10357.stdout | 110 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10357.hs | 13 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10255.hs => t10357.hs} | 14 ++- 8 files changed, 177 insertions(+), 2 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 6fea0826ee73e72aedff3b7aca57855b197c0655 From git at git.haskell.org Mon May 11 22:30:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:30:22 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. (300a10c) Message-ID: <20150511223022.CA3363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/300a10c627887ed39788cc73de40fb1844ed1474/ghc >--------------------------------------------------------------- commit 300a10c627887ed39788cc73de40fb1844ed1474 Author: Alan Zimmerman Date: Mon May 11 17:57:05 2015 +0200 ApiAnnotations : PatBind gives wrong SrcSpan for the pattern. Summary: The production for decl_no_th starts decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; ... The e value should be just the pattern, excluding the rhs, but the span created includes the rhs. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D873 GHC Trac Issues: #10358 (cherry picked from commit ecc3d6be218b1c7a36ee3f2f36c4f3ac4f45c34f) >--------------------------------------------------------------- 300a10c627887ed39788cc73de40fb1844ed1474 compiler/parser/Parser.y | 4 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 7 +++ testsuite/tests/ghc-api/annotations/T10358.stderr | 12 +++++ testsuite/tests/ghc-api/annotations/T10358.stdout | 58 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10358.hs | 8 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/boolFormula.stderr | 17 ------- .../ghc-api/annotations/{t10357.hs => t10358.hs} | 2 +- 9 files changed, 90 insertions(+), 20 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index be193b3..623bcaa 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1853,10 +1853,10 @@ docdecld :: { LDocDecl } decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } - | '!' aexp rhs {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; + | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; pat <- checkPattern empty e; _ <- ams (sLL $1 $> ()) - (mj AnnBang $1:(fst $ unLoc $3)); + (fst $ unLoc $3); return $ sLL $1 $> $ unitOL $ sLL $1 $> $ ValD $ PatBind pat (snd $ unLoc $3) placeHolderType diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index 4f6f3be..b8bba4f 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -5,6 +5,7 @@ exampleTest listcomps t10309 t10357 +t10358 t10255 t10268 t10269 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 0cebeaf..7cf7baf 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -37,6 +37,13 @@ listcomps: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc listcomps ./listcomps "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" +t10358: + rm -f t10358.o t10358.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10358 + ./t10358 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10358 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10358.stderr b/testsuite/tests/ghc-api/annotations/T10358.stderr new file mode 100644 index 0000000..96daaad --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10358.stderr @@ -0,0 +1,12 @@ + +Test10358.hs:5:14: error: Not in scope: ?x? + +Test10358.hs:5:16: error: Not in scope: ?x? + +Test10358.hs:6:12: error: Not in scope: ?v? + +Test10358.hs:6:14: error: Not in scope: ?v? + +Test10358.hs:6:16: error: Not in scope: ?v? + +Test10358.hs:7:12: error: Not in scope: ?d? diff --git a/testsuite/tests/ghc-api/annotations/T10358.stdout b/testsuite/tests/ghc-api/annotations/T10358.stdout new file mode 100644 index 0000000..02dcb7a --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10358.stdout @@ -0,0 +1,58 @@ +---Problems--------------------- +[ +(AK AnnEofPos = [Test10358.hs:9:1]) +] + +---Problems'-------------------- +[(AnnEofPos, Test10358.hs:9:1)] +-------------------------------- +[ +(AK Test10358.hs:1:1 AnnModule = [Test10358.hs:2:1-6]) + +(AK Test10358.hs:1:1 AnnWhere = [Test10358.hs:2:18-22]) + +(AK Test10358.hs:(4,1)-(8,6) AnnEqual = [Test10358.hs:4:13]) + +(AK Test10358.hs:(4,1)-(8,6) AnnFunId = [Test10358.hs:4:1-7]) + +(AK Test10358.hs:(4,1)-(8,6) AnnSemi = [Test10358.hs:9:1]) + +(AK Test10358.hs:(5,3)-(8,6) AnnIn = [Test10358.hs:8:3-4]) + +(AK Test10358.hs:(5,3)-(8,6) AnnLet = [Test10358.hs:5:3-5]) + +(AK Test10358.hs:5:7-10 AnnBang = [Test10358.hs:5:7]) + +(AK Test10358.hs:5:7-16 AnnEqual = [Test10358.hs:5:12]) + +(AK Test10358.hs:5:7-16 AnnSemi = [Test10358.hs:5:17]) + +(AK Test10358.hs:5:14-16 AnnVal = [Test10358.hs:5:15]) + +(AK Test10358.hs:5:19-22 AnnBang = [Test10358.hs:5:19]) + +(AK Test10358.hs:5:19-32 AnnEqual = [Test10358.hs:5:24]) + +(AK Test10358.hs:5:19-32 AnnSemi = [Test10358.hs:6:7]) + +(AK Test10358.hs:5:26-32 AnnVal = [Test10358.hs:5:29]) + +(AK Test10358.hs:6:7-16 AnnEqual = [Test10358.hs:6:10]) + +(AK Test10358.hs:6:7-16 AnnFunId = [Test10358.hs:6:7-8]) + +(AK Test10358.hs:6:7-16 AnnSemi = [Test10358.hs:7:7]) + +(AK Test10358.hs:6:12-14 AnnVal = [Test10358.hs:6:13]) + +(AK Test10358.hs:6:12-16 AnnVal = [Test10358.hs:6:15]) + +(AK Test10358.hs:7:7-17 AnnEqual = [Test10358.hs:7:10]) + +(AK Test10358.hs:7:7-17 AnnFunId = [Test10358.hs:7:7-8]) + +(AK Test10358.hs:7:12-17 AnnVal = [Test10358.hs:7:14]) + +(AK AnnEofPos = [Test10358.hs:9:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10358.hs b/testsuite/tests/ghc-api/annotations/Test10358.hs new file mode 100644 index 0000000..9badab2 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10358.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE BangPatterns #-} +module Test10358 where + +mtGamma a b = + let !x_2 = x*x; !x_4 = x_2*x_2 + v3 = v*v*v + dv = d * v3 + in 5 diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 5614127..b60f0bc 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -12,3 +12,4 @@ test('T10307', normal, run_command, ['$MAKE -s --no-print-directory t10307' test('T10309', normal, run_command, ['$MAKE -s --no-print-directory t10309']) test('boolFormula', normal, run_command, ['$MAKE -s --no-print-directory boolFormula']) test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357']) +test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) diff --git a/testsuite/tests/ghc-api/annotations/boolFormula.stderr b/testsuite/tests/ghc-api/annotations/boolFormula.stderr deleted file mode 100644 index 65cbf26..0000000 --- a/testsuite/tests/ghc-api/annotations/boolFormula.stderr +++ /dev/null @@ -1,17 +0,0 @@ - -TestBoolFormula.hs:3:1: Warning: - The MINIMAL pragma does not require: - ?aOp?, ?bOp?, ?cOp?, ?dOp?, ?eOp?, and ?fOp? - but there is no default implementation. - In the class declaration for ?ManyOps? - -TestBoolFormula.hs:15:1: Warning: - The MINIMAL pragma does not require: - ?baq?, ?baz?, and ?quux? - but there is no default implementation. - In the class declaration for ?Foo? - -TestBoolFormula.hs:23:10: Warning: - No explicit implementation for - either (?foo? and ?baq?) or ?foo? - In the instance declaration for ?Foo Int? diff --git a/testsuite/tests/ghc-api/annotations/t10357.hs b/testsuite/tests/ghc-api/annotations/t10358.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10357.hs copy to testsuite/tests/ghc-api/annotations/t10358.hs index 93a1f70..82994cc 100644 --- a/testsuite/tests/ghc-api/annotations/t10357.hs +++ b/testsuite/tests/ghc-api/annotations/t10358.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10357" + testOneFile libdir "Test10358" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Mon May 11 22:58:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 22:58:18 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: Update 7.10.2 release notes a bit (70925f0) Message-ID: <20150511225818.4A21F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/70925f0a317a9db31d228ae51e0d0acd0cb66542/ghc >--------------------------------------------------------------- commit 70925f0a317a9db31d228ae51e0d0acd0cb66542 Author: Austin Seipp Date: Mon May 11 17:59:13 2015 -0500 docs: Update 7.10.2 release notes a bit Signed-off-by: Austin Seipp >--------------------------------------------------------------- 70925f0a317a9db31d228ae51e0d0acd0cb66542 docs/users_guide/7.10.2-notes.xml | 185 +++++++++++++++++++++++++++++++++++++- 1 file changed, 183 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/7.10.2-notes.xml b/docs/users_guide/7.10.2-notes.xml index 10c6708..2f5ce76 100644 --- a/docs/users_guide/7.10.2-notes.xml +++ b/docs/users_guide/7.10.2-notes.xml @@ -3,8 +3,9 @@ Release notes for version 7.10.2 - The 7.10.2 release is a bugfix release. The major bugfixes relative - to 7.10.1 are listed below. + The 7.10.2 release is a bugfix release, with over 40+ bug fixes + from users and contributors. The major bugfixes relative to 7.10.1 + are listed below. @@ -30,6 +31,186 @@ accesses in the RTS has been fixed. + + + A type-system bug which could allow a user to write + unsafeCoerce has been fixed (issue + #9858). + + + + + A bug which caused GHC to generate incorrect hyperlinks to + documentation in Haddock has been fixed (#10206). + + + + + A bug in the typechecker which allowed erroneous programs + using Coercible to typecheck has been + fixed (issue #10285). + + + + + An issue which could cause the "Call Arity" analysis to + perform poorly in general has been fixed (issue #10293). + + + + + Several dozen bugs in the new API annotations work have + been fixed (issues #10395, #10363, #10358, #10357, #10315, + #10314, #10312, and many more). + + + + + A regression which could cause the typechecker fail to + properly simplify type-level terms has been fixed (issue + #10321). + + + + + A bug which caused programs compiled with + -flate-dmd-anal to crash at runtime has + been fixed (issue #10288). + + + + + A bug which caused ARM/Linux binaries to be built with + executable stacks has been fixed (issue #10369). + + + + + Several bugs in GHC's cross compilation support using LLVM + have been fixed (#10275). + + + + + Several bugs in GHC's support for AArch64 have been fixed + (such as issue #10264). + + + + + A bug which could cause GHC to generate incorrect code at + runtime (generating an infinite loop exception) has been + fixed (issue #10218). + + + + + 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. + + + + + + + Cabal + + + + Version number 1.22.3.0 (was 1.22.2.0) + + + + + + + ghc + + + + Several new constructors have been added to the + AnnKeywordId datatype, in order + to fix several problem with GHC's new support for + API annotations (this should not regress or effect + any clients of the GHC API not using these new + features). + + + + + + + + Known bugs + + + + For issues dealing with language changes, please see + the GHC + 7.10 Migration Guide on the GHC wiki. + + + + + GHC's LLVM backend does not support LLVM 3.4 (issue #9929) + + + + + On Mac OS X, the -threaded Garbage + Collector currently suffers from a large performance + penalty due to a lack of system-specific optimization + (issue #7602). + + + + + GHC's LLVM backend is currently incompatible with LLVM + 3.4 (issue #9929). + + + + + GHCi fails to appropriately load + .dyn_o files (issue #8736). + + + + + Not all cases of non-terminating type-level computation (with both + recursive type families and recursive newtypes) are caught. This + means that GHC might hang, but it should do so only when the program + is ill-typed (due to non-terminating type-level features). The bugs + are reported as #7788 + and #10139. + There also remain certain obscure scenarios where the solver for + Coercible instances is known to be still + incomplete. See comments in #10079. + + + + From git at git.haskell.org Mon May 11 23:02:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 May 2015 23:02:00 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: more carefully describe unification versus unioning. (b0784cc) Message-ID: <20150511230200.BDC153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0784cc5390cd98ca6518fcbd68bd078c8e73470/ghc >--------------------------------------------------------------- commit b0784cc5390cd98ca6518fcbd68bd078c8e73470 Author: Edward Z. Yang Date: Fri May 8 15:09:20 2015 -0700 Backpack docs: more carefully describe unification versus unioning. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- b0784cc5390cd98ca6518fcbd68bd078c8e73470 docs/backpack/algorithm.pdf | Bin 257231 -> 257231 bytes docs/backpack/algorithm.tex | 13 ++++++------- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/docs/backpack/algorithm.pdf b/docs/backpack/algorithm.pdf index 8207286..d9c9b76 100644 Binary files a/docs/backpack/algorithm.pdf and b/docs/backpack/algorithm.pdf differ diff --git a/docs/backpack/algorithm.tex b/docs/backpack/algorithm.tex index 7674050..1b582a0 100644 --- a/docs/backpack/algorithm.tex +++ b/docs/backpack/algorithm.tex @@ -428,9 +428,8 @@ After merging this in, the final shape of \verb|q| is: The shapes we've given for individual declarations have been quite simple. Merging combines two shapes, filling requirements with -implementations and substituting information we learn about the -identities of \verb|Name|s; it is the most complicated part of the -shaping process. +implementations, unifying \verb|Name|s, and unioning requirements; it is +the most complicated part of the shaping process. The best way to think about merging is that we take two packages with inputs (requirements) and outputs (provisions) and ``wiring'' them up so @@ -448,17 +447,17 @@ proceeds as follows: $p$.} For each requirement $M$ of $q$ that is provided by $p$ (in particular, all of its required \verb|Name|s are provided), substitute each \verb|Module| occurrence of \verb|HOLE:M| with the - provided $p(M)$, merge the names, and remove the requirement from $q$. - Error if a provision is insufficient for the requirement. + provided $p(M)$, unify the names, and remove the requirement from $q$. + If the names of the provision are not a superset of the required names, error. \item If mutual recursion is supported, \emph{fill every requirement of $p$ with provided modules from $q$.} \item \emph{Merge leftover requirements.} For each requirement $M$ of $q$ that is not - provided by $p$ but required by $p$, merge the names. (It's not + provided by $p$ but required by $p$, unify the names, and union them together to form the new requirement. (It's not necessary to substitute \verb|Module|s, since they are guaranteed to be the same.) \item \emph{Add provisions of $q$.} Union the provisions of $p$ and $q$, erroring if there is a duplicate that doesn't have the same identity. \end{enumerate} % -To merge two sets of names, union the two sets, handling each pair of names with matching \verb|OccName|s $n$ and $m$ as follows: +To unify two sets of names, find each pair of names with matching \verb|OccName|s $n$ and $m$ and do the following: \begin{enumerate} \item If both are from holes, pick a canonical representative $m$ and substitute $n$ with $m$. From git at git.haskell.org Tue May 12 01:01:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 01:01:16 +0000 (UTC) Subject: [commit: ghc] master: Ignore out and toc files. (b4f6c16) Message-ID: <20150512010116.321913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4f6c168bae4bec053a882c07c4a7031c23e75ea/ghc >--------------------------------------------------------------- commit b4f6c168bae4bec053a882c07c4a7031c23e75ea Author: Edward Z. Yang Date: Mon May 11 16:05:16 2015 -0700 Ignore out and toc files. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- b4f6c168bae4bec053a882c07c4a7031c23e75ea docs/backpack/.gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/backpack/.gitignore b/docs/backpack/.gitignore index c3eb46e..cdea05d 100644 --- a/docs/backpack/.gitignore +++ b/docs/backpack/.gitignore @@ -7,4 +7,6 @@ *.fls *.log *.synctex.gz +*.out +*.toc backpack-impl.pdf From git at git.haskell.org Tue May 12 01:01:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 01:01:18 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: proper discourse on ModIface and ModDetails. (53409a7) Message-ID: <20150512010118.E7E6D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/53409a7b043621c3ab3d165535ae4969f56c23ea/ghc >--------------------------------------------------------------- commit 53409a7b043621c3ab3d165535ae4969f56c23ea Author: Edward Z. Yang Date: Mon May 11 18:02:09 2015 -0700 Backpack docs: proper discourse on ModIface and ModDetails. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 53409a7b043621c3ab3d165535ae4969f56c23ea docs/backpack/algorithm.pdf | Bin 257231 -> 264266 bytes docs/backpack/algorithm.tex | 150 ++++++++++++++++++++++++++++++++++++-------- 2 files changed, 124 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 53409a7b043621c3ab3d165535ae4969f56c23ea From git at git.haskell.org Tue May 12 01:20:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 01:20:37 +0000 (UTC) Subject: [commit: ghc] master: Fix safe haskell bug: instances in safe-inferred (eecef17) Message-ID: <20150512012037.76E783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eecef1733d5de342383665943b955bc1c96472f4/ghc >--------------------------------------------------------------- commit eecef1733d5de342383665943b955bc1c96472f4 Author: David Terei Date: Sat Aug 2 13:37:26 2014 -0700 Fix safe haskell bug: instances in safe-inferred Instances in Safe Inferred modules weren't marked being marked as coming from a Safe module. >--------------------------------------------------------------- eecef1733d5de342383665943b955bc1c96472f4 compiler/deSugar/Desugar.hs | 4 ++-- compiler/iface/MkIface.hs | 2 +- compiler/main/GHC.hs | 5 +++-- compiler/typecheck/TcRnMonad.hs | 7 +++++++ .../safeHaskell/safeInfered/SafeInfered05.stderr | 19 +++++++++++++++++++ .../tests/safeHaskell/safeInfered/SafeInfered05_A.hs | 1 + testsuite/tests/safeHaskell/safeInfered/all.T | 6 +++--- 7 files changed, 36 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index e4181b9..c8e3f64 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -14,7 +14,7 @@ import DynFlags import HscTypes import HsSyn import TcRnTypes -import TcRnMonad ( finalSafeMode ) +import TcRnMonad ( finalSafeMode, fixSafeInstances ) import MkIface import Id import Name @@ -179,7 +179,7 @@ deSugar hsc_env mg_warns = warns, mg_anns = anns, mg_tcs = tcs, - mg_insts = insts, + mg_insts = fixSafeInstances safe_mode insts, mg_fam_insts = fam_insts, mg_inst_env = inst_env, mg_fam_inst_env = fam_inst_env, diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 49f86fd..9a2cd35 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -272,7 +272,7 @@ mkIface_ hsc_env maybe_old_fingerprint fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env] warns = src_warns iface_rules = map (coreRuleToIfaceRule this_mod) rules - iface_insts = map instanceToIfaceInst insts + iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts iface_fam_insts = map famInstToIfaceFamInst fam_insts iface_vect_info = flattenVectInfo vect_info trust_info = setSafeMode safe_mode diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 79c6dca..d6aa227 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -295,7 +295,7 @@ import HscMain import GhcMake import DriverPipeline ( compileOne' ) import GhcMonad -import TcRnMonad ( finalSafeMode ) +import TcRnMonad ( finalSafeMode, fixSafeInstances ) import TcRnTypes import Packages import NameSet @@ -887,6 +887,7 @@ typecheckModule pmod = do hpm_annotations = pm_annotations pmod } details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env safe <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env + return $ TypecheckedModule { tm_internals_ = (tc_gbl_env, details), @@ -898,7 +899,7 @@ typecheckModule pmod = do minf_type_env = md_types details, minf_exports = availsToNameSet $ md_exports details, minf_rdr_env = Just (tcg_rdr_env tc_gbl_env), - minf_instances = md_insts details, + minf_instances = fixSafeInstances safe $ md_insts details, minf_iface = Nothing, minf_safe = safe #ifdef GHCI diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index f576e33..5507e60 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -1304,6 +1304,13 @@ finalSafeMode dflags tcg_env = do | otherwise -> Sf_None s -> s +-- | Switch instances to safe instances if we're in Safe mode. +fixSafeInstances :: SafeHaskellMode -> [ClsInst] -> [ClsInst] +fixSafeInstances sfMode | sfMode /= Sf_Safe = id +fixSafeInstances _ = map fixSafe + where fixSafe inst = let new_flag = (is_flag inst) { isSafeOverlap = True } + in inst { is_flag = new_flag } + {- ************************************************************************ * * diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr new file mode 100644 index 0000000..10e70c4 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr @@ -0,0 +1,19 @@ + +SafeInfered05.hs:2:14: Warning: + -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS +[1 of 2] Compiling SafeInfered05_A ( SafeInfered05_A.hs, SafeInfered05_A.o ) + +SafeInfered05_A.hs:2:16: Warning: + ?SafeInfered05_A? has been inferred as safe! +[2 of 2] Compiling SafeInfered05 ( SafeInfered05.hs, SafeInfered05.o ) + +SafeInfered05.hs:31:9: + Unsafe overlapping instances for C [Int] arising from a use of ?f? + The matching instance is: + instance [safe] C [Int] -- Defined at SafeInfered05_A.hs:8:10 + It is compiled in a Safe module and as such can only + overlap instances from the same module, however it + overlaps the following instances from different modules: + instance [overlap ok] C [a] -- Defined at SafeInfered05.hs:27:10 + In the expression: f ([1, 2, 3, 4] :: [Int]) + In an equation for ?test2?: test2 = f ([1, 2, 3, 4] :: [Int]) diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs index a1e12a6..c9e5c96 100644 --- a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs +++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fwarn-safe #-} module SafeInfered05_A where class C a where diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T index 12e80a7..9fb4b2c 100644 --- a/testsuite/tests/safeHaskell/safeInfered/all.T +++ b/testsuite/tests/safeHaskell/safeInfered/all.T @@ -22,9 +22,9 @@ test('SafeInfered04', multimod_compile, ['SafeInfered04', '']) # Test should fail, tests an earlier bug in 7.8 -# test('SafeInfered05', -# [ extra_clean(['SafeInfered05_A.hi', 'SafeInfered05_A.o']) ], -# multimod_compile_fail, ['SafeInfered05', '']) +test('SafeInfered05', + [ extra_clean(['SafeInfered05_A.hi', 'SafeInfered05_A.o']) ], + multimod_compile_fail, ['SafeInfered05', '']) # Tests that should fail to compile as they should be infered unsafe test('UnsafeInfered01', From git at git.haskell.org Tue May 12 01:20:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 01:20:40 +0000 (UTC) Subject: [commit: ghc] master: New handling of overlapping inst in Safe Haskell (4fffbc3) Message-ID: <20150512012040.5DAF23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4fffbc34c024231c3c9fac7a2134896cc09c7fb7/ghc >--------------------------------------------------------------- commit 4fffbc34c024231c3c9fac7a2134896cc09c7fb7 Author: David Terei Date: Mon May 11 16:05:37 2015 -0700 New handling of overlapping inst in Safe Haskell We do much better now due to the newish per-instance flags. Rather than mark any module that uses `-XOverlappingInstances`, `-XIncoherentInstances` or the new `OVERLAP*` pragmas as unsafe, we regard them all as safe and defer the check until an overlap occurs. An type-class method call that involves overlapping instances is considered _unsafe_ when: 1) The most specific instance, Ix, is from a module marked `-XSafe` 2) Ix is an orphan instance or a MPTC 3) At least one instance that Ix overlaps, Iy, is: a) from a different module than Ix AND b) Iy is not marked `OVERLAPPABLE` This check is only enforced in modules compiled with `-XSafe` or `-XTrustworthy`. This fixes Safe Haskell to work with the latest overlapping instance pragmas, and also brings consistent behavior. Previously, Safe Inferred modules behaved differently than `-XSafe` modules. >--------------------------------------------------------------- 4fffbc34c024231c3c9fac7a2134896cc09c7fb7 compiler/main/DynFlags.hs | 13 +- compiler/main/HscMain.hs | 14 +- compiler/typecheck/Inst.hs | 2 +- compiler/typecheck/TcErrors.hs | 61 ++++--- compiler/typecheck/TcForeign.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 10 +- compiler/typecheck/TcInteract.hs | 75 +++++--- compiler/typecheck/TcRnMonad.hs | 11 +- compiler/typecheck/TcRnTypes.hs | 34 ++-- compiler/typecheck/TcSMonad.hs | 57 +++++- compiler/typecheck/TcSimplify.hs | 198 +++++++++++++++++---- compiler/typecheck/TcSplice.hs | 2 +- compiler/types/InstEnv.hs | 56 +++--- testsuite/tests/safeHaskell/ghci/P13_A.hs | 2 +- testsuite/tests/safeHaskell/ghci/p13.stderr | 7 +- .../overlapping}/Makefile | 0 .../tests/safeHaskell/overlapping/SH_Overlap1.hs | 16 ++ .../safeHaskell/overlapping/SH_Overlap1.stderr | 15 ++ .../tests/safeHaskell/overlapping/SH_Overlap10.hs | 17 ++ .../safeHaskell/overlapping/SH_Overlap10.stderr | 3 + .../safeHaskell/overlapping/SH_Overlap10_A.hs | 13 ++ .../safeHaskell/overlapping/SH_Overlap10_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap11.hs | 18 ++ .../safeHaskell/overlapping/SH_Overlap11.stderr | 18 ++ .../safeHaskell/overlapping/SH_Overlap11_A.hs | 13 ++ .../safeHaskell/overlapping/SH_Overlap11_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap1_A.hs | 13 ++ .../tests/safeHaskell/overlapping/SH_Overlap1_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap2.hs | 19 ++ .../safeHaskell/overlapping/SH_Overlap2.stderr | 15 ++ .../tests/safeHaskell/overlapping/SH_Overlap2_A.hs | 13 ++ .../tests/safeHaskell/overlapping/SH_Overlap2_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap3.hs | 16 ++ .../safeHaskell/overlapping/SH_Overlap3.stderr | 3 + .../tests/safeHaskell/overlapping/SH_Overlap3_A.hs | 13 ++ .../tests/safeHaskell/overlapping/SH_Overlap3_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap4.hs | 23 +++ .../safeHaskell/overlapping/SH_Overlap4.stderr | 3 + .../tests/safeHaskell/overlapping/SH_Overlap4_A.hs | 13 ++ .../tests/safeHaskell/overlapping/SH_Overlap4_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap5.hs | 16 ++ .../safeHaskell/overlapping/SH_Overlap5.stderr | 15 ++ .../tests/safeHaskell/overlapping/SH_Overlap5_A.hs | 13 ++ .../tests/safeHaskell/overlapping/SH_Overlap5_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap6.hs | 15 ++ .../safeHaskell/overlapping/SH_Overlap6.stderr | 15 ++ .../tests/safeHaskell/overlapping/SH_Overlap6_A.hs | 13 ++ .../tests/safeHaskell/overlapping/SH_Overlap6_B.hs | 8 + .../tests/safeHaskell/overlapping/SH_Overlap7.hs | 15 ++ .../safeHaskell/overlapping/SH_Overlap7.stderr | 21 +++ .../tests/safeHaskell/overlapping/SH_Overlap7_A.hs | 14 ++ .../tests/safeHaskell/overlapping/SH_Overlap7_B.hs | 9 + .../tests/safeHaskell/overlapping/SH_Overlap8.hs | 18 ++ .../safeHaskell/overlapping/SH_Overlap8.stderr | 2 + .../tests/safeHaskell/overlapping/SH_Overlap8_A.hs | 14 ++ .../tests/safeHaskell/overlapping/SH_Overlap9.hs | 16 ++ .../safeHaskell/overlapping/SH_Overlap9.stderr | 3 + .../tests/safeHaskell/overlapping/SH_Overlap9_A.hs | 13 ++ .../tests/safeHaskell/overlapping/SH_Overlap9_B.hs | 8 + testsuite/tests/safeHaskell/overlapping/all.T | 62 +++++++ .../tests/safeHaskell/safeInfered/SafeInfered05.hs | 20 +-- .../safeHaskell/safeInfered/SafeInfered05.stderr | 15 +- .../safeHaskell/safeInfered/UnsafeInfered08.stderr | 4 - .../safeHaskell/safeInfered/UnsafeInfered08_A.hs | 4 +- .../safeHaskell/safeInfered/UnsafeInfered13.stderr | 9 - .../safeHaskell/safeInfered/UnsafeInfered14.stderr | 9 - .../safeHaskell/safeInfered/UnsafeInfered15.stderr | 9 - .../safeHaskell/safeInfered/UnsafeInfered16.stderr | 13 -- .../safeHaskell/safeInfered/UnsafeInfered17.stderr | 9 - .../safeHaskell/safeInfered/UnsafeInfered18.stderr | 10 +- .../safeHaskell/safeInfered/UnsafeInfered19.stderr | 11 -- testsuite/tests/safeHaskell/safeInfered/all.T | 24 +-- 72 files changed, 992 insertions(+), 279 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 4fffbc34c024231c3c9fac7a2134896cc09c7fb7 From git at git.haskell.org Tue May 12 04:34:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 04:34:49 +0000 (UTC) Subject: [commit: ghc] master: Make template-haskell build with GHC 7.6, fixes bootstrap build. (ef7ed16) Message-ID: <20150512043449.5165F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef7ed16c8a34e5ab26a23264f02aa6391c338884/ghc >--------------------------------------------------------------- commit ef7ed16c8a34e5ab26a23264f02aa6391c338884 Author: Edward Z. Yang Date: Mon May 11 15:48:35 2015 -0700 Make template-haskell build with GHC 7.6, fixes bootstrap build. Signed-off-by: Edward Z. Yang Test Plan: validate on 7.6 Reviewers: austin, goldfire Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D885 >--------------------------------------------------------------- ef7ed16c8a34e5ab26a23264f02aa6391c338884 libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 11 ++++++++++- libraries/template-haskell/template-haskell.cabal | 3 +-- mk/warnings.mk | 4 ---- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 8879c62..a6f970d 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1,5 +1,12 @@ {-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents, - RoleAnnotations, DeriveGeneric, FlexibleInstances #-} + DeriveGeneric, FlexibleInstances #-} + +#if __GLASGOW_HASKELL__ >= 707 +{-# LANGUAGE RoleAnnotations #-} +{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} +#else +{-# OPTIONS_GHC -w #-} -- -fno-warn-inline-rule-shadowing doesn't exist +#endif #if MIN_VERSION_base(4,8,0) #define HAS_NATURAL @@ -170,7 +177,9 @@ instance Applicative Q where -- ----------------------------------------------------- +#if __GLASGOW_HASKELL__ >= 707 type role TExp nominal -- See Note [Role of TExp] +#endif newtype TExp a = TExp { unType :: Exp } unTypeQ :: Q (TExp a) -> Q Exp diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index bd277d1..de71132 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -31,7 +31,6 @@ Library MagicHash PolymorphicComponents RankNTypes - RoleAnnotations ScopedTypeVariables TemplateHaskell UnboxedTuples @@ -48,7 +47,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base >= 4.7 && < 4.9, + base >= 4.6 && < 4.9, pretty == 1.1.* -- We need to set the package key to template-haskell (without a diff --git a/mk/warnings.mk b/mk/warnings.mk index 5c41d5f..22acf9a 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -101,10 +101,6 @@ libraries/base_dist-install_EXTRA_HC_OPTS += -fno-warn-trustworthy-safe libraries/ghc-prim_dist-install_EXTRA_HC_OPTS += -fno-warn-trustworthy-safe libraries/Win32_dist-install_EXTRA_HC_OPTS += -fno-warn-trustworthy-safe -# Temporarely disable inline rule shadowing warning -libraries/template-haskell_dist-boot_EXTRA_HC_OPTS += -fno-warn-inline-rule-shadowing -libraries/template-haskell_dist-install_EXTRA_HC_OPTS += -fno-warn-inline-rule-shadowing - # We need -fno-warn-deprecated-flags to avoid failure with -Werror GhcLibExtraHcOpts += -fno-warn-deprecated-flags GhcBootLibExtraHcOpts += -fno-warn-deprecated-flags From git at git.haskell.org Tue May 12 05:24:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 05:24:02 +0000 (UTC) Subject: [commit: ghc] master: Use fmap instead of <$> (Fixes #10407) (c119a80) Message-ID: <20150512052402.BE5753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c119a8020f4e3073460e2c350507d5cf65771cea/ghc >--------------------------------------------------------------- commit c119a8020f4e3073460e2c350507d5cf65771cea Author: Erik de Castro Lopo Date: Tue May 12 14:52:16 2015 +1000 Use fmap instead of <$> (Fixes #10407) The <$> operator is only available in the standard Prelude in ghc 7.10 and later. Signed-off-by: Erik de Castro Lopo Test Plan: build with ghc-7.6 Reviewers: dterei, ezyang, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D886 GHC Trac Issues: #10407 >--------------------------------------------------------------- c119a8020f4e3073460e2c350507d5cf65771cea compiler/typecheck/TcInteract.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 33ff043..95715fe 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2030,8 +2030,8 @@ matchClassInst inerts clas tys loc ; traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr pred , text "inerts=" <+> ppr inerts ] ; instEnvs <- getInstEnvs - ; safeOverlapCheck <- (`elem` [Sf_Safe, Sf_Trustworthy]) - <$> safeHaskell <$> getDynFlags + ; safeOverlapCheck <- ((`elem` [Sf_Safe, Sf_Trustworthy]) . safeHaskell) + `fmap` getDynFlags ; let (matches, unify, unsafeOverlaps) = lookupInstEnv True instEnvs clas tys safeHaskFail = safeOverlapCheck && not (null unsafeOverlaps) ; case (matches, unify, safeHaskFail) of From git at git.haskell.org Tue May 12 08:29:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 08:29:24 +0000 (UTC) Subject: [commit: ghc] master: We need an empty boolFormula.stderr (ca7c855) Message-ID: <20150512082924.65B353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca7c8550acbde1e03bbd3640a6a6d555a77f7e00/ghc >--------------------------------------------------------------- commit ca7c8550acbde1e03bbd3640a6a6d555a77f7e00 Author: Alan Zimmerman Date: Tue May 12 10:28:56 2015 +0200 We need an empty boolFormula.stderr Otherwise the test sometimes fails. >--------------------------------------------------------------- ca7c8550acbde1e03bbd3640a6a6d555a77f7e00 .../tests/ghc-api/annotations/boolFormula.stderr | 0 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/libraries/base/tests/IO/misc001.stdout b/testsuite/tests/ghc-api/annotations/boolFormula.stderr similarity index 100% copy from libraries/base/tests/IO/misc001.stdout copy to testsuite/tests/ghc-api/annotations/boolFormula.stderr From git at git.haskell.org Tue May 12 13:56:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 13:56:18 +0000 (UTC) Subject: [commit: ghc] master: Fix weird behavior of -ignore-dot-ghci and -ghci-scipt (f5188f3) Message-ID: <20150512135618.CBFB53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f5188f3acd73a07b648924a58b9882c2d0a3dbcb/ghc >--------------------------------------------------------------- commit f5188f3acd73a07b648924a58b9882c2d0a3dbcb Author: Zejun Wu Date: Tue May 12 08:56:12 2015 -0500 Fix weird behavior of -ignore-dot-ghci and -ghci-scipt * Make `-ghci-script` be executed in the order they are specified; * Make `-ignore-dot-ghci` only ignores the default .ghci files but still execute the scripts passed by `-ghci-script`. Reviewed By: simonmar, austin Differential Revision: https://phabricator.haskell.org/D887 GHC Trac Issues: #10408 >--------------------------------------------------------------- f5188f3acd73a07b648924a58b9882c2d0a3dbcb compiler/main/DynFlags.hs | 2 + ghc/InteractiveUI.hs | 80 ++++++++++++++--------------- testsuite/tests/ghci/scripts/Makefile | 10 ++++ testsuite/tests/ghci/scripts/T10408A.script | 1 + testsuite/tests/ghci/scripts/T10408A.stdout | 2 + testsuite/tests/ghci/scripts/T10408B.script | 1 + testsuite/tests/ghci/scripts/T10408B.stdout | 2 + testsuite/tests/ghci/scripts/all.T | 5 ++ 8 files changed, 63 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 f5188f3acd73a07b648924a58b9882c2d0a3dbcb From git at git.haskell.org Tue May 12 15:03:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 15:03:59 +0000 (UTC) Subject: [commit: ghc] master: Turn off warnings when compiling boolFormula (6ee4b6f) Message-ID: <20150512150359.0FC253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ee4b6fdfb07bb479a1a9ab3e3866ca6a6192e20/ghc >--------------------------------------------------------------- commit 6ee4b6fdfb07bb479a1a9ab3e3866ca6a6192e20 Author: Alan Zimmerman Date: Tue May 12 17:04:50 2015 +0200 Turn off warnings when compiling boolFormula Summary: There is a problem where harbourmaster builds complain about a bad boolFormula.stderr ghc-api/annotations boolFormula [bad stderr] (normal) The problem does not occur for a local build on my box This patch turns off warnings for this test, to get rid of the stderr issue. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, hvr Differential Revision: https://phabricator.haskell.org/D888 >--------------------------------------------------------------- 6ee4b6fdfb07bb479a1a9ab3e3866ca6a6192e20 testsuite/tests/ghc-api/annotations/Makefile | 3 +- .../tests/ghc-api/annotations/TestBoolFormula.hs | 10 ++ .../tests/ghc-api/annotations/boolFormula.stderr | 0 .../tests/ghc-api/annotations/boolFormula.stdout | 190 ++++++++++++++------- 4 files changed, 137 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 6ee4b6fdfb07bb479a1a9ab3e3866ca6a6192e20 From git at git.haskell.org Tue May 12 17:23:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 17:23:39 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: Consistently italicize metavariables. (1b47692) Message-ID: <20150512172339.C72F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1b4769200797655e527089a644b77536375c4536/ghc >--------------------------------------------------------------- commit 1b4769200797655e527089a644b77536375c4536 Author: Edward Z. Yang Date: Tue May 12 10:24:27 2015 -0700 Backpack docs: Consistently italicize metavariables. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 1b4769200797655e527089a644b77536375c4536 docs/backpack/algorithm.pdf | Bin 264266 -> 272423 bytes docs/backpack/algorithm.tex | 170 ++++++++++++++++++++++---------------------- 2 files changed, 85 insertions(+), 85 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 1b4769200797655e527089a644b77536375c4536 From git at git.haskell.org Tue May 12 22:43:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 22:43:11 +0000 (UTC) Subject: [commit: ghc] master: Update some tests for recent Safe Haskell change. (4432863) Message-ID: <20150512224311.EF3813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/44328639fb9044049be27fdb02a79f0e381c592c/ghc >--------------------------------------------------------------- commit 44328639fb9044049be27fdb02a79f0e381c592c Author: David Terei Date: Tue May 12 14:15:20 2015 -0700 Update some tests for recent Safe Haskell change. >--------------------------------------------------------------- 44328639fb9044049be27fdb02a79f0e381c592c testsuite/tests/ghci/scripts/T5820.stdout | 4 ++-- testsuite/tests/ghci/scripts/ghci019.stdout | 2 +- testsuite/tests/ghci/scripts/ghci044.stderr | 6 +++--- testsuite/tests/typecheck/should_compile/T4912.stderr | 8 ++++---- testsuite/tests/warnings/should_compile/T9178.stderr | 4 ++-- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/ghci/scripts/T5820.stdout b/testsuite/tests/ghci/scripts/T5820.stdout index e0a97a0..a8dddd3 100644 --- a/testsuite/tests/ghci/scripts/T5820.stdout +++ b/testsuite/tests/ghci/scripts/T5820.stdout @@ -1,4 +1,4 @@ data Foo = Foo -- Defined at T5820.hs:2:1 -instance Eq Foo -- Defined at T5820.hs:3:10 +instance [safe] Eq Foo -- Defined at T5820.hs:3:10 data Foo = Foo -- Defined at T5820.hs:2:1 -instance Eq Foo -- Defined at T5820.hs:3:10 +instance [safe] Eq Foo -- Defined at T5820.hs:3:10 diff --git a/testsuite/tests/ghci/scripts/ghci019.stdout b/testsuite/tests/ghci/scripts/ghci019.stdout index 85b5e02..5c8b242 100644 --- a/testsuite/tests/ghci/scripts/ghci019.stdout +++ b/testsuite/tests/ghci/scripts/ghci019.stdout @@ -1,2 +1,2 @@ data Foo = Foo -- Defined at ghci019.hs:8:1 -instance Eq Foo -- Defined at ghci019.hs:9:10 +instance [safe] Eq Foo -- Defined at ghci019.hs:9:10 diff --git a/testsuite/tests/ghci/scripts/ghci044.stderr b/testsuite/tests/ghci/scripts/ghci044.stderr index 625696a..b49978d 100644 --- a/testsuite/tests/ghci/scripts/ghci044.stderr +++ b/testsuite/tests/ghci/scripts/ghci044.stderr @@ -1,8 +1,8 @@ -:10:1: +:10:1: error: Overlapping instances for C [Int] arising from a use of ?f? Matching instances: - instance C [Int] -- Defined at :7:10 - instance C a => C [a] -- Defined at :9:10 + instance [safe] C [Int] -- Defined at :7:10 + instance [safe] C a => C [a] -- Defined at :9:10 In the expression: f [4 :: Int] In an equation for ?it?: it = f [4 :: Int] diff --git a/testsuite/tests/typecheck/should_compile/T4912.stderr b/testsuite/tests/typecheck/should_compile/T4912.stderr index 0e0920f..855d365 100644 --- a/testsuite/tests/typecheck/should_compile/T4912.stderr +++ b/testsuite/tests/typecheck/should_compile/T4912.stderr @@ -1,12 +1,12 @@ -T4912.hs:10:10: Warning: - Orphan instance: instance Foo TheirData +T4912.hs:10:10: warning: + Orphan instance: instance [safe] Foo TheirData To avoid this move the instance declaration to the module of the class or of the type, or wrap the type with a newtype and declare the instance on the new type. -T4912.hs:13:10: Warning: - Orphan instance: instance Bar OurData +T4912.hs:13:10: warning: + Orphan instance: instance [safe] Bar OurData To avoid this move the instance declaration to the module of the class or of the type, or wrap the type with a newtype and declare the instance on the new type. diff --git a/testsuite/tests/warnings/should_compile/T9178.stderr b/testsuite/tests/warnings/should_compile/T9178.stderr index 6f4b6c0..c1e99bc 100644 --- a/testsuite/tests/warnings/should_compile/T9178.stderr +++ b/testsuite/tests/warnings/should_compile/T9178.stderr @@ -1,8 +1,8 @@ [1 of 2] Compiling T9178DataType ( T9178DataType.hs, T9178DataType.o ) [2 of 2] Compiling T9178 ( T9178.hs, T9178.o ) -T9178.hs:8:10: Warning: - Orphan instance: instance Show T9178_Type +T9178.hs:8:10: warning: + Orphan instance: instance [safe] Show T9178_Type To avoid this move the instance declaration to the module of the class or of the type, or wrap the type with a newtype and declare the instance on the new type. From git at git.haskell.org Tue May 12 22:43:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 22:43:14 +0000 (UTC) Subject: [commit: ghc] master: Update Safe Haskell documentation. (a171cc1) Message-ID: <20150512224314.C1AD73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a171cc133cc1111e91cf892fdbaa7ca476129b07/ghc >--------------------------------------------------------------- commit a171cc133cc1111e91cf892fdbaa7ca476129b07 Author: David Terei Date: Tue May 12 15:30:36 2015 -0700 Update Safe Haskell documentation. Biggest change is to document new overlapping instances behavior. We also add back in the explanation of GND being restricted, and improve the docs across the board. >--------------------------------------------------------------- a171cc133cc1111e91cf892fdbaa7ca476129b07 docs/users_guide/safe_haskell.xml | 660 +++++++++++++++++++++++--------------- 1 file changed, 397 insertions(+), 263 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 a171cc133cc1111e91cf892fdbaa7ca476129b07 From git at git.haskell.org Tue May 12 22:44:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 May 2015 22:44:31 +0000 (UTC) Subject: [commit: ghc] master: Fix fragile T9579 tests (4b8b4ce) Message-ID: <20150512224431.D77C63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b8b4ce12a1b5f682071a27bc313649fa50e0e91/ghc >--------------------------------------------------------------- commit 4b8b4ce12a1b5f682071a27bc313649fa50e0e91 Author: Javran Cheng Date: Wed May 13 07:54:57 2015 +1000 Fix fragile T9579 tests Fix fragile tests according to comment 13 of #9579 (by @bherzog) Done by capturing stderr and replace `xx bytes` with `NUM bytes` (literal). Some numbers like `(1 MB)` would still remain, but I think it's safe to assume the actual difference in bytes (on different architectures) is too small to have an effect on the rounded megabyte value. Test Plan: validate Reviewers: erikd, austin Reviewed By: erikd, austin Subscribers: erikd, bgamari, thomie, bherzog Differential Revision: https://phabricator.haskell.org/D882 GHC Trac Issues: #9579 >--------------------------------------------------------------- 4b8b4ce12a1b5f682071a27bc313649fa50e0e91 ...rtsall.stderr => T9579_outofheap_rtsall.stdout} | 3 +- ...> T9579_outofheap_rtsall_no_suggestions.stdout} | 3 +- ...snone.stderr => T9579_outofheap_rtsnone.stdout} | 3 +- ...ssome.stderr => T9579_outofheap_rtssome.stdout} | 3 +- .../rts/T9579/T9579_stackoverflow_rtsall.stderr | 2 - .../rts/T9579/T9579_stackoverflow_rtsall.stdout | 3 + ...579_stackoverflow_rtsall_no_suggestions.stdout} | 3 +- ...e.stderr => T9579_stackoverflow_rtsnone.stdout} | 3 +- ...e.stderr => T9579_stackoverflow_rtssome.stdout} | 3 +- testsuite/tests/rts/T9579/all.T | 95 +++++++--------------- 10 files changed, 48 insertions(+), 73 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 4b8b4ce12a1b5f682071a27bc313649fa50e0e91 From git at git.haskell.org Wed May 13 03:08:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 03:08:29 +0000 (UTC) Subject: [commit: ghc] master: Revert D727 (8764a7e) Message-ID: <20150513030829.412FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8764a7e8caa18491c2c14d860bc4e392d8ec0eee/ghc >--------------------------------------------------------------- commit 8764a7e8caa18491c2c14d860bc4e392d8ec0eee Author: Austin Seipp Date: Tue May 12 22:07:06 2015 -0500 Revert D727 This caused print007 to fail, so I guess I botched this more than I thought. This is a combination of reverting: "Fix build breakage from 9736c042", commit f35d621. "compiler: make sure we reject -O + HscInterpreted", commit 9736c04. >--------------------------------------------------------------- 8764a7e8caa18491c2c14d860bc4e392d8ec0eee compiler/main/DynFlags.hs | 12 ++++---- compiler/main/ErrUtils.hs | 6 +--- compiler/main/GHC.hs | 41 ++++---------------------- compiler/simplCore/FloatOut.hs | 27 ----------------- testsuite/.gitignore | 1 - testsuite/tests/ghc-api/T10052/Makefile | 12 -------- testsuite/tests/ghc-api/T10052/T10052-input.hs | 1 - testsuite/tests/ghc-api/T10052/T10052.hs | 30 ------------------- testsuite/tests/ghc-api/T10052/T10052.stderr | 3 -- testsuite/tests/ghc-api/T10052/T10052.stdout | 1 - testsuite/tests/ghc-api/T10052/all.T | 2 -- 11 files changed, 12 insertions(+), 124 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 8764a7e8caa18491c2c14d860bc4e392d8ec0eee From git at git.haskell.org Wed May 13 08:01:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 08:01:42 +0000 (UTC) Subject: [commit: ghc] master: Delete commented-out line (8da785d) Message-ID: <20150513080142.900F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8da785d59f5989b9a9df06386d5bd13f65435bc0/ghc >--------------------------------------------------------------- commit 8da785d59f5989b9a9df06386d5bd13f65435bc0 Author: Simon Peyton Jones Date: Mon May 11 23:00:45 2015 +0100 Delete commented-out line >--------------------------------------------------------------- 8da785d59f5989b9a9df06386d5bd13f65435bc0 compiler/main/StaticFlags.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 914a145..e2876a4 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -43,7 +43,6 @@ import CmdLineParser import FastString import SrcLoc import Util --- import Maybes ( firstJusts ) import Panic import Control.Monad From git at git.haskell.org Wed May 13 08:01:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 08:01:46 +0000 (UTC) Subject: [commit: ghc] master: Refactor tuple constraints (130e93a) Message-ID: <20150513080146.735B33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/130e93aab220bdf14d08028771f83df210da340b/ghc >--------------------------------------------------------------- commit 130e93aab220bdf14d08028771f83df210da340b Author: Simon Peyton Jones Date: Mon May 11 23:19:14 2015 +0100 Refactor tuple constraints Make tuple constraints be handled by a perfectly ordinary type class, with the component constraints being the superclasses: class (c1, c2) => (c2, c2) This change was provoked by #10359 inability to re-use a given tuple constraint as a whole #9858 confusion between term tuples and constraint tuples but it's generally a very nice simplification. We get rid of - In Type, the TuplePred constructor of PredTree, and all the code that dealt with TuplePreds - In TcEvidence, the constructors EvTupleMk, EvTupleSel See Note [How tuples work] in TysWiredIn. Of course, nothing is ever entirely simple. This one proved quite fiddly. - I did quite a bit of renaming, which makes this patch touch a lot of modules. In partiuclar tupleCon -> tupleDataCon. - I made constraint tuples known-key rather than wired-in. This is different to boxed/unboxed tuples, but it proved awkward to have all the superclass selectors wired-in. Easier just to use the standard mechanims. - While I was fiddling with known-key names, I split the TH Name definitions out of DsMeta into a new module THNames. That meant that the known-key names can all be gathered in PrelInfo, without causing module loops. - I found that the parser was parsing an import item like T( .. ) as a *data constructor* T, and then using setRdrNameSpace to fix it. Stupid! So I changed the parser to parse a *type constructor* T, which means less use of setRdrNameSpace. I also improved setRdrNameSpace to behave better on Exact Names. Largely on priciple; I don't think it matters a lot. - When compiling a data type declaration for a wired-in thing like tuples (,), or lists, we don't really need to look at the declaration. We have the wired-in thing! And not doing so avoids having to line up the uniques for data constructor workers etc. See Note [Declarations for wired-in things] - I found that FunDeps.oclose wasn't taking superclasses into account; easily fixed. - Some error message refactoring for invalid constraints in TcValidity >--------------------------------------------------------------- 130e93aab220bdf14d08028771f83df210da340b compiler/basicTypes/BasicTypes.hs | 21 +- compiler/basicTypes/DataCon.hs | 1 - compiler/basicTypes/RdrName.hs | 28 +- compiler/basicTypes/Unique.hs | 28 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/coreSyn/MkCore.hs | 7 +- compiler/coreSyn/PprCore.hs | 4 +- compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsArrows.hs | 2 +- compiler/deSugar/DsBinds.hs | 25 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsExpr.hs | 5 +- compiler/deSugar/DsMeta.hs | 840 +-------------------- compiler/deSugar/Match.hs | 4 +- compiler/ghc.cabal.in | 3 +- compiler/ghci/RtClosureInspect.hs | 7 +- compiler/hsSyn/Convert.hs | 4 +- compiler/hsSyn/HsExpr.hs | 3 +- compiler/hsSyn/HsPat.hs | 35 +- compiler/hsSyn/HsTypes.hs | 2 +- compiler/iface/BinIface.hs | 14 +- compiler/iface/BuildTyCl.hs | 4 + compiler/iface/IfaceSyn.hs | 9 +- compiler/iface/IfaceType.hs | 154 ++-- compiler/iface/TcIface.hs | 84 ++- compiler/main/Constants.hs | 3 + compiler/main/HscMain.hs | 7 - compiler/parser/Parser.y | 20 +- compiler/parser/RdrHsSyn.hs | 164 +++- compiler/prelude/PrelInfo.hs | 28 +- compiler/prelude/PrelNames.hs | 17 - compiler/prelude/PrelRules.hs | 6 +- compiler/prelude/PrimOp.hs | 2 +- compiler/prelude/THNames.hs | 836 ++++++++++++++++++++ compiler/prelude/TysWiredIn.hs | 269 ++++--- compiler/rename/RnEnv.hs | 1 + compiler/rename/RnNames.hs | 42 +- compiler/rename/RnSplice.hs | 6 +- compiler/simplStg/UnariseStg.hs | 10 +- compiler/specialise/Specialise.hs | 3 +- compiler/stranal/WwLib.hs | 6 +- compiler/typecheck/FunDeps.hs | 32 +- compiler/typecheck/TcCanonical.hs | 32 - compiler/typecheck/TcErrors.hs | 2 - compiler/typecheck/TcEvidence.hs | 15 +- compiler/typecheck/TcExpr.hs | 10 +- compiler/typecheck/TcGenDeriv.hs | 15 +- compiler/typecheck/TcHsSyn.hs | 5 +- compiler/typecheck/TcHsType.hs | 15 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcInteract.hs | 10 +- compiler/typecheck/TcMType.hs | 1 - compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcRnMonad.hs | 4 + compiler/typecheck/TcSimplify.hs | 1 - compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 17 +- compiler/typecheck/TcType.hs | 3 - compiler/typecheck/TcValidity.hs | 186 +++-- compiler/types/TyCon.hs | 34 +- compiler/types/Type.hs | 7 +- compiler/types/TypeRep.hs | 11 +- compiler/vectorise/Vectorise/Builtins/Base.hs | 2 +- .../vectorise/Vectorise/Builtins/Initialise.hs | 2 +- compiler/vectorise/Vectorise/Utils/Closure.hs | 4 +- libraries/ghc-prim/GHC/Classes.hs | 37 +- libraries/ghc-prim/GHC/Tuple.hs | 242 +++--- libraries/ghc-prim/GHC/Types.hs | 2 +- .../should_fail/NotRelaxedExamples.stderr | 17 +- .../indexed-types/should_fail/TyFamUndec.stderr | 17 +- testsuite/tests/module/all.T | 2 +- testsuite/tests/module/mod89.hs | 2 + testsuite/tests/module/mod89.stderr | 10 +- .../tests/typecheck/should_fail/T9858a.stderr | 2 +- .../tests/typecheck/should_fail/fd-loop.stderr | 12 +- .../tests/typecheck/should_fail/tcfail108.stderr | 4 +- .../tests/typecheck/should_fail/tcfail154.stderr | 6 +- .../tests/typecheck/should_fail/tcfail157.stderr | 12 +- .../tests/typecheck/should_fail/tcfail213.stderr | 4 +- .../tests/typecheck/should_fail/tcfail214.stderr | 8 +- .../tests/typecheck/should_fail/tcfail220.hsig | 1 - .../tests/typecheck/should_fail/tcfail220.stderr | 8 - utils/genprimopcode/Main.hs | 2 +- 83 files changed, 1880 insertions(+), 1638 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 130e93aab220bdf14d08028771f83df210da340b From git at git.haskell.org Wed May 13 08:01:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 08:01:49 +0000 (UTC) Subject: [commit: ghc] master: Change in capitalisation of error msg (5910a1b) Message-ID: <20150513080149.40E3B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5910a1bc8142b4e56a19abea104263d7bb5c5d3f/ghc >--------------------------------------------------------------- commit 5910a1bc8142b4e56a19abea104263d7bb5c5d3f Author: Simon Peyton Jones Date: Tue May 12 21:51:45 2015 +0100 Change in capitalisation of error msg -outofmem.exe: Out of memory +outofmem.exe: out of memory >--------------------------------------------------------------- 5910a1bc8142b4e56a19abea104263d7bb5c5d3f testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32 b/testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32 index 4b16ce9..2786841 100644 --- a/testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32 +++ b/testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32 @@ -1 +1 @@ -outofmem.exe: Out of memory +outofmem.exe: out of memory From git at git.haskell.org Wed May 13 08:51:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 08:51:03 +0000 (UTC) Subject: [commit: ghc] master: Two wibbles to fix the build (a154944) Message-ID: <20150513085103.B522E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a154944bf07b2e13175519bafebd5a03926bf105/ghc >--------------------------------------------------------------- commit a154944bf07b2e13175519bafebd5a03926bf105 Author: Simon Peyton Jones Date: Wed May 13 09:51:49 2015 +0100 Two wibbles to fix the build ...following the constraint-tuple patch. * There was interaction with the recent Safe Haskell change * Haddock comoplained about constraint tuples defined but not used >--------------------------------------------------------------- a154944bf07b2e13175519bafebd5a03926bf105 compiler/typecheck/TcInteract.hs | 3 ++- libraries/ghc-prim/GHC/Classes.hs | 7 ++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index ce51b0d..603c127 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2026,7 +2026,8 @@ matchClassInst _ clas [ ty ] _ matchClassInst _ clas ts _ | isCTupleClass clas , let data_con = tyConSingleDataCon (classTyCon clas) - = return (GenInst ts (EvDFunApp (dataConWrapId data_con) ts)) + tuple_ev = EvDFunApp (dataConWrapId data_con) ts + = return (GenInst ts tuple_ev True) -- The dfun is the data constructor! matchClassInst _ clas [k,t] _ diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs index 5a3e48e..73ae69e 100644 --- a/libraries/ghc-prim/GHC/Classes.hs +++ b/libraries/ghc-prim/GHC/Classes.hs @@ -6,7 +6,12 @@ -- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic {-# OPTIONS_GHC -fno-warn-unused-imports #-} --- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh. +-- -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh. + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} +-- -fno-warn-unused-top-binds is there (I hope) to stop Haddock complaining +-- about the constraint tuples being defined but not used + {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | From git at git.haskell.org Wed May 13 09:17:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 09:17:39 +0000 (UTC) Subject: [commit: ghc] master: Fix imports in HscMain (stage2) (a8493e0) Message-ID: <20150513091739.9DD663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8493e03b89f3b3bfcdb6005795de050501f5c29/ghc >--------------------------------------------------------------- commit a8493e03b89f3b3bfcdb6005795de050501f5c29 Author: Simon Peyton Jones Date: Wed May 13 10:18:23 2015 +0100 Fix imports in HscMain (stage2) >--------------------------------------------------------------- a8493e03b89f3b3bfcdb6005795de050501f5c29 compiler/main/HscMain.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 47d4515..5ae104b 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -90,9 +90,7 @@ import BasicTypes ( HValue ) import ByteCodeGen ( byteCodeGen, coreExprToBCOs ) import Linker import CoreTidy ( tidyExpr ) -import Type ( Type ) -import PrelNames -import {- Kind parts of -} Type ( Kind ) +import Type ( Type, Kind ) import CoreLint ( lintInteractiveExpr ) import VarEnv ( emptyTidyEnv ) import Panic From git at git.haskell.org Wed May 13 11:08:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 11:08:23 +0000 (UTC) Subject: [commit: ghc] master: Separate transCloVarSet from fixVarSet (6e1174d) Message-ID: <20150513110823.607063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e1174da5b8e0b296f5bfc8b39904300d04eb5b7/ghc >--------------------------------------------------------------- commit 6e1174da5b8e0b296f5bfc8b39904300d04eb5b7 Author: Simon Peyton Jones Date: Wed May 13 12:00:10 2015 +0100 Separate transCloVarSet from fixVarSet I wasn't clear about the distinction before, and that led to a bug when I refactored FunDeps.oclose to use transCloVarSet; it should use fixVarSet. >--------------------------------------------------------------- 6e1174da5b8e0b296f5bfc8b39904300d04eb5b7 compiler/basicTypes/VarSet.hs | 23 +++++++++++++++++++---- compiler/typecheck/FunDeps.hs | 2 +- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs index 7b21487..7adc898 100644 --- a/compiler/basicTypes/VarSet.hs +++ b/compiler/basicTypes/VarSet.hs @@ -17,7 +17,7 @@ module VarSet ( intersectVarSet, intersectsVarSet, disjointVarSet, isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey, minusVarSet, foldVarSet, filterVarSet, - transCloVarSet, + transCloVarSet, fixVarSet, lookupVarSet, mapVarSet, sizeVarSet, seqVarSet, elemVarSetByKey, partitionVarSet ) where @@ -110,13 +110,28 @@ intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2) disjointVarSet s1 s2 = isEmptyVarSet (s1 `intersectVarSet` s2) subVarSet s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2) +fixVarSet :: (VarSet -> VarSet) -- Map the current set to a new set + -> VarSet -> VarSet +-- (fixVarSet f s) repeatedly applies f to the set s, +-- until it reaches a fixed point. +fixVarSet fn vars + | new_vars `subVarSet` vars = vars + | otherwise = fixVarSet fn new_vars + where + new_vars = fn vars + transCloVarSet :: (VarSet -> VarSet) -- Map some variables in the set to -- extra variables that should be in it -> VarSet -> VarSet --- (transCloVarSet f s) repeatedly applies f to the set s, adding any --- new variables to s that it finds thereby, until it reaches a fixed --- point. The actual algorithm is a bit more efficient. +-- (transCloVarSet f s) repeatedly applies f to new candidates, adding any +-- new variables to s that it finds thereby, until it reaches a fixed point. +-- +-- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet) +-- for efficiency, so that the test can be batched up. +-- It's essential that fn will work fine if given new candidates +-- one at at time; ie fn {v1,v2} = fn v1 `union` fn v2 +-- Use fixVarSet if the function needs to see the whole set all at once transCloVarSet fn seeds = go seeds seeds where diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs index 3e07f6b..830873c 100644 --- a/compiler/typecheck/FunDeps.hs +++ b/compiler/typecheck/FunDeps.hs @@ -446,7 +446,7 @@ oclose :: [PredType] -> TyVarSet -> TyVarSet -- See Note [The liberal coverage condition] oclose preds fixed_tvs | null tv_fds = fixed_tvs -- Fast escape hatch for common case. - | otherwise = transCloVarSet extend fixed_tvs + | otherwise = fixVarSet extend fixed_tvs where extend fixed_tvs = foldl add fixed_tvs tv_fds where From git at git.haskell.org Wed May 13 11:08:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 11:08:26 +0000 (UTC) Subject: [commit: ghc] master: Update haddock submodule (51cbad1) Message-ID: <20150513110826.26A333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/51cbad15f86fca1d1b0e777199eb1079a1b64d74/ghc >--------------------------------------------------------------- commit 51cbad15f86fca1d1b0e777199eb1079a1b64d74 Author: Simon Peyton Jones Date: Wed May 13 12:06:36 2015 +0100 Update haddock submodule The location of setRdrNameSpace has changed in GHC. (Sadly, the build still fails with a tyConStupidTheta failure in a haddock invocation; I have no idea why. But at least Haddock itself builds.) >--------------------------------------------------------------- 51cbad15f86fca1d1b0e777199eb1079a1b64d74 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 2380f07..5a57a24 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 2380f07c430c525b205ce2eae6dab23c8388d899 +Subproject commit 5a57a24c44e06e964c4ea2276c842c722c4e93d9 From git at git.haskell.org Wed May 13 11:48:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 11:48:47 +0000 (UTC) Subject: [commit: ghc] master: Add a case to checkValidTyCon (ca173aa) Message-ID: <20150513114847.E1B7A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca173aa30467a0b1023682d573fcd94244d85c50/ghc >--------------------------------------------------------------- commit ca173aa30467a0b1023682d573fcd94244d85c50 Author: Simon Peyton Jones Date: Wed May 13 12:44:12 2015 +0100 Add a case to checkValidTyCon Apparently when Haddock'ing, we check GHC.Prim. So checkValidTyCon must not crash when dealing with PrimTyCons; and it was doing so in dataConStupidTheta. The fix is easy, but I'm puzzled about why Haddock needs to typecheck GHC.Prim. >--------------------------------------------------------------- ca173aa30467a0b1023682d573fcd94244d85c50 compiler/typecheck/TcTyClsDecls.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 59ff6cb..1b324f6 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -1451,6 +1451,9 @@ checkValidTyCl thing checkValidTyCon :: TyCon -> TcM () checkValidTyCon tc + | isPrimTyCon tc -- Happens when Haddock'ing GHC.Prim + = return () + | Just cl <- tyConClass_maybe tc = checkValidClass cl From git at git.haskell.org Wed May 13 11:48:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 11:48:50 +0000 (UTC) Subject: [commit: ghc] master: Make the "matchable-given" check happen first (eb6ca85) Message-ID: <20150513114850.B5A963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eb6ca851f553262efe0824b8dcbe64952de4963d/ghc >--------------------------------------------------------------- commit eb6ca851f553262efe0824b8dcbe64952de4963d Author: Simon Peyton Jones Date: Wed May 13 12:49:13 2015 +0100 Make the "matchable-given" check happen first This change makes the matchable-given check apply uniformly to - constraint tuples - natural numbers - Typeable as well as to vanilla class constraints. See Note [Instance and Given overlap] in TcInteract >--------------------------------------------------------------- eb6ca851f553262efe0824b8dcbe64952de4963d compiler/typecheck/TcInteract.hs | 113 +++++++++++++++++++++------------------ 1 file changed, 60 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 eb6ca851f553262efe0824b8dcbe64952de4963d From git at git.haskell.org Wed May 13 16:22:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 16:22:25 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10248 (c0aae6f) Message-ID: <20150513162225.3669E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0aae6f699cbd222d826d0b8d78d6cb3f682079e/ghc >--------------------------------------------------------------- commit c0aae6f699cbd222d826d0b8d78d6cb3f682079e Author: Simon Peyton Jones Date: Wed May 13 17:11:46 2015 +0100 Test Trac #10248 >--------------------------------------------------------------- c0aae6f699cbd222d826d0b8d78d6cb3f682079e testsuite/tests/ghci/scripts/T10248.script | 2 ++ testsuite/tests/ghci/scripts/T10248.stderr | 18 ++++++++++++++++++ testsuite/tests/ghci/scripts/all.T | 1 + 3 files changed, 21 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T10248.script b/testsuite/tests/ghci/scripts/T10248.script new file mode 100644 index 0000000..6614044 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10248.script @@ -0,0 +1,2 @@ +:set -fdefer-type-errors +Just <$> _ diff --git a/testsuite/tests/ghci/scripts/T10248.stderr b/testsuite/tests/ghci/scripts/T10248.stderr new file mode 100644 index 0000000..1245b99 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10248.stderr @@ -0,0 +1,18 @@ + +:3:10: warning: + Found hole ?_? with type: IO () + In the second argument of ?(<$>)?, namely ?_? + In the first argument of ?ghciStepIO :: + IO a_alT -> IO a_alT?, namely + ?Just <$> _? + In a stmt of an interactive GHCi command: + it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _) +*** Exception: :3:10: error: + Found hole ?_? with type: IO () + In the second argument of ?(<$>)?, namely ?_? + In the first argument of ?ghciStepIO :: + IO a_alT -> IO a_alT?, namely + ?Just <$> _? + In a stmt of an interactive GHCi command: + it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _) +(deferred type error) diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 1582344..85ba5af 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -216,3 +216,4 @@ test('T10408A', normal, run_command, ['$MAKE -s --no-print-directory T10408A']) test('T10408B', normal, run_command, ['$MAKE -s --no-print-directory T10408B']) +test('T10248', normal, ghci_script, ['T10248.script']) From git at git.haskell.org Wed May 13 16:22:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 16:22:28 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10403 (a9ccd37) Message-ID: <20150513162228.83EC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9ccd37add8315e061c02e5bf26c08f05fad9ac9/ghc >--------------------------------------------------------------- commit a9ccd37add8315e061c02e5bf26c08f05fad9ac9 Author: Simon Peyton Jones Date: Wed May 13 17:17:22 2015 +0100 Test Trac #10403 >--------------------------------------------------------------- a9ccd37add8315e061c02e5bf26c08f05fad9ac9 testsuite/tests/partial-sigs/should_compile/T10403.hs | 19 +++++++++++++++++++ .../tests/partial-sigs/should_compile/T10403.stderr | 17 +++++++++++++++++ testsuite/tests/partial-sigs/should_compile/all.T | 1 + 3 files changed, 37 insertions(+) diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.hs b/testsuite/tests/partial-sigs/should_compile/T10403.hs new file mode 100644 index 0000000..a33646d --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T10403.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE PartialTypeSignatures #-} +module T10403 where + +data I a = I a +instance Functor I where + fmap f (I a) = I (f a) + +newtype B t a = B a +instance Functor (B t) where + fmap f (B a) = B (f a) + +newtype H f = H (f ()) + +app :: H (B t) +app = h (H . I) (B ()) + +h :: _ => _ +--h :: Functor m => (a -> b) -> m a -> H m +h f b = (H . fmap (const ())) (fmap f b) diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr new file mode 100644 index 0000000..6b0660d --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr @@ -0,0 +1,17 @@ + +T10403.hs:17:6: warning: + Found hole ?_? with inferred constraints: Functor f + In the type signature for ?h?: _ => _ + +T10403.hs:17:11: warning: + Found hole ?_? with type: (a -> b) -> f a -> H f + Where: ?f? is a rigid type variable bound by + the inferred type of h :: Functor f => (a -> b) -> f a -> H f + at T10403.hs:19:1 + ?b? is a rigid type variable bound by + the inferred type of h :: Functor f => (a -> b) -> f a -> H f + at T10403.hs:19:1 + ?a? is a rigid type variable bound by + the inferred type of h :: Functor f => (a -> b) -> f a -> H f + at T10403.hs:19:1 + In the type signature for ?h?: _ => _ diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index e83e070..91294a5 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -46,3 +46,4 @@ test('SomethingShowable', normal, compile, ['-ddump-types -fno-warn-partial-type test('Uncurry', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('UncurryNamed', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('WarningWildcardInstantiations', normal, compile, ['-ddump-types']) +test('T10403', normal, compile, ['']) From git at git.haskell.org Wed May 13 16:22:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 May 2015 16:22:31 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10359 (04a484e) Message-ID: <20150513162231.8656C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/04a484eafc9eb9f8774b4bdd41a5dc6c9f640daf/ghc >--------------------------------------------------------------- commit 04a484eafc9eb9f8774b4bdd41a5dc6c9f640daf Author: Simon Peyton Jones Date: Wed May 13 17:23:06 2015 +0100 Test Trac #10359 >--------------------------------------------------------------- 04a484eafc9eb9f8774b4bdd41a5dc6c9f640daf testsuite/tests/perf/should_run/T10359.hs | 125 ++++++++++++++++++++++++++ testsuite/tests/perf/should_run/T10359.stdout | 1 + testsuite/tests/perf/should_run/all.T | 10 ++- 3 files changed, 135 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/should_run/T10359.hs b/testsuite/tests/perf/should_run/T10359.hs new file mode 100644 index 0000000..fa10560 --- /dev/null +++ b/testsuite/tests/perf/should_run/T10359.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ConstraintKinds #-} + +module Main( main, boo ) where + +import Prelude hiding (repeat) + +boo xs f = (\x -> f x, xs) + +repeat :: Int -> (a -> a) -> a -> a +repeat 1 f x = f x +repeat n f x = n `seq` x `seq` repeat (n-1) f $ f x + +---- Buggy version +------------------ + +type Numerical a = (Fractional a, Real a) + +data Box a = Box + { func :: forall dum. (Numerical dum) => dum -> a -> a + , obj :: !a } + +do_step :: (Numerical num) => num -> Box a -> Box a +do_step number Box{..} = Box{ obj = func number obj, .. } + +start :: Box Double +start = Box { func = \x y -> realToFrac x + y + , obj = 0 } + +test :: Int -> IO () +test steps = putStrLn $ show $ obj $ repeat steps (do_step 1) start + +---- Driver +----------- + +main :: IO () +main = test 2000 -- compare test2 10000000 or test3 10000000, but test4 20000 + + +{- +---- No tuple constraint synonym is better +------------------------------------------ + +data Box2 a = Box2 + { func2 :: forall num. (Fractional num, Real num) => num -> a -> a + , obj2 :: !a } + +do_step2 :: (Fractional num, Real num) => num -> Box2 a -> Box2 a +do_step2 number Box2{..} = Box2{ obj2 = func2 number obj2, ..} + +start2 :: Box2 Double +start2 = Box2 { func2 = \x y -> realToFrac x + y + , obj2 = 0 } + +test2 :: Int -> IO () +test2 steps = putStrLn $ show $ obj2 $ repeat steps (do_step2 1) start2 + +---- Not copying the function field works too +--------------------------------------------- + +do_step3 :: (Numerical num) => num -> Box a -> Box a +do_step3 number b at Box{..} = b{ obj = func number obj } + +test3 :: Int -> IO () +test3 steps = putStrLn $ show $ obj $ repeat steps (do_step3 1) start + +---- But record wildcards are not at fault +------------------------------------------ + +do_step4 :: (Numerical num) => num -> Box a -> Box a +do_step4 number Box{func = f, obj = x} = Box{ obj = f number x, func = f } + +test4 :: Int -> IO () +test4 steps = putStrLn $ show $ obj $ repeat steps (do_step4 1) start +-} + + +{- +First of all, very nice example. Thank you for making it so small and easy to work with. + +I can see what's happening. The key part is what happens here: +{{{ +do_step4 :: (Numerical num) => num -> Box a -> Box a +do_step4 number Box{ func = f, obj = x} + = Box{ func = f, obj = f number x } +}}} +After elaboration (ie making dictionaries explicit) we get this: +{{{ +do_step4 dn1 number (Box {func = f, obj = x }) + = Box { func = \dn2 -> f ( case dn2 of (f,r) -> f + , case dn2 of (f,r) -> r) + , obj = f dn1 number x } +}}} +That's odd! We expected this: +{{{ +do_step4 dn1 number (Box {func = f, obj = x }) + = Box { func = f + , obj = f dn1 number x } +}}} +And indeed, the allocation of all those `\dn2` closures is what is causing the problem. +So we are missing this optimisation: +{{{ + (case dn2 of (f,r) -> f, case dn2 of (f,r) -> r) +===> + dn2 +}}} +If we did this, then the lambda would look like `\dn2 -> f dn2` which could eta-reduce to `f`. +But there are at least three problems: + * The tuple transformation above is hard to spot + * The tuple transformation is not quite semantically right; if `dn2` was bottom, the LHS and RHS are different + * The eta-reduction isn't quite semantically right: if `f` ws bottom, the LHS and RHS are different. + +You might argue that the latter two can be ignored because dictionary arguments are special; +indeed we often toy with making them strict. + +But perhaps a better way to avoid the tuple-transformation issue would be not to construct that strange expression in the first place. Where is it coming from? It comes from the call to `f` (admittedly applied to no arguments) in `Box { ..., func = f }`. GHC needs a dictionary for `(Numerical dum)` (I changed the name of the type variable in `func`'s type in the definition of `Box`). Since it's just a pair GHC says "fine, I'll build a pair, out of `Fractional dum` and `Real dum`. How does it get those dictionaries? By selecting the components of the `Franctional dum` passed to `f`. + +If GHC said instead "I need `Numerical dum` and behold I have one in hand, it'd be much better. It doesn't because tuple constraints are treated specially. But if we adopted the idea in #10362, we would (automatically) get to re-use the `Numerical dum` constraint. That would leave us with eta reduction, which is easier. + +As to what will get you rolling, a good solution is `test3`, which saves instantiating and re-generalising `f`. The key thing is to update all the fields ''except'' the polymorphic `func` field. I'm surprised you say that it doesn't work. Can you give a (presumably more complicated) example to demonstrate? Maybe there's a separate bug! + +-} + + diff --git a/testsuite/tests/perf/should_run/T10359.stdout b/testsuite/tests/perf/should_run/T10359.stdout new file mode 100644 index 0000000..f6f4e07 --- /dev/null +++ b/testsuite/tests/perf/should_run/T10359.stdout @@ -0,0 +1 @@ +2000.0 diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index f680104..c95dfa0 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -1,8 +1,16 @@ # Tests that newArray/newArray_ is being optimised correctly +test('T10359', + [stats_num_field('bytes allocated', + [(wordsize(64), 499512, 5), + (wordsize(32), 250000, 5)]), + only_ways(['normal']) + ], + compile_and_run, + ['-O']) + # fortunately the values here are mostly independent of the wordsize, # because the test allocates an unboxed array of doubles. - test('T3586', [stats_num_field('peak_megabytes_allocated', (17, 1)), # expected value: 17 (amd64/Linux) From git at git.haskell.org Thu May 14 21:26:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 May 2015 21:26:05 +0000 (UTC) Subject: [commit: ghc] master: Revert multiple commits (3cf8ecd) Message-ID: <20150514212605.A4D953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3cf8ecdc70cb295a2b9606080a1c7b5fa8eb16f4/ghc >--------------------------------------------------------------- commit 3cf8ecdc70cb295a2b9606080a1c7b5fa8eb16f4 Author: Austin Seipp Date: Thu May 14 10:55:03 2015 -0500 Revert multiple commits This reverts multiple commits from Simon: - 04a484eafc9eb9f8774b4bdd41a5dc6c9f640daf Test Trac #10359 - a9ccd37add8315e061c02e5bf26c08f05fad9ac9 Test Trac #10403 - c0aae6f699cbd222d826d0b8d78d6cb3f682079e Test Trac #10248 - eb6ca851f553262efe0824b8dcbe64952de4963d Make the "matchable-given" check happen first - ca173aa30467a0b1023682d573fcd94244d85c50 Add a case to checkValidTyCon - 51cbad15f86fca1d1b0e777199eb1079a1b64d74 Update haddock submodule - 6e1174da5b8e0b296f5bfc8b39904300d04eb5b7 Separate transCloVarSet from fixVarSet - a8493e03b89f3b3bfcdb6005795de050501f5c29 Fix imports in HscMain (stage2) - a154944bf07b2e13175519bafebd5a03926bf105 Two wibbles to fix the build - 5910a1bc8142b4e56a19abea104263d7bb5c5d3f Change in capitalisation of error msg - 130e93aab220bdf14d08028771f83df210da340b Refactor tuple constraints - 8da785d59f5989b9a9df06386d5bd13f65435bc0 Delete commented-out line These break the build by causing Haddock to fail mysteriously when trying to examine GHC.Prim it seems. >--------------------------------------------------------------- 3cf8ecdc70cb295a2b9606080a1c7b5fa8eb16f4 compiler/basicTypes/BasicTypes.hs | 21 +- compiler/basicTypes/DataCon.hs | 1 + compiler/basicTypes/RdrName.hs | 28 +- compiler/basicTypes/Unique.hs | 28 +- compiler/basicTypes/VarSet.hs | 23 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/coreSyn/MkCore.hs | 7 +- compiler/coreSyn/PprCore.hs | 4 +- compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsArrows.hs | 2 +- compiler/deSugar/DsBinds.hs | 25 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsExpr.hs | 5 +- compiler/deSugar/DsMeta.hs | 840 ++++++++++++++++++++- compiler/deSugar/Match.hs | 4 +- compiler/ghc.cabal.in | 3 +- compiler/ghci/RtClosureInspect.hs | 7 +- compiler/hsSyn/Convert.hs | 4 +- compiler/hsSyn/HsExpr.hs | 3 +- compiler/hsSyn/HsPat.hs | 35 +- compiler/hsSyn/HsTypes.hs | 2 +- compiler/iface/BinIface.hs | 14 +- compiler/iface/BuildTyCl.hs | 4 - compiler/iface/IfaceSyn.hs | 9 +- compiler/iface/IfaceType.hs | 154 ++-- compiler/iface/TcIface.hs | 84 +-- compiler/main/Constants.hs | 3 - compiler/main/HscMain.hs | 11 +- compiler/main/StaticFlags.hs | 1 + compiler/parser/Parser.y | 20 +- compiler/parser/RdrHsSyn.hs | 164 +--- compiler/prelude/PrelInfo.hs | 28 +- compiler/prelude/PrelNames.hs | 17 + compiler/prelude/PrelRules.hs | 6 +- compiler/prelude/PrimOp.hs | 2 +- compiler/prelude/THNames.hs | 836 -------------------- compiler/prelude/TysWiredIn.hs | 269 +++---- compiler/rename/RnEnv.hs | 1 - compiler/rename/RnNames.hs | 42 +- compiler/rename/RnSplice.hs | 6 +- compiler/simplStg/UnariseStg.hs | 10 +- compiler/specialise/Specialise.hs | 3 +- compiler/stranal/WwLib.hs | 6 +- compiler/typecheck/FunDeps.hs | 32 +- compiler/typecheck/TcCanonical.hs | 32 + compiler/typecheck/TcErrors.hs | 2 + compiler/typecheck/TcEvidence.hs | 15 +- compiler/typecheck/TcExpr.hs | 10 +- compiler/typecheck/TcGenDeriv.hs | 15 +- compiler/typecheck/TcHsSyn.hs | 5 +- compiler/typecheck/TcHsType.hs | 15 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcInteract.hs | 122 ++- compiler/typecheck/TcMType.hs | 1 + compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcRnMonad.hs | 4 - compiler/typecheck/TcSimplify.hs | 1 + compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 20 +- compiler/typecheck/TcType.hs | 3 + compiler/typecheck/TcValidity.hs | 186 ++--- compiler/types/TyCon.hs | 34 +- compiler/types/Type.hs | 7 +- compiler/types/TypeRep.hs | 11 +- compiler/vectorise/Vectorise/Builtins/Base.hs | 2 +- .../vectorise/Vectorise/Builtins/Initialise.hs | 2 +- compiler/vectorise/Vectorise/Utils/Closure.hs | 4 +- libraries/ghc-prim/GHC/Classes.hs | 44 +- libraries/ghc-prim/GHC/Tuple.hs | 242 +++--- libraries/ghc-prim/GHC/Types.hs | 2 +- testsuite/tests/ghci/scripts/T10248.script | 2 - testsuite/tests/ghci/scripts/T10248.stderr | 18 - testsuite/tests/ghci/scripts/all.T | 1 - .../should_fail/NotRelaxedExamples.stderr | 17 +- .../indexed-types/should_fail/TyFamUndec.stderr | 17 +- testsuite/tests/module/all.T | 2 +- testsuite/tests/module/mod89.hs | 2 - testsuite/tests/module/mod89.stderr | 10 +- .../tests/partial-sigs/should_compile/T10403.hs | 19 - .../partial-sigs/should_compile/T10403.stderr | 17 - testsuite/tests/partial-sigs/should_compile/all.T | 1 - testsuite/tests/perf/should_run/T10359.hs | 125 --- testsuite/tests/perf/should_run/T10359.stdout | 1 - testsuite/tests/perf/should_run/all.T | 10 +- .../tests/rts/outofmem.stderr-i386-unknown-mingw32 | 2 +- .../tests/typecheck/should_fail/T9858a.stderr | 2 +- .../tests/typecheck/should_fail/fd-loop.stderr | 12 +- .../tests/typecheck/should_fail/tcfail108.stderr | 4 +- .../tests/typecheck/should_fail/tcfail154.stderr | 6 +- .../tests/typecheck/should_fail/tcfail157.stderr | 12 +- .../tests/typecheck/should_fail/tcfail213.stderr | 4 +- .../tests/typecheck/should_fail/tcfail214.stderr | 8 +- .../tests/typecheck/should_fail/tcfail220.hsig | 1 + .../tests/typecheck/should_fail/tcfail220.stderr | 8 + utils/genprimopcode/Main.hs | 2 +- utils/haddock | 2 +- 96 files changed, 1702 insertions(+), 2164 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 3cf8ecdc70cb295a2b9606080a1c7b5fa8eb16f4 From git at git.haskell.org Thu May 14 21:26:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 May 2015 21:26:08 +0000 (UTC) Subject: [commit: ghc] master: Do not check dir perms when .ghci doesn't exist (3ef7fce) Message-ID: <20150514212608.801C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ef7fcedfa1ad47968ca5fa107d51a6ab7051ed7/ghc >--------------------------------------------------------------- commit 3ef7fcedfa1ad47968ca5fa107d51a6ab7051ed7 Author: Zejun Wu Date: Thu May 14 10:56:51 2015 -0500 Do not check dir perms when .ghci doesn't exist Do not check dir perms when .ghci doesn't exist, otherwise GHCi will print some confusing and useless warnings in some cases (e.g. in travis). This will fix test T8333 and T10408A in travis. T10408A will be a test case to cover this. And T8333 is changed to be not affected by this. Test Plan: chmod o+w ~/.ghc make TESTS="T8333 T10408A T10408B" chmod o-w ~/.ghc Reviewers: austin, nomeata Differential Revision: https://phabricator.haskell.org/D890 >--------------------------------------------------------------- 3ef7fcedfa1ad47968ca5fa107d51a6ab7051ed7 ghc/InteractiveUI.hs | 9 ++++----- testsuite/tests/th/Makefile | 2 +- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 77f65eb..70e4df1 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -502,7 +502,7 @@ runGHCi paths maybe_exprs = do dot_cfgs <- if ignore_dot_ghci then return [] else do dot_files <- catMaybes <$> sequence [ current_dir, app_user_dir, home_dir ] - liftIO $ filterM checkDirAndFilePerms dot_files + liftIO $ filterM checkFileAndDirPerms dot_files let arg_cfgs = reverse $ ghciScripts dflags -- -ghci-script are collected in reverse order mcfgs <- liftIO $ mapM canonicalizePath' $ dot_cfgs ++ arg_cfgs @@ -589,11 +589,10 @@ nextInputLine show_prompt is_tty -- don't need to check .. and ../.. etc. because "." always refers to -- the same directory while a process is running. -checkDirAndFilePerms :: FilePath -> IO Bool -checkDirAndFilePerms file = do - dir_ok <- checkPerms $ getDirectory file +checkFileAndDirPerms :: FilePath -> IO Bool +checkFileAndDirPerms file = do file_ok <- checkPerms file - return (dir_ok && file_ok) + if file_ok then checkPerms (getDirectory file) else return False where getDirectory f = case takeDirectory f of "" -> "." diff --git a/testsuite/tests/th/Makefile b/testsuite/tests/th/Makefile index d10476e..031c285 100644 --- a/testsuite/tests/th/Makefile +++ b/testsuite/tests/th/Makefile @@ -36,7 +36,7 @@ TH_Depends: T8333: - '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --interactive -v0 T8333.hs < /dev/null + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --interactive -v0 -ignore-ghci-script T8333.hs < /dev/null # This was an easy way to re-use the stdout testing # to check the contents of a generated file. From git at git.haskell.org Thu May 14 22:42:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 May 2015 22:42:10 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: Rewrite type checking section to have a more concrete plan. (5972037) Message-ID: <20150514224210.29D003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59720370849c0e15f207f059e54b21e4f8e05d82/ghc >--------------------------------------------------------------- commit 59720370849c0e15f207f059e54b21e4f8e05d82 Author: Edward Z. Yang Date: Wed May 13 16:16:39 2015 -0700 Backpack docs: Rewrite type checking section to have a more concrete plan. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 59720370849c0e15f207f059e54b21e4f8e05d82 docs/backpack/algorithm.pdf | Bin 272423 -> 279771 bytes docs/backpack/algorithm.tex | 425 +++++++++++++++++++++++--------------------- 2 files changed, 225 insertions(+), 200 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 59720370849c0e15f207f059e54b21e4f8e05d82 From git at git.haskell.org Fri May 15 22:22:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 May 2015 22:22:54 +0000 (UTC) Subject: [commit: ghc] master: Failing test for #10420 using plugins. (ab45de1) Message-ID: <20150515222254.E039C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab45de12cee5af5dcb68b2afce1826ab9bf71ba0/ghc >--------------------------------------------------------------- commit ab45de12cee5af5dcb68b2afce1826ab9bf71ba0 Author: Edward Z. Yang Date: Fri May 15 14:40:37 2015 -0700 Failing test for #10420 using plugins. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- ab45de12cee5af5dcb68b2afce1826ab9bf71ba0 testsuite/.gitignore | 2 ++ testsuite/tests/plugins/Makefile | 5 ++++- testsuite/tests/plugins/Plugins07a.hs | 2 ++ testsuite/tests/plugins/all.T | 6 ++++++ testsuite/tests/plugins/plugins07.hs | 10 ++++++++++ testsuite/tests/plugins/plugins07.stdout | 1 + .../{simple-plugin => rule-defining-plugin}/LICENSE | 0 .../{simple-plugin => rule-defining-plugin}/Makefile | 2 -- .../plugins/rule-defining-plugin/RuleDefiningPlugin.hs | 8 ++++++++ .../{simple-plugin => rule-defining-plugin}/Setup.hs | 0 .../rule-defining-plugin/rule-defining-plugin.cabal | 15 +++++++++++++++ 11 files changed, 48 insertions(+), 3 deletions(-) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 422d42f..ecd0e93 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1197,6 +1197,7 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk /tests/plugins/plugins01 /tests/plugins/plugins05 /tests/plugins/plugins06 +/tests/plugins/plugins07 /tests/plugins/simple-plugin/dist/ /tests/plugins/simple-plugin/install/ /tests/plugins/simple-plugin/local.package.conf @@ -1204,6 +1205,7 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk /tests/plugins/simple-plugin/pkg.plugins02/ /tests/plugins/simple-plugin/pkg.plugins03/ /tests/plugins/simple-plugin/setup +/tests/plugins/rule-defining-plugin/pkg.plugins07/ /tests/polykinds/Freeman /tests/polykinds/MonoidsFD /tests/polykinds/MonoidsTF diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index ddbc7eb..aac3b12 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -2,9 +2,12 @@ TOP=../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: plugins01 +.PHONY: plugins01 plugins07 plugins01: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -package simple-plugin ./plugins01 +plugins07: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -package rule-defining-plugin + ./plugins07 diff --git a/testsuite/tests/plugins/Plugins07a.hs b/testsuite/tests/plugins/Plugins07a.hs new file mode 100644 index 0000000..7453a31 --- /dev/null +++ b/testsuite/tests/plugins/Plugins07a.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -fplugin RuleDefiningPlugin #-} +module Plugins07a where diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 8b2256a..e39c049 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -38,3 +38,9 @@ test('plugins06', only_ways([config.ghc_plugin_way]) ], multimod_compile_and_run, ['plugins06', '-package ghc']) +test('plugins07', + [pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.plugins07'), + clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.plugins07'), + expect_broken(10420)], + run_command, + ['$MAKE -s --no-print-directory plugins07']) diff --git a/testsuite/tests/plugins/plugins07.hs b/testsuite/tests/plugins/plugins07.hs new file mode 100644 index 0000000..78762a3 --- /dev/null +++ b/testsuite/tests/plugins/plugins07.hs @@ -0,0 +1,10 @@ +module Main where + +import Plugins07a + +import RuleDefiningPlugin + +{-# NOINLINE x #-} +x = "foo" + +main = putStrLn (show x) diff --git a/testsuite/tests/plugins/plugins07.stdout b/testsuite/tests/plugins/plugins07.stdout new file mode 100644 index 0000000..d27268d --- /dev/null +++ b/testsuite/tests/plugins/plugins07.stdout @@ -0,0 +1 @@ +SHOWED diff --git a/testsuite/tests/plugins/simple-plugin/LICENSE b/testsuite/tests/plugins/rule-defining-plugin/LICENSE similarity index 100% copy from testsuite/tests/plugins/simple-plugin/LICENSE copy to testsuite/tests/plugins/rule-defining-plugin/LICENSE diff --git a/testsuite/tests/plugins/simple-plugin/Makefile b/testsuite/tests/plugins/rule-defining-plugin/Makefile similarity index 99% copy from testsuite/tests/plugins/simple-plugin/Makefile copy to testsuite/tests/plugins/rule-defining-plugin/Makefile index eb7cc6a..7d957d0 100644 --- a/testsuite/tests/plugins/simple-plugin/Makefile +++ b/testsuite/tests/plugins/rule-defining-plugin/Makefile @@ -12,9 +12,7 @@ package.%: $(MAKE) clean.$* mkdir pkg.$* "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs - "$(GHC_PKG)" init pkg.$*/local.package.conf - pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf pkg.$*/setup build --distdir pkg.$*/dist -v0 pkg.$*/setup install --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/plugins/rule-defining-plugin/RuleDefiningPlugin.hs b/testsuite/tests/plugins/rule-defining-plugin/RuleDefiningPlugin.hs new file mode 100644 index 0000000..ad66571 --- /dev/null +++ b/testsuite/tests/plugins/rule-defining-plugin/RuleDefiningPlugin.hs @@ -0,0 +1,8 @@ +module RuleDefiningPlugin where + +import GhcPlugins + +{-# RULES "unsound" forall x. show x = "SHOWED" #-} + +plugin :: Plugin +plugin = defaultPlugin diff --git a/testsuite/tests/plugins/simple-plugin/Setup.hs b/testsuite/tests/plugins/rule-defining-plugin/Setup.hs similarity index 100% copy from testsuite/tests/plugins/simple-plugin/Setup.hs copy to testsuite/tests/plugins/rule-defining-plugin/Setup.hs diff --git a/testsuite/tests/plugins/rule-defining-plugin/rule-defining-plugin.cabal b/testsuite/tests/plugins/rule-defining-plugin/rule-defining-plugin.cabal new file mode 100644 index 0000000..b354f6b --- /dev/null +++ b/testsuite/tests/plugins/rule-defining-plugin/rule-defining-plugin.cabal @@ -0,0 +1,15 @@ +Name: rule-defining-plugin +Version: 0.1 +Synopsis: For testing +Cabal-Version: >= 1.2 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Author: Edward Z. Yang +Homepage: http://ezyang.com + +Library + Build-Depends: base, ghc + ghc-options: -O + Exposed-Modules: + RuleDefiningPlugin From git at git.haskell.org Sat May 16 19:55:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 May 2015 19:55:04 +0000 (UTC) Subject: [commit: ghc] master: Greatly speed up nativeCodeGen/seqBlocks (8e4dc8f) Message-ID: <20150516195504.A0C4B3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e4dc8fb63b8d3bfee485c1c830776f3ed704f4d/ghc >--------------------------------------------------------------- commit 8e4dc8fb63b8d3bfee485c1c830776f3ed704f4d Author: Joachim Breitner Date: Sat May 16 17:47:31 2015 +0200 Greatly speed up nativeCodeGen/seqBlocks When working on #10397, I noticed that "reorder" in nativeCodeGen/seqBlocks took more than 60% of the time. With this refactoring, it does not even show up in the profile any more. This fixes #10422. Differential Revision: https://phabricator.haskell.org/D893 >--------------------------------------------------------------- 8e4dc8fb63b8d3bfee485c1c830776f3ed704f4d compiler/nativeGen/AsmCodeGen.hs | 53 ++++++++++++++++++++++++------------- testsuite/tests/perf/compiler/all.T | 4 ++- 2 files changed, 38 insertions(+), 19 deletions(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 4080398..9c57e76 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -63,6 +63,7 @@ import UniqFM import UniqSupply import DynFlags import Util +import Unique import BasicTypes ( Alignment ) import Digraph @@ -779,25 +780,41 @@ mkNode block@(BasicBlock id instrs) = (block, id, getOutEdges instrs) seqBlocks :: BlockEnv i -> [(GenBasicBlock t1, BlockId, [BlockId])] -> [GenBasicBlock t1] -seqBlocks _ [] = [] -seqBlocks infos ((block,_,[]) : rest) - = block : seqBlocks infos rest -seqBlocks infos ((block@(BasicBlock id instrs),_,[next]) : rest) - | can_fallthrough = BasicBlock id (init instrs) : seqBlocks infos rest' - | otherwise = block : seqBlocks infos rest' +seqBlocks infos blocks = placeNext pullable0 todo0 where - can_fallthrough = not (mapMember next infos) && can_reorder - (can_reorder, rest') = reorder next [] rest - -- TODO: we should do a better job for cycles; try to maximise the - -- fallthroughs within a loop. -seqBlocks _ _ = panic "AsmCodegen:seqBlocks" - -reorder :: (Eq a) => a -> [(t, a, t1)] -> [(t, a, t1)] -> (Bool, [(t, a, t1)]) -reorder _ accum [] = (False, reverse accum) -reorder id accum (b@(block,id',out) : rest) - | id == id' = (True, (block,id,out) : reverse accum ++ rest) - | otherwise = reorder id (b:accum) rest - + -- pullable: Blocks that are not yet placed + -- todo: Original order of blocks, to be followed if we have no good + -- reason not to; + -- may include blocks that have already been placed, but then + -- these are not in pullable + pullable0 = listToUFM [ (i,(b,n)) | (b,i,n) <- blocks ] + todo0 = [i | (_,i,_) <- blocks ] + + placeNext _ [] = [] + placeNext pullable (i:rest) + | Just (block, pullable') <- lookupDeleteUFM pullable i + = place pullable' rest block + | otherwise + -- We already placed this block, so ignore + = placeNext pullable rest + + place pullable todo (block,[]) + = block : placeNext pullable todo + place pullable todo (block@(BasicBlock id instrs),[next]) + | mapMember next infos + = block : placeNext pullable todo + | Just (nextBlock, pullable') <- lookupDeleteUFM pullable next + = BasicBlock id (init instrs) : place pullable' todo nextBlock + | otherwise + = block : placeNext pullable todo + place _ _ (_,tooManyNextNodes) + = pprPanic "seqBlocks" (ppr tooManyNextNodes) + + +lookupDeleteUFM :: Uniquable key => UniqFM elt -> key -> Maybe (elt, UniqFM elt) +lookupDeleteUFM m k = do -- Maybe monad + v <- lookupUFM m k + return (v, delFromUFM m k) -- ----------------------------------------------------------------------------- -- Generate jump tables diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 6813f52..bb6ceaa 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -394,7 +394,7 @@ test('T783', # 2014-09-03: 223377364 (Windows) better specialisation, raft of core-to-core optimisations # 2014-12-22: 235002220 (Windows) not sure why - (wordsize(64), 719814352, 10)]), + (wordsize(64), 548288760, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -413,6 +413,8 @@ test('T783', # (changed order of cmm block causes analyses to allocate much more, # but the changed order is slighly better in terms of runtime, and # this test seems to be an extreme outlier.) + # 2015-05-16: 548288760 (amd64/Linux) + # (improved sequenceBlocks in nativeCodeGen, #10422) extra_hc_opts('-static') ], compile,['']) From git at git.haskell.org Sat May 16 19:55:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 May 2015 19:55:01 +0000 (UTC) Subject: [commit: ghc] master: Speed up elimCommonBlocks by grouping blocks also by outgoing labels (c256357) Message-ID: <20150516195501.D7A483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c256357242ee2dd282fd0516260edccbb7617244/ghc >--------------------------------------------------------------- commit c256357242ee2dd282fd0516260edccbb7617244 Author: Joachim Breitner Date: Sat May 16 01:22:06 2015 +0200 Speed up elimCommonBlocks by grouping blocks also by outgoing labels This is an attempt to improve the situation described in #10397, where the linear scan of possible candidates for commoning up is far too expensive. There is (ever) more room for improvement, but this is a start. Differential Revision: https://phabricator.haskell.org/D892 >--------------------------------------------------------------- c256357242ee2dd282fd0516260edccbb7617244 compiler/cmm/CmmCommonBlockElim.hs | 143 +++++++++++++++++++++++++++++-------- 1 file changed, 112 insertions(+), 31 deletions(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index 0912410..ad3c28d 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs, BangPatterns #-} module CmmCommonBlockElim ( elimCommonBlocks ) @@ -20,9 +20,8 @@ import Data.Word import qualified Data.Map as M import Outputable import UniqFM - -my_trace :: String -> SDoc -> a -> a -my_trace = if False then pprTrace else \_ _ a -> a +import Unique +import Control.Arrow (first, second) -- ----------------------------------------------------------------------------- -- Eliminate common blocks @@ -38,40 +37,72 @@ my_trace = if False then pprTrace else \_ _ a -> a -- is made redundant by the old block. -- Otherwise, it is added to the useful blocks. +-- To avoid comparing every block with every other block repeatedly, we group +-- them by +-- * a hash of the block, ignoring labels (explained below) +-- * the list of outgoing labels +-- The hash is invariant under relabeling, so we only ever compare within +-- the same group of blocks. +-- +-- The list of outgoing labels is updated as we merge blocks, and only blocks +-- that had different labels before are compared. +-- +-- All in all, two blocks should never be compared if they have different +-- hashes, and at most once otherwise. Previously, we were slower, and people +-- rightfully complained: #10397 + -- TODO: Use optimization fuel elimCommonBlocks :: CmmGraph -> CmmGraph elimCommonBlocks g = replaceLabels env $ copyTicks env g where - env = iterate hashed_blocks mapEmpty - hashed_blocks = map (\b -> (hash_block b, b)) $ postorderDfs g - --- Iterate over the blocks until convergence -iterate :: [(HashCode,CmmBlock)] -> BlockEnv BlockId -> BlockEnv BlockId -iterate blocks subst = - case foldl common_block (False, emptyUFM, subst) blocks of - (changed, _, subst) - | changed -> iterate blocks subst - | otherwise -> subst + env = iterate mapEmpty blocks_with_key + groups = groupBy hash_block (postorderDfs g) + blocks_with_key = [ [ (successors b, [b]) | b <- bs] | bs <- groups] + +-- Invariant: The blocks in the list are pairwise distinct +-- (so avoid comparing them again) +type DistinctBlocks = [CmmBlock] +type Key = [Label] +type Subst = BlockEnv BlockId + +-- The outer list groups by hash. We retain this grouping throughout. +iterate :: Subst -> [[(Key, DistinctBlocks)]] -> Subst +iterate subst blocks + | mapNull new_substs = subst + | otherwise = iterate subst' updated_blocks + where + grouped_blocks :: [[(Key, [DistinctBlocks])]] + grouped_blocks = map groupByLabel blocks -type State = (ChangeFlag, UniqFM [CmmBlock], BlockEnv BlockId) + merged_blocks :: [[(Key, DistinctBlocks)]] + (new_substs, merged_blocks) = List.mapAccumL (List.mapAccumL go) mapEmpty grouped_blocks + where + go !new_subst1 (k,dbs) = (new_subst1 `mapUnion` new_subst2, (k,db)) + where + (new_subst2, db) = mergeBlockList subst dbs -type ChangeFlag = Bool -type HashCode = Int + subst' = subst `mapUnion` new_substs + updated_blocks = map (map (first (map (lookupBid subst')))) merged_blocks --- Try to find a block that is equal (or ``common'') to b. -common_block :: State -> (HashCode, CmmBlock) -> State -common_block (old_change, bmap, subst) (hash, b) = - case lookupUFM bmap hash of - Just bs -> case (List.find (eqBlockBodyWith (eqBid subst) b) bs, - mapLookup bid subst) of - (Just b', Nothing) -> addSubst b' - (Just b', Just b'') | entryLabel b' /= b'' -> addSubst b' - | otherwise -> (old_change, bmap, subst) - _ -> (old_change, addToUFM bmap hash (b : bs), subst) - Nothing -> (old_change, addToUFM bmap hash [b], subst) - where bid = entryLabel b - addSubst b' = my_trace "found new common block" (ppr bid <> char '=' <> ppr (entryLabel b')) $ - (True, bmap, mapInsert bid (entryLabel b') subst) +mergeBlocks :: Subst -> DistinctBlocks -> DistinctBlocks -> (Subst, DistinctBlocks) +mergeBlocks subst existing new = go new + where + go [] = (mapEmpty, existing) + go (b:bs) = case List.find (eqBlockBodyWith (eqBid subst) b) existing of + -- This block is a duplicate. Drop it, and add it to the substitution + Just b' -> first (mapInsert (entryLabel b) (entryLabel b')) $ go bs + -- This block is not a duplicate, keep it. + Nothing -> second (b:) $ go bs + +mergeBlockList :: Subst -> [DistinctBlocks] -> (Subst, DistinctBlocks) +mergeBlockList _ [] = pprPanic "mergeBlockList" empty +mergeBlockList subst (b:bs) = go mapEmpty b bs + where + go !new_subst1 b [] = (new_subst1, b) + go !new_subst1 b1 (b2:bs) = go new_subst b bs + where + (new_subst2, b) = mergeBlocks subst b1 b2 + new_subst = new_subst1 `mapUnion` new_subst2 -- ----------------------------------------------------------------------------- @@ -83,6 +114,9 @@ common_block (old_change, bmap, subst) (hash, b) = -- To speed up comparisons, we hash each basic block modulo labels. -- The hashing is a bit arbitrary (the numbers are completely arbitrary), -- but it should be fast and good enough. + +type HashCode = Int + hash_block :: CmmBlock -> HashCode hash_block block = fromIntegral (foldBlockNodesB3 (hash_fst, hash_mid, hash_lst) block (0 :: Word32) .&. (0x7fffffff :: Word32)) @@ -235,3 +269,50 @@ copyTicks env g (CmmEntry lbl scp1, code) = blockSplitHead to in CmmEntry lbl (combineTickScopes scp0 scp1) `blockJoinHead` foldr blockCons code (map CmmTick ticks) + +-- Group by [Label] +groupByLabel :: [(Key, a)] -> [(Key, [a])] +groupByLabel = go emptyILM + where + go !m [] = elemsILM m + go !m ((k,v) : entries) = go (alterILM adjust m k') entries + where k' = map getUnique k + adjust Nothing = Just (k,[v]) + adjust (Just (_,vs)) = Just (k,v:vs) + +groupBy :: (a -> Int) -> [a] -> [[a]] +groupBy f xs = eltsUFM $ List.foldl' go emptyUFM xs + where go m x = alterUFM (Just . maybe [x] (x:)) m (f x) + +-- Efficient lookup into [([Unique], a)] +data IntListMap a = ILM (Maybe a) (UniqFM (IntListMap a)) + +emptyILM :: IntListMap a +emptyILM = ILM Nothing emptyUFM + +unitILM :: [Unique] -> a -> IntListMap a +unitILM [] a = ILM (Just a) emptyUFM +unitILM (l:ls) a = ILM Nothing (unitUFM l (unitILM ls a)) + + +alterILM :: (Maybe a -> Maybe a) -> IntListMap a -> [Unique] -> IntListMap a +alterILM f (ILM ma m) [] = ILM (f ma) m +alterILM f (ILM ma m) (l:ls) = ILM ma (alterUFM go m l) + where go Nothing = fmap (unitILM ls) (f Nothing) + go (Just ilm) = Just $ alterILM f ilm ls + +{- currently unused +addToILM :: IntListMap a -> [Unique] -> a -> IntListMap a +addToILM (ILM _ m) [] a = ILM (Just a) m +addToILM (ILM ma m) (l:ls) a = ILM ma $ alterUFM go m l + where go Nothing = Just $ unitILM ls a + go (Just ilm) = Just $ addToILM ilm ls a + +lookupILM :: IntListMap a -> [Unique] -> Maybe a +lookupILM (ILM ma _) [] = ma +lookupILM (ILM _ m) (l:ls) = lookupUFM m l >>= (\m -> lookupILM m ls) +-} + +elemsILM :: IntListMap a -> [a] +elemsILM (ILM ma m) = maybe id (:) ma $ concatMap elemsILM $ eltsUFM m + From git at git.haskell.org Mon May 18 11:12:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 11:12:14 +0000 (UTC) Subject: [commit: ghc] master: CmmCommonBlockElim: Improve hash function (73f836f) Message-ID: <20150518111214.609633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/73f836f5d57a3106029b573c42f83d2039d21d89/ghc >--------------------------------------------------------------- commit 73f836f5d57a3106029b573c42f83d2039d21d89 Author: Joachim Breitner Date: Mon May 18 10:39:54 2015 +0200 CmmCommonBlockElim: Improve hash function Previously, the hash function used to cut down the number of block comparisons did not take local registers into account, causing far too many similar, but different bocks to be considered candidates for the (expensive!) comparision. Adding register to the hash takes CmmCommonBlockElim's share of the runtime of the example in #10397 from 17% to 2.5%, and eliminates all unwanted hash collisions. This patch also replaces the fancy trie by a plain Data.Map. It turned out to be not performance critical, so this simplifies the code. Differential Revision: https://phabricator.haskell.org/D896 >--------------------------------------------------------------- 73f836f5d57a3106029b573c42f83d2039d21d89 compiler/cmm/CmmCommonBlockElim.hs | 71 ++++++++++++++------------------------ 1 file changed, 26 insertions(+), 45 deletions(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index ad3c28d..8c82fce 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -10,6 +10,7 @@ import Cmm import CmmUtils import CmmSwitch (eqSwitchTargetWith) import CmmContFlowOpt +-- import PprCmm () import Prelude hiding (iterate, succ, unzip, zip) import Hoopl hiding (ChangeFlag) @@ -44,8 +45,8 @@ import Control.Arrow (first, second) -- The hash is invariant under relabeling, so we only ever compare within -- the same group of blocks. -- --- The list of outgoing labels is updated as we merge blocks, and only blocks --- that had different labels before are compared. +-- The list of outgoing labels is updated as we merge blocks (that is why they +-- are not included in the hash, which we want to calculate only once). -- -- All in all, two blocks should never be compared if they have different -- hashes, and at most once otherwise. Previously, we were slower, and people @@ -56,7 +57,7 @@ elimCommonBlocks :: CmmGraph -> CmmGraph elimCommonBlocks g = replaceLabels env $ copyTicks env g where env = iterate mapEmpty blocks_with_key - groups = groupBy hash_block (postorderDfs g) + groups = groupByInt hash_block (postorderDfs g) blocks_with_key = [ [ (successors b, [b]) | b <- bs] | bs <- groups] -- Invariant: The blocks in the list are pairwise distinct @@ -111,10 +112,14 @@ mergeBlockList subst (b:bs) = go mapEmpty b bs -- Below here is mostly boilerplate: hashing blocks ignoring labels, -- and comparing blocks modulo a label mapping. --- To speed up comparisons, we hash each basic block modulo labels. +-- To speed up comparisons, we hash each basic block modulo jump labels. -- The hashing is a bit arbitrary (the numbers are completely arbitrary), -- but it should be fast and good enough. +-- We want to get as many small buckets as possible, as comparing blocks is +-- expensive. So include as much as possible in the hash. Ideally everything +-- that is compared with (==) in eqBlockBodyWith. + type HashCode = Int hash_block :: CmmBlock -> HashCode @@ -139,7 +144,7 @@ hash_block block = hash_node _ = error "hash_node: unknown Cmm node!" hash_reg :: CmmReg -> Word32 - hash_reg (CmmLocal _) = 117 + hash_reg (CmmLocal localReg) = hash_unique localReg -- important for performance, see #10397 hash_reg (CmmGlobal _) = 19 hash_e :: CmmExpr -> Word32 @@ -167,6 +172,9 @@ hash_block block = cvt = fromInteger . toInteger + hash_unique :: Uniquable a => a -> Word32 + hash_unique = cvt . getKey . getUnique + -- | Ignore these node types for equality dont_care :: CmmNode O x -> Bool dont_care CmmComment {} = True @@ -223,13 +231,18 @@ eqExprWith eqBid = eq -- IDs to block IDs. eqBlockBodyWith :: (BlockId -> BlockId -> Bool) -> CmmBlock -> CmmBlock -> Bool eqBlockBodyWith eqBid block block' - = and (zipWith (eqMiddleWith eqBid) nodes nodes') && - eqLastWith eqBid l l' + {- + | equal = pprTrace "equal" (vcat [ppr block, ppr block']) True + | otherwise = pprTrace "not equal" (vcat [ppr block, ppr block']) False + -} + = equal where (_,m,l) = blockSplit block nodes = filter (not . dont_care) (blockToList m) (_,m',l') = blockSplit block' nodes' = filter (not . dont_care) (blockToList m') + equal = and (zipWith (eqMiddleWith eqBid) nodes nodes') && + eqLastWith eqBid l l' eqLastWith :: (BlockId -> BlockId -> Bool) -> CmmNode O C -> CmmNode O C -> Bool @@ -272,47 +285,15 @@ copyTicks env g -- Group by [Label] groupByLabel :: [(Key, a)] -> [(Key, [a])] -groupByLabel = go emptyILM +groupByLabel = go M.empty where - go !m [] = elemsILM m - go !m ((k,v) : entries) = go (alterILM adjust m k') entries + go !m [] = M.elems m + go !m ((k,v) : entries) = go (M.alter adjust k' m) entries where k' = map getUnique k adjust Nothing = Just (k,[v]) adjust (Just (_,vs)) = Just (k,v:vs) -groupBy :: (a -> Int) -> [a] -> [[a]] -groupBy f xs = eltsUFM $ List.foldl' go emptyUFM xs - where go m x = alterUFM (Just . maybe [x] (x:)) m (f x) - --- Efficient lookup into [([Unique], a)] -data IntListMap a = ILM (Maybe a) (UniqFM (IntListMap a)) - -emptyILM :: IntListMap a -emptyILM = ILM Nothing emptyUFM - -unitILM :: [Unique] -> a -> IntListMap a -unitILM [] a = ILM (Just a) emptyUFM -unitILM (l:ls) a = ILM Nothing (unitUFM l (unitILM ls a)) - - -alterILM :: (Maybe a -> Maybe a) -> IntListMap a -> [Unique] -> IntListMap a -alterILM f (ILM ma m) [] = ILM (f ma) m -alterILM f (ILM ma m) (l:ls) = ILM ma (alterUFM go m l) - where go Nothing = fmap (unitILM ls) (f Nothing) - go (Just ilm) = Just $ alterILM f ilm ls - -{- currently unused -addToILM :: IntListMap a -> [Unique] -> a -> IntListMap a -addToILM (ILM _ m) [] a = ILM (Just a) m -addToILM (ILM ma m) (l:ls) a = ILM ma $ alterUFM go m l - where go Nothing = Just $ unitILM ls a - go (Just ilm) = Just $ addToILM ilm ls a - -lookupILM :: IntListMap a -> [Unique] -> Maybe a -lookupILM (ILM ma _) [] = ma -lookupILM (ILM _ m) (l:ls) = lookupUFM m l >>= (\m -> lookupILM m ls) --} - -elemsILM :: IntListMap a -> [a] -elemsILM (ILM ma m) = maybe id (:) ma $ concatMap elemsILM $ eltsUFM m +groupByInt :: (a -> Int) -> [a] -> [[a]] +groupByInt f xs = eltsUFM $ List.foldl' go emptyUFM xs + where go m x = alterUFM (Just . maybe [x] (x:)) m (f x) From git at git.haskell.org Mon May 18 12:45:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 12:45:22 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10359 (3f42de5) Message-ID: <20150518124522.6022A3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3f42de51ab2de697089917ee71feec9a7333dd0d/ghc >--------------------------------------------------------------- commit 3f42de51ab2de697089917ee71feec9a7333dd0d Author: Simon Peyton Jones Date: Wed May 13 17:23:06 2015 +0100 Test Trac #10359 >--------------------------------------------------------------- 3f42de51ab2de697089917ee71feec9a7333dd0d testsuite/tests/perf/should_run/T10359.hs | 125 ++++++++++++++++++++++++++ testsuite/tests/perf/should_run/T10359.stdout | 1 + testsuite/tests/perf/should_run/all.T | 10 ++- 3 files changed, 135 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/should_run/T10359.hs b/testsuite/tests/perf/should_run/T10359.hs new file mode 100644 index 0000000..fa10560 --- /dev/null +++ b/testsuite/tests/perf/should_run/T10359.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ConstraintKinds #-} + +module Main( main, boo ) where + +import Prelude hiding (repeat) + +boo xs f = (\x -> f x, xs) + +repeat :: Int -> (a -> a) -> a -> a +repeat 1 f x = f x +repeat n f x = n `seq` x `seq` repeat (n-1) f $ f x + +---- Buggy version +------------------ + +type Numerical a = (Fractional a, Real a) + +data Box a = Box + { func :: forall dum. (Numerical dum) => dum -> a -> a + , obj :: !a } + +do_step :: (Numerical num) => num -> Box a -> Box a +do_step number Box{..} = Box{ obj = func number obj, .. } + +start :: Box Double +start = Box { func = \x y -> realToFrac x + y + , obj = 0 } + +test :: Int -> IO () +test steps = putStrLn $ show $ obj $ repeat steps (do_step 1) start + +---- Driver +----------- + +main :: IO () +main = test 2000 -- compare test2 10000000 or test3 10000000, but test4 20000 + + +{- +---- No tuple constraint synonym is better +------------------------------------------ + +data Box2 a = Box2 + { func2 :: forall num. (Fractional num, Real num) => num -> a -> a + , obj2 :: !a } + +do_step2 :: (Fractional num, Real num) => num -> Box2 a -> Box2 a +do_step2 number Box2{..} = Box2{ obj2 = func2 number obj2, ..} + +start2 :: Box2 Double +start2 = Box2 { func2 = \x y -> realToFrac x + y + , obj2 = 0 } + +test2 :: Int -> IO () +test2 steps = putStrLn $ show $ obj2 $ repeat steps (do_step2 1) start2 + +---- Not copying the function field works too +--------------------------------------------- + +do_step3 :: (Numerical num) => num -> Box a -> Box a +do_step3 number b at Box{..} = b{ obj = func number obj } + +test3 :: Int -> IO () +test3 steps = putStrLn $ show $ obj $ repeat steps (do_step3 1) start + +---- But record wildcards are not at fault +------------------------------------------ + +do_step4 :: (Numerical num) => num -> Box a -> Box a +do_step4 number Box{func = f, obj = x} = Box{ obj = f number x, func = f } + +test4 :: Int -> IO () +test4 steps = putStrLn $ show $ obj $ repeat steps (do_step4 1) start +-} + + +{- +First of all, very nice example. Thank you for making it so small and easy to work with. + +I can see what's happening. The key part is what happens here: +{{{ +do_step4 :: (Numerical num) => num -> Box a -> Box a +do_step4 number Box{ func = f, obj = x} + = Box{ func = f, obj = f number x } +}}} +After elaboration (ie making dictionaries explicit) we get this: +{{{ +do_step4 dn1 number (Box {func = f, obj = x }) + = Box { func = \dn2 -> f ( case dn2 of (f,r) -> f + , case dn2 of (f,r) -> r) + , obj = f dn1 number x } +}}} +That's odd! We expected this: +{{{ +do_step4 dn1 number (Box {func = f, obj = x }) + = Box { func = f + , obj = f dn1 number x } +}}} +And indeed, the allocation of all those `\dn2` closures is what is causing the problem. +So we are missing this optimisation: +{{{ + (case dn2 of (f,r) -> f, case dn2 of (f,r) -> r) +===> + dn2 +}}} +If we did this, then the lambda would look like `\dn2 -> f dn2` which could eta-reduce to `f`. +But there are at least three problems: + * The tuple transformation above is hard to spot + * The tuple transformation is not quite semantically right; if `dn2` was bottom, the LHS and RHS are different + * The eta-reduction isn't quite semantically right: if `f` ws bottom, the LHS and RHS are different. + +You might argue that the latter two can be ignored because dictionary arguments are special; +indeed we often toy with making them strict. + +But perhaps a better way to avoid the tuple-transformation issue would be not to construct that strange expression in the first place. Where is it coming from? It comes from the call to `f` (admittedly applied to no arguments) in `Box { ..., func = f }`. GHC needs a dictionary for `(Numerical dum)` (I changed the name of the type variable in `func`'s type in the definition of `Box`). Since it's just a pair GHC says "fine, I'll build a pair, out of `Fractional dum` and `Real dum`. How does it get those dictionaries? By selecting the components of the `Franctional dum` passed to `f`. + +If GHC said instead "I need `Numerical dum` and behold I have one in hand, it'd be much better. It doesn't because tuple constraints are treated specially. But if we adopted the idea in #10362, we would (automatically) get to re-use the `Numerical dum` constraint. That would leave us with eta reduction, which is easier. + +As to what will get you rolling, a good solution is `test3`, which saves instantiating and re-generalising `f`. The key thing is to update all the fields ''except'' the polymorphic `func` field. I'm surprised you say that it doesn't work. Can you give a (presumably more complicated) example to demonstrate? Maybe there's a separate bug! + +-} + + diff --git a/testsuite/tests/perf/should_run/T10359.stdout b/testsuite/tests/perf/should_run/T10359.stdout new file mode 100644 index 0000000..f6f4e07 --- /dev/null +++ b/testsuite/tests/perf/should_run/T10359.stdout @@ -0,0 +1 @@ +2000.0 diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index f680104..c95dfa0 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -1,8 +1,16 @@ # Tests that newArray/newArray_ is being optimised correctly +test('T10359', + [stats_num_field('bytes allocated', + [(wordsize(64), 499512, 5), + (wordsize(32), 250000, 5)]), + only_ways(['normal']) + ], + compile_and_run, + ['-O']) + # fortunately the values here are mostly independent of the wordsize, # because the test allocates an unboxed array of doubles. - test('T3586', [stats_num_field('peak_megabytes_allocated', (17, 1)), # expected value: 17 (amd64/Linux) From git at git.haskell.org Mon May 18 12:45:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 12:45:25 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10403 (f1f265d) Message-ID: <20150518124525.8ED003A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f1f265df0742b7214f3b909190f5a171819392b5/ghc >--------------------------------------------------------------- commit f1f265df0742b7214f3b909190f5a171819392b5 Author: Simon Peyton Jones Date: Wed May 13 17:17:22 2015 +0100 Test Trac #10403 >--------------------------------------------------------------- f1f265df0742b7214f3b909190f5a171819392b5 testsuite/tests/partial-sigs/should_compile/T10403.hs | 19 +++++++++++++++++++ .../tests/partial-sigs/should_compile/T10403.stderr | 17 +++++++++++++++++ testsuite/tests/partial-sigs/should_compile/all.T | 1 + 3 files changed, 37 insertions(+) diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.hs b/testsuite/tests/partial-sigs/should_compile/T10403.hs new file mode 100644 index 0000000..a33646d --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T10403.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE PartialTypeSignatures #-} +module T10403 where + +data I a = I a +instance Functor I where + fmap f (I a) = I (f a) + +newtype B t a = B a +instance Functor (B t) where + fmap f (B a) = B (f a) + +newtype H f = H (f ()) + +app :: H (B t) +app = h (H . I) (B ()) + +h :: _ => _ +--h :: Functor m => (a -> b) -> m a -> H m +h f b = (H . fmap (const ())) (fmap f b) diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr new file mode 100644 index 0000000..6b0660d --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr @@ -0,0 +1,17 @@ + +T10403.hs:17:6: warning: + Found hole ?_? with inferred constraints: Functor f + In the type signature for ?h?: _ => _ + +T10403.hs:17:11: warning: + Found hole ?_? with type: (a -> b) -> f a -> H f + Where: ?f? is a rigid type variable bound by + the inferred type of h :: Functor f => (a -> b) -> f a -> H f + at T10403.hs:19:1 + ?b? is a rigid type variable bound by + the inferred type of h :: Functor f => (a -> b) -> f a -> H f + at T10403.hs:19:1 + ?a? is a rigid type variable bound by + the inferred type of h :: Functor f => (a -> b) -> f a -> H f + at T10403.hs:19:1 + In the type signature for ?h?: _ => _ diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index e83e070..91294a5 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -46,3 +46,4 @@ test('SomethingShowable', normal, compile, ['-ddump-types -fno-warn-partial-type test('Uncurry', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('UncurryNamed', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('WarningWildcardInstantiations', normal, compile, ['-ddump-types']) +test('T10403', normal, compile, ['']) From git at git.haskell.org Mon May 18 12:45:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 12:45:28 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10248 (fa0bdd3) Message-ID: <20150518124528.AEADD3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa0bdd3d6e1fa7bca044ee13b84f6aeeacbe50e2/ghc >--------------------------------------------------------------- commit fa0bdd3d6e1fa7bca044ee13b84f6aeeacbe50e2 Author: Simon Peyton Jones Date: Wed May 13 17:11:46 2015 +0100 Test Trac #10248 >--------------------------------------------------------------- fa0bdd3d6e1fa7bca044ee13b84f6aeeacbe50e2 testsuite/tests/ghci/scripts/T10248.script | 2 ++ testsuite/tests/ghci/scripts/T10248.stderr | 18 ++++++++++++++++++ testsuite/tests/ghci/scripts/all.T | 1 + 3 files changed, 21 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T10248.script b/testsuite/tests/ghci/scripts/T10248.script new file mode 100644 index 0000000..6614044 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10248.script @@ -0,0 +1,2 @@ +:set -fdefer-type-errors +Just <$> _ diff --git a/testsuite/tests/ghci/scripts/T10248.stderr b/testsuite/tests/ghci/scripts/T10248.stderr new file mode 100644 index 0000000..1245b99 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10248.stderr @@ -0,0 +1,18 @@ + +:3:10: warning: + Found hole ?_? with type: IO () + In the second argument of ?(<$>)?, namely ?_? + In the first argument of ?ghciStepIO :: + IO a_alT -> IO a_alT?, namely + ?Just <$> _? + In a stmt of an interactive GHCi command: + it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _) +*** Exception: :3:10: error: + Found hole ?_? with type: IO () + In the second argument of ?(<$>)?, namely ?_? + In the first argument of ?ghciStepIO :: + IO a_alT -> IO a_alT?, namely + ?Just <$> _? + In a stmt of an interactive GHCi command: + it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _) +(deferred type error) diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 1582344..85ba5af 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -216,3 +216,4 @@ test('T10408A', normal, run_command, ['$MAKE -s --no-print-directory T10408A']) test('T10408B', normal, run_command, ['$MAKE -s --no-print-directory T10408B']) +test('T10248', normal, ghci_script, ['T10248.script']) From git at git.haskell.org Mon May 18 12:45:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 12:45:31 +0000 (UTC) Subject: [commit: ghc] master: Delete commented-out line (76024fd) Message-ID: <20150518124531.63E043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/76024fdbad0f6daedd8757b974eace3314bd4eec/ghc >--------------------------------------------------------------- commit 76024fdbad0f6daedd8757b974eace3314bd4eec Author: Simon Peyton Jones Date: Mon May 11 23:00:45 2015 +0100 Delete commented-out line >--------------------------------------------------------------- 76024fdbad0f6daedd8757b974eace3314bd4eec compiler/main/StaticFlags.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 914a145..e2876a4 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -43,7 +43,6 @@ import CmdLineParser import FastString import SrcLoc import Util --- import Maybes ( firstJusts ) import Panic import Control.Monad From git at git.haskell.org Mon May 18 12:45:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 12:45:35 +0000 (UTC) Subject: [commit: ghc] master: Refactor tuple constraints (ffc2150) Message-ID: <20150518124535.0FF013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ffc21506894c7887d3620423aaf86bc6113a1071/ghc >--------------------------------------------------------------- commit ffc21506894c7887d3620423aaf86bc6113a1071 Author: Simon Peyton Jones Date: Mon May 11 23:19:14 2015 +0100 Refactor tuple constraints Make tuple constraints be handled by a perfectly ordinary type class, with the component constraints being the superclasses: class (c1, c2) => (c2, c2) This change was provoked by #10359 inability to re-use a given tuple constraint as a whole #9858 confusion between term tuples and constraint tuples but it's generally a very nice simplification. We get rid of - In Type, the TuplePred constructor of PredTree, and all the code that dealt with TuplePreds - In TcEvidence, the constructors EvTupleMk, EvTupleSel See Note [How tuples work] in TysWiredIn. Of course, nothing is ever entirely simple. This one proved quite fiddly. - I did quite a bit of renaming, which makes this patch touch a lot of modules. In partiuclar tupleCon -> tupleDataCon. - I made constraint tuples known-key rather than wired-in. This is different to boxed/unboxed tuples, but it proved awkward to have all the superclass selectors wired-in. Easier just to use the standard mechanims. - While I was fiddling with known-key names, I split the TH Name definitions out of DsMeta into a new module THNames. That meant that the known-key names can all be gathered in PrelInfo, without causing module loops. - I found that the parser was parsing an import item like T( .. ) as a *data constructor* T, and then using setRdrNameSpace to fix it. Stupid! So I changed the parser to parse a *type constructor* T, which means less use of setRdrNameSpace. I also improved setRdrNameSpace to behave better on Exact Names. Largely on priciple; I don't think it matters a lot. - When compiling a data type declaration for a wired-in thing like tuples (,), or lists, we don't really need to look at the declaration. We have the wired-in thing! And not doing so avoids having to line up the uniques for data constructor workers etc. See Note [Declarations for wired-in things] - I found that FunDeps.oclose wasn't taking superclasses into account; easily fixed. - Some error message refactoring for invalid constraints in TcValidity - Haddock needs to absorb the change too; so there is a submodule update >--------------------------------------------------------------- ffc21506894c7887d3620423aaf86bc6113a1071 compiler/basicTypes/BasicTypes.hs | 21 +- compiler/basicTypes/DataCon.hs | 1 - compiler/basicTypes/RdrName.hs | 28 +- compiler/basicTypes/Unique.hs | 28 +- compiler/basicTypes/VarSet.hs | 23 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/coreSyn/MkCore.hs | 7 +- compiler/coreSyn/PprCore.hs | 4 +- compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsArrows.hs | 2 +- compiler/deSugar/DsBinds.hs | 25 +- compiler/deSugar/DsCCall.hs | 6 +- compiler/deSugar/DsExpr.hs | 5 +- compiler/deSugar/DsMeta.hs | 840 +-------------------- compiler/deSugar/Match.hs | 4 +- compiler/ghc.cabal.in | 3 +- compiler/ghci/RtClosureInspect.hs | 7 +- compiler/hsSyn/Convert.hs | 4 +- compiler/hsSyn/HsExpr.hs | 3 +- compiler/hsSyn/HsPat.hs | 35 +- compiler/hsSyn/HsTypes.hs | 2 +- compiler/iface/BinIface.hs | 14 +- compiler/iface/BuildTyCl.hs | 4 + compiler/iface/IfaceSyn.hs | 9 +- compiler/iface/IfaceType.hs | 154 ++-- compiler/iface/TcIface.hs | 84 ++- compiler/main/Constants.hs | 3 + compiler/main/HscMain.hs | 11 +- compiler/parser/Parser.y | 20 +- compiler/parser/RdrHsSyn.hs | 164 +++- compiler/prelude/PrelInfo.hs | 28 +- compiler/prelude/PrelNames.hs | 17 - compiler/prelude/PrelRules.hs | 6 +- compiler/prelude/PrimOp.hs | 2 +- compiler/prelude/THNames.hs | 836 ++++++++++++++++++++ compiler/prelude/TysWiredIn.hs | 269 ++++--- compiler/rename/RnEnv.hs | 1 + compiler/rename/RnNames.hs | 42 +- compiler/rename/RnSplice.hs | 6 +- compiler/simplStg/UnariseStg.hs | 10 +- compiler/specialise/Specialise.hs | 3 +- compiler/stranal/WwLib.hs | 6 +- compiler/typecheck/FunDeps.hs | 32 +- compiler/typecheck/TcBinds.hs | 52 +- compiler/typecheck/TcCanonical.hs | 32 - compiler/typecheck/TcErrors.hs | 2 - compiler/typecheck/TcEvidence.hs | 15 +- compiler/typecheck/TcExpr.hs | 10 +- compiler/typecheck/TcGenDeriv.hs | 15 +- compiler/typecheck/TcHsSyn.hs | 5 +- compiler/typecheck/TcHsType.hs | 15 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcInteract.hs | 11 +- compiler/typecheck/TcMType.hs | 1 - compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcRnMonad.hs | 4 + compiler/typecheck/TcSimplify.hs | 1 - compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 20 +- compiler/typecheck/TcType.hs | 3 - compiler/typecheck/TcValidity.hs | 186 +++-- compiler/types/TyCon.hs | 34 +- compiler/types/Type.hs | 7 +- compiler/types/TypeRep.hs | 11 +- compiler/vectorise/Vectorise/Builtins/Base.hs | 2 +- .../vectorise/Vectorise/Builtins/Initialise.hs | 2 +- compiler/vectorise/Vectorise/Utils/Closure.hs | 4 +- libraries/ghc-prim/GHC/Classes.hs | 44 +- libraries/ghc-prim/GHC/Tuple.hs | 242 +++--- libraries/ghc-prim/GHC/Types.hs | 2 +- .../should_fail/NotRelaxedExamples.stderr | 17 +- .../indexed-types/should_fail/TyFamUndec.stderr | 17 +- testsuite/tests/module/all.T | 2 +- testsuite/tests/module/mod89.hs | 2 + testsuite/tests/module/mod89.stderr | 10 +- .../tests/typecheck/should_fail/T9858a.stderr | 2 +- .../tests/typecheck/should_fail/fd-loop.stderr | 12 +- .../tests/typecheck/should_fail/tcfail108.stderr | 4 +- .../tests/typecheck/should_fail/tcfail154.stderr | 6 +- .../tests/typecheck/should_fail/tcfail157.stderr | 12 +- .../tests/typecheck/should_fail/tcfail213.stderr | 4 +- .../tests/typecheck/should_fail/tcfail214.stderr | 8 +- .../tests/typecheck/should_fail/tcfail220.hsig | 1 - .../tests/typecheck/should_fail/tcfail220.stderr | 8 - utils/genprimopcode/Main.hs | 49 +- utils/haddock | 2 +- 86 files changed, 1985 insertions(+), 1672 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 ffc21506894c7887d3620423aaf86bc6113a1071 From git at git.haskell.org Mon May 18 12:45:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 12:45:37 +0000 (UTC) Subject: [commit: ghc] master: Make the "matchable-given" check happen first (228ddb9) Message-ID: <20150518124537.B89A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/228ddb95ee137e7cef02dcfe2521233892dd61e0/ghc >--------------------------------------------------------------- commit 228ddb95ee137e7cef02dcfe2521233892dd61e0 Author: Simon Peyton Jones Date: Wed May 13 12:49:13 2015 +0100 Make the "matchable-given" check happen first This change makes the matchable-given check apply uniformly to - constraint tuples - natural numbers - Typeable as well as to vanilla class constraints. See Note [Instance and Given overlap] in TcInteract >--------------------------------------------------------------- 228ddb95ee137e7cef02dcfe2521233892dd61e0 compiler/typecheck/TcInteract.hs | 113 +++++++++++++++++++++------------------ 1 file changed, 60 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 228ddb95ee137e7cef02dcfe2521233892dd61e0 From git at git.haskell.org Mon May 18 13:37:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 13:37:43 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Speed up elimCommonBlocks by grouping blocks also by outgoing labels (bac8717) Message-ID: <20150518133743.40DF33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/bac8717c68ef4907908f80b23dc9dd9e88dfa987/ghc >--------------------------------------------------------------- commit bac8717c68ef4907908f80b23dc9dd9e88dfa987 Author: Joachim Breitner Date: Sat May 16 01:22:06 2015 +0200 Speed up elimCommonBlocks by grouping blocks also by outgoing labels This is an attempt to improve the situation described in #10397, where the linear scan of possible candidates for commoning up is far too expensive. There is (ever) more room for improvement, but this is a start. Differential Revision: https://phabricator.haskell.org/D892 (cherry picked from commit c256357242ee2dd282fd0516260edccbb7617244) >--------------------------------------------------------------- bac8717c68ef4907908f80b23dc9dd9e88dfa987 compiler/cmm/CmmCommonBlockElim.hs | 143 +++++++++++++++++++++++++++++-------- 1 file changed, 112 insertions(+), 31 deletions(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index 95910d1..83b2841 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs, BangPatterns #-} module CmmCommonBlockElim ( elimCommonBlocks ) @@ -19,9 +19,8 @@ import Data.Word import qualified Data.Map as M import Outputable import UniqFM - -my_trace :: String -> SDoc -> a -> a -my_trace = if False then pprTrace else \_ _ a -> a +import Unique +import Control.Arrow (first, second) -- ----------------------------------------------------------------------------- -- Eliminate common blocks @@ -37,40 +36,72 @@ my_trace = if False then pprTrace else \_ _ a -> a -- is made redundant by the old block. -- Otherwise, it is added to the useful blocks. +-- To avoid comparing every block with every other block repeatedly, we group +-- them by +-- * a hash of the block, ignoring labels (explained below) +-- * the list of outgoing labels +-- The hash is invariant under relabeling, so we only ever compare within +-- the same group of blocks. +-- +-- The list of outgoing labels is updated as we merge blocks, and only blocks +-- that had different labels before are compared. +-- +-- All in all, two blocks should never be compared if they have different +-- hashes, and at most once otherwise. Previously, we were slower, and people +-- rightfully complained: #10397 + -- TODO: Use optimization fuel elimCommonBlocks :: CmmGraph -> CmmGraph elimCommonBlocks g = replaceLabels env $ copyTicks env g where - env = iterate hashed_blocks mapEmpty - hashed_blocks = map (\b -> (hash_block b, b)) $ postorderDfs g - --- Iterate over the blocks until convergence -iterate :: [(HashCode,CmmBlock)] -> BlockEnv BlockId -> BlockEnv BlockId -iterate blocks subst = - case foldl common_block (False, emptyUFM, subst) blocks of - (changed, _, subst) - | changed -> iterate blocks subst - | otherwise -> subst + env = iterate mapEmpty blocks_with_key + groups = groupBy hash_block (postorderDfs g) + blocks_with_key = [ [ (successors b, [b]) | b <- bs] | bs <- groups] + +-- Invariant: The blocks in the list are pairwise distinct +-- (so avoid comparing them again) +type DistinctBlocks = [CmmBlock] +type Key = [Label] +type Subst = BlockEnv BlockId + +-- The outer list groups by hash. We retain this grouping throughout. +iterate :: Subst -> [[(Key, DistinctBlocks)]] -> Subst +iterate subst blocks + | mapNull new_substs = subst + | otherwise = iterate subst' updated_blocks + where + grouped_blocks :: [[(Key, [DistinctBlocks])]] + grouped_blocks = map groupByLabel blocks -type State = (ChangeFlag, UniqFM [CmmBlock], BlockEnv BlockId) + merged_blocks :: [[(Key, DistinctBlocks)]] + (new_substs, merged_blocks) = List.mapAccumL (List.mapAccumL go) mapEmpty grouped_blocks + where + go !new_subst1 (k,dbs) = (new_subst1 `mapUnion` new_subst2, (k,db)) + where + (new_subst2, db) = mergeBlockList subst dbs -type ChangeFlag = Bool -type HashCode = Int + subst' = subst `mapUnion` new_substs + updated_blocks = map (map (first (map (lookupBid subst')))) merged_blocks --- Try to find a block that is equal (or ``common'') to b. -common_block :: State -> (HashCode, CmmBlock) -> State -common_block (old_change, bmap, subst) (hash, b) = - case lookupUFM bmap hash of - Just bs -> case (List.find (eqBlockBodyWith (eqBid subst) b) bs, - mapLookup bid subst) of - (Just b', Nothing) -> addSubst b' - (Just b', Just b'') | entryLabel b' /= b'' -> addSubst b' - | otherwise -> (old_change, bmap, subst) - _ -> (old_change, addToUFM bmap hash (b : bs), subst) - Nothing -> (old_change, addToUFM bmap hash [b], subst) - where bid = entryLabel b - addSubst b' = my_trace "found new common block" (ppr bid <> char '=' <> ppr (entryLabel b')) $ - (True, bmap, mapInsert bid (entryLabel b') subst) +mergeBlocks :: Subst -> DistinctBlocks -> DistinctBlocks -> (Subst, DistinctBlocks) +mergeBlocks subst existing new = go new + where + go [] = (mapEmpty, existing) + go (b:bs) = case List.find (eqBlockBodyWith (eqBid subst) b) existing of + -- This block is a duplicate. Drop it, and add it to the substitution + Just b' -> first (mapInsert (entryLabel b) (entryLabel b')) $ go bs + -- This block is not a duplicate, keep it. + Nothing -> second (b:) $ go bs + +mergeBlockList :: Subst -> [DistinctBlocks] -> (Subst, DistinctBlocks) +mergeBlockList _ [] = pprPanic "mergeBlockList" empty +mergeBlockList subst (b:bs) = go mapEmpty b bs + where + go !new_subst1 b [] = (new_subst1, b) + go !new_subst1 b1 (b2:bs) = go new_subst b bs + where + (new_subst2, b) = mergeBlocks subst b1 b2 + new_subst = new_subst1 `mapUnion` new_subst2 -- ----------------------------------------------------------------------------- @@ -82,6 +113,9 @@ common_block (old_change, bmap, subst) (hash, b) = -- To speed up comparisons, we hash each basic block modulo labels. -- The hashing is a bit arbitrary (the numbers are completely arbitrary), -- but it should be fast and good enough. + +type HashCode = Int + hash_block :: CmmBlock -> HashCode hash_block block = fromIntegral (foldBlockNodesB3 (hash_fst, hash_mid, hash_lst) block (0 :: Word32) .&. (0x7fffffff :: Word32)) @@ -237,3 +271,50 @@ copyTicks env g (CmmEntry lbl scp1, code) = blockSplitHead to in CmmEntry lbl (combineTickScopes scp0 scp1) `blockJoinHead` foldr blockCons code (map CmmTick ticks) + +-- Group by [Label] +groupByLabel :: [(Key, a)] -> [(Key, [a])] +groupByLabel = go emptyILM + where + go !m [] = elemsILM m + go !m ((k,v) : entries) = go (alterILM adjust m k') entries + where k' = map getUnique k + adjust Nothing = Just (k,[v]) + adjust (Just (_,vs)) = Just (k,v:vs) + +groupBy :: (a -> Int) -> [a] -> [[a]] +groupBy f xs = eltsUFM $ List.foldl' go emptyUFM xs + where go m x = alterUFM (Just . maybe [x] (x:)) m (f x) + +-- Efficient lookup into [([Unique], a)] +data IntListMap a = ILM (Maybe a) (UniqFM (IntListMap a)) + +emptyILM :: IntListMap a +emptyILM = ILM Nothing emptyUFM + +unitILM :: [Unique] -> a -> IntListMap a +unitILM [] a = ILM (Just a) emptyUFM +unitILM (l:ls) a = ILM Nothing (unitUFM l (unitILM ls a)) + + +alterILM :: (Maybe a -> Maybe a) -> IntListMap a -> [Unique] -> IntListMap a +alterILM f (ILM ma m) [] = ILM (f ma) m +alterILM f (ILM ma m) (l:ls) = ILM ma (alterUFM go m l) + where go Nothing = fmap (unitILM ls) (f Nothing) + go (Just ilm) = Just $ alterILM f ilm ls + +{- currently unused +addToILM :: IntListMap a -> [Unique] -> a -> IntListMap a +addToILM (ILM _ m) [] a = ILM (Just a) m +addToILM (ILM ma m) (l:ls) a = ILM ma $ alterUFM go m l + where go Nothing = Just $ unitILM ls a + go (Just ilm) = Just $ addToILM ilm ls a + +lookupILM :: IntListMap a -> [Unique] -> Maybe a +lookupILM (ILM ma _) [] = ma +lookupILM (ILM _ m) (l:ls) = lookupUFM m l >>= (\m -> lookupILM m ls) +-} + +elemsILM :: IntListMap a -> [a] +elemsILM (ILM ma m) = maybe id (:) ma $ concatMap elemsILM $ eltsUFM m + From git at git.haskell.org Mon May 18 13:37:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 13:37:46 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Greatly speed up nativeCodeGen/seqBlocks (009e285) Message-ID: <20150518133746.0340E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/009e28520c045a5d0479af5f5c27bca4736e88ae/ghc >--------------------------------------------------------------- commit 009e28520c045a5d0479af5f5c27bca4736e88ae Author: Joachim Breitner Date: Sat May 16 17:47:31 2015 +0200 Greatly speed up nativeCodeGen/seqBlocks When working on #10397, I noticed that "reorder" in nativeCodeGen/seqBlocks took more than 60% of the time. With this refactoring, it does not even show up in the profile any more. This fixes #10422. Differential Revision: https://phabricator.haskell.org/D893 (cherry picked from commit 8e4dc8fb63b8d3bfee485c1c830776f3ed704f4d) >--------------------------------------------------------------- 009e28520c045a5d0479af5f5c27bca4736e88ae compiler/nativeGen/AsmCodeGen.hs | 53 ++++++++++++++++++++++++------------- testsuite/tests/perf/compiler/all.T | 4 ++- 2 files changed, 38 insertions(+), 19 deletions(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 4080398..9c57e76 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -63,6 +63,7 @@ import UniqFM import UniqSupply import DynFlags import Util +import Unique import BasicTypes ( Alignment ) import Digraph @@ -779,25 +780,41 @@ mkNode block@(BasicBlock id instrs) = (block, id, getOutEdges instrs) seqBlocks :: BlockEnv i -> [(GenBasicBlock t1, BlockId, [BlockId])] -> [GenBasicBlock t1] -seqBlocks _ [] = [] -seqBlocks infos ((block,_,[]) : rest) - = block : seqBlocks infos rest -seqBlocks infos ((block@(BasicBlock id instrs),_,[next]) : rest) - | can_fallthrough = BasicBlock id (init instrs) : seqBlocks infos rest' - | otherwise = block : seqBlocks infos rest' +seqBlocks infos blocks = placeNext pullable0 todo0 where - can_fallthrough = not (mapMember next infos) && can_reorder - (can_reorder, rest') = reorder next [] rest - -- TODO: we should do a better job for cycles; try to maximise the - -- fallthroughs within a loop. -seqBlocks _ _ = panic "AsmCodegen:seqBlocks" - -reorder :: (Eq a) => a -> [(t, a, t1)] -> [(t, a, t1)] -> (Bool, [(t, a, t1)]) -reorder _ accum [] = (False, reverse accum) -reorder id accum (b@(block,id',out) : rest) - | id == id' = (True, (block,id,out) : reverse accum ++ rest) - | otherwise = reorder id (b:accum) rest - + -- pullable: Blocks that are not yet placed + -- todo: Original order of blocks, to be followed if we have no good + -- reason not to; + -- may include blocks that have already been placed, but then + -- these are not in pullable + pullable0 = listToUFM [ (i,(b,n)) | (b,i,n) <- blocks ] + todo0 = [i | (_,i,_) <- blocks ] + + placeNext _ [] = [] + placeNext pullable (i:rest) + | Just (block, pullable') <- lookupDeleteUFM pullable i + = place pullable' rest block + | otherwise + -- We already placed this block, so ignore + = placeNext pullable rest + + place pullable todo (block,[]) + = block : placeNext pullable todo + place pullable todo (block@(BasicBlock id instrs),[next]) + | mapMember next infos + = block : placeNext pullable todo + | Just (nextBlock, pullable') <- lookupDeleteUFM pullable next + = BasicBlock id (init instrs) : place pullable' todo nextBlock + | otherwise + = block : placeNext pullable todo + place _ _ (_,tooManyNextNodes) + = pprPanic "seqBlocks" (ppr tooManyNextNodes) + + +lookupDeleteUFM :: Uniquable key => UniqFM elt -> key -> Maybe (elt, UniqFM elt) +lookupDeleteUFM m k = do -- Maybe monad + v <- lookupUFM m k + return (v, delFromUFM m k) -- ----------------------------------------------------------------------------- -- Generate jump tables diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 31b0a5a..e6d31c4 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -379,7 +379,7 @@ test('T783', # 2014-04-04: 319179104 (x86 Windows, 64 bit machine) # 2014-09-03: 223377364 (Windows, better specialisation, raft of core-to-core optimisations) - (wordsize(64), 441932632, 10)]), + (wordsize(64), 452933048, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -394,6 +394,8 @@ test('T783', # (general round of updates) # 2014-08-29: 441932632 (amd64/Linux) # (better specialisation, raft of core-to-core optimisations) + # 2015-05-16: 452933048 (amd64/Linux) + # (improved sequenceBlocks in nativeCodeGen, #10422) extra_hc_opts('-static') ], compile,['']) From git at git.haskell.org Mon May 18 13:37:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 13:37:49 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix superclass generation in an instance (7f24cdd) Message-ID: <20150518133749.296A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/7f24cdd63fbfd69a83f81e85384dc8cb7ef57704/ghc >--------------------------------------------------------------- commit 7f24cdd63fbfd69a83f81e85384dc8cb7ef57704 Author: Simon Peyton Jones Date: Tue Apr 21 13:38:32 2015 +0100 Fix superclass generation in an instance More fallout from the silent-superclass refactoring; nothing drastic. Fixes Trac #10335. (cherry picked from commit 646866ff318d6eb8beeed98032644182dd9d997b) >--------------------------------------------------------------- 7f24cdd63fbfd69a83f81e85384dc8cb7ef57704 compiler/deSugar/DsBinds.hs | 8 ++++---- compiler/typecheck/TcEvidence.hs | 16 ++++++++++++++-- testsuite/tests/typecheck/should_compile/T10335.hs | 16 ++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 35 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 72f0801..bb10711 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -883,16 +883,16 @@ dsEvTerm (EvDFunApp df tys tms) = do { tms' <- mapM dsEvTerm tms dsEvTerm (EvCoercion (TcCoVarCo v)) = return (Var v) -- See Note [Simple coercions] dsEvTerm (EvCoercion co) = dsTcCoercion co mkEqBox -dsEvTerm (EvTupleSel v n) - = do { tm' <- dsEvTerm v - ; let scrut_ty = exprType tm' +dsEvTerm (EvTupleSel tm n) + = do { tup <- dsEvTerm tm + ; let scrut_ty = exprType tup (tc, tys) = splitTyConApp scrut_ty Just [dc] = tyConDataCons_maybe tc xs = mkTemplateLocals tys the_x = getNth xs n ; ASSERT( isTupleTyCon tc ) return $ - Case tm' (mkWildValBinder scrut_ty) (idType the_x) [(DataAlt dc, xs, Var the_x)] } + Case tup (mkWildValBinder scrut_ty) (idType the_x) [(DataAlt dc, xs, Var the_x)] } dsEvTerm (EvTupleMk tms) = do { tms' <- mapM dsEvTerm tms diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index a5a727b..9eef643 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -13,7 +13,7 @@ module TcEvidence ( TcEvBinds(..), EvBindsVar(..), EvBindMap(..), emptyEvBindMap, extendEvBinds, lookupEvBind, evBindMapBinds, EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, - EvTerm(..), mkEvCast, evVarsOfTerm, + EvTerm(..), mkEvCast, evVarsOfTerm, mkEvTupleSelectors, mkEvScSelectors, EvLit(..), evTermCoercion, EvTypeable(..), @@ -34,10 +34,11 @@ module TcEvidence ( import Var import Coercion import PprCore () -- Instance OutputableBndr TyVar -import TypeRep -- Knows type representation +import TypeRep -- Knows type representation import TcType import Type import TyCon +import Class( Class ) import CoAxiom import PrelNames import VarEnv @@ -825,6 +826,17 @@ mkEvCast ev lco isTcReflCo lco = ev | otherwise = EvCast ev lco +mkEvTupleSelectors :: EvTerm -> [TcPredType] -> [(TcPredType, EvTerm)] +mkEvTupleSelectors ev preds = zipWith mk_pr preds [0..] + where + mk_pr pred i = (pred, EvTupleSel ev i) + +mkEvScSelectors :: EvTerm -> Class -> [TcType] -> [(TcPredType, EvTerm)] +mkEvScSelectors ev cls tys + = zipWith mk_pr (immSuperClasses cls tys) [0..] + where + mk_pr pred i = (pred, EvSuperClass ev i) + emptyTcEvBinds :: TcEvBinds emptyTcEvBinds = EvBinds emptyBag diff --git a/testsuite/tests/typecheck/should_compile/T10335.hs b/testsuite/tests/typecheck/should_compile/T10335.hs new file mode 100644 index 0000000..045c3a6 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10335.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ConstraintKinds #-} + +module Foo where + +type X a = (Eq a, Show a) + +class Eq a => C a b + +-- HEAD was unable to find the (Eq a) superclass +-- for a while in March/April 2015 +instance X a => C a [b] + + + + + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index e23f67c..af58fcd 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -443,3 +443,4 @@ test('T10072', normal, compile_fail, ['']) test('T10177', normal, compile, ['']) test('T10195', normal, compile, ['']) test('T10109', normal, compile, ['']) +test('T10335', normal, compile, ['']) From git at git.haskell.org Mon May 18 20:29:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 20:29:02 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: CmmCommonBlockElim: Improve hash function (a6d9c3a) Message-ID: <20150518202902.E19693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/a6d9c3a584b7d22a570424df9b0f863ee47bb182/ghc >--------------------------------------------------------------- commit a6d9c3a584b7d22a570424df9b0f863ee47bb182 Author: Joachim Breitner Date: Mon May 18 10:39:54 2015 +0200 CmmCommonBlockElim: Improve hash function Previously, the hash function used to cut down the number of block comparisons did not take local registers into account, causing far too many similar, but different bocks to be considered candidates for the (expensive!) comparision. Adding register to the hash takes CmmCommonBlockElim's share of the runtime of the example in #10397 from 17% to 2.5%, and eliminates all unwanted hash collisions. This patch also replaces the fancy trie by a plain Data.Map. It turned out to be not performance critical, so this simplifies the code. Differential Revision: https://phabricator.haskell.org/D896 (cherry picked from commit 73f836f5d57a3106029b573c42f83d2039d21d89) >--------------------------------------------------------------- a6d9c3a584b7d22a570424df9b0f863ee47bb182 compiler/cmm/CmmCommonBlockElim.hs | 71 ++++++++++++++------------------------ 1 file changed, 26 insertions(+), 45 deletions(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index 83b2841..cf05754 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -9,6 +9,7 @@ import BlockId import Cmm import CmmUtils import CmmContFlowOpt +-- import PprCmm () import Prelude hiding (iterate, succ, unzip, zip) import Hoopl hiding (ChangeFlag) @@ -43,8 +44,8 @@ import Control.Arrow (first, second) -- The hash is invariant under relabeling, so we only ever compare within -- the same group of blocks. -- --- The list of outgoing labels is updated as we merge blocks, and only blocks --- that had different labels before are compared. +-- The list of outgoing labels is updated as we merge blocks (that is why they +-- are not included in the hash, which we want to calculate only once). -- -- All in all, two blocks should never be compared if they have different -- hashes, and at most once otherwise. Previously, we were slower, and people @@ -55,7 +56,7 @@ elimCommonBlocks :: CmmGraph -> CmmGraph elimCommonBlocks g = replaceLabels env $ copyTicks env g where env = iterate mapEmpty blocks_with_key - groups = groupBy hash_block (postorderDfs g) + groups = groupByInt hash_block (postorderDfs g) blocks_with_key = [ [ (successors b, [b]) | b <- bs] | bs <- groups] -- Invariant: The blocks in the list are pairwise distinct @@ -110,10 +111,14 @@ mergeBlockList subst (b:bs) = go mapEmpty b bs -- Below here is mostly boilerplate: hashing blocks ignoring labels, -- and comparing blocks modulo a label mapping. --- To speed up comparisons, we hash each basic block modulo labels. +-- To speed up comparisons, we hash each basic block modulo jump labels. -- The hashing is a bit arbitrary (the numbers are completely arbitrary), -- but it should be fast and good enough. +-- We want to get as many small buckets as possible, as comparing blocks is +-- expensive. So include as much as possible in the hash. Ideally everything +-- that is compared with (==) in eqBlockBodyWith. + type HashCode = Int hash_block :: CmmBlock -> HashCode @@ -138,7 +143,7 @@ hash_block block = hash_node _ = error "hash_node: unknown Cmm node!" hash_reg :: CmmReg -> Word32 - hash_reg (CmmLocal _) = 117 + hash_reg (CmmLocal localReg) = hash_unique localReg -- important for performance, see #10397 hash_reg (CmmGlobal _) = 19 hash_e :: CmmExpr -> Word32 @@ -166,6 +171,9 @@ hash_block block = cvt = fromInteger . toInteger + hash_unique :: Uniquable a => a -> Word32 + hash_unique = cvt . getKey . getUnique + -- | Ignore these node types for equality dont_care :: CmmNode O x -> Bool dont_care CmmComment {} = True @@ -222,13 +230,18 @@ eqExprWith eqBid = eq -- IDs to block IDs. eqBlockBodyWith :: (BlockId -> BlockId -> Bool) -> CmmBlock -> CmmBlock -> Bool eqBlockBodyWith eqBid block block' - = and (zipWith (eqMiddleWith eqBid) nodes nodes') && - eqLastWith eqBid l l' + {- + | equal = pprTrace "equal" (vcat [ppr block, ppr block']) True + | otherwise = pprTrace "not equal" (vcat [ppr block, ppr block']) False + -} + = equal where (_,m,l) = blockSplit block nodes = filter (not . dont_care) (blockToList m) (_,m',l') = blockSplit block' nodes' = filter (not . dont_care) (blockToList m') + equal = and (zipWith (eqMiddleWith eqBid) nodes nodes') && + eqLastWith eqBid l l' eqLastWith :: (BlockId -> BlockId -> Bool) -> CmmNode O C -> CmmNode O C -> Bool @@ -274,47 +287,15 @@ copyTicks env g -- Group by [Label] groupByLabel :: [(Key, a)] -> [(Key, [a])] -groupByLabel = go emptyILM +groupByLabel = go M.empty where - go !m [] = elemsILM m - go !m ((k,v) : entries) = go (alterILM adjust m k') entries + go !m [] = M.elems m + go !m ((k,v) : entries) = go (M.alter adjust k' m) entries where k' = map getUnique k adjust Nothing = Just (k,[v]) adjust (Just (_,vs)) = Just (k,v:vs) -groupBy :: (a -> Int) -> [a] -> [[a]] -groupBy f xs = eltsUFM $ List.foldl' go emptyUFM xs - where go m x = alterUFM (Just . maybe [x] (x:)) m (f x) - --- Efficient lookup into [([Unique], a)] -data IntListMap a = ILM (Maybe a) (UniqFM (IntListMap a)) - -emptyILM :: IntListMap a -emptyILM = ILM Nothing emptyUFM - -unitILM :: [Unique] -> a -> IntListMap a -unitILM [] a = ILM (Just a) emptyUFM -unitILM (l:ls) a = ILM Nothing (unitUFM l (unitILM ls a)) - - -alterILM :: (Maybe a -> Maybe a) -> IntListMap a -> [Unique] -> IntListMap a -alterILM f (ILM ma m) [] = ILM (f ma) m -alterILM f (ILM ma m) (l:ls) = ILM ma (alterUFM go m l) - where go Nothing = fmap (unitILM ls) (f Nothing) - go (Just ilm) = Just $ alterILM f ilm ls - -{- currently unused -addToILM :: IntListMap a -> [Unique] -> a -> IntListMap a -addToILM (ILM _ m) [] a = ILM (Just a) m -addToILM (ILM ma m) (l:ls) a = ILM ma $ alterUFM go m l - where go Nothing = Just $ unitILM ls a - go (Just ilm) = Just $ addToILM ilm ls a - -lookupILM :: IntListMap a -> [Unique] -> Maybe a -lookupILM (ILM ma _) [] = ma -lookupILM (ILM _ m) (l:ls) = lookupUFM m l >>= (\m -> lookupILM m ls) --} - -elemsILM :: IntListMap a -> [a] -elemsILM (ILM ma m) = maybe id (:) ma $ concatMap elemsILM $ eltsUFM m +groupByInt :: (a -> Int) -> [a] -> [[a]] +groupByInt f xs = eltsUFM $ List.foldl' go emptyUFM xs + where go m x = alterUFM (Just . maybe [x] (x:)) m (f x) From git at git.haskell.org Mon May 18 21:26:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 May 2015 21:26:12 +0000 (UTC) Subject: [commit: ghc] master: includes/stg/SMP.h: implement simple load_/store_load_barrier on armv6 and older (eaaa38b) Message-ID: <20150518212612.4476B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eaaa38ba24d5152623cb202a98f71ed09deef0bb/ghc >--------------------------------------------------------------- commit eaaa38ba24d5152623cb202a98f71ed09deef0bb Author: Sergei Trofimovich Date: Mon May 18 22:22:18 2015 +0100 includes/stg/SMP.h: implement simple load_/store_load_barrier on armv6 and older Assuming there is no real SMP systems on these CPUs I've added only compiler barrier (otherwise write_barrier and friends need to be fixed as well). Patch also fixes build breakage reported in #10244. Signed-off-by: Sergei Trofimovich Reviewers: rwbarton, nomeata, austin Reviewed By: nomeata, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D894 GHC Trac Issues: #10244 >--------------------------------------------------------------- eaaa38ba24d5152623cb202a98f71ed09deef0bb includes/stg/SMP.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h index 5ded05d..5460a2b 100644 --- a/includes/stg/SMP.h +++ b/includes/stg/SMP.h @@ -373,6 +373,8 @@ store_load_barrier(void) { __asm__ __volatile__ ("sync" : : : "memory"); #elif sparc_HOST_ARCH __asm__ __volatile__ ("membar #StoreLoad" : : : "memory"); +#elif arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv7) + __asm__ __volatile__ ("" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb" : : : "memory"); #elif aarch64_HOST_ARCH @@ -395,6 +397,8 @@ load_load_barrier(void) { #elif sparc_HOST_ARCH /* Sparc in TSO mode does not require load/load barriers. */ __asm__ __volatile__ ("" : : : "memory"); +#elif arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv7) + __asm__ __volatile__ ("" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb" : : : "memory"); #elif aarch64_HOST_ARCH From git at git.haskell.org Tue May 19 06:26:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 06:26:36 +0000 (UTC) Subject: [commit: ghc] master: Add regression test for #10110. (85bf9e4) Message-ID: <20150519062636.52A0E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/85bf9e49f5ab4e0681eeda2549dbd4b5faf3ef7f/ghc >--------------------------------------------------------------- commit 85bf9e49f5ab4e0681eeda2549dbd4b5faf3ef7f Author: Peter Trommler Date: Tue May 19 01:21:09 2015 -0500 Add regression test for #10110. Module C imports a from Module A and b from module B. B does not import anything from A. So if ld is configured to drop DT_NEEDED tags for libraries it does not depend on no DT_NEEDED tag for the temporary shared object containing module A is recorded in the temp SO containing module B. This leads to an undefined symbol when linking the temp SO for module C. Fixes #10110. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D895 GHC Trac Issues: #10110 >--------------------------------------------------------------- 85bf9e49f5ab4e0681eeda2549dbd4b5faf3ef7f testsuite/tests/ghci/scripts/T10110.script | 5 +++++ .../should_run/tcrun023.stdout => ghci/scripts/T10110.stdout} | 1 + testsuite/tests/ghci/scripts/{T10322A.hs => T10110A.hs} | 2 +- testsuite/tests/ghci/scripts/T10110B.hs | 3 +++ testsuite/tests/ghci/scripts/T10110C.hs | 5 +++++ testsuite/tests/ghci/scripts/all.T | 1 + 6 files changed, 16 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/ghci/scripts/T10110.script b/testsuite/tests/ghci/scripts/T10110.script new file mode 100644 index 0000000..df67c30 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10110.script @@ -0,0 +1,5 @@ +:set -fobject-code +:load T10110A T10110B T10110C +T10110A.a +T10110B.b +T10110C.c diff --git a/testsuite/tests/typecheck/should_run/tcrun023.stdout b/testsuite/tests/ghci/scripts/T10110.stdout similarity index 66% copy from testsuite/tests/typecheck/should_run/tcrun023.stdout copy to testsuite/tests/ghci/scripts/T10110.stdout index 2050fde..21cc9a8 100644 --- a/testsuite/tests/typecheck/should_run/tcrun023.stdout +++ b/testsuite/tests/ghci/scripts/T10110.stdout @@ -1,2 +1,3 @@ +3 5 8 diff --git a/testsuite/tests/ghci/scripts/T10322A.hs b/testsuite/tests/ghci/scripts/T10110A.hs similarity index 57% copy from testsuite/tests/ghci/scripts/T10322A.hs copy to testsuite/tests/ghci/scripts/T10110A.hs index ba01fd2..8482e7f 100644 --- a/testsuite/tests/ghci/scripts/T10322A.hs +++ b/testsuite/tests/ghci/scripts/T10110A.hs @@ -1,4 +1,4 @@ -module T10322A (a) where +module T10110A (a) where {-# NOINLINE a #-} a :: Int a = 3 diff --git a/testsuite/tests/ghci/scripts/T10110B.hs b/testsuite/tests/ghci/scripts/T10110B.hs new file mode 100644 index 0000000..65cfc7e --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10110B.hs @@ -0,0 +1,3 @@ +module T10110B (b) where +b :: Int +b = 5 diff --git a/testsuite/tests/ghci/scripts/T10110C.hs b/testsuite/tests/ghci/scripts/T10110C.hs new file mode 100644 index 0000000..7069207 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10110C.hs @@ -0,0 +1,5 @@ +module T10110C (c) where +import T10110A (a) +import T10110B (b) +c :: Int +c = a+b diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 85ba5af..e0f2301 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -217,3 +217,4 @@ test('T10408A', normal, run_command, test('T10408B', normal, run_command, ['$MAKE -s --no-print-directory T10408B']) test('T10248', normal, ghci_script, ['T10248.script']) +test('T10110', normal, ghci_script, ['T10110.script']) From git at git.haskell.org Tue May 19 06:26:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 06:26:39 +0000 (UTC) Subject: [commit: ghc] master: user guide: correct documentation for -Wall (fixes #10386) (5cbac88) Message-ID: <20150519062639.0D9EF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5cbac8866e1cf1f5a015e318bf298954b7bf6417/ghc >--------------------------------------------------------------- commit 5cbac8866e1cf1f5a015e318bf298954b7bf6417 Author: Alexander Eyers-Taylor Date: Tue May 19 01:22:27 2015 -0500 user guide: correct documentation for -Wall (fixes #10386) This fixes the documentation for -Wall. As was done previously it leaves out deprecated flags and also fwarn-safe and fwarn-unsafe. I don't know if that was intended or not. -fwarn-safe and fwarn-unsafe are not mentioned on the warnings page at all instead they are mentioned in the safe haskell section. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D889 GHC Trac Issues: #10386 >--------------------------------------------------------------- 5cbac8866e1cf1f5a015e318bf298954b7bf6417 docs/users_guide/using.xml | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 2ac51f6..ec44a50 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -1088,14 +1088,15 @@ test.hs:(5,4)-(6,7): suspicious code. The warnings that are not enabled by are - , - , - , - , - , - , and - , - . + , + , + , + , + , + , + , + and + . From git at git.haskell.org Tue May 19 06:26:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 06:26:41 +0000 (UTC) Subject: [commit: ghc] master: Remove unneeded compatibility with LLVM < 3.6 (578d2ba) Message-ID: <20150519062641.BEA393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/578d2bad19b3e03fac4da1e5be4b22b73cef0a44/ghc >--------------------------------------------------------------- commit 578d2bad19b3e03fac4da1e5be4b22b73cef0a44 Author: Michal Terepeta Date: Tue May 19 01:23:03 2015 -0500 Remove unneeded compatibility with LLVM < 3.6 Since GHC requires at least LLVM 3.6, some of the special cases (for, e.g., LLVM 2.8 or 2.9) in the LLVM CodeGen can be simply removed. Reviewed By: rwbarton, austin Differential Revision: https://phabricator.haskell.org/D884 GHC Trac Issues: #10074 >--------------------------------------------------------------- 578d2bad19b3e03fac4da1e5be4b22b73cef0a44 compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 44 +++++++-------------------------- 1 file changed, 9 insertions(+), 35 deletions(-) diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 3a7c05b..2c48c28 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -156,21 +156,6 @@ barrier = do let s = Fence False SyncSeqCst return (unitOL s, []) --- | Memory barrier instruction for LLVM < 3.0 -oldBarrier :: LlvmM StmtData -oldBarrier = do - - (fv, _, tops) <- getInstrinct (fsLit "llvm.memory.barrier") LMVoid [i1, i1, i1, i1, i1] - - let args = [lmTrue, lmTrue, lmTrue, lmTrue, lmTrue] - let s1 = Expr $ Call StdCall fv args llvmStdFunAttrs - - return (unitOL s1, tops) - - where - lmTrue :: LlvmVar - lmTrue = mkIntLit i1 (-1) - -- | Foreign Calls genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData @@ -179,12 +164,9 @@ genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -- intrinsic function. genCall (PrimTarget MO_WriteBarrier) _ _ = do platform <- getLlvmPlatform - ver <- getLlvmVer - case () of - _ | platformArch platform `elem` [ArchX86, ArchX86_64, ArchSPARC] - -> return (nilOL, []) - | ver > 29 -> barrier - | otherwise -> oldBarrier + if platformArch platform `elem` [ArchX86, ArchX86_64, ArchSPARC] + then return (nilOL, []) + else barrier genCall (PrimTarget MO_Touch) _ _ = return (nilOL, []) @@ -206,9 +188,7 @@ genCall (PrimTarget (MO_UF_Conv _)) [_] args = -- Handle prefetching data genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args | 0 <= localityInt && localityInt <= 3 = do - ver <- getLlvmVer - let argTy | ver <= 29 = [i8Ptr, i32, i32] - | otherwise = [i8Ptr, i32, i32, i32] + let argTy = [i8Ptr, i32, i32, i32] funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing @@ -219,8 +199,7 @@ genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args (argVars', stmts3) <- castVars $ zip argVars argTy trash <- getTrashStmts - let argSuffix | ver <= 29 = [mkIntLit i32 0, mkIntLit i32 localityInt] - | otherwise = [mkIntLit i32 0, mkIntLit i32 localityInt, mkIntLit i32 1] + let argSuffix = [mkIntLit i32 0, mkIntLit i32 localityInt, mkIntLit i32 1] call = Expr $ Call StdCall fptr (argVars' ++ argSuffix) [] stmts = stmts1 `appOL` stmts2 `appOL` stmts3 `appOL` trash `snocOL` call @@ -255,12 +234,10 @@ genCall t@(PrimTarget op) [] args' | op == MO_Memcpy || op == MO_Memset || op == MO_Memmove = do - ver <- getLlvmVer dflags <- getDynFlags let (args, alignVal) = splitAlignVal args' - (isVolTy, isVolVal) - | ver >= 28 = ([i1], [mkIntLit i1 0]) - | otherwise = ([], []) + isVolTy = [i1] + isVolVal = [mkIntLit i1 0] argTy | op == MO_Memset = [i8Ptr, i8, llvmWord dflags, i32] ++ isVolTy | otherwise = [i8Ptr, i8Ptr, llvmWord dflags, i32] ++ isVolTy funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible @@ -516,12 +493,9 @@ castVar v t | getVarType v == t cmmPrimOpFunctions :: CallishMachOp -> LlvmM LMString cmmPrimOpFunctions mop = do - ver <- getLlvmVer dflags <- getDynFlags - let intrinTy1 = (if ver >= 28 - then "p0i8.p0i8." else "") ++ showSDoc dflags (ppr $ llvmWord dflags) - intrinTy2 = (if ver >= 28 - then "p0i8." else "") ++ showSDoc dflags (ppr $ llvmWord dflags) + let intrinTy1 = "p0i8.p0i8." ++ showSDoc dflags (ppr $ llvmWord dflags) + intrinTy2 = "p0i8." ++ showSDoc dflags (ppr $ llvmWord dflags) unsupported = panic ("cmmPrimOpFunctions: " ++ show mop ++ " not supported here") From git at git.haskell.org Tue May 19 06:26:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 06:26:44 +0000 (UTC) Subject: [commit: ghc] master: ghci: Allow :back and :forward to take counts (b03f074) Message-ID: <20150519062644.8E8373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b03f074fd51adfb9bc4f5275294712ee62741aed/ghc >--------------------------------------------------------------- commit b03f074fd51adfb9bc4f5275294712ee62741aed Author: Ben Gamari Date: Tue May 19 01:23:47 2015 -0500 ghci: Allow :back and :forward to take counts These behave like the count arguments of the gdb `up` and `down` commands, allowing the user to quickly jump around in history. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D853 >--------------------------------------------------------------- b03f074fd51adfb9bc4f5275294712ee62741aed compiler/main/InteractiveEval.hs | 8 +++---- docs/users_guide/7.12.1-notes.xml | 5 +++++ docs/users_guide/ghci.xml | 16 +++++++++----- ghc/InteractiveUI.hs | 46 ++++++++++++++++++++++++--------------- 4 files changed, 47 insertions(+), 28 deletions(-) diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 44b207a..5458368 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -564,11 +564,11 @@ resumeExec canLogSpan step handleRunStatus step expr bindings final_ids breakMVar statusMVar status hist' -back :: GhcMonad m => m ([Name], Int, SrcSpan) -back = moveHist (+1) +back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) +back n = moveHist (+n) -forward :: GhcMonad m => m ([Name], Int, SrcSpan) -forward = moveHist (subtract 1) +forward :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) +forward n = moveHist (subtract n) moveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan) moveHist fn = do diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index 9a87588..d0eefab 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -96,6 +96,11 @@ Main with an explicit module header but without main is now an error (#7765). + + The :back and :forward + commands now take an optional count allowing the user to move forward or + backward in history several steps at a time. + diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index 6e09f3a..627aa79 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -2096,12 +2096,14 @@ $ ghci -lm - :back + :back n :back - Travel back one step in the history. See . See also: + Travel back n steps in the + history. n is one if omitted. + See for more about GHCi's debugging + facilities. See also: :trace, :history, :forward. @@ -2474,12 +2476,14 @@ Prelude> :. cmds.ghci - :forward + :forward n :forward - Move forward in the history. See . See also: + Move forward n steps in the + history. n is one if omitted. + See for more about GHCi's debugging + facilities. See also: :trace, :history, :back. diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 70e4df1..0adc0cd 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -268,14 +268,14 @@ defFullHelpText = " -- Commands for debugging:\n" ++ "\n" ++ " :abandon at a breakpoint, abandon current computation\n" ++ - " :back go back in the history (after :trace)\n" ++ + " :back [] go back in the history N steps (after :trace)\n" ++ " :break [] [] set a breakpoint at the specified location\n" ++ " :break set a breakpoint on the specified function\n" ++ " :continue resume after a breakpoint\n" ++ " :delete delete the specified breakpoint\n" ++ " :delete * delete all breakpoints\n" ++ " :force print , forcing unevaluated parts\n" ++ - " :forward go forward in the history (after :back)\n" ++ + " :forward [] go forward in the history N step s(after :back)\n" ++ " :history [] after :trace, show the execution history\n" ++ " :list show the source code around current breakpoint\n" ++ " :list show the source code for \n" ++ @@ -2747,24 +2747,34 @@ bold c | do_bold = text start_bold <> c <> text end_bold | otherwise = c backCmd :: String -> GHCi () -backCmd = noArgs $ withSandboxOnly ":back" $ do - (names, _, pan) <- GHC.back - printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr pan - printTypeOfNames names - -- run the command set with ":set stop " - st <- getGHCiState - enqueueCommands [stop st] +backCmd arg + | null arg = back 1 + | all isDigit arg = back (read arg) + | otherwise = liftIO $ putStrLn "Syntax: :back [num]" + where + back num = withSandboxOnly ":back" $ do + (names, _, pan) <- GHC.back num + printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr pan + printTypeOfNames names + -- run the command set with ":set stop " + st <- getGHCiState + enqueueCommands [stop st] forwardCmd :: String -> GHCi () -forwardCmd = noArgs $ withSandboxOnly ":forward" $ do - (names, ix, pan) <- GHC.forward - printForUser $ (if (ix == 0) - then ptext (sLit "Stopped at") - else ptext (sLit "Logged breakpoint at")) <+> ppr pan - printTypeOfNames names - -- run the command set with ":set stop " - st <- getGHCiState - enqueueCommands [stop st] +forwardCmd arg + | null arg = forward 1 + | all isDigit arg = forward (read arg) + | otherwise = liftIO $ putStrLn "Syntax: :back [num]" + where + forward num = withSandboxOnly ":forward" $ do + (names, ix, pan) <- GHC.forward num + printForUser $ (if (ix == 0) + then ptext (sLit "Stopped at") + else ptext (sLit "Logged breakpoint at")) <+> ppr pan + printTypeOfNames names + -- run the command set with ":set stop " + st <- getGHCiState + enqueueCommands [stop st] -- handle the "break" command breakCmd :: String -> GHCi () From git at git.haskell.org Tue May 19 06:26:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 06:26:47 +0000 (UTC) Subject: [commit: ghc] master: In ghci linker, link against all previous temp sos (#10322) (b0b11ad) Message-ID: <20150519062647.4DF9C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0b11ad93cf8470caed572dc16e5cf91304fa355/ghc >--------------------------------------------------------------- commit b0b11ad93cf8470caed572dc16e5cf91304fa355 Author: Reid Barton Date: Tue May 19 01:23:59 2015 -0500 In ghci linker, link against all previous temp sos (#10322) The OS X dlopen() appears to only resolve undefined symbols in the direct dependencies of the shared library it is loading. Reviewed By: trommler, austin Differential Revision: https://phabricator.haskell.org/D852 GHC Trac Issues: #10322 >--------------------------------------------------------------- b0b11ad93cf8470caed572dc16e5cf91304fa355 compiler/ghci/Linker.hs | 22 +++++++++++----------- testsuite/tests/ghci/scripts/all.T | 1 + 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index cec0904..3e8423c 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -119,9 +119,9 @@ data PersistentLinkerState -- that is really important pkgs_loaded :: ![PackageKey], - -- we need to remember the name of the last temporary DLL/.so - -- so we can link it - last_temp_so :: !(Maybe (FilePath, String)) } + -- we need to remember the name of previous temporary DLL/.so + -- libraries so we can link them (see #10322) + temp_sos :: ![(FilePath, String)] } emptyPLS :: DynFlags -> PersistentLinkerState @@ -131,7 +131,7 @@ emptyPLS _ = PersistentLinkerState { pkgs_loaded = init_pkgs, bcos_loaded = [], objs_loaded = [], - last_temp_so = Nothing } + temp_sos = [] } -- Packages that don't need loading, because the compiler -- shares them with the interpreted program. @@ -841,19 +841,19 @@ dynLoadObjs dflags pls objs = do dflags2 = dflags1 { -- We don't want the original ldInputs in -- (they're already linked in), but we do want - -- to link against the previous dynLoadObjs - -- library if there was one, so that the linker + -- to link against previous dynLoadObjs + -- libraries if there were any, so that the linker -- can resolve dependencies when it loads this -- library. ldInputs = - case last_temp_so pls of - Nothing -> [] - Just (lp, l) -> + concatMap + (\(lp, l) -> [ Option ("-L" ++ lp) , Option ("-Wl,-rpath") , Option ("-Wl," ++ lp) , Option ("-l" ++ l) - ], + ]) + (temp_sos pls), -- Even if we're e.g. profiling, we still want -- the vanilla dynamic libraries, so we set the -- ways / build tag to be just WayDyn. @@ -868,7 +868,7 @@ dynLoadObjs dflags pls objs = do consIORef (filesToNotIntermediateClean dflags) soFile m <- loadDLL soFile case m of - Nothing -> return pls { last_temp_so = Just (libPath, libName) } + Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls } Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index e0f2301..e4ec994 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -218,3 +218,4 @@ test('T10408B', normal, run_command, ['$MAKE -s --no-print-directory T10408B']) test('T10248', normal, ghci_script, ['T10248.script']) test('T10110', normal, ghci_script, ['T10110.script']) +test('T10322', normal, ghci_script, ['T10322.script']) From git at git.haskell.org Tue May 19 08:00:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 08:00:12 +0000 (UTC) Subject: [commit: ghc] master: compiler: make sure we reject -O + HscInterpreted (b199536) Message-ID: <20150519080012.636A23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b199536be25ea046079587933cc73d0a948a0626/ghc >--------------------------------------------------------------- commit b199536be25ea046079587933cc73d0a948a0626 Author: Austin Seipp Date: Tue May 19 01:56:48 2015 -0500 compiler: make sure we reject -O + HscInterpreted When using GHCi, we explicitly reject optimization, because the compilers optimization passes can introduce unboxed tuples, which the interpreter is not able to handle. But this goes the other way too: using GHCi on optimized code may cause the optimizer to float out breakpoints that the interpreter introduces. This manifests itself in weird ways, particularly if you as an API client use custom DynFlags to introduce optimization in combination with HscInterpreted. It turns out we weren't checking for consistent DynFlag settings when doing `setSessionDynFlags`, as #10052 showed. While the main driver handled it in `DynFlags` via `parseDynamicFlags`, we didn't check this elsewhere. This does a little refactoring to split out some of the common code, and immunizes the various `DynFlags` utilities in the `GHC` module from this particular bug. We should probably be checking other general invariants too. This fixes #10052, and adds some notes about the behavior in `GHC` and `FloatOut` As a bonus, expose `warningMsg` from `ErrUtils` as a helper since it didn't exist (somehow). Signed-off-by: Austin Seipp Reviewed By: edsko Differential Revision: https://phabricator.haskell.org/D727 GHC Trac Issues: #10052 >--------------------------------------------------------------- b199536be25ea046079587933cc73d0a948a0626 compiler/main/DynFlags.hs | 12 ++++--- compiler/main/ErrUtils.hs | 6 +++- compiler/main/GHC.hs | 41 ++++++++++++++++++---- compiler/simplCore/FloatOut.hs | 27 ++++++++++++++ testsuite/.gitignore | 1 + testsuite/tests/ghc-api/T10052/Makefile | 12 +++++++ testsuite/tests/ghc-api/T10052/T10052-input.hs | 1 + testsuite/tests/ghc-api/T10052/T10052.hs | 30 ++++++++++++++++ .../T10052/T10052.stderr} | 0 testsuite/tests/ghc-api/T10052/T10052.stdout | 1 + testsuite/tests/ghc-api/T10052/all.T | 2 ++ 11 files changed, 121 insertions(+), 12 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b199536be25ea046079587933cc73d0a948a0626 From git at git.haskell.org Tue May 19 08:58:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 08:58:56 +0000 (UTC) Subject: [commit: ghc] master: Revert "In ghci linker, link against all previous temp sos (#10322)" (470a949) Message-ID: <20150519085856.7E47A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/470a94947b076cb74a6adcbcf9b39057a67e1fba/ghc >--------------------------------------------------------------- commit 470a94947b076cb74a6adcbcf9b39057a67e1fba Author: Austin Seipp Date: Tue May 19 03:57:44 2015 -0500 Revert "In ghci linker, link against all previous temp sos (#10322)" This reverts commit b0b11ad93cf8470caed572dc16e5cf91304fa355. It apparently made Harbormaster sad. >--------------------------------------------------------------- 470a94947b076cb74a6adcbcf9b39057a67e1fba compiler/ghci/Linker.hs | 22 +++++++++++----------- testsuite/tests/ghci/scripts/all.T | 1 - 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 3e8423c..cec0904 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -119,9 +119,9 @@ data PersistentLinkerState -- that is really important pkgs_loaded :: ![PackageKey], - -- we need to remember the name of previous temporary DLL/.so - -- libraries so we can link them (see #10322) - temp_sos :: ![(FilePath, String)] } + -- we need to remember the name of the last temporary DLL/.so + -- so we can link it + last_temp_so :: !(Maybe (FilePath, String)) } emptyPLS :: DynFlags -> PersistentLinkerState @@ -131,7 +131,7 @@ emptyPLS _ = PersistentLinkerState { pkgs_loaded = init_pkgs, bcos_loaded = [], objs_loaded = [], - temp_sos = [] } + last_temp_so = Nothing } -- Packages that don't need loading, because the compiler -- shares them with the interpreted program. @@ -841,19 +841,19 @@ dynLoadObjs dflags pls objs = do dflags2 = dflags1 { -- We don't want the original ldInputs in -- (they're already linked in), but we do want - -- to link against previous dynLoadObjs - -- libraries if there were any, so that the linker + -- to link against the previous dynLoadObjs + -- library if there was one, so that the linker -- can resolve dependencies when it loads this -- library. ldInputs = - concatMap - (\(lp, l) -> + case last_temp_so pls of + Nothing -> [] + Just (lp, l) -> [ Option ("-L" ++ lp) , Option ("-Wl,-rpath") , Option ("-Wl," ++ lp) , Option ("-l" ++ l) - ]) - (temp_sos pls), + ], -- Even if we're e.g. profiling, we still want -- the vanilla dynamic libraries, so we set the -- ways / build tag to be just WayDyn. @@ -868,7 +868,7 @@ dynLoadObjs dflags pls objs = do consIORef (filesToNotIntermediateClean dflags) soFile m <- loadDLL soFile case m of - Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls } + Nothing -> return pls { last_temp_so = Just (libPath, libName) } Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index e4ec994..e0f2301 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -218,4 +218,3 @@ test('T10408B', normal, run_command, ['$MAKE -s --no-print-directory T10408B']) test('T10248', normal, ghci_script, ['T10248.script']) test('T10110', normal, ghci_script, ['T10110.script']) -test('T10322', normal, ghci_script, ['T10322.script']) From git at git.haskell.org Tue May 19 09:21:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 09:21:46 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Add regression test for #10110. (072abeb) Message-ID: <20150519092146.9ADA53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/072abebbccbe87f153ae3e8593388d07d169cd09/ghc >--------------------------------------------------------------- commit 072abebbccbe87f153ae3e8593388d07d169cd09 Author: Peter Trommler Date: Tue May 19 01:21:09 2015 -0500 Add regression test for #10110. Module C imports a from Module A and b from module B. B does not import anything from A. So if ld is configured to drop DT_NEEDED tags for libraries it does not depend on no DT_NEEDED tag for the temporary shared object containing module A is recorded in the temp SO containing module B. This leads to an undefined symbol when linking the temp SO for module C. Fixes #10110. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D895 GHC Trac Issues: #10110 (cherry picked from commit 85bf9e49f5ab4e0681eeda2549dbd4b5faf3ef7f) >--------------------------------------------------------------- 072abebbccbe87f153ae3e8593388d07d169cd09 testsuite/tests/ghci/scripts/T10110.script | 5 +++++ .../should_run/tcrun023.stdout => ghci/scripts/T10110.stdout} | 1 + testsuite/tests/ghci/scripts/{T8696A.hs => T10110A.hs} | 2 +- testsuite/tests/ghci/scripts/T10110B.hs | 3 +++ testsuite/tests/ghci/scripts/T10110C.hs | 5 +++++ testsuite/tests/ghci/scripts/all.T | 1 + 6 files changed, 16 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/ghci/scripts/T10110.script b/testsuite/tests/ghci/scripts/T10110.script new file mode 100644 index 0000000..df67c30 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10110.script @@ -0,0 +1,5 @@ +:set -fobject-code +:load T10110A T10110B T10110C +T10110A.a +T10110B.b +T10110C.c diff --git a/testsuite/tests/typecheck/should_run/tcrun023.stdout b/testsuite/tests/ghci/scripts/T10110.stdout similarity index 66% copy from testsuite/tests/typecheck/should_run/tcrun023.stdout copy to testsuite/tests/ghci/scripts/T10110.stdout index 2050fde..21cc9a8 100644 --- a/testsuite/tests/typecheck/should_run/tcrun023.stdout +++ b/testsuite/tests/ghci/scripts/T10110.stdout @@ -1,2 +1,3 @@ +3 5 8 diff --git a/testsuite/tests/ghci/scripts/T8696A.hs b/testsuite/tests/ghci/scripts/T10110A.hs similarity index 57% copy from testsuite/tests/ghci/scripts/T8696A.hs copy to testsuite/tests/ghci/scripts/T10110A.hs index 465af37..8482e7f 100644 --- a/testsuite/tests/ghci/scripts/T8696A.hs +++ b/testsuite/tests/ghci/scripts/T10110A.hs @@ -1,4 +1,4 @@ -module T8696A (a) where +module T10110A (a) where {-# NOINLINE a #-} a :: Int a = 3 diff --git a/testsuite/tests/ghci/scripts/T10110B.hs b/testsuite/tests/ghci/scripts/T10110B.hs new file mode 100644 index 0000000..65cfc7e --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10110B.hs @@ -0,0 +1,3 @@ +module T10110B (b) where +b :: Int +b = 5 diff --git a/testsuite/tests/ghci/scripts/T10110C.hs b/testsuite/tests/ghci/scripts/T10110C.hs new file mode 100644 index 0000000..7069207 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10110C.hs @@ -0,0 +1,5 @@ +module T10110C (c) where +import T10110A (a) +import T10110B (b) +c :: Int +c = a+b diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 270e3ae..69c5254 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -208,3 +208,4 @@ test('T9878b', ghci_script, ['T9878b.script']) test('T10321', normal, ghci_script, ['T10321.script']) +test('T10110', normal, ghci_script, ['T10110.script']) From git at git.haskell.org Tue May 19 09:21:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 09:21:49 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: user guide: correct documentation for -Wall (fixes #10386) (6d5387f) Message-ID: <20150519092149.49BE73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/6d5387f6f1f86c5a622df0de76f0b909ce1c1a7d/ghc >--------------------------------------------------------------- commit 6d5387f6f1f86c5a622df0de76f0b909ce1c1a7d Author: Alexander Eyers-Taylor Date: Tue May 19 01:22:27 2015 -0500 user guide: correct documentation for -Wall (fixes #10386) This fixes the documentation for -Wall. As was done previously it leaves out deprecated flags and also fwarn-safe and fwarn-unsafe. I don't know if that was intended or not. -fwarn-safe and fwarn-unsafe are not mentioned on the warnings page at all instead they are mentioned in the safe haskell section. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D889 GHC Trac Issues: #10386 (cherry picked from commit 5cbac8866e1cf1f5a015e318bf298954b7bf6417) >--------------------------------------------------------------- 6d5387f6f1f86c5a622df0de76f0b909ce1c1a7d docs/users_guide/using.xml | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 50da497..98c17fc 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -1078,14 +1078,15 @@ test.hs:(5,4)-(6,7): suspicious code. The warnings that are not enabled by are - , - , - , - , - , - , and - , - . + , + , + , + , + , + , + , + and + . From git at git.haskell.org Tue May 19 09:21:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 09:21:52 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: includes/stg/SMP.h: implement simple load_/store_load_barrier on armv6 and older (b41e4be) Message-ID: <20150519092152.024C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/b41e4be724c02c7f08821c2fd74a33c6ed1021ae/ghc >--------------------------------------------------------------- commit b41e4be724c02c7f08821c2fd74a33c6ed1021ae Author: Sergei Trofimovich Date: Mon May 18 22:22:18 2015 +0100 includes/stg/SMP.h: implement simple load_/store_load_barrier on armv6 and older Assuming there is no real SMP systems on these CPUs I've added only compiler barrier (otherwise write_barrier and friends need to be fixed as well). Patch also fixes build breakage reported in #10244. Signed-off-by: Sergei Trofimovich Reviewers: rwbarton, nomeata, austin Reviewed By: nomeata, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D894 GHC Trac Issues: #10244 (cherry picked from commit eaaa38ba24d5152623cb202a98f71ed09deef0bb) >--------------------------------------------------------------- b41e4be724c02c7f08821c2fd74a33c6ed1021ae includes/stg/SMP.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h index 5ded05d..5460a2b 100644 --- a/includes/stg/SMP.h +++ b/includes/stg/SMP.h @@ -373,6 +373,8 @@ store_load_barrier(void) { __asm__ __volatile__ ("sync" : : : "memory"); #elif sparc_HOST_ARCH __asm__ __volatile__ ("membar #StoreLoad" : : : "memory"); +#elif arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv7) + __asm__ __volatile__ ("" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb" : : : "memory"); #elif aarch64_HOST_ARCH @@ -395,6 +397,8 @@ load_load_barrier(void) { #elif sparc_HOST_ARCH /* Sparc in TSO mode does not require load/load barriers. */ __asm__ __volatile__ ("" : : : "memory"); +#elif arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv7) + __asm__ __volatile__ ("" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb" : : : "memory"); #elif aarch64_HOST_ARCH From git at git.haskell.org Tue May 19 09:34:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 09:34:16 +0000 (UTC) Subject: [commit: ghc] master: Add a TODO FIXME w.r.t. D894 (753b156) Message-ID: <20150519093416.1A0C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/753b156dc6b0c38b106c390952750fb800bf27e7/ghc >--------------------------------------------------------------- commit 753b156dc6b0c38b106c390952750fb800bf27e7 Author: Austin Seipp Date: Tue May 19 04:32:49 2015 -0500 Add a TODO FIXME w.r.t. D894 As Reid mentioned in a comment on D894, the case fixed by this revision likely isn't really correct, because old ARM binaries could run on newer machines, meaning we need to detect at runtime whether we need a proper barrier. But in the mean time, this actually stops the build from failing - which is better off. So we'll just remember this when we fix it in the future. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 753b156dc6b0c38b106c390952750fb800bf27e7 includes/stg/SMP.h | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h index 5460a2b..10ef83e 100644 --- a/includes/stg/SMP.h +++ b/includes/stg/SMP.h @@ -374,6 +374,11 @@ store_load_barrier(void) { #elif sparc_HOST_ARCH __asm__ __volatile__ ("membar #StoreLoad" : : : "memory"); #elif arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv7) + // TODO FIXME: This case probably isn't totally correct - just because we + // use a pre-ARMv7 toolchain (e.g. to target an old Android device), doesn't + // mean the binary won't run on a newer ARMv7 system - in which case it + // needs a proper barrier. So we should rethink this + // - Reid __asm__ __volatile__ ("" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb" : : : "memory"); From git at git.haskell.org Tue May 19 10:49:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 10:49:32 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #8799, #8555 (fc8c5e7) Message-ID: <20150519104932.A8EA83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fc8c5e7a516803c04f2a38b53b9e8beb2066c056/ghc >--------------------------------------------------------------- commit fc8c5e7a516803c04f2a38b53b9e8beb2066c056 Author: Simon Peyton Jones Date: Tue May 19 11:48:53 2015 +0100 Test Trac #8799, #8555 >--------------------------------------------------------------- fc8c5e7a516803c04f2a38b53b9e8beb2066c056 testsuite/tests/typecheck/should_compile/T8555.hs | 7 +++++++ testsuite/tests/typecheck/should_compile/T8799.hs | 10 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 3 files changed, 19 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T8555.hs b/testsuite/tests/typecheck/should_compile/T8555.hs new file mode 100644 index 0000000..c5e817b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T8555.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE FlexibleContexts #-} + +module T8555 where +import Data.Coerce + +foo :: Coercible [a] [b] => a -> b +foo = coerce diff --git a/testsuite/tests/typecheck/should_compile/T8799.hs b/testsuite/tests/typecheck/should_compile/T8799.hs new file mode 100644 index 0000000..f5a92d4 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T8799.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE FlexibleContexts #-} + +module T8555 where +import Data.Coerce + +foo :: Coercible a b => b -> a +foo = coerce + +bar :: (Coercible a b, Coercible b c) => b -> c -> a +bar b c = coerce c diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 562acba..2f257ea 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -454,3 +454,5 @@ test('T10335', normal, compile, ['']) test('Improvement', normal, compile, ['']) test('T10009', normal, compile, ['']) test('T10390', normal, compile, ['']) +test('T8555', normal, compile, ['']) +test('T8799', normal, compile, ['']) From git at git.haskell.org Tue May 19 12:28:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 12:28:28 +0000 (UTC) Subject: [commit: ghc] master: Revert "compiler: make sure we reject -O + HscInterpreted" (again) (edb8dc5) Message-ID: <20150519122828.95F5B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/edb8dc5cd2350206fcbe0ab8aa0954b3db50d7ab/ghc >--------------------------------------------------------------- commit edb8dc5cd2350206fcbe0ab8aa0954b3db50d7ab Author: Austin Seipp Date: Tue May 19 07:28:00 2015 -0500 Revert "compiler: make sure we reject -O + HscInterpreted" (again) Apparently my machine likes this commit, but Harbormaster does not? This reverts commit b199536be25ea046079587933cc73d0a948a0626. >--------------------------------------------------------------- edb8dc5cd2350206fcbe0ab8aa0954b3db50d7ab compiler/main/DynFlags.hs | 12 ++++---- compiler/main/ErrUtils.hs | 6 +--- compiler/main/GHC.hs | 41 ++++---------------------- compiler/simplCore/FloatOut.hs | 27 ----------------- testsuite/.gitignore | 1 - testsuite/tests/ghc-api/T10052/Makefile | 12 -------- testsuite/tests/ghc-api/T10052/T10052-input.hs | 1 - testsuite/tests/ghc-api/T10052/T10052.hs | 30 ------------------- testsuite/tests/ghc-api/T10052/T10052.stderr | 3 -- testsuite/tests/ghc-api/T10052/T10052.stdout | 1 - testsuite/tests/ghc-api/T10052/all.T | 2 -- 11 files changed, 12 insertions(+), 124 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 edb8dc5cd2350206fcbe0ab8aa0954b3db50d7ab From git at git.haskell.org Tue May 19 19:37:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 19:37:40 +0000 (UTC) Subject: [commit: ghc] master: Fix error messages from open(Binary)TempFileWithDefaultPermissions (25d1a71) Message-ID: <20150519193740.075603A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/25d1a716395e349736994759d1fcbb3721f3ee9f/ghc >--------------------------------------------------------------- commit 25d1a716395e349736994759d1fcbb3721f3ee9f Author: Reid Barton Date: Tue May 19 15:34:31 2015 -0400 Fix error messages from open(Binary)TempFileWithDefaultPermissions Fixes Trac #10430. >--------------------------------------------------------------- 25d1a716395e349736994759d1fcbb3721f3ee9f libraries/base/System/IO.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index 7b13552..e0ee9b1 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -453,13 +453,13 @@ openBinaryTempFile tmp_dir template openTempFileWithDefaultPermissions :: FilePath -> String -> IO (FilePath, Handle) openTempFileWithDefaultPermissions tmp_dir template - = openTempFile' "openBinaryTempFile" tmp_dir template False 0o666 + = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666 -- | Like 'openBinaryTempFile', but uses the default file permissions openBinaryTempFileWithDefaultPermissions :: FilePath -> String -> IO (FilePath, Handle) openBinaryTempFileWithDefaultPermissions tmp_dir template - = openTempFile' "openBinaryTempFile" tmp_dir template True 0o666 + = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666 openTempFile' :: String -> FilePath -> String -> Bool -> CMode -> IO (FilePath, Handle) From git at git.haskell.org Tue May 19 21:57:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 May 2015 21:57:51 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: Clarifications from today's Skype call. (c934914) Message-ID: <20150519215751.11E763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c9349146ea74f0e074e287f29581e759cc5f8afd/ghc >--------------------------------------------------------------- commit c9349146ea74f0e074e287f29581e759cc5f8afd Author: Edward Z. Yang Date: Tue May 19 14:57:42 2015 -0700 Backpack docs: Clarifications from today's Skype call. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- c9349146ea74f0e074e287f29581e759cc5f8afd docs/backpack/algorithm.pdf | Bin 279771 -> 280399 bytes docs/backpack/algorithm.tex | 44 ++++++++++++++++++++++++++++---------------- 2 files changed, 28 insertions(+), 16 deletions(-) diff --git a/docs/backpack/algorithm.pdf b/docs/backpack/algorithm.pdf index 557bdf2..bff61ae 100644 Binary files a/docs/backpack/algorithm.pdf and b/docs/backpack/algorithm.pdf differ diff --git a/docs/backpack/algorithm.tex b/docs/backpack/algorithm.tex index f3828b2..106dcc2 100644 --- a/docs/backpack/algorithm.tex +++ b/docs/backpack/algorithm.tex @@ -118,8 +118,12 @@ $$ \end{figure} Shaping computes a \I{Shape}, whose form is described in Figure~\ref{fig:semantic}. -Initializing the shape context to the empty shape, we incrementally -build the context as follows: +A shape describes what modules a package implements and exports (the \emph{provides}) +and what signatures a package needs to have filled in (the \emph{requires}). Both +provisions and requires can be imported after a package is included. + +We incrementally build a shape by starting with an empty +shape context and adding to it as follows: \begin{enumerate} \item Calculate the shape of a declaration, with respect to the @@ -740,8 +744,8 @@ key from the identifiers. module B where data T = S { baz :: Bool } module C(bar, baz) where - import A - import B + import A(bar) + import B(baz) -- A.T{ A.bar }, B.T{ B.baz } -- NB: it would be illegal for the type constructors -- A.T and B.T to be both exported from C! @@ -806,8 +810,8 @@ The answer is no! Consider these implementations: data A = A { foo :: Int, bar :: Bool } module A(foo, bar) where - import A1 - import A2 + import A1(foo) + import A2(bar) \end{verbatim} Here, \verb|module A1| implements \verb|signature A1|, \verb|module A2| implements \verb|signature A2|, @@ -864,31 +868,36 @@ equivalent to the shapes for these which should merge: \subsection{Subtyping record selectors as functions} \begin{verbatim} - signature H(foo) where + signature H(A, foo) where data A foo :: A -> Int - module M(foo) where + module M(A, foo) where data A = A { foo :: Int, bar :: Bool } \end{verbatim} % Does \verb|M| successfully fill \verb|H|? If so, it means that anywhere a signature requests a function \verb|foo|, we can instead validly -provide a record selector. This capability seems quite attractive -but actually it is quite complicated, because we can no longer assume -that every child name is associated with a parent name. +provide a record selector. This capability seems quite attractive, +although in practice record selectors rarely seem to be abstracted this +way: one reason is that \verb|M.foo| still \emph{is} a record selector, +and can be used to modify a record. (Many library authors find this +suprising!) -As a workaround, \verb|H| can equivalently be written as: +Nor does this seem to be an insurmountable instance of the avoidance +problem: +as a workaround, \verb|H| can equivalently be written as: \begin{verbatim} signature H(foo) where data A = A { foo :: Int, bar :: Bool } \end{verbatim} % -This is suboptimal, however, as the otherwise irrelevant \verb|bar| must be mentioned +However, you might not like this, as the otherwise irrelevant \verb|bar| must be mentioned in the definition. -So what if we actually want to write the original signature \verb|H|? +In any case, actually implementing this `subtyping' is quite complicated, because we can no +longer assume that every child name is associated with a parent name. The technical difficulty is that we now need to unify a plain identifier \I{AvailInfo} (from the signature) with a type constructor \I{AvailInfo} (from a module.) It is not clear what this should mean. @@ -910,8 +919,11 @@ Consider this situation: import X(A(..)) -- ??? \end{verbatim} -Should the wildcard import on \verb|X| be allowed? Probably not? -How about this situation: +Should the wildcard import on \verb|X| be allowed? +This question is equivalent to whether or not shaping discovers +whether or not a function is a record selector and propagates this +information elsewhere. +If the wildcard is not allowed, here is another situation: \begin{verbatim} package p where From git at git.haskell.org Wed May 20 14:00:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 May 2015 14:00:46 +0000 (UTC) Subject: [commit: ghc] master: Fix binary instance for IfaceLitTy (9f968e9) Message-ID: <20150520140046.20DB73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f968e97a0de9c2509da00f6337b612dd72a0389/ghc >--------------------------------------------------------------- commit 9f968e97a0de9c2509da00f6337b612dd72a0389 Author: Simon Peyton Jones Date: Wed May 20 14:26:06 2015 +0100 Fix binary instance for IfaceLitTy Thanks to Christiaan Baaj for spotting this. >--------------------------------------------------------------- 9f968e97a0de9c2509da00f6337b612dd72a0389 compiler/iface/IfaceType.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 6dfff6e..4e3f9d6 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -748,11 +748,9 @@ instance Binary IfaceType where ; return (IfaceTyConApp tc tys) } 6 -> do { s <- get bh; i <- get bh; tys <- get bh ; return (IfaceTupleTy s i tys) } - 30 -> do n <- get bh + _ -> do n <- get bh return (IfaceLitTy n) - _ -> panic ("get IfaceType " ++ show h) - instance Binary IfaceCoercion where put_ bh (IfaceReflCo a b) = do putByte bh 1 From git at git.haskell.org Thu May 21 12:13:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 12:13:51 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : AST version of nested forall loses forall annotation (c553e98) Message-ID: <20150521121351.BBF243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c553e980e4a5d149af13bb705ec02819a15937ee/ghc >--------------------------------------------------------------- commit c553e980e4a5d149af13bb705ec02819a15937ee Author: Alan Zimmerman Date: Thu May 21 14:13:42 2015 +0200 ApiAnnotations : AST version of nested forall loses forall annotation Summary: When parsing {-# LANGUAGE ScopedTypeVariables #-} extremumNewton :: forall tag. forall tag1. tag -> tag1 -> Int extremumNewton = undefined the parser creates nested HsForAllTy's for the two forall statements. These get flattened into a single one in `HsTypes.mk_forall_ty` This patch removes the flattening, so that API Annotations are not lost in the process. Test Plan: ./validate Reviewers: goldfire, austin, simonpj Reviewed By: simonpj Subscribers: bgamari, mpickering, thomie, goldfire Differential Revision: https://phabricator.haskell.org/D836 GHC Trac Issues: #10278, #10315, #10354, #10363 >--------------------------------------------------------------- c553e980e4a5d149af13bb705ec02819a15937ee compiler/hsSyn/Convert.hs | 5 +- compiler/hsSyn/HsSyn.hs | 2 +- compiler/hsSyn/HsTypes.hs | 85 +++++++--- compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 13 +- compiler/rename/RnNames.hs | 3 +- compiler/rename/RnTypes.hs | 107 +++++++------ testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + testsuite/tests/ghc-api/annotations/T10278.stderr | 16 ++ testsuite/tests/ghc-api/annotations/T10278.stdout | 171 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10278.hs | 20 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10357.hs => t10278.hs} | 2 +- 14 files changed, 360 insertions(+), 78 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 c553e980e4a5d149af13bb705ec02819a15937ee From git at git.haskell.org Thu May 21 13:05:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 13:05:57 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations : parens around a context with wildcard loses annotations (0df14b5) Message-ID: <20150521130557.B83773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0df14b5db06751f817d3ba794cc74ac54519b5b8/ghc >--------------------------------------------------------------- commit 0df14b5db06751f817d3ba794cc74ac54519b5b8 Author: Alan Zimmerman Date: Thu May 21 15:05:48 2015 +0200 ApiAnnotations : parens around a context with wildcard loses annotations Summary: In the following code, the extra set of parens around the context end up with detached annotations. {-# LANGUAGE PartialTypeSignatures #-} module ParensAroundContext where f :: ((Eq a, _)) => a -> a -> Bool f x y = x == y Trac ticket #10354 It turns out it was the TupleTy that was the culprit. This may also solve #10315 Test Plan: ./validate Reviewers: hvr, austin, goldfire Reviewed By: austin Subscribers: goldfire, bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D868 GHC Trac Issues: #10354, #10315 >--------------------------------------------------------------- 0df14b5db06751f817d3ba794cc74ac54519b5b8 compiler/parser/Parser.y | 10 +-- compiler/parser/RdrHsSyn.hs | 18 +++-- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10278.stdout | 16 ++-- testsuite/tests/ghc-api/annotations/T10354.stderr | 3 + testsuite/tests/ghc-api/annotations/T10354.stdout | 90 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10354.hs | 14 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10278.hs => t10354.hs} | 2 +- 10 files changed, 141 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0df14b5db06751f817d3ba794cc74ac54519b5b8 From git at git.haskell.org Thu May 21 13:48:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 13:48:16 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotatons : AnnDcolon in wrong place for PatBind (c488da8) Message-ID: <20150521134816.912C43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c488da851c39ca202cdd056091176acbabdd7dd4/ghc >--------------------------------------------------------------- commit c488da851c39ca202cdd056091176acbabdd7dd4 Author: Alan Zimmerman Date: Thu May 21 15:48:07 2015 +0200 ApiAnnotatons : AnnDcolon in wrong place for PatBind Summary: In the following code fragment let ls :: Int = undefined the `::` is attached to the ls function as a whole, rather than to the pattern on the LHS. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D883 GHC Trac Issues: #10396 >--------------------------------------------------------------- c488da851c39ca202cdd056091176acbabdd7dd4 compiler/parser/Parser.y | 5 ++- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++++ testsuite/tests/ghc-api/annotations/T10396.stdout | 43 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10396.hs | 7 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 +- .../tests/ghc-api/annotations/parseTree.stdout | 2 +- .../ghc-api/annotations/{t10278.hs => t10396.hs} | 2 +- 9 files changed, 66 insertions(+), 5 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 5a862a8..c167da0 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2002,8 +2002,9 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } case r of { (FunBind n _ _ _ _ _) -> ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ; - _ -> return () } ; - _ <- ams (L l ()) (ann ++ (fst $2) ++ (fst $ unLoc $3)); + (PatBind (L lh _lhs) _rhs _ _ _) -> + ams (L lh ()) (fst $2) >> return () } ; + _ <- ams (L l ()) (ann ++ (fst $ unLoc $3)); return $! (sL l (unitOL $! (sL l $ ValD r))) } } | pattern_synonym_decl { sLL $1 $> $ unitOL $1 } | docdecl { sLL $1 $> $ unitOL $1 } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index bb19b13..a7726f8 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -15,6 +15,7 @@ t10307 boolFormula t10278 t10354 +t10396 *.hi *.o *.run.* diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index da6a358..69ce026 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -13,6 +13,7 @@ clean: rm -f t10357 rm -f t10278 rm -f t10354 + rm -f t10396 annotations: rm -f annotations.o annotations.hi @@ -46,6 +47,13 @@ t10358: .PHONY: t10358 +T10396: + rm -f T10396.o T10396.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10396 + ./t10396 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10396 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10396.stdout b/testsuite/tests/ghc-api/annotations/T10396.stdout new file mode 100644 index 0000000..61d0399 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10396.stdout @@ -0,0 +1,43 @@ +---Problems--------------------- +[ +] + +---Problems'-------------------- +[] +-------------------------------- +[ +(AK Test10396.hs:1:1 AnnModule = [Test10396.hs:2:1-6]) + +(AK Test10396.hs:1:1 AnnWhere = [Test10396.hs:2:18-22]) + +(AK Test10396.hs:4:1-15 AnnDcolon = [Test10396.hs:4:8-9]) + +(AK Test10396.hs:4:1-15 AnnSemi = [Test10396.hs:5:1]) + +(AK Test10396.hs:4:14-15 AnnCloseP = [Test10396.hs:4:15]) + +(AK Test10396.hs:4:14-15 AnnOpenP = [Test10396.hs:4:14]) + +(AK Test10396.hs:(5,1)-(7,11) AnnEqual = [Test10396.hs:5:7]) + +(AK Test10396.hs:(5,1)-(7,11) AnnFunId = [Test10396.hs:5:1-6]) + +(AK Test10396.hs:(5,1)-(7,11) AnnSemi = [Test10396.hs:8:1]) + +(AK Test10396.hs:(5,9)-(7,11) AnnDo = [Test10396.hs:5:9-10]) + +(AK Test10396.hs:6:3-27 AnnLet = [Test10396.hs:6:3-5]) + +(AK Test10396.hs:6:3-27 AnnSemi = [Test10396.hs:7:3]) + +(AK Test10396.hs:6:7-15 AnnDcolon = [Test10396.hs:6:10-11]) + +(AK Test10396.hs:6:7-27 AnnEqual = [Test10396.hs:6:17]) + +(AK Test10396.hs:7:10-11 AnnCloseP = [Test10396.hs:7:11]) + +(AK Test10396.hs:7:10-11 AnnOpenP = [Test10396.hs:7:10]) + +(AK AnnEofPos = [Test10396.hs:8:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10396.hs b/testsuite/tests/ghc-api/annotations/Test10396.hs new file mode 100644 index 0000000..71b18a8 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10396.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Test10396 where + +errors :: IO () +errors= do + let ls :: Int = undefined + return () diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 0a0b5a6..ed04646 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -15,3 +15,4 @@ test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357' test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) test('T10278', normal, run_command, ['$MAKE -s --no-print-directory T10278']) test('T10354', normal, run_command, ['$MAKE -s --no-print-directory T10354']) +test('T10396', normal, run_command, ['$MAKE -s --no-print-directory T10396']) diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout index 128b70a..706d858 100644 --- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout +++ b/testsuite/tests/ghc-api/annotations/exampleTest.stdout @@ -149,7 +149,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/parseTree.stdout b/testsuite/tests/ghc-api/annotations/parseTree.stdout index 9965fd2..4986ddf 100644 --- a/testsuite/tests/ghc-api/annotations/parseTree.stdout +++ b/testsuite/tests/ghc-api/annotations/parseTree.stdout @@ -153,7 +153,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/t10278.hs b/testsuite/tests/ghc-api/annotations/t10396.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10278.hs copy to testsuite/tests/ghc-api/annotations/t10396.hs index 9d13548..5ece668 100644 --- a/testsuite/tests/ghc-api/annotations/t10278.hs +++ b/testsuite/tests/ghc-api/annotations/t10396.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10278" + testOneFile libdir "Test10396" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Thu May 21 18:25:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 18:25:07 +0000 (UTC) Subject: [commit: ghc] branch 'wip/api-annots-ghc-7.10' created Message-ID: <20150521182507.8153A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/api-annots-ghc-7.10 Referencing: 382eba2bbad73b6dcfb8d0bad3bb2d6cc0ded5a3 From git at git.haskell.org Thu May 21 18:25:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 18:25:10 +0000 (UTC) Subject: [commit: ghc] wip/api-annots-ghc-7.10: Turn off warnings when compiling boolFormula (e026fb2) Message-ID: <20150521182510.755073A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots-ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/e026fb2116443031a7264d204a2a602242182208/ghc >--------------------------------------------------------------- commit e026fb2116443031a7264d204a2a602242182208 Author: Alan Zimmerman Date: Tue May 12 17:04:50 2015 +0200 Turn off warnings when compiling boolFormula Summary: There is a problem where harbourmaster builds complain about a bad boolFormula.stderr ghc-api/annotations boolFormula [bad stderr] (normal) The problem does not occur for a local build on my box This patch turns off warnings for this test, to get rid of the stderr issue. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, hvr Differential Revision: https://phabricator.haskell.org/D888 (cherry picked from commit 6ee4b6fdfb07bb479a1a9ab3e3866ca6a6192e20) >--------------------------------------------------------------- e026fb2116443031a7264d204a2a602242182208 testsuite/tests/ghc-api/annotations/Makefile | 3 +- .../tests/ghc-api/annotations/TestBoolFormula.hs | 10 ++ .../tests/ghc-api/annotations/boolFormula.stdout | 190 ++++++++++++++------- 3 files changed, 137 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 e026fb2116443031a7264d204a2a602242182208 From git at git.haskell.org Thu May 21 18:25:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 18:25:14 +0000 (UTC) Subject: [commit: ghc] wip/api-annots-ghc-7.10: ApiAnnotations : AST version of nested forall loses forall annotation (2cbd7f9) Message-ID: <20150521182514.9AC923A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots-ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2cbd7f959976618ddb03fcee5714d5801b60ab9e/ghc >--------------------------------------------------------------- commit 2cbd7f959976618ddb03fcee5714d5801b60ab9e Author: Alan Zimmerman Date: Thu May 21 14:13:42 2015 +0200 ApiAnnotations : AST version of nested forall loses forall annotation Summary: When parsing {-# LANGUAGE ScopedTypeVariables #-} extremumNewton :: forall tag. forall tag1. tag -> tag1 -> Int extremumNewton = undefined the parser creates nested HsForAllTy's for the two forall statements. These get flattened into a single one in `HsTypes.mk_forall_ty` This patch removes the flattening, so that API Annotations are not lost in the process. Test Plan: ./validate Reviewers: goldfire, austin, simonpj Reviewed By: simonpj Subscribers: bgamari, mpickering, thomie, goldfire Differential Revision: https://phabricator.haskell.org/D836 GHC Trac Issues: #10278, #10315, #10354, #10363 (cherry picked from commit c553e980e4a5d149af13bb705ec02819a15937ee) Conflicts: compiler/hsSyn/HsTypes.hs >--------------------------------------------------------------- 2cbd7f959976618ddb03fcee5714d5801b60ab9e compiler/hsSyn/Convert.hs | 5 +- compiler/hsSyn/HsSyn.hs | 2 +- compiler/hsSyn/HsTypes.hs | 94 ++++++++--- compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 13 +- compiler/rename/RnNames.hs | 3 +- compiler/rename/RnTypes.hs | 107 +++++++------ testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + testsuite/tests/ghc-api/annotations/T10278.stderr | 12 ++ testsuite/tests/ghc-api/annotations/T10278.stdout | 171 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10278.hs | 20 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10357.hs => t10278.hs} | 2 +- 14 files changed, 365 insertions(+), 78 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 2cbd7f959976618ddb03fcee5714d5801b60ab9e From git at git.haskell.org Thu May 21 18:25:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 18:25:18 +0000 (UTC) Subject: [commit: ghc] wip/api-annots-ghc-7.10: ApiAnnotations : parens around a context with wildcard loses annotations (1289c59) Message-ID: <20150521182518.D02EB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots-ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/1289c598b91ba3ec7c5313cc20437a41122c1fc2/ghc >--------------------------------------------------------------- commit 1289c598b91ba3ec7c5313cc20437a41122c1fc2 Author: Alan Zimmerman Date: Thu May 21 15:05:48 2015 +0200 ApiAnnotations : parens around a context with wildcard loses annotations Summary: In the following code, the extra set of parens around the context end up with detached annotations. {-# LANGUAGE PartialTypeSignatures #-} module ParensAroundContext where f :: ((Eq a, _)) => a -> a -> Bool f x y = x == y Trac ticket #10354 It turns out it was the TupleTy that was the culprit. This may also solve #10315 Test Plan: ./validate Reviewers: hvr, austin, goldfire Reviewed By: austin Subscribers: goldfire, bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D868 GHC Trac Issues: #10354, #10315 (cherry picked from commit 0df14b5db06751f817d3ba794cc74ac54519b5b8) >--------------------------------------------------------------- 1289c598b91ba3ec7c5313cc20437a41122c1fc2 compiler/parser/Parser.y | 10 +-- compiler/parser/RdrHsSyn.hs | 18 +++-- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10278.stdout | 16 ++-- testsuite/tests/ghc-api/annotations/T10354.stderr | 3 + testsuite/tests/ghc-api/annotations/T10354.stdout | 90 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10354.hs | 14 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10278.hs => t10354.hs} | 2 +- 10 files changed, 141 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1289c598b91ba3ec7c5313cc20437a41122c1fc2 From git at git.haskell.org Thu May 21 18:25:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 May 2015 18:25:22 +0000 (UTC) Subject: [commit: ghc] wip/api-annots-ghc-7.10: ApiAnnotatons : AnnDcolon in wrong place for PatBind (382eba2) Message-ID: <20150521182522.AA5CF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots-ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/382eba2bbad73b6dcfb8d0bad3bb2d6cc0ded5a3/ghc >--------------------------------------------------------------- commit 382eba2bbad73b6dcfb8d0bad3bb2d6cc0ded5a3 Author: Alan Zimmerman Date: Thu May 21 15:48:07 2015 +0200 ApiAnnotatons : AnnDcolon in wrong place for PatBind Summary: In the following code fragment let ls :: Int = undefined the `::` is attached to the ls function as a whole, rather than to the pattern on the LHS. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D883 GHC Trac Issues: #10396 (cherry picked from commit c488da851c39ca202cdd056091176acbabdd7dd4) >--------------------------------------------------------------- 382eba2bbad73b6dcfb8d0bad3bb2d6cc0ded5a3 compiler/parser/Parser.y | 5 ++- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++++ testsuite/tests/ghc-api/annotations/T10354.stderr | 2 +- testsuite/tests/ghc-api/annotations/T10396.stdout | 43 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10396.hs | 7 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 +- .../tests/ghc-api/annotations/parseTree.stdout | 2 +- .../ghc-api/annotations/{t10278.hs => t10396.hs} | 2 +- 10 files changed, 67 insertions(+), 6 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index d37c204..53a7b7c 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1870,8 +1870,9 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } case r of { (FunBind n _ _ _ _ _) -> ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ; - _ -> return () } ; - _ <- ams (L l ()) (ann ++ (fst $2) ++ (fst $ unLoc $3)); + (PatBind (L lh _lhs) _rhs _ _ _) -> + ams (L lh ()) (fst $2) >> return () } ; + _ <- ams (L l ()) (ann ++ (fst $ unLoc $3)); return $! (sL l (unitOL $! (sL l $ ValD r))) } } | pattern_synonym_decl { sLL $1 $> $ unitOL $1 } | docdecl { sLL $1 $> $ unitOL $1 } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index bb19b13..a7726f8 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -15,6 +15,7 @@ t10307 boolFormula t10278 t10354 +t10396 *.hi *.o *.run.* diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index da6a358..69ce026 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -13,6 +13,7 @@ clean: rm -f t10357 rm -f t10278 rm -f t10354 + rm -f t10396 annotations: rm -f annotations.o annotations.hi @@ -46,6 +47,13 @@ t10358: .PHONY: t10358 +T10396: + rm -f T10396.o T10396.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10396 + ./t10396 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10396 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10354.stderr b/testsuite/tests/ghc-api/annotations/T10354.stderr index c0f9172..1e97b8a 100644 --- a/testsuite/tests/ghc-api/annotations/T10354.stderr +++ b/testsuite/tests/ghc-api/annotations/T10354.stderr @@ -1,3 +1,3 @@ -Test10354.hs:13:8: error: +Test10354.hs:13:8: Not in scope: type constructor or class ?ForceError? diff --git a/testsuite/tests/ghc-api/annotations/T10396.stdout b/testsuite/tests/ghc-api/annotations/T10396.stdout new file mode 100644 index 0000000..61d0399 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10396.stdout @@ -0,0 +1,43 @@ +---Problems--------------------- +[ +] + +---Problems'-------------------- +[] +-------------------------------- +[ +(AK Test10396.hs:1:1 AnnModule = [Test10396.hs:2:1-6]) + +(AK Test10396.hs:1:1 AnnWhere = [Test10396.hs:2:18-22]) + +(AK Test10396.hs:4:1-15 AnnDcolon = [Test10396.hs:4:8-9]) + +(AK Test10396.hs:4:1-15 AnnSemi = [Test10396.hs:5:1]) + +(AK Test10396.hs:4:14-15 AnnCloseP = [Test10396.hs:4:15]) + +(AK Test10396.hs:4:14-15 AnnOpenP = [Test10396.hs:4:14]) + +(AK Test10396.hs:(5,1)-(7,11) AnnEqual = [Test10396.hs:5:7]) + +(AK Test10396.hs:(5,1)-(7,11) AnnFunId = [Test10396.hs:5:1-6]) + +(AK Test10396.hs:(5,1)-(7,11) AnnSemi = [Test10396.hs:8:1]) + +(AK Test10396.hs:(5,9)-(7,11) AnnDo = [Test10396.hs:5:9-10]) + +(AK Test10396.hs:6:3-27 AnnLet = [Test10396.hs:6:3-5]) + +(AK Test10396.hs:6:3-27 AnnSemi = [Test10396.hs:7:3]) + +(AK Test10396.hs:6:7-15 AnnDcolon = [Test10396.hs:6:10-11]) + +(AK Test10396.hs:6:7-27 AnnEqual = [Test10396.hs:6:17]) + +(AK Test10396.hs:7:10-11 AnnCloseP = [Test10396.hs:7:11]) + +(AK Test10396.hs:7:10-11 AnnOpenP = [Test10396.hs:7:10]) + +(AK AnnEofPos = [Test10396.hs:8:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10396.hs b/testsuite/tests/ghc-api/annotations/Test10396.hs new file mode 100644 index 0000000..71b18a8 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10396.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Test10396 where + +errors :: IO () +errors= do + let ls :: Int = undefined + return () diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 0a0b5a6..ed04646 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -15,3 +15,4 @@ test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357' test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) test('T10278', normal, run_command, ['$MAKE -s --no-print-directory T10278']) test('T10354', normal, run_command, ['$MAKE -s --no-print-directory T10354']) +test('T10396', normal, run_command, ['$MAKE -s --no-print-directory T10396']) diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout index 128b70a..706d858 100644 --- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout +++ b/testsuite/tests/ghc-api/annotations/exampleTest.stdout @@ -149,7 +149,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/parseTree.stdout b/testsuite/tests/ghc-api/annotations/parseTree.stdout index 9965fd2..4986ddf 100644 --- a/testsuite/tests/ghc-api/annotations/parseTree.stdout +++ b/testsuite/tests/ghc-api/annotations/parseTree.stdout @@ -153,7 +153,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/t10278.hs b/testsuite/tests/ghc-api/annotations/t10396.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10278.hs copy to testsuite/tests/ghc-api/annotations/t10396.hs index 9d13548..5ece668 100644 --- a/testsuite/tests/ghc-api/annotations/t10278.hs +++ b/testsuite/tests/ghc-api/annotations/t10396.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10278" + testOneFile libdir "Test10396" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Fri May 22 13:09:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 13:09:21 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: compiler: make sure we reject -O + HscInterpreted (46edc43) Message-ID: <20150522130921.9B1823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/46edc43cbe011978d903dd0b5f0ffc62c602fbaa/ghc >--------------------------------------------------------------- commit 46edc43cbe011978d903dd0b5f0ffc62c602fbaa Author: Austin Seipp Date: Tue May 19 01:56:48 2015 -0500 compiler: make sure we reject -O + HscInterpreted When using GHCi, we explicitly reject optimization, because the compilers optimization passes can introduce unboxed tuples, which the interpreter is not able to handle. But this goes the other way too: using GHCi on optimized code may cause the optimizer to float out breakpoints that the interpreter introduces. This manifests itself in weird ways, particularly if you as an API client use custom DynFlags to introduce optimization in combination with HscInterpreted. It turns out we weren't checking for consistent DynFlag settings when doing `setSessionDynFlags`, as #10052 showed. While the main driver handled it in `DynFlags` via `parseDynamicFlags`, we didn't check this elsewhere. This does a little refactoring to split out some of the common code, and immunizes the various `DynFlags` utilities in the `GHC` module from this particular bug. We should probably be checking other general invariants too. This fixes #10052, and adds some notes about the behavior in `GHC` and `FloatOut` As a bonus, expose `warningMsg` from `ErrUtils` as a helper since it didn't exist (somehow). Signed-off-by: Austin Seipp Reviewed By: edsko Differential Revision: https://phabricator.haskell.org/D727 GHC Trac Issues: #10052 (cherry picked from commit b199536be25ea046079587933cc73d0a948a0626) >--------------------------------------------------------------- 46edc43cbe011978d903dd0b5f0ffc62c602fbaa compiler/main/DynFlags.hs | 12 ++++--- compiler/main/ErrUtils.hs | 6 +++- compiler/main/GHC.hs | 41 ++++++++++++++++++---- compiler/simplCore/FloatOut.hs | 27 ++++++++++++++ testsuite/.gitignore | 1 + testsuite/tests/ghc-api/T10052/Makefile | 12 +++++++ testsuite/tests/ghc-api/T10052/T10052-input.hs | 1 + testsuite/tests/ghc-api/T10052/T10052.hs | 30 ++++++++++++++++ .../T10052/T10052.stderr} | 0 testsuite/tests/ghc-api/T10052/T10052.stdout | 1 + testsuite/tests/ghc-api/T10052/all.T | 2 ++ 11 files changed, 121 insertions(+), 12 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 46edc43cbe011978d903dd0b5f0ffc62c602fbaa From git at git.haskell.org Fri May 22 13:09:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 13:09:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotations : AST version of nested forall loses forall annotation (fb918ab) Message-ID: <20150522130925.C63283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/fb918ab551b6da75cdaf96ad62f9479dcab21400/ghc >--------------------------------------------------------------- commit fb918ab551b6da75cdaf96ad62f9479dcab21400 Author: Alan Zimmerman Date: Thu May 21 14:13:42 2015 +0200 ApiAnnotations : AST version of nested forall loses forall annotation Summary: When parsing {-# LANGUAGE ScopedTypeVariables #-} extremumNewton :: forall tag. forall tag1. tag -> tag1 -> Int extremumNewton = undefined the parser creates nested HsForAllTy's for the two forall statements. These get flattened into a single one in `HsTypes.mk_forall_ty` This patch removes the flattening, so that API Annotations are not lost in the process. Test Plan: ./validate Reviewers: goldfire, austin, simonpj Reviewed By: simonpj Subscribers: bgamari, mpickering, thomie, goldfire Differential Revision: https://phabricator.haskell.org/D836 GHC Trac Issues: #10278, #10315, #10354, #10363 (cherry picked from commit c553e980e4a5d149af13bb705ec02819a15937ee) Conflicts: compiler/hsSyn/HsTypes.hs >--------------------------------------------------------------- fb918ab551b6da75cdaf96ad62f9479dcab21400 compiler/hsSyn/Convert.hs | 5 +- compiler/hsSyn/HsSyn.hs | 2 +- compiler/hsSyn/HsTypes.hs | 94 ++++++++--- compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 13 +- compiler/rename/RnNames.hs | 3 +- compiler/rename/RnTypes.hs | 107 +++++++------ testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 + testsuite/tests/ghc-api/annotations/T10278.stderr | 12 ++ testsuite/tests/ghc-api/annotations/T10278.stdout | 171 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10278.hs | 20 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10357.hs => t10278.hs} | 2 +- 14 files changed, 365 insertions(+), 78 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 fb918ab551b6da75cdaf96ad62f9479dcab21400 From git at git.haskell.org Fri May 22 13:09:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 13:09:30 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotations : parens around a context with wildcard loses annotations (adb21a8) Message-ID: <20150522130930.1E14F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/adb21a824540f2bbacd67006d9a29da2aee66026/ghc >--------------------------------------------------------------- commit adb21a824540f2bbacd67006d9a29da2aee66026 Author: Alan Zimmerman Date: Thu May 21 15:05:48 2015 +0200 ApiAnnotations : parens around a context with wildcard loses annotations Summary: In the following code, the extra set of parens around the context end up with detached annotations. {-# LANGUAGE PartialTypeSignatures #-} module ParensAroundContext where f :: ((Eq a, _)) => a -> a -> Bool f x y = x == y Trac ticket #10354 It turns out it was the TupleTy that was the culprit. This may also solve #10315 Test Plan: ./validate Reviewers: hvr, austin, goldfire Reviewed By: austin Subscribers: goldfire, bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D868 GHC Trac Issues: #10354, #10315 (cherry picked from commit 0df14b5db06751f817d3ba794cc74ac54519b5b8) >--------------------------------------------------------------- adb21a824540f2bbacd67006d9a29da2aee66026 compiler/parser/Parser.y | 10 +-- compiler/parser/RdrHsSyn.hs | 18 +++-- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10278.stdout | 16 ++-- testsuite/tests/ghc-api/annotations/T10354.stderr | 3 + testsuite/tests/ghc-api/annotations/T10354.stdout | 90 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10354.hs | 14 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../ghc-api/annotations/{t10278.hs => t10354.hs} | 2 +- 10 files changed, 141 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc adb21a824540f2bbacd67006d9a29da2aee66026 From git at git.haskell.org Fri May 22 13:09:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 13:09:32 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Turn off warnings when compiling boolFormula (4edbfcf) Message-ID: <20150522130932.F2F033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/4edbfcf835698f07e004b9631ca6e987a1061ffc/ghc >--------------------------------------------------------------- commit 4edbfcf835698f07e004b9631ca6e987a1061ffc Author: Alan Zimmerman Date: Tue May 12 17:04:50 2015 +0200 Turn off warnings when compiling boolFormula Summary: There is a problem where harbourmaster builds complain about a bad boolFormula.stderr ghc-api/annotations boolFormula [bad stderr] (normal) The problem does not occur for a local build on my box This patch turns off warnings for this test, to get rid of the stderr issue. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, hvr Differential Revision: https://phabricator.haskell.org/D888 (cherry picked from commit 6ee4b6fdfb07bb479a1a9ab3e3866ca6a6192e20) >--------------------------------------------------------------- 4edbfcf835698f07e004b9631ca6e987a1061ffc testsuite/tests/ghc-api/annotations/Makefile | 3 +- .../tests/ghc-api/annotations/TestBoolFormula.hs | 10 ++ .../tests/ghc-api/annotations/boolFormula.stdout | 190 ++++++++++++++------- 3 files changed, 137 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 4edbfcf835698f07e004b9631ca6e987a1061ffc From git at git.haskell.org Fri May 22 13:09:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 13:09:36 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotatons : AnnDcolon in wrong place for PatBind (d66eb5a) Message-ID: <20150522130936.CC19E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d66eb5a911ac5cb6d00acde326a306fcae6c6fee/ghc >--------------------------------------------------------------- commit d66eb5a911ac5cb6d00acde326a306fcae6c6fee Author: Alan Zimmerman Date: Thu May 21 15:48:07 2015 +0200 ApiAnnotatons : AnnDcolon in wrong place for PatBind Summary: In the following code fragment let ls :: Int = undefined the `::` is attached to the ls function as a whole, rather than to the pattern on the LHS. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D883 GHC Trac Issues: #10396 (cherry picked from commit c488da851c39ca202cdd056091176acbabdd7dd4) >--------------------------------------------------------------- d66eb5a911ac5cb6d00acde326a306fcae6c6fee compiler/parser/Parser.y | 5 ++- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++++ testsuite/tests/ghc-api/annotations/T10354.stderr | 2 +- testsuite/tests/ghc-api/annotations/T10396.stdout | 43 ++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10396.hs | 7 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 +- .../tests/ghc-api/annotations/parseTree.stdout | 2 +- .../ghc-api/annotations/{t10278.hs => t10396.hs} | 2 +- 10 files changed, 67 insertions(+), 6 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index d37c204..53a7b7c 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1870,8 +1870,9 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } case r of { (FunBind n _ _ _ _ _) -> ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ; - _ -> return () } ; - _ <- ams (L l ()) (ann ++ (fst $2) ++ (fst $ unLoc $3)); + (PatBind (L lh _lhs) _rhs _ _ _) -> + ams (L lh ()) (fst $2) >> return () } ; + _ <- ams (L l ()) (ann ++ (fst $ unLoc $3)); return $! (sL l (unitOL $! (sL l $ ValD r))) } } | pattern_synonym_decl { sLL $1 $> $ unitOL $1 } | docdecl { sLL $1 $> $ unitOL $1 } diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore index bb19b13..a7726f8 100644 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ b/testsuite/tests/ghc-api/annotations/.gitignore @@ -15,6 +15,7 @@ t10307 boolFormula t10278 t10354 +t10396 *.hi *.o *.run.* diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index da6a358..69ce026 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -13,6 +13,7 @@ clean: rm -f t10357 rm -f t10278 rm -f t10354 + rm -f t10396 annotations: rm -f annotations.o annotations.hi @@ -46,6 +47,13 @@ t10358: .PHONY: t10358 +T10396: + rm -f T10396.o T10396.hi + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10396 + ./t10396 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +.PHONY: t10396 + t10255: rm -f t10255.o t10255.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255 diff --git a/testsuite/tests/ghc-api/annotations/T10354.stderr b/testsuite/tests/ghc-api/annotations/T10354.stderr index c0f9172..1e97b8a 100644 --- a/testsuite/tests/ghc-api/annotations/T10354.stderr +++ b/testsuite/tests/ghc-api/annotations/T10354.stderr @@ -1,3 +1,3 @@ -Test10354.hs:13:8: error: +Test10354.hs:13:8: Not in scope: type constructor or class ?ForceError? diff --git a/testsuite/tests/ghc-api/annotations/T10396.stdout b/testsuite/tests/ghc-api/annotations/T10396.stdout new file mode 100644 index 0000000..61d0399 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10396.stdout @@ -0,0 +1,43 @@ +---Problems--------------------- +[ +] + +---Problems'-------------------- +[] +-------------------------------- +[ +(AK Test10396.hs:1:1 AnnModule = [Test10396.hs:2:1-6]) + +(AK Test10396.hs:1:1 AnnWhere = [Test10396.hs:2:18-22]) + +(AK Test10396.hs:4:1-15 AnnDcolon = [Test10396.hs:4:8-9]) + +(AK Test10396.hs:4:1-15 AnnSemi = [Test10396.hs:5:1]) + +(AK Test10396.hs:4:14-15 AnnCloseP = [Test10396.hs:4:15]) + +(AK Test10396.hs:4:14-15 AnnOpenP = [Test10396.hs:4:14]) + +(AK Test10396.hs:(5,1)-(7,11) AnnEqual = [Test10396.hs:5:7]) + +(AK Test10396.hs:(5,1)-(7,11) AnnFunId = [Test10396.hs:5:1-6]) + +(AK Test10396.hs:(5,1)-(7,11) AnnSemi = [Test10396.hs:8:1]) + +(AK Test10396.hs:(5,9)-(7,11) AnnDo = [Test10396.hs:5:9-10]) + +(AK Test10396.hs:6:3-27 AnnLet = [Test10396.hs:6:3-5]) + +(AK Test10396.hs:6:3-27 AnnSemi = [Test10396.hs:7:3]) + +(AK Test10396.hs:6:7-15 AnnDcolon = [Test10396.hs:6:10-11]) + +(AK Test10396.hs:6:7-27 AnnEqual = [Test10396.hs:6:17]) + +(AK Test10396.hs:7:10-11 AnnCloseP = [Test10396.hs:7:11]) + +(AK Test10396.hs:7:10-11 AnnOpenP = [Test10396.hs:7:10]) + +(AK AnnEofPos = [Test10396.hs:8:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10396.hs b/testsuite/tests/ghc-api/annotations/Test10396.hs new file mode 100644 index 0000000..71b18a8 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10396.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Test10396 where + +errors :: IO () +errors= do + let ls :: Int = undefined + return () diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 0a0b5a6..ed04646 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -15,3 +15,4 @@ test('T10357', normal, run_command, ['$MAKE -s --no-print-directory t10357' test('T10358', normal, run_command, ['$MAKE -s --no-print-directory t10358']) test('T10278', normal, run_command, ['$MAKE -s --no-print-directory T10278']) test('T10354', normal, run_command, ['$MAKE -s --no-print-directory T10354']) +test('T10396', normal, run_command, ['$MAKE -s --no-print-directory T10396']) diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout index 128b70a..706d858 100644 --- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout +++ b/testsuite/tests/ghc-api/annotations/exampleTest.stdout @@ -149,7 +149,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/parseTree.stdout b/testsuite/tests/ghc-api/annotations/parseTree.stdout index 9965fd2..4986ddf 100644 --- a/testsuite/tests/ghc-api/annotations/parseTree.stdout +++ b/testsuite/tests/ghc-api/annotations/parseTree.stdout @@ -153,7 +153,7 @@ (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) -(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6]) +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) (AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) diff --git a/testsuite/tests/ghc-api/annotations/t10278.hs b/testsuite/tests/ghc-api/annotations/t10396.hs similarity index 98% copy from testsuite/tests/ghc-api/annotations/t10278.hs copy to testsuite/tests/ghc-api/annotations/t10396.hs index 9d13548..5ece668 100644 --- a/testsuite/tests/ghc-api/annotations/t10278.hs +++ b/testsuite/tests/ghc-api/annotations/t10396.hs @@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs - testOneFile libdir "Test10278" + testOneFile libdir "Test10396" testOneFile libdir fileName = do ((anns,cs),p) <- runGhc (Just libdir) $ do From git at git.haskell.org Fri May 22 13:11:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 13:11:27 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Revert "compiler: make sure we reject -O + HscInterpreted" (70d594d) Message-ID: <20150522131127.95D163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/70d594d29cf948b217ed6e6d163f3bb6691a3dfb/ghc >--------------------------------------------------------------- commit 70d594d29cf948b217ed6e6d163f3bb6691a3dfb Author: Austin Seipp Date: Fri May 22 08:11:02 2015 -0500 Revert "compiler: make sure we reject -O + HscInterpreted" This reverts commit 46edc43cbe011978d903dd0b5f0ffc62c602fbaa. This failed on master due to a buildbot wibble I haven't had time to look into. But apparently I pushed it as an error, as it was sitting in my tree. D'oh. >--------------------------------------------------------------- 70d594d29cf948b217ed6e6d163f3bb6691a3dfb compiler/main/DynFlags.hs | 12 ++++---- compiler/main/ErrUtils.hs | 6 +--- compiler/main/GHC.hs | 41 ++++---------------------- compiler/simplCore/FloatOut.hs | 27 ----------------- testsuite/.gitignore | 1 - testsuite/tests/ghc-api/T10052/Makefile | 12 -------- testsuite/tests/ghc-api/T10052/T10052-input.hs | 1 - testsuite/tests/ghc-api/T10052/T10052.hs | 30 ------------------- testsuite/tests/ghc-api/T10052/T10052.stderr | 3 -- testsuite/tests/ghc-api/T10052/T10052.stdout | 1 - testsuite/tests/ghc-api/T10052/all.T | 2 -- 11 files changed, 12 insertions(+), 124 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 70d594d29cf948b217ed6e6d163f3bb6691a3dfb From git at git.haskell.org Fri May 22 14:14:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 14:14:36 +0000 (UTC) Subject: [commit: ghc] master: White space layout only (369dd0c) Message-ID: <20150522141436.5E7DC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/369dd0c61ad7b95076584016c2492594cb73cf5b/ghc >--------------------------------------------------------------- commit 369dd0c61ad7b95076584016c2492594cb73cf5b Author: Simon Peyton Jones Date: Fri May 22 14:33:16 2015 +0100 White space layout only >--------------------------------------------------------------- 369dd0c61ad7b95076584016c2492594cb73cf5b compiler/main/TidyPgm.hs | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 1c72130..e9dd8d1 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -1039,25 +1039,25 @@ tidyTopName mod nc_var maybe_ref occ_env id loc = nameSrcSpan name old_occ = nameOccName name - new_occ - | Just ref <- maybe_ref, ref /= id = - mkOccName (occNameSpace old_occ) $ - let - ref_str = occNameString (getOccName ref) - occ_str = occNameString old_occ - in - case occ_str of - '$':'w':_ -> occ_str - -- workers: the worker for a function already - -- includes the occname for its parent, so there's - -- no need to prepend the referrer. - _other | isSystemName name -> ref_str - | otherwise -> ref_str ++ '_' : occ_str - -- If this name was system-generated, then don't bother - -- to retain its OccName, just use the referrer. These - -- system-generated names will become "f1", "f2", etc. for - -- a referrer "f". - | otherwise = old_occ + new_occ | Just ref <- maybe_ref + , ref /= id + = mkOccName (occNameSpace old_occ) $ + let + ref_str = occNameString (getOccName ref) + occ_str = occNameString old_occ + in + case occ_str of + '$':'w':_ -> occ_str + -- workers: the worker for a function already + -- includes the occname for its parent, so there's + -- no need to prepend the referrer. + _other | isSystemName name -> ref_str + | otherwise -> ref_str ++ '_' : occ_str + -- If this name was system-generated, then don't bother + -- to retain its OccName, just use the referrer. These + -- system-generated names will become "f1", "f2", etc. for + -- a referrer "f". + | otherwise = old_occ (occ_env', occ') = tidyOccName occ_env new_occ From git at git.haskell.org Fri May 22 14:14:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 14:14:39 +0000 (UTC) Subject: [commit: ghc] master: Reduce magic for seqId (eae703a) Message-ID: <20150522141439.5AFF03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eae703aa60f41fd232be5478e196b661839ec3de/ghc >--------------------------------------------------------------- commit eae703aa60f41fd232be5478e196b661839ec3de Author: Simon Peyton Jones Date: Fri May 22 14:41:54 2015 +0100 Reduce magic for seqId An upcoming commit means that the RULES for 'seq' get only one value arg, not two. This patch prepares for that by - reducing the arity of seq's built-in rule, to take one value arg - making 'seq' not inline on the LHS of RULES - and removing the horrid un-inlining in DsBinds.decomposeRuleLhs >--------------------------------------------------------------- eae703aa60f41fd232be5478e196b661839ec3de compiler/basicTypes/MkId.hs | 34 ++++++++++++++++++++++++---------- compiler/coreSyn/CoreSubst.hs | 15 +++++++++++---- compiler/deSugar/DsBinds.hs | 6 ------ 3 files changed, 35 insertions(+), 20 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 365ed82..2e84d83 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1074,10 +1074,15 @@ nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info seqId :: Id -- See Note [seqId magic] seqId = pcMiscPrelId seqName ty info where - info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma + info = noCafIdInfo `setInlinePragInfo` inline_prag `setUnfoldingInfo` mkCompulsoryUnfolding rhs `setSpecInfo` mkSpecInfo [seq_cast_rule] + inline_prag = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter 0 + -- Make 'seq' not inline-always, so that simpleOptExpr + -- (see CoreSubst.simple_app) won't inline 'seq' on the + -- LHS of rules. That way we can have rules for 'seq'; + -- see Note [seqId magic] ty = mkForAllTys [alphaTyVar,betaTyVar] (mkFunTy alphaTy (mkFunTy betaTy betaTy)) @@ -1087,17 +1092,18 @@ seqId = pcMiscPrelId seqName ty info rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)]) -- See Note [Built-in RULES for seq] + -- NB: ru_nargs = 3, not 4, to match the code in + -- Simplify.rebuildCase which tries to apply this rule seq_cast_rule = BuiltinRule { ru_name = fsLit "seq of cast" , ru_fn = seqName - , ru_nargs = 4 - , ru_try = match_seq_of_cast - } + , ru_nargs = 3 + , ru_try = match_seq_of_cast } match_seq_of_cast :: RuleFun -- See Note [Built-in RULES for seq] -match_seq_of_cast _ _ _ [Type _, Type res_ty, Cast scrut co, expr] +match_seq_of_cast _ _ _ [Type _, Type res_ty, Cast scrut co] = Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty, - scrut, expr]) + scrut]) match_seq_of_cast _ _ _ _ = Nothing ------------------------------------------------ @@ -1203,16 +1209,24 @@ transform to Rather than attempt some general analysis to support this, I've added enough support that you can do this using a rewrite rule: - RULE "f/seq" forall n. seq (f n) e = seq n e + RULE "f/seq" forall n. seq (f n) = seq n You write that rule. When GHC sees a case expression that discards its result, it mentally transforms it to a call to 'seq' and looks for a RULE. (This is done in Simplify.rebuildCase.) As usual, the correctness of the rule is up to you. -To make this work, we need to be careful that the magical desugaring -done in Note [seqId magic] item (c) is *not* done on the LHS of a rule. -Or rather, we arrange to un-do it, in DsBinds.decomposeRuleLhs. +VERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2. +If we wrote + RULE "f/seq" forall n e. seq (f n) e = seq n e +with rule arity 2, then two bad things would happen: + + - The magical desugaring done in Note [seqId magic] item (c) + for saturated application of 'seq' would turn the LHS into + a case expression! + + - The code in Simplify.rebuildCase would need to actually supply + the value argument, which turns out to be awkward. Note [Built-in RULES for seq] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 52f4c0d..a3665ed 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -954,6 +954,7 @@ simple_app subst (Lam b e) (a:as) b2 = add_info subst' b b' simple_app subst (Var v) as | isCompulsoryUnfolding (idUnfolding v) + , isAlwaysActive (idInlineActivation v) -- See Note [Unfold compulsory unfoldings in LHSs] = simple_app subst (unfoldingTemplate (idUnfolding v)) as simple_app subst (Tick t e) as @@ -1108,10 +1109,16 @@ to remain visible until Phase 1 Note [Unfold compulsory unfoldings in LHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When the user writes `map coerce = coerce` as a rule, the rule will only ever -match if we replace coerce by its unfolding on the LHS, because that is the -core that the rule matching engine will find. So do that for everything that -has a compulsory unfolding. Also see Note [Desugaring coerce as cast] in Desugar +When the user writes `RULES map coerce = coerce` as a rule, the rule +will only ever match if simpleOptExpr replaces coerce by its unfolding +on the LHS, because that is the core that the rule matching engine +will find. So do that for everything that has a compulsory +unfolding. Also see Note [Desugaring coerce as cast] in Desugar. + +However, we don't want to inline 'seq', which happens to also have a +compulsory unfolding, so we only do this unfolding only for things +that are always-active. See Note [User-defined RULES for seq] in MkId. + ************************************************************************ * * diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index f67ffac..fac5eb7 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -53,7 +53,6 @@ import MkId(proxyHashId) import Class import DataCon ( dataConTyCon ) import Name -import MkId ( seqId ) import IdInfo ( IdDetails(..) ) import Var import VarSet @@ -602,11 +601,6 @@ decomposeRuleLhs orig_bndrs orig_lhs | not (fn_id `elemVarSet` orig_bndr_set) = Just (fn_id, args) - decompose (Case scrut bndr ty [(DEFAULT, _, body)]) args - | isDeadBinder bndr -- Note [Matching seqId] - , let args' = [Type (idType bndr), Type ty, scrut, body] - = Just (seqId, args' ++ args) - decompose _ _ = Nothing bad_shape_msg = hang (ptext (sLit "RULE left-hand side too complicated to desugar")) From git at git.haskell.org Fri May 22 14:14:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 14:14:42 +0000 (UTC) Subject: [commit: ghc] master: Fix quadratic behaviour in tidyOccName (c89bd68) Message-ID: <20150522141442.38AAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c89bd681d34d3339771ebdde8aa468b1d9ab042b/ghc >--------------------------------------------------------------- commit c89bd681d34d3339771ebdde8aa468b1d9ab042b Author: Simon Peyton Jones Date: Fri May 22 14:46:51 2015 +0100 Fix quadratic behaviour in tidyOccName In the test program from comment:3 of Trac #10370, it turned out that 25% of all compile time was going in OccName.tidyOccName! It was all becuase the algorithm for finding an unused OccName had a quadratic case. This patch fixes it. THe effect is pretty big: Before: total time = 34.30 secs (34295 ticks @ 1000 us, 1 processor) total alloc = 15,496,011,168 bytes (excludes profiling overheads) After total time = 25.41 secs (25415 ticks @ 1000 us, 1 processor) total alloc = 11,812,744,816 bytes (excludes profiling overheads) >--------------------------------------------------------------- c89bd681d34d3339771ebdde8aa468b1d9ab042b compiler/basicTypes/OccName.hs | 57 +++++++++++++++++----- compiler/typecheck/TcMType.hs | 2 - compiler/types/TypeRep.hs | 2 + .../tests/ghci.debugger/scripts/print027.stdout | 6 +-- testsuite/tests/parser/should_fail/T7848.stderr | 6 +-- .../tests/simplCore/should_compile/T7360.stderr | 16 +++--- 6 files changed, 60 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c89bd681d34d3339771ebdde8aa468b1d9ab042b From git at git.haskell.org Fri May 22 14:14:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 14:14:45 +0000 (UTC) Subject: [commit: ghc] master: Fix a huge space leak in the mighty Simplifier (45d9a15) Message-ID: <20150522141445.22DE33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/45d9a15c4b85a2ed89579106bdafd84accf2cb39/ghc >--------------------------------------------------------------- commit 45d9a15c4b85a2ed89579106bdafd84accf2cb39 Author: Simon Peyton Jones Date: Fri May 22 15:04:47 2015 +0100 Fix a huge space leak in the mighty Simplifier This long-standing, terrible, adn somewhat subtle bug was exposed by Trac #10370, thanks to Reid Barton's brilliant test case (comment:3). The effect is large on the Trac #10370 test. Here is what the profile report says: Before: total time = 24.35 secs (24353 ticks @ 1000 us, 1 processor) total alloc = 11,864,360,816 bytes (excludes profiling overheads) After: total time = 21.16 secs (21160 ticks @ 1000 us, 1 processor) total alloc = 7,947,141,136 bytes (excludes profiling overheads) The /combined/ effect of the tidyOccName fix, plus this one, is dramtic for Trac #10370. Here is what +RTS -s says: Before: 15,490,210,952 bytes allocated in the heap 1,783,919,456 bytes maximum residency (20 sample(s)) MUT time 30.117s ( 31.383s elapsed) GC time 90.103s ( 90.107s elapsed) Total time 120.843s (122.065s elapsed) After: 7,928,671,936 bytes allocated in the heap 52,914,832 bytes maximum residency (25 sample(s)) MUT time 13.912s ( 15.110s elapsed) GC time 6.809s ( 6.808s elapsed) Total time 20.789s ( 21.954s elapsed) - Heap allocation halved - Residency cut by a factor of more than 30. - ELapsed time cut by a factor of 6 Not bad! The details ~~~~~~~~~~~ The culprit was SimplEnv.mkCoreSubst, which used mapVarEnv to do some impedence-matching from the substitituion used by the simplifier to the one used by CoreSubst. But the impedence-mactching was recursive! mk_subst tv_env cv_env id_env = CoreSubst.mkSubst in_scope tv_env cv_env (mapVarEnv fiddle id_env) fiddle (DoneEx e) = e fiddle (DoneId v) = Var v fiddle (ContEx tv cv id e) = CoreSubst.substExpr (mk_subst tv cv id) e Inside fiddle, in the ContEx case, we may do another whole level of fiddle. And so on. Moreover, UniqFM (which is built on Data.IntMap) is strict, so the fiddling is done eagerly. I didn't wok through all the details but the result is a gargatuan blow-up of entirely unnecessary work. Laziness would make this go away, I think, but I don't want to mess with IntMap. And in any case, the impedence matching is a royal pain. In the end I simply ceased trying to use CoreSubst.substExpr in the simplifier, and instead just use simplExpr. That does mean bit of duplication; e.g. new code for simplRules. But it's not a big deal and it's far more direct and easy to reason about. A bit of knock-on refactoring: * Data type ArgSummary moves to CoreUnfold. * interestingArg moves from CoreUnfold to SimplUtils, and gets a SimplEnv argument which can be used when we encounter a variable. * simplLamBndrs, addBndrRules move from SimplEnv to Simplify (because they now calls simplUnfolding, simplRules resp) * SimplUtils.substExpr, substUnfolding, mkCoreSubst die completely * In Simplify some several functions that were previously pure substitution-based functions are now monadic: - addBndrRules, simplRule - addCoerce, add_coerce in simplCast * In case 2c of Simplify.rebuildCase, there was a pretty disgusting expression-substitution taking place for 'rhs'; and we really don't want to make that monadic becuase 'rhs' can be big. Solution: reduce the arity of the rules for seq. See Note [User-defined RULES for seq] in MkId. >--------------------------------------------------------------- 45d9a15c4b85a2ed89579106bdafd84accf2cb39 compiler/coreSyn/CoreUnfold.hs | 88 +----- compiler/simplCore/SimplCore.hs | 25 +- compiler/simplCore/SimplEnv.hs | 94 +----- compiler/simplCore/SimplUtils.hs | 217 +++++++++----- compiler/simplCore/Simplify.hs | 323 +++++++++++++-------- testsuite/tests/perf/compiler/all.T | 4 +- .../tests/simplCore/should_compile/T7785.stderr | 2 + .../tests/simplCore/should_compile/rule2.stderr | 3 +- testsuite/tests/simplCore/should_run/SeqRule.hs | 2 +- 9 files changed, 397 insertions(+), 361 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 45d9a15c4b85a2ed89579106bdafd84accf2cb39 From git at git.haskell.org Fri May 22 14:39:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 14:39:04 +0000 (UTC) Subject: [commit: ghc] branch 'wip/7.10-api-annots' deleted Message-ID: <20150522143904.E7C683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/7.10-api-annots From git at git.haskell.org Fri May 22 14:39:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 May 2015 14:39:22 +0000 (UTC) Subject: [commit: ghc] branch 'wip/7.10-api-annots2' deleted Message-ID: <20150522143922.8AD413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/7.10-api-annots2 From git at git.haskell.org Sat May 23 20:08:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 May 2015 20:08:12 +0000 (UTC) Subject: [commit: ghc] master: testsuite: commit missing T4945 stdout (7d519da) Message-ID: <20150523200812.C87253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d519dabd2006c9742e82fce02df55704da15482/ghc >--------------------------------------------------------------- commit 7d519dabd2006c9742e82fce02df55704da15482 Author: Austin Seipp Date: Sat May 23 07:24:50 2015 -0500 testsuite: commit missing T4945 stdout Simon apparently forgot this it seems. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7d519dabd2006c9742e82fce02df55704da15482 testsuite/tests/simplCore/should_compile/T4945.stdout | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/testsuite/tests/simplCore/should_compile/T4945.stdout b/testsuite/tests/simplCore/should_compile/T4945.stdout new file mode 100644 index 0000000..4e53cfd --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T4945.stdout @@ -0,0 +1,9 @@ + -> STUArray RealWorld Int Int -> (# State# RealWorld, () #) + (ipv3 [OS=OneShot] :: STUArray RealWorld Int Int) -> + case ipv3 of _ [Occ=Dead] { STUArray ds5 ds6 dt ds7 -> + (Data.Array.Base.STUArray + (Data.Array.Base.STUArray + (Data.Array.Base.STUArray + (Data.Array.Base.STUArray + (Data.Array.Base.STUArray + (Data.Array.Base.STUArray From git at git.haskell.org Sat May 23 20:08:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 May 2015 20:08:15 +0000 (UTC) Subject: [commit: ghc] master: compiler: kill a stray pprTrace in OccName (4d6c0ee) Message-ID: <20150523200815.7F58F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d6c0ee11ff2c439fcd06677d55c57b8644ed7a7/ghc >--------------------------------------------------------------- commit 4d6c0ee11ff2c439fcd06677d55c57b8644ed7a7 Author: Austin Seipp Date: Sat May 23 07:26:55 2015 -0500 compiler: kill a stray pprTrace in OccName Left in by c89bd681d34d, and otherwise rather annoying during the build! Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4d6c0ee11ff2c439fcd06677d55c57b8644ed7a7 compiler/basicTypes/OccName.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 3ea3aa4..c3f0c9f 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -853,9 +853,7 @@ tidyOccName env occ@(OccName occ_sp fs) -- 1, add 1, add 2, add 3, etc which -- moves at quadratic speed through a dense patch - Nothing -> (if k>5 then pprTrace "tidyOccName" (ppr k $$ ppr occ $$ ppr new_fs) - else \x -> x) - (new_env, OccName occ_sp new_fs) + Nothing -> (new_env, OccName occ_sp new_fs) where new_fs = mkFastString (base ++ show n) new_env = addToUFM (addToUFM env new_fs 1) base1 (n+1) From git at git.haskell.org Sat May 23 21:05:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 May 2015 21:05:53 +0000 (UTC) Subject: [commit: ghc] master: testsuite: handle missing stats files gracefully (#10305) (6694ccf) Message-ID: <20150523210553.3F3483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6694ccf9444baf565eb0f38f7808767616f23825/ghc >--------------------------------------------------------------- commit 6694ccf9444baf565eb0f38f7808767616f23825 Author: Thomas Miedema Date: Tue May 19 19:18:28 2015 +0200 testsuite: handle missing stats files gracefully (#10305) The following tests would result in framework failures when using a ghc build with HADDOCK_DOCS=NO in mk/build.mk or mk/validate.mk: * haddock.Cabal * haddock.base * haddock.compiler Test Plan: run make in tests/perf/haddock Differential Revision: https://phabricator.haskell.org/D899 >--------------------------------------------------------------- 6694ccf9444baf565eb0f38f7808767616f23825 testsuite/config/ghc | 1 + testsuite/driver/testlib.py | 9 ++++++++- testsuite/mk/boilerplate.mk | 10 ++++++++++ testsuite/mk/test.mk | 16 +++++++++------- testsuite/tests/perf/haddock/all.T | 6 +++--- 5 files changed, 31 insertions(+), 11 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index 6bfa535..5e4bda2 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -9,6 +9,7 @@ config.compiler_type = 'ghc' config.compiler = 'ghc' config.compiler_always_flags = ghc_compiler_always_flags.split() +config.haddock = 'haddock' config.hp2ps = 'hp2ps' config.hpc = 'hpc' config.gs = 'gs' diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 4e877f5..e9beee4 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -123,6 +123,10 @@ def _reqlib( name, opts, lib ): if not got_it: opts.expect = 'missing-lib' +def req_haddock( name, opts ): + if not config.haddock: + opts.expect = 'missing-lib' + def req_profiling( name, opts ): if not config.have_profiling: opts.expect = 'fail' @@ -1128,7 +1132,10 @@ def checkStats(name, way, stats_file, range_fields): result = passed() if len(range_fields) > 0: - f = open(in_testdir(stats_file)) + try: + f = open(in_testdir(stats_file)) + except IOError as e: + return failBecause(str(e)) contents = f.read() f.close() diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index 3292d3d..43bc4df 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -108,6 +108,10 @@ ifeq "$(RUNGHC)" "" RUNGHC := $(call find_tool,runghc) endif +ifeq "$(HADDOCK)" "" +HADDOCK := $(call find_tool,haddock) +endif + ifeq "$(HSC2HS)" "" HSC2HS := $(call find_tool,hsc2hs) endif @@ -130,6 +134,12 @@ ifeq "$(shell test -x '$(GHC_PKG)' && echo exists)" "" $(error Cannot find ghc-pkg: $(GHC_PKG)) endif +$(eval $(call canonicaliseExecutable,HADDOCK)) +ifeq "$(shell test -x '$(HADDOCK)' && echo exists)" "" +# haddock is optional. +HADDOCK := +endif + $(eval $(call canonicaliseExecutable,HSC2HS)) ifeq "$(shell test -x '$(HSC2HS)' && echo exists)" "" $(error Cannot find hsc2hs: $(HSC2HS)) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index d1d66c7..9927b6d 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -205,15 +205,17 @@ RUNTEST_OPTS += \ -e 'config.exeext="$(exeext)"' \ -e 'config.top="$(TOP_ABS)"' -# Put an extra pair of quotes around program paths, +# Put an extra pair of quotes around non-empty program paths, # so we don't have to in .T scripts or driver/testlib.py. +quote_path = $(if $1,"\"$1\"","") RUNTEST_OPTS += \ - -e 'config.compiler="\"$(TEST_HC)\""' \ - -e 'config.ghc_pkg="\"$(GHC_PKG)\""' \ - -e 'config.hp2ps="\"$(HP2PS_ABS)\""' \ - -e 'config.hpc="\"$(HPC)\""' \ - -e 'config.gs="\"$(GS)\""' \ - -e 'config.timeout_prog="\"$(TIMEOUT_PROGRAM)\""' + -e 'config.compiler=$(call quote_path,$(TEST_HC))' \ + -e 'config.ghc_pkg=$(call quote_path,$(GHC_PKG))' \ + -e 'config.haddock=$(call quote_path,$(HADDOCK))' \ + -e 'config.hp2ps=$(call quote_path,$(HP2PS_ABS))' \ + -e 'config.hpc=$(call quote_path,$(HPC))' \ + -e 'config.gs=$(call quote_path,$(GS))' \ + -e 'config.timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))' ifneq "$(OUTPUT_SUMMARY)" "" RUNTEST_OPTS += \ diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index e9ffbb6..bf2c009 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -3,7 +3,7 @@ # detect outliers, as described in Note [residency]. See #9556. test('haddock.base', - [unless(in_tree_compiler(), skip) + [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', [(wordsize(64), 9014511528, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -43,7 +43,7 @@ test('haddock.base', ['../../../../libraries/base/dist-install/doc/html/base/base.haddock.t']) test('haddock.Cabal', - [unless(in_tree_compiler(), skip) + [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', [(wordsize(64), 6710234312, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -84,7 +84,7 @@ test('haddock.Cabal', ['../../../../libraries/Cabal/Cabal/dist-install/doc/html/Cabal/Cabal.haddock.t']) test('haddock.compiler', - [unless(in_tree_compiler(), skip) + [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', [(wordsize(64), 33562468736, 10) # 2012P-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Sat May 23 21:05:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 May 2015 21:05:56 +0000 (UTC) Subject: [commit: ghc] master: Update .mailmap (c00f051) Message-ID: <20150523210556.1F2993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c00f051ba187ce3048779a658a96de7ec9f4fe2f/ghc >--------------------------------------------------------------- commit c00f051ba187ce3048779a658a96de7ec9f4fe2f Author: Thomas Miedema Date: Wed May 20 00:06:02 2015 +0200 Update .mailmap [skip ci] >--------------------------------------------------------------- c00f051ba187ce3048779a658a96de7ec9f4fe2f .mailmap | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/.mailmap b/.mailmap index 552920d..ec555d5 100644 --- a/.mailmap +++ b/.mailmap @@ -7,6 +7,8 @@ Aaron Tomb Alastair Reid areid Alastair Reid reid +Alexander Lukyanov # Ticket #9360. +Alexander Vershilov Alexey Rodriguez Alexey Rodriguez mrchebas at gmail.com Andrew Farmer @@ -30,6 +32,7 @@ Bas van Dijk v.dijk.bas at gmail.com Ben Chan # See Note [usrbincc]. Ben Gamari Ben Gamari +Ben Gamari Ben Lippmeier Ben Lippmeier Ben Lippmeier Ben.Lippmeier.anu.edu.au @@ -48,6 +51,7 @@ Cain Norris ghc at cainnorris.net < Chris Catalfo # https://github.com/ccatalfo Chris Rodrigues red5_2 at hotmail.com Chris Smith cdsmith at twu.net +Christiaan Baaij Christoph Bauer ich at christoph-bauer.net Claus Reinke Claus Reinke claus.reinke at talk21.com @@ -122,6 +126,7 @@ John Dias dias at eecs.harvard.ed John Dias dias at eecs.tufts.edu John McCall rjmccall at gmail.com Jon Fairbairn jon.fairbairn at cl.cam.ac.uk +Jose Pedro Magalhaes Jose Pedro Magalhaes Jose Pedro Magalhaes jpm at cs.uu.nl Josef Svenningsson josefs @@ -155,7 +160,9 @@ Malcolm Wallace malcolm Manuel M T Chakravarty chak Marc Weber marco-oweber at gmx.de Marcin 'Qrczak' Kowalczyk qrczak +Marco T?lio Gontijo e Silva Marco T?lio Gontijo e Silva +Marios Titas Matt Chapman matthewc Matthias Kilian kili at outback.escape.de Michael D. Adams @@ -190,6 +197,7 @@ Ryan Lortie desrt Sam Anklesaria Sam Anklesaria amsay at amsay.net Sean Seefried sseefried +Sergei Trofimovich Sergei Trofimovich Sergei Trofimovich Sergei Trofimovich @@ -200,6 +208,7 @@ Simon Hengel Simon Marlow Simon Marlow +Simon Marlow Simon Marlow simonm Simon Marlow simonmar Simon Marlow simonmar at microsoft.com @@ -239,6 +248,8 @@ Wolfgang Thaller wolfgang Wolfgang Thaller wolfgang.thaller at gmx.net Yorick Laupa # https://github.com/yoeight Yuri de Wit # Commit 37d64a. +Yusuke Matsushita # https://github.com/Kinokkory +Zejun Wu gwern gwern0 at gmail.com # Uses this name online. shelarcy # Uses this name online. ?mer Sinan A?acan # https://github.com/osa1 From git at git.haskell.org Sat May 23 22:56:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 May 2015 22:56:37 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix typo in comment (c04571d) Message-ID: <20150523225637.6F63F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c04571daf6175d3976827dcfce61e08c0896d0ee/ghc >--------------------------------------------------------------- commit c04571daf6175d3976827dcfce61e08c0896d0ee Author: Erik de Castro Lopo Date: Thu May 21 14:11:15 2015 +1000 rts: Fix typo in comment >--------------------------------------------------------------- c04571daf6175d3976827dcfce61e08c0896d0ee rts/StgCRun.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/StgCRun.c b/rts/StgCRun.c index f8a3f0f..02ec532 100644 --- a/rts/StgCRun.c +++ b/rts/StgCRun.c @@ -692,7 +692,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) { #endif /* * allocate some space for Stg machine's temporary storage. - * Note: RESERVER_C_STACK_BYTES has to be a round number here or + * Note: RESERVED_C_STACK_BYTES has to be a round number here or * the assembler can't assemble it. */ "sub sp, sp, %3\n\t" @@ -776,7 +776,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) { /* * allocate some space for Stg machine's temporary storage. - * Note: RESERVER_C_STACK_BYTES has to be a round number here or + * Note: RESERVED_C_STACK_BYTES has to be a round number here or * the assembler can't assemble it. */ "sub sp, sp, %3\n\t" From git at git.haskell.org Mon May 25 14:29:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 May 2015 14:29:17 +0000 (UTC) Subject: [commit: ghc] master: Add missing name for FFI import (fixes #9950) (326989e) Message-ID: <20150525142917.4500E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/326989ed06e6ad52d1cc2307be19d21b66b95813/ghc >--------------------------------------------------------------- commit 326989ed06e6ad52d1cc2307be19d21b66b95813 Author: erdeszt Date: Mon May 25 16:28:43 2015 +0200 Add missing name for FFI import (fixes #9950) Signed-off-by: erdeszt Reviewed By: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D902 >--------------------------------------------------------------- 326989ed06e6ad52d1cc2307be19d21b66b95813 docs/users_guide/ffi-chap.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/ffi-chap.xml b/docs/users_guide/ffi-chap.xml index e7d5a0c..ab099b2 100644 --- a/docs/users_guide/ffi-chap.xml +++ b/docs/users_guide/ffi-chap.xml @@ -110,7 +110,7 @@ OK: foreign import ccall interruptible - "sleep" :: CUint -> IO CUint + "sleep" sleepBlock :: CUint -> IO CUint interruptible behaves exactly as From git at git.haskell.org Tue May 26 02:05:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 May 2015 02:05:27 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Add missing name for FFI import (fixes #9950) (3690f03) Message-ID: <20150526020527.8335F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/3690f03563d552899f267dc8d3254c7b66574634/ghc >--------------------------------------------------------------- commit 3690f03563d552899f267dc8d3254c7b66574634 Author: erdeszt Date: Mon May 25 16:28:43 2015 +0200 Add missing name for FFI import (fixes #9950) Signed-off-by: erdeszt Reviewed By: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D902 (cherry picked from commit 326989ed06e6ad52d1cc2307be19d21b66b95813) >--------------------------------------------------------------- 3690f03563d552899f267dc8d3254c7b66574634 docs/users_guide/ffi-chap.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/ffi-chap.xml b/docs/users_guide/ffi-chap.xml index e7d5a0c..ab099b2 100644 --- a/docs/users_guide/ffi-chap.xml +++ b/docs/users_guide/ffi-chap.xml @@ -110,7 +110,7 @@ OK: foreign import ccall interruptible - "sleep" :: CUint -> IO CUint + "sleep" sleepBlock :: CUint -> IO CUint interruptible behaves exactly as From git at git.haskell.org Tue May 26 02:05:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 May 2015 02:05:30 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix error messages from open(Binary)TempFileWithDefaultPermissions (079f228) Message-ID: <20150526020530.33ABB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/079f228c7e0fc177d68d50df991235f088200672/ghc >--------------------------------------------------------------- commit 079f228c7e0fc177d68d50df991235f088200672 Author: Reid Barton Date: Tue May 19 15:34:31 2015 -0400 Fix error messages from open(Binary)TempFileWithDefaultPermissions Fixes Trac #10430. (cherry picked from commit 25d1a716395e349736994759d1fcbb3721f3ee9f) >--------------------------------------------------------------- 079f228c7e0fc177d68d50df991235f088200672 libraries/base/System/IO.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index 7b13552..e0ee9b1 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -453,13 +453,13 @@ openBinaryTempFile tmp_dir template openTempFileWithDefaultPermissions :: FilePath -> String -> IO (FilePath, Handle) openTempFileWithDefaultPermissions tmp_dir template - = openTempFile' "openBinaryTempFile" tmp_dir template False 0o666 + = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666 -- | Like 'openBinaryTempFile', but uses the default file permissions openBinaryTempFileWithDefaultPermissions :: FilePath -> String -> IO (FilePath, Handle) openBinaryTempFileWithDefaultPermissions tmp_dir template - = openTempFile' "openBinaryTempFile" tmp_dir template True 0o666 + = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666 openTempFile' :: String -> FilePath -> String -> Bool -> CMode -> IO (FilePath, Handle) From git at git.haskell.org Tue May 26 16:16:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 May 2015 16:16:16 +0000 (UTC) Subject: [commit: ghc] master: Fix ghci-way tests of -XStaticPointers. (70f1ca4) Message-ID: <20150526161616.E5DB83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70f1ca431c948be468f7f9a86892fd81c8f1a64b/ghc >--------------------------------------------------------------- commit 70f1ca431c948be468f7f9a86892fd81c8f1a64b Author: Facundo Dom?nguez Date: Mon May 25 21:07:54 2015 -0500 Fix ghci-way tests of -XStaticPointers. Summary: Add -fobject-code to StaticPointers tests in ghci. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: bgamari, thomie, mboes Differential Revision: https://phabricator.haskell.org/D905 >--------------------------------------------------------------- 70f1ca431c948be468f7f9a86892fd81c8f1a64b testsuite/tests/codeGen/should_run/all.T | 4 +++- testsuite/tests/deSugar/should_run/all.T | 5 ++++- testsuite/tests/rts/all.T | 8 ++++++-- testsuite/tests/th/all.T | 4 +++- 4 files changed, 16 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 41d18e5..59e4dca 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -115,7 +115,9 @@ test('T7953', reqlib('random'), compile_and_run, ['']) test('T8256', normal, compile_and_run, ['-dcore-lint -O1']) test('T6084',normal, compile_and_run, ['-O2']) test('CgStaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) test('StaticArraySize', normal, compile_and_run, ['-O2']) test('StaticByteArraySize', normal, compile_and_run, ['-O2']) diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T index 87ebe8e..5787816 100644 --- a/testsuite/tests/deSugar/should_run/all.T +++ b/testsuite/tests/deSugar/should_run/all.T @@ -41,6 +41,9 @@ test('T5742', normal, compile_and_run, ['']) test('DsLambdaCase', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, ['']) test('DsMultiWayIf', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, ['']) test('DsStaticPointers', - when(compiler_lt('ghc', '7.9'), skip), compile_and_run, ['']) + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], + compile_and_run, ['']) test('T8952', normal, compile_and_run, ['']) test('T9844', normal, compile_and_run, ['']) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 3965ee4..d823c2b 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -255,10 +255,14 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) compile_and_run, ['-rdynamic -package ghc']) test('GcStaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) test('ListStaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) # 251 = RTS exit code for "out of memory" diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 43c3e89..084ace5 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -308,7 +308,9 @@ test('T8577', ['T8577', '-v0 ' + config.ghc_th_way_flags]) test('T8625', normal, ghci_script, ['T8625.script']) test('TH_StaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) test('TH_StaticPointers02', [ when(compiler_lt('ghc', '7.9'), skip) ], From git at git.haskell.org Tue May 26 16:16:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 May 2015 16:16:19 +0000 (UTC) Subject: [commit: ghc] master: Omit the static form error for variables not in scope. (71d1f01) Message-ID: <20150526161619.A30883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/71d1f01db94dda5b8c2c367fba8cc7b115b06e95/ghc >--------------------------------------------------------------- commit 71d1f01db94dda5b8c2c367fba8cc7b115b06e95 Author: Facundo Dom?nguez Date: Mon May 25 21:08:05 2015 -0500 Omit the static form error for variables not in scope. Summary: Fixes T10446. The following program > g = static f now produces only: > ...: error > Not in scope: 'f' Before it would also produce a complaint about 'f' not being a top-level identifier. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: bgamari, thomie, mboes Differential Revision: https://phabricator.haskell.org/D906 GHC Trac Issues: #10446 >--------------------------------------------------------------- 71d1f01db94dda5b8c2c367fba8cc7b115b06e95 compiler/rename/RnExpr.hs | 4 +++- testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr | 9 ++------- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 50860f9..71fa1cb 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -330,7 +330,9 @@ rnExpr e@(HsStatic expr) = do ] _ -> do let isTopLevelName n = isExternalName n || isWiredInName n - case nameSetElems $ filterNameSet (not . isTopLevelName) fvExpr of + case nameSetElems $ filterNameSet + (\n -> not (isTopLevelName n || isUnboundName n)) + fvExpr of [] -> return () fvNonGlobal -> addErr $ cat [ text $ "Only identifiers of top-level bindings can " diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr index 6524702..52e3609 100644 --- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr +++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr @@ -1,8 +1,3 @@ -RnStaticPointersFail02.hs:5:5: - Only identifiers of top-level bindings can appear in the body of the static form: - static T - but the following identifiers were found instead: - T - -RnStaticPointersFail02.hs:5:12: Not in scope: data constructor ?T? +RnStaticPointersFail02.hs:5:12: error: + Not in scope: data constructor ?T? From git at git.haskell.org Tue May 26 19:45:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 May 2015 19:45:14 +0000 (UTC) Subject: [commit: ghc] branch 'wip/api-annots-ghc-7.10' deleted Message-ID: <20150526194514.5B2A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/api-annots-ghc-7.10 From git at git.haskell.org Wed May 27 15:07:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 15:07:52 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix ghci-way tests of -XStaticPointers. (fe9e5a4) Message-ID: <20150527150752.0C9E03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/fe9e5a46d48c7e7e24da926178a0c73bd14f87b7/ghc >--------------------------------------------------------------- commit fe9e5a46d48c7e7e24da926178a0c73bd14f87b7 Author: Facundo Dom?nguez Date: Mon May 25 21:07:54 2015 -0500 Fix ghci-way tests of -XStaticPointers. Summary: Add -fobject-code to StaticPointers tests in ghci. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: bgamari, thomie, mboes Differential Revision: https://phabricator.haskell.org/D905 (cherry picked from commit 70f1ca431c948be468f7f9a86892fd81c8f1a64b) >--------------------------------------------------------------- fe9e5a46d48c7e7e24da926178a0c73bd14f87b7 testsuite/tests/codeGen/should_run/all.T | 4 +++- testsuite/tests/deSugar/should_run/all.T | 5 ++++- testsuite/tests/rts/all.T | 8 ++++++-- testsuite/tests/th/all.T | 4 +++- 4 files changed, 16 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index d193834..12418f0 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -115,7 +115,9 @@ test('T7953', reqlib('random'), compile_and_run, ['']) test('T8256', normal, compile_and_run, ['-dcore-lint -O1']) test('T6084',normal, compile_and_run, ['-O2']) test('CgStaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) test('StaticArraySize', normal, compile_and_run, ['-O2']) test('StaticByteArraySize', normal, compile_and_run, ['-O2']) diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T index 87ebe8e..5787816 100644 --- a/testsuite/tests/deSugar/should_run/all.T +++ b/testsuite/tests/deSugar/should_run/all.T @@ -41,6 +41,9 @@ test('T5742', normal, compile_and_run, ['']) test('DsLambdaCase', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, ['']) test('DsMultiWayIf', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, ['']) test('DsStaticPointers', - when(compiler_lt('ghc', '7.9'), skip), compile_and_run, ['']) + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], + compile_and_run, ['']) test('T8952', normal, compile_and_run, ['']) test('T9844', normal, compile_and_run, ['']) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 88c354f..8e0e76e 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -248,10 +248,14 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) compile_and_run, ['-rdynamic -package ghc']) test('GcStaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) test('ListStaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) # 251 = RTS exit code for "out of memory" diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index fc3f3b5..335363b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -323,7 +323,9 @@ test('T8577', test('T8633', normal, compile_and_run, ['']) test('T8625', normal, ghci_script, ['T8625.script']) test('TH_StaticPointers', - [ when(compiler_lt('ghc', '7.9'), skip) ], + [ when(compiler_lt('ghc', '7.9'), skip) + , when(doing_ghci(), extra_hc_opts('-fobject-code')) + ], compile_and_run, ['']) test('TH_StaticPointers02', [ when(compiler_lt('ghc', '7.9'), skip) ], From git at git.haskell.org Wed May 27 15:07:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 15:07:54 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Omit the static form error for variables not in scope. (0a7f3b3) Message-ID: <20150527150754.BD5773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/0a7f3b303f29724658ddb1c1481b2a26a5fd8b0a/ghc >--------------------------------------------------------------- commit 0a7f3b303f29724658ddb1c1481b2a26a5fd8b0a Author: Facundo Dom?nguez Date: Mon May 25 21:08:05 2015 -0500 Omit the static form error for variables not in scope. Summary: Fixes T10446. The following program > g = static f now produces only: > ...: error > Not in scope: 'f' Before it would also produce a complaint about 'f' not being a top-level identifier. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: bgamari, thomie, mboes Differential Revision: https://phabricator.haskell.org/D906 GHC Trac Issues: #10446 (cherry picked from commit 71d1f01db94dda5b8c2c367fba8cc7b115b06e95) >--------------------------------------------------------------- 0a7f3b303f29724658ddb1c1481b2a26a5fd8b0a compiler/rename/RnExpr.hs | 4 +++- testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr | 9 ++------- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 4cebafc..0dab57d 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -339,7 +339,9 @@ rnExpr e@(HsStatic expr) = do ] _ -> do let isTopLevelName n = isExternalName n || isWiredInName n - case nameSetElems $ filterNameSet (not . isTopLevelName) fvExpr of + case nameSetElems $ filterNameSet + (\n -> not (isTopLevelName n || isUnboundName n)) + fvExpr of [] -> return () fvNonGlobal -> addErr $ cat [ text $ "Only identifiers of top-level bindings can " diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr index 6524702..52e3609 100644 --- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr +++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr @@ -1,8 +1,3 @@ -RnStaticPointersFail02.hs:5:5: - Only identifiers of top-level bindings can appear in the body of the static form: - static T - but the following identifiers were found instead: - T - -RnStaticPointersFail02.hs:5:12: Not in scope: data constructor ?T? +RnStaticPointersFail02.hs:5:12: error: + Not in scope: data constructor ?T? From git at git.haskell.org Wed May 27 15:14:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 15:14:01 +0000 (UTC) Subject: [commit: ghc] master: Build system: don't install haddock .t files (#10410) (388448b) Message-ID: <20150527151401.4EE5A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/388448bcc2e363d1913b5132a36ac7aaa20eafc0/ghc >--------------------------------------------------------------- commit 388448bcc2e363d1913b5132a36ac7aaa20eafc0 Author: Thomas Miedema Date: Sun May 24 18:58:19 2015 +0200 Build system: don't install haddock .t files (#10410) When generating a haddock .t file for a library, don't save it in the `dist-install/doc` directory for that library, as then it gets copied to the installation directory during `make install` by `ghc-cabal copy`. Instead, save it a few directories up; putting it next to `haddock-prologue.txt` seemed appropriate. Test Plan: run `make` in `tests/perf/haddock`. Differential Revision: https://phabricator.haskell.org/D903 >--------------------------------------------------------------- 388448bcc2e363d1913b5132a36ac7aaa20eafc0 rules/haddock.mk | 2 +- testsuite/tests/perf/haddock/all.T | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/rules/haddock.mk b/rules/haddock.mk index a7785fe..a43df95 100644 --- a/rules/haddock.mk +++ b/rules/haddock.mk @@ -61,7 +61,7 @@ endif $$($1_$2_HADDOCK_FLAGS) $$($1_$2_HADDOCK_OPTS) \ $$($1_$2_HS_SRCS) \ $$($1_$2_EXTRA_HADDOCK_SRCS) \ - +RTS -t$$@.t --machine-readable + +RTS -t"$1/$2/haddock.t" --machine-readable # --no-tmp-comp-dir above is important: it saves a few minutes in a # validate. This flag lets Haddock use the pre-compiled object files diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index bf2c009..5d1e6a0 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -40,7 +40,7 @@ test('haddock.base', # 2014-08-05: XXX TODO UPDATE ME XXX ], stats, - ['../../../../libraries/base/dist-install/doc/html/base/base.haddock.t']) + ['../../../../libraries/base/dist-install/haddock.t']) test('haddock.Cabal', [unless(in_tree_compiler(), skip), req_haddock @@ -81,7 +81,7 @@ test('haddock.Cabal', # 2014-08-05: XXX TODO UPDATE ME XXX ], stats, - ['../../../../libraries/Cabal/Cabal/dist-install/doc/html/Cabal/Cabal.haddock.t']) + ['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']) test('haddock.compiler', [unless(in_tree_compiler(), skip), req_haddock @@ -109,4 +109,4 @@ test('haddock.compiler', # 2014-06-29: 15110426000 (x86/Linux) ], stats, - ['../../../../compiler/stage2/doc/html/ghc/ghc.haddock.t']) + ['../../../../compiler/stage2/haddock.t']) From git at git.haskell.org Wed May 27 15:50:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 15:50:58 +0000 (UTC) Subject: [commit: ghc] master: ApiAnnotations tweaks (c591147) Message-ID: <20150527155058.464923A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5911479f295242e16e396eb5d1369f2e4ce8de0/ghc >--------------------------------------------------------------- commit c5911479f295242e16e396eb5d1369f2e4ce8de0 Author: Alan Zimmerman Date: Wed May 27 17:50:55 2015 +0200 ApiAnnotations tweaks Summary: A collection of minor updates for the API Annotations. 1. The annotations for the implicity parameter is disconnected in the following type MPI = ?mpi_secret :: MPISecret 2. In the following, the annotation for one of the commas is disconeected. mkPoli = mkBila . map ((,,(),,()) <$> P.base <*> P.pos <*> P.form) 3. In the following, the annotation for the parens becomes disconnected data MaybeDefault v where SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v SetTo4 :: forall v a. (( Eq v, Show v ) => v -> MaybeDefault v -> a -> MaybeDefault [a]) Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D901 GHC Trac Issues: #10399 >--------------------------------------------------------------- c5911479f295242e16e396eb5d1369f2e4ce8de0 compiler/ghc.mk | 2 + compiler/hsSyn/HsTypes.hs | 28 ++-- compiler/parser/ApiAnnotation.hs | 3 + compiler/parser/Parser.y | 25 ++-- compiler/parser/RdrHsSyn.hs | 12 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10399.stderr | 13 ++ testsuite/tests/ghc-api/annotations/T10399.stdout | 154 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10399.hs | 18 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 - .../tests/ghc-api/annotations/parseTree.stdout | 4 +- .../ghc-api/annotations/{t10278.hs => t10399.hs} | 2 +- 14 files changed, 242 insertions(+), 31 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c5911479f295242e16e396eb5d1369f2e4ce8de0 From git at git.haskell.org Wed May 27 15:53:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 15:53:14 +0000 (UTC) Subject: [commit: ghc] branch 'wip/api-annots' deleted Message-ID: <20150527155314.683273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/api-annots From git at git.haskell.org Wed May 27 16:55:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 16:55:15 +0000 (UTC) Subject: [commit: ghc] branch 'wip/api-annots-7.10' created Message-ID: <20150527165515.1D2783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/api-annots-7.10 Referencing: 2ac9b8e3220e058e70c2ce0c21604cb390b18fca From git at git.haskell.org Wed May 27 16:55:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 16:55:18 +0000 (UTC) Subject: [commit: ghc] wip/api-annots-7.10: ApiAnnotations tweaks (2ac9b8e) Message-ID: <20150527165518.E34B63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2ac9b8e3220e058e70c2ce0c21604cb390b18fca/ghc >--------------------------------------------------------------- commit 2ac9b8e3220e058e70c2ce0c21604cb390b18fca Author: Alan Zimmerman Date: Wed May 27 17:50:55 2015 +0200 ApiAnnotations tweaks Summary: A collection of minor updates for the API Annotations. 1. The annotations for the implicity parameter is disconnected in the following type MPI = ?mpi_secret :: MPISecret 2. In the following, the annotation for one of the commas is disconeected. mkPoli = mkBila . map ((,,(),,()) <$> P.base <*> P.pos <*> P.form) 3. In the following, the annotation for the parens becomes disconnected data MaybeDefault v where SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v SetTo4 :: forall v a. (( Eq v, Show v ) => v -> MaybeDefault v -> a -> MaybeDefault [a]) Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D901 GHC Trac Issues: #10399 (cherry picked from commit c5911479f295242e16e396eb5d1369f2e4ce8de0) >--------------------------------------------------------------- 2ac9b8e3220e058e70c2ce0c21604cb390b18fca compiler/ghc.mk | 2 + compiler/hsSyn/HsTypes.hs | 28 ++-- compiler/parser/ApiAnnotation.hs | 3 + compiler/parser/Parser.y | 25 ++-- compiler/parser/RdrHsSyn.hs | 12 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10399.stderr | 13 ++ testsuite/tests/ghc-api/annotations/T10399.stdout | 154 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10399.hs | 18 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 - .../tests/ghc-api/annotations/parseTree.stdout | 4 +- .../ghc-api/annotations/{t10278.hs => t10399.hs} | 2 +- 14 files changed, 242 insertions(+), 31 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2ac9b8e3220e058e70c2ce0c21604cb390b18fca From git at git.haskell.org Wed May 27 19:52:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 19:52:17 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: testsuite: fix RnStaticPointersFail02 stderr (d29d7cb) Message-ID: <20150527195217.20AE43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d29d7cbc72571d308ca349c79f7c895c2385908f/ghc >--------------------------------------------------------------- commit d29d7cbc72571d308ca349c79f7c895c2385908f Author: Austin Seipp Date: Wed May 27 14:51:55 2015 -0500 testsuite: fix RnStaticPointersFail02 stderr Another oops moment from the 'error:' message change. Signed-off-by: Austin Seipp >--------------------------------------------------------------- d29d7cbc72571d308ca349c79f7c895c2385908f testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr index 52e3609..e949727 100644 --- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr +++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr @@ -1,3 +1,2 @@ -RnStaticPointersFail02.hs:5:12: error: - Not in scope: data constructor ?T? +RnStaticPointersFail02.hs:5:12: Not in scope: data constructor ?T? From git at git.haskell.org Wed May 27 22:07:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 22:07:06 +0000 (UTC) Subject: [commit: ghc] branch 'wip/api-annots-7.10-2' created Message-ID: <20150527220706.E32593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/api-annots-7.10-2 Referencing: e979c0e7dffc43507c4c7a3886f46a3a156425fe From git at git.haskell.org Wed May 27 22:07:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 May 2015 22:07:10 +0000 (UTC) Subject: [commit: ghc] wip/api-annots-7.10-2: ApiAnnotations tweaks (e979c0e) Message-ID: <20150527220710.D812D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/api-annots-7.10-2 Link : http://ghc.haskell.org/trac/ghc/changeset/e979c0e7dffc43507c4c7a3886f46a3a156425fe/ghc >--------------------------------------------------------------- commit e979c0e7dffc43507c4c7a3886f46a3a156425fe Author: Alan Zimmerman Date: Wed May 27 17:50:55 2015 +0200 ApiAnnotations tweaks Summary: A collection of minor updates for the API Annotations. 1. The annotations for the implicity parameter is disconnected in the following type MPI = ?mpi_secret :: MPISecret 2. In the following, the annotation for one of the commas is disconeected. mkPoli = mkBila . map ((,,(),,()) <$> P.base <*> P.pos <*> P.form) 3. In the following, the annotation for the parens becomes disconnected data MaybeDefault v where SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v SetTo4 :: forall v a. (( Eq v, Show v ) => v -> MaybeDefault v -> a -> MaybeDefault [a]) Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D901 GHC Trac Issues: #10399 (cherry picked from commit c5911479f295242e16e396eb5d1369f2e4ce8de0) >--------------------------------------------------------------- e979c0e7dffc43507c4c7a3886f46a3a156425fe compiler/ghc.mk | 2 + compiler/hsSyn/HsTypes.hs | 28 ++-- compiler/parser/ApiAnnotation.hs | 3 + compiler/parser/Parser.y | 25 ++-- compiler/parser/RdrHsSyn.hs | 12 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10399.stderr | 13 ++ testsuite/tests/ghc-api/annotations/T10399.stdout | 154 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10399.hs | 18 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 - .../tests/ghc-api/annotations/parseTree.stdout | 4 +- .../ghc-api/annotations/{t10278.hs => t10399.hs} | 2 +- 14 files changed, 242 insertions(+), 31 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e979c0e7dffc43507c4c7a3886f46a3a156425fe From git at git.haskell.org Thu May 28 13:20:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 May 2015 13:20:15 +0000 (UTC) Subject: [commit: ghc] master: Testdriver: don't use os.popen in config/ghc (ef90466) Message-ID: <20150528132015.BEADF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef9046601b8616106878529884ce1e9ae645f9ed/ghc >--------------------------------------------------------------- commit ef9046601b8616106878529884ce1e9ae645f9ed Author: Phil Ruffwind Date: Thu May 28 14:14:49 2015 +0200 Testdriver: don't use os.popen in config/ghc Rewrite config/ghc to use getStdout (which use subprocess.Popen) instead of os.popen, which is deprecated; this also avoids the use of shell Also: * Move getStdout to driver/testutil.py so both config/ghc and driver/runtests.py can use it * Remove support for Python below 2.4, which doesn't have subprocess Reviewed By: thomie Differential Revision: https://phabricator.haskell.org/D908 >--------------------------------------------------------------- ef9046601b8616106878529884ce1e9ae645f9ed testsuite/config/ghc | 11 +++------- testsuite/driver/runtests.py | 5 +---- testsuite/driver/testlib.py | 52 +++++++++----------------------------------- testsuite/driver/testutil.py | 18 +++++++++++++++ 4 files changed, 32 insertions(+), 54 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index 5e4bda2..a1b1ccc 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -1,5 +1,5 @@ -import os import re +import subprocess # Testsuite configuration setup for GHC # @@ -159,16 +159,11 @@ llvm_ways = [x[0] for x in config.way_flags('dummy_name').items() if '-fflvm' in x[1]] def get_compiler_info(): -# This should really not go through the shell - h = os.popen(config.compiler + ' --info', 'r') - s = h.read() + s = getStdout([config.compiler, '--info']).decode('utf8') s = re.sub('[\r\n]', '', s) - h.close() compilerInfoDict = dict(eval(s)) - h = os.popen(config.compiler + ' +RTS --info', 'r') - s = h.read() + s = getStdout([config.compiler, '+RTS', '--info']).decode('utf8') s = re.sub('[\r\n]', '', s) - h.close() rtsInfoDict = dict(eval(s)) # We use a '/'-separated path for libdir, even on Windows diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 4e497e8..fcfad77 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -18,10 +18,7 @@ import re # * If we import ctypes before subprocess on cygwin, then sys.exit(0) # says "Aborted" and we fail with exit code 134. # So we import it here first, so that the testsuite doesn't appear to fail. -try: - import subprocess -except: - pass +import subprocess PYTHON3 = sys.version_info >= (3, 0) if PYTHON3: diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index e9beee4..98a75e0 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -17,13 +17,7 @@ import copy import glob from math import ceil, trunc import collections - -have_subprocess = False -try: - import subprocess - have_subprocess = True -except: - print("Warning: subprocess not found, will fall back to spawnv") +import subprocess from testglobals import * from testutil import * @@ -103,20 +97,14 @@ def _reqlib( name, opts, lib ): if lib in have_lib: got_it = have_lib[lib] else: - if have_subprocess: - # By preference we use subprocess, as the alternative uses - # /dev/null which mingw doesn't have. - cmd = strip_quotes(config.ghc_pkg) - p = subprocess.Popen([cmd, '--no-user-package-db', 'describe', lib], - stdout=subprocess.PIPE, - stderr=subprocess.PIPE) - # read from stdout and stderr to avoid blocking due to - # buffers filling - p.communicate() - r = p.wait() - else: - r = os.system(config.ghc_pkg + ' --no-user-package-db describe ' - + lib + ' > /dev/null 2> /dev/null') + cmd = strip_quotes(config.ghc_pkg) + p = subprocess.Popen([cmd, '--no-user-package-db', 'describe', lib], + stdout=subprocess.PIPE, + stderr=subprocess.PIPE) + # read from stdout and stderr to avoid blocking due to + # buffers filling + p.communicate() + r = p.wait() got_it = r == 0 have_lib[lib] = got_it @@ -1803,13 +1791,8 @@ def rawSystem(cmd_and_args): # with the Windows (non-cygwin) python. An argument "a b c" # turns into three arguments ["a", "b", "c"]. - # However, subprocess is new in python 2.4, so fall back to - # using spawnv if we don't have it cmd = cmd_and_args[0] - if have_subprocess: - return subprocess.call([strip_quotes(cmd)] + cmd_and_args[1:]) - else: - return os.spawnv(os.P_WAIT, cmd, cmd_and_args) + return subprocess.call([strip_quotes(cmd)] + cmd_and_args[1:]) # When running under native msys Python, any invocations of non-msys binaries, # including timeout.exe, will have their arguments munged according to some @@ -2293,20 +2276,5 @@ def printFailingTestInfosSummary(file, testInfos): ' (' + ','.join(testInfos[directory][test][reason]) + ')\n') file.write('\n') -def getStdout(cmd_and_args): - if have_subprocess: - p = subprocess.Popen([strip_quotes(cmd_and_args[0])] + cmd_and_args[1:], - stdout=subprocess.PIPE, - stderr=subprocess.PIPE) - (stdout, stderr) = p.communicate() - r = p.wait() - if r != 0: - raise Exception("Command failed: " + str(cmd_and_args)) - if stderr != '': - raise Exception("stderr from command: " + str(cmd_and_args)) - return stdout - else: - raise Exception("Need subprocess to get stdout, but don't have it") - def modify_lines(s, f): return '\n'.join([f(l) for l in s.splitlines()]) diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index 2cfa8f1..2f037f0 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -1,5 +1,8 @@ # ----------------------------------------------------------------------------- # Utils + +import subprocess + def version_to_ints(v): return [ int(x) for x in v.split('.') ] @@ -18,3 +21,18 @@ def version_ge(x, y): def strip_quotes(s): # Don't wrap commands to subprocess.call/Popen in quotes. return s.strip('\'"') + +def getStdout(cmd_and_args): + # Can't use subprocess.check_output as it's not available in Python 2.6; + # It's also not quite the same as check_output, since we also verify that + # no stderr was produced + p = subprocess.Popen([strip_quotes(cmd_and_args[0])] + cmd_and_args[1:], + stdout=subprocess.PIPE, + stderr=subprocess.PIPE) + (stdout, stderr) = p.communicate() + r = p.wait() + if r != 0: + raise Exception("Command failed: " + str(cmd_and_args)) + if stderr != '': + raise Exception("stderr from command: " + str(cmd_and_args)) + return stdout From git at git.haskell.org Thu May 28 13:20:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 May 2015 13:20:18 +0000 (UTC) Subject: [commit: ghc] master: Testdriver: do not interfer with MinGW path magic (#10449) (ce166a3) Message-ID: <20150528132018.6CFFB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce166a3aaab28a9b08c60da6d0cfdab998b6e8ca/ghc >--------------------------------------------------------------- commit ce166a3aaab28a9b08c60da6d0cfdab998b6e8ca Author: Thomas Miedema Date: Wed May 27 15:02:35 2015 +0200 Testdriver: do not interfer with MinGW path magic (#10449) This should fix the testsuite driver on Windows using the MinGW tools with a native build of Python. MinGW automagically converts MinGW-style paths (e.g. '/c/programs/ghc/bin/ghc') into ordinary Windows paths (e.g. 'C:/programs/ghc/bin/ghc') when a native Windows program is invoked. But it doesn't do so when those paths are wrapped with a pair of escaped double quotes. The fix is to not call `eval` on the paths in Python, which let's us use one less pair of quotes, and makes MinGW happy. Reviewers: Rufflewind, austin Differential Revision: https://phabricator.haskell.org/D911 >--------------------------------------------------------------- ce166a3aaab28a9b08c60da6d0cfdab998b6e8ca testsuite/driver/runtests.py | 9 +++++++-- testsuite/mk/test.mk | 28 +++++++++++++++++----------- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index fcfad77..72e1419 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -40,7 +40,8 @@ config = getConfig() # get it from testglobals # cmd-line options long_options = [ - "config=", # config file + "configfile=", # config file + "config=", # config field "rootdir=", # root of tree containing tests (default: .) "output-summary=", # file in which to save the (human-readable) summary "only=", # just this test (can be give multiple --only= flags) @@ -55,7 +56,7 @@ long_options = [ opts, args = getopt.getopt(sys.argv[1:], "e:", long_options) for opt,arg in opts: - if opt == '--config': + if opt == '--configfile': exec(open(arg).read()) # -e is a string to execute from the command line. For example: @@ -63,6 +64,10 @@ for opt,arg in opts: if opt == '-e': exec(arg) + if opt == '--config': + field, value = arg.split('=', 1) + setattr(config, field, value) + if opt == '--rootdir': config.rootdirs.append(arg) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 9927b6d..7e5b038 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -194,7 +194,7 @@ endif RUNTEST_OPTS += \ --rootdir=. \ - --config=$(CONFIG) \ + --configfile=$(CONFIG) \ -e 'config.confdir="$(CONFIGDIR)"' \ -e 'config.platform="$(TARGETPLATFORM)"' \ -e 'config.os="$(TargetOS_CPP)"' \ @@ -205,17 +205,23 @@ RUNTEST_OPTS += \ -e 'config.exeext="$(exeext)"' \ -e 'config.top="$(TOP_ABS)"' -# Put an extra pair of quotes around non-empty program paths, -# so we don't have to in .T scripts or driver/testlib.py. -quote_path = $(if $1,"\"$1\"","") +# Wrap non-empty program paths in quotes, because they may contain spaces. Do +# it here, so we don't have to (and don't forget to do it) in the .T test +# scripts (search for '{compiler}' or '{hpc}'). This may or may not be a good +# idea. +# Use `--config` instead of `-e`, because `-e` (which calls Python's `eval` +# function) would require another pair of (escaped) quotes, which interfers +# with MinGW's magic path handling (see #10449, and +# http://www.mingw.org/wiki/Posix_path_conversion). +quote_path = $(if $1,"$1") RUNTEST_OPTS += \ - -e 'config.compiler=$(call quote_path,$(TEST_HC))' \ - -e 'config.ghc_pkg=$(call quote_path,$(GHC_PKG))' \ - -e 'config.haddock=$(call quote_path,$(HADDOCK))' \ - -e 'config.hp2ps=$(call quote_path,$(HP2PS_ABS))' \ - -e 'config.hpc=$(call quote_path,$(HPC))' \ - -e 'config.gs=$(call quote_path,$(GS))' \ - -e 'config.timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))' + --config 'compiler=$(call quote_path,$(TEST_HC))' \ + --config 'ghc_pkg=$(call quote_path,$(GHC_PKG))' \ + --config 'haddock=$(call quote_path,$(HADDOCK))' \ + --config 'hp2ps=$(call quote_path,$(HP2PS_ABS))' \ + --config 'hpc=$(call quote_path,$(HPC))' \ + --config 'gs=$(call quote_path,$(GS))' \ + --config 'timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))' ifneq "$(OUTPUT_SUMMARY)" "" RUNTEST_OPTS += \ From git at git.haskell.org Thu May 28 17:25:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 May 2015 17:25:29 +0000 (UTC) Subject: [commit: ghc] master: Remove unnecessary loadInterface for TH quoted name. (640fe14) Message-ID: <20150528172529.C7E733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/640fe14255706ab9c6a1fa101d9b05dfabdc6556/ghc >--------------------------------------------------------------- commit 640fe14255706ab9c6a1fa101d9b05dfabdc6556 Author: Edward Z. Yang Date: Thu May 14 15:49:44 2015 -0700 Remove unnecessary loadInterface for TH quoted name. Summary: The load was introduced a32d3e4da0aceb624c958f02cad7327e17ac94db to fix a bug where deprecations assumed that the name in question had already had their interface loaded. The new deprecation code no longer makes this assumption and just loads the interface, so this eager load is not necessary. Verified that TH_reifyType2 continues to work. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D891 GHC Trac Issues: #10419 >--------------------------------------------------------------- 640fe14255706ab9c6a1fa101d9b05dfabdc6556 compiler/rename/RnSplice.hs | 15 ++------------- 1 file changed, 2 insertions(+), 13 deletions(-) diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 737dcc9..61b5b14 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -22,7 +22,6 @@ import Kind import RnEnv import RnSource ( rnSrcDecls, findSplice ) import RnPat ( rnPat ) -import LoadIface ( loadInterfaceForName ) import BasicTypes ( TopLevelFlag, isTopLevel ) import Outputable import Module @@ -98,10 +97,8 @@ rn_bracket outer_stage br@(VarBr flg rdr_name) = do { name <- lookupOccRn rdr_name ; this_mod <- getModule - ; case flg of - { -- Type variables can be quoted in TH. See #5721. - False -> return () - ; True | nameIsLocalOrFrom this_mod name -> + ; when (flg && nameIsLocalOrFrom this_mod name) $ + -- Type variables can be quoted in TH. See #5721. do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name ; case mb_bind_lvl of { Nothing -> return () -- Can happen for data constructors, @@ -116,15 +113,7 @@ rn_bracket outer_stage br@(VarBr flg rdr_name) (quotedNameStageErr br) } } } - ; True | otherwise -> -- Imported thing - discardResult (loadInterfaceForName msg name) - -- Reason for loadInterface: deprecation checking - -- assumes that the home interface is loaded, and - -- this is the only way that is going to happen - } ; return (VarBr flg name, unitFV name) } - where - msg = ptext (sLit "Need interface for Template Haskell quoted Name") rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e ; return (ExpBr e', fvs) } From git at git.haskell.org Thu May 28 21:20:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 May 2015 21:20:09 +0000 (UTC) Subject: [commit: ghc] master: base: fix #10298 & #7695 (e28462d) Message-ID: <20150528212009.515D83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e28462de700240288519a016d0fe44d4360d9ffd/ghc >--------------------------------------------------------------- commit e28462de700240288519a016d0fe44d4360d9ffd Author: Austin Seipp Date: Tue May 19 04:56:40 2015 -0500 base: fix #10298 & #7695 Summary: This applies a patch from Reid Barton and Sylvain Henry, which fix a disasterous infinite loop when iconv fails to load locale files, as specified in #10298. The fix is a bit of a hack but should be fine - for the actual reasoning behind it, see `Note [Disaster and iconv]` for more info. In addition to this fix, we also patch up the IO Encoding utilities to recognize several variations of the 'ASCII' encoding (including its aliases) directly so that GHC can do conversions without iconv. This allows a static binary to sit in an initramfs. Authored-by: Reid Barton Authored-by: Sylvain Henry Signed-off-by: Austin Seipp Test Plan: Eyeballed it. Reviewers: rwbarton, hvr Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D898 GHC Trac Issues: #10298, #7695 >--------------------------------------------------------------- e28462de700240288519a016d0fe44d4360d9ffd libraries/base/GHC/IO/Encoding.hs | 14 +++++++++++++- libraries/base/GHC/TopHandler.hs | 29 ++++++++++++++++++++++++++++- 2 files changed, 41 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/IO/Encoding.hs b/libraries/base/GHC/IO/Encoding.hs index 31683b4..014b61b 100644 --- a/libraries/base/GHC/IO/Encoding.hs +++ b/libraries/base/GHC/IO/Encoding.hs @@ -235,7 +235,14 @@ mkTextEncoding e = case mb_coding_failure_mode of _ -> Nothing mkTextEncoding' :: CodingFailureMode -> String -> IO TextEncoding -mkTextEncoding' cfm enc = case [toUpper c | c <- enc, c /= '-'] of +mkTextEncoding' cfm enc + -- First, specifically match on ASCII encodings directly using + -- several possible aliases (specified by RFC 1345 & co), which + -- allows us to handle ASCII conversions without iconv at all (see + -- trac #10298). + | any (== enc) ansiEncNames = return (UTF8.mkUTF8 cfm) + -- Otherwise, handle other encoding needs via iconv. + | otherwise = case [toUpper c | c <- enc, c /= '-'] of "UTF8" -> return $ UTF8.mkUTF8 cfm "UTF16" -> return $ UTF16.mkUTF16 cfm "UTF16LE" -> return $ UTF16.mkUTF16le cfm @@ -249,6 +256,11 @@ mkTextEncoding' cfm enc = case [toUpper c | c <- enc, c /= '-'] of #else _ -> Iconv.mkIconvEncoding cfm enc #endif + where + ansiEncNames = -- ASCII aliases + [ "ANSI_X3.4-1968", "iso-ir-6", "ANSI_X3.4-1986", "ISO_646.irv:1991" + , "US-ASCII", "us", "IBM367", "cp367", "csASCII", "ASCII", "ISO646-US" + ] latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8) latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8 diff --git a/libraries/base/GHC/TopHandler.hs b/libraries/base/GHC/TopHandler.hs index d7c0038..e725196 100644 --- a/libraries/base/GHC/TopHandler.hs +++ b/libraries/base/GHC/TopHandler.hs @@ -157,13 +157,40 @@ real_handler exit se = do Just (ExitFailure n) -> exit n -- EPIPE errors received for stdout are ignored (#2699) - _ -> case fromException se of + _ -> catch (case fromException se of Just IOError{ ioe_type = ResourceVanished, ioe_errno = Just ioe, ioe_handle = Just hdl } | Errno ioe == ePIPE, hdl == stdout -> exit 0 _ -> do reportError se exit 1 + ) (disasterHandler exit) -- See Note [Disaster with iconv] + +-- don't use errorBelch() directly, because we cannot call varargs functions +-- using the FFI. +foreign import ccall unsafe "HsBase.h errorBelch2" + errorBelch :: CString -> CString -> IO () + +disasterHandler :: (Int -> IO a) -> IOError -> IO a +disasterHandler exit _ = + withCAString "%s" $ \fmt -> + withCAString msgStr $ \msg -> + errorBelch fmt msg >> exit 1 + where msgStr = "encountered an exception while trying to report an exception" + +{- Note [Disaster with iconv] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When using iconv, it's possible for things like iconv_open to fail in +restricted environments (like an initram or restricted container), but +when this happens the error raised inevitably calls `peekCString`, +which depends on the users locale, which depends on using +`iconv_open`... which causes an infinite loop. + +This occurrence is also known as tickets #10298 and #7695. So to work +around it we just set _another_ error handler and bail directly by +calling the RTS, without iconv at all. +-} -- try to flush stdout/stderr, but don't worry if we fail From git at git.haskell.org Thu May 28 21:36:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 May 2015 21:36:52 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: testsuite: handle missing stats files gracefully (#10305) (b6e5ad7) Message-ID: <20150528213652.935813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/b6e5ad78837f687a8d43fd4b3fecbe9b83784f15/ghc >--------------------------------------------------------------- commit b6e5ad78837f687a8d43fd4b3fecbe9b83784f15 Author: Thomas Miedema Date: Tue May 19 19:18:28 2015 +0200 testsuite: handle missing stats files gracefully (#10305) The following tests would result in framework failures when using a ghc build with HADDOCK_DOCS=NO in mk/build.mk or mk/validate.mk: * haddock.Cabal * haddock.base * haddock.compiler Test Plan: run make in tests/perf/haddock Differential Revision: https://phabricator.haskell.org/D899 (cherry picked from commit 6694ccf9444baf565eb0f38f7808767616f23825) >--------------------------------------------------------------- b6e5ad78837f687a8d43fd4b3fecbe9b83784f15 testsuite/config/ghc | 1 + testsuite/driver/testlib.py | 9 ++++++++- testsuite/mk/boilerplate.mk | 10 ++++++++++ testsuite/mk/test.mk | 16 +++++++++------- testsuite/tests/perf/haddock/all.T | 6 +++--- 5 files changed, 31 insertions(+), 11 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index c208838..bf1bc77 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -9,6 +9,7 @@ config.compiler_type = 'ghc' config.compiler = 'ghc' config.compiler_always_flags = ghc_compiler_always_flags.split() +config.haddock = 'haddock' config.hp2ps = 'hp2ps' config.hpc = 'hpc' config.gs = 'gs' diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index af1dcdf..65ff8ba 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -123,6 +123,10 @@ def _reqlib( name, opts, lib ): if not got_it: opts.expect = 'missing-lib' +def req_haddock( name, opts ): + if not config.haddock: + opts.expect = 'missing-lib' + def req_profiling( name, opts ): if not config.have_profiling: opts.expect = 'fail' @@ -1115,7 +1119,10 @@ def checkStats(name, way, stats_file, range_fields): result = passed() if len(range_fields) > 0: - f = open(in_testdir(stats_file)) + try: + f = open(in_testdir(stats_file)) + except IOError as e: + return failBecause(str(e)) contents = f.read() f.close() diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index 1765d78..98c9886 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -95,6 +95,10 @@ ifeq "$(RUNGHC)" "" RUNGHC := $(BIN_ROOT)/runghc endif +ifeq "$(HADDOCK)" "" +HADDOCK := $(call find_tool,haddock) +endif + ifeq "$(HSC2HS)" "" HSC2HS := $(BIN_ROOT)/hsc2hs endif @@ -117,6 +121,12 @@ ifeq "$(shell test -x '$(GHC_PKG)' && echo exists)" "" $(error Cannot find ghc-pkg: $(GHC_PKG)) endif +$(eval $(call canonicaliseExecutable,HADDOCK)) +ifeq "$(shell test -x '$(HADDOCK)' && echo exists)" "" +# haddock is optional. +HADDOCK := +endif + $(eval $(call canonicaliseExecutable,HSC2HS)) ifeq "$(shell test -x '$(HSC2HS)' && echo exists)" "" $(error Cannot find hsc2hs: $(HSC2HS)) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 813a3a1..42e634a 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -205,15 +205,17 @@ RUNTEST_OPTS += \ -e 'config.exeext="$(exeext)"' \ -e 'config.top="$(TOP_ABS)"' -# Put an extra pair of quotes around program paths, +# Put an extra pair of quotes around non-empty program paths, # so we don't have to in .T scripts or driver/testlib.py. +quote_path = $(if $1,"\"$1\"","") RUNTEST_OPTS += \ - -e 'config.compiler="\"$(TEST_HC)\""' \ - -e 'config.ghc_pkg="\"$(GHC_PKG)\""' \ - -e 'config.hp2ps="\"$(HP2PS_ABS)\""' \ - -e 'config.hpc="\"$(HPC)\""' \ - -e 'config.gs="\"$(GS)\""' \ - -e 'config.timeout_prog="\"$(TIMEOUT_PROGRAM)\""' + -e 'config.compiler=$(call quote_path,$(TEST_HC))' \ + -e 'config.ghc_pkg=$(call quote_path,$(GHC_PKG))' \ + -e 'config.haddock=$(call quote_path,$(HADDOCK))' \ + -e 'config.hp2ps=$(call quote_path,$(HP2PS_ABS))' \ + -e 'config.hpc=$(call quote_path,$(HPC))' \ + -e 'config.gs=$(call quote_path,$(GS))' \ + -e 'config.timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))' ifneq "$(OUTPUT_SUMMARY)" "" RUNTEST_OPTS += \ diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 905ab91..8e0b971 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -3,7 +3,7 @@ # detect outliers, as described in Note [residency]. See #9556. test('haddock.base', - [unless(in_tree_compiler(), skip) + [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', [(wordsize(64), 9502647104, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -40,7 +40,7 @@ test('haddock.base', ['../../../../libraries/base/dist-install/doc/html/base/base.haddock.t']) test('haddock.Cabal', - [unless(in_tree_compiler(), skip) + [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', [(wordsize(64), 6387320816, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -79,7 +79,7 @@ test('haddock.Cabal', ['../../../../libraries/Cabal/Cabal/dist-install/doc/html/Cabal/Cabal.haddock.t']) test('haddock.compiler', - [unless(in_tree_compiler(), skip) + [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', [(wordsize(64), 33562468736, 10) # 2012-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Thu May 28 21:36:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 May 2015 21:36:55 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Testdriver: do not interfer with MinGW path magic (#10449) (080c4e7) Message-ID: <20150528213655.5391D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/080c4e7ab60019cfe345449c6862d276d09fb25b/ghc >--------------------------------------------------------------- commit 080c4e7ab60019cfe345449c6862d276d09fb25b Author: Thomas Miedema Date: Wed May 27 15:02:35 2015 +0200 Testdriver: do not interfer with MinGW path magic (#10449) This should fix the testsuite driver on Windows using the MinGW tools with a native build of Python. MinGW automagically converts MinGW-style paths (e.g. '/c/programs/ghc/bin/ghc') into ordinary Windows paths (e.g. 'C:/programs/ghc/bin/ghc') when a native Windows program is invoked. But it doesn't do so when those paths are wrapped with a pair of escaped double quotes. The fix is to not call `eval` on the paths in Python, which let's us use one less pair of quotes, and makes MinGW happy. Reviewers: Rufflewind, austin Differential Revision: https://phabricator.haskell.org/D911 (cherry picked from commit ce166a3aaab28a9b08c60da6d0cfdab998b6e8ca) >--------------------------------------------------------------- 080c4e7ab60019cfe345449c6862d276d09fb25b testsuite/driver/runtests.py | 9 +++++++-- testsuite/mk/test.mk | 28 +++++++++++++++++----------- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 4e497e8..b6970b0 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -43,7 +43,8 @@ config = getConfig() # get it from testglobals # cmd-line options long_options = [ - "config=", # config file + "configfile=", # config file + "config=", # config field "rootdir=", # root of tree containing tests (default: .) "output-summary=", # file in which to save the (human-readable) summary "only=", # just this test (can be give multiple --only= flags) @@ -58,7 +59,7 @@ long_options = [ opts, args = getopt.getopt(sys.argv[1:], "e:", long_options) for opt,arg in opts: - if opt == '--config': + if opt == '--configfile': exec(open(arg).read()) # -e is a string to execute from the command line. For example: @@ -66,6 +67,10 @@ for opt,arg in opts: if opt == '-e': exec(arg) + if opt == '--config': + field, value = arg.split('=', 1) + setattr(config, field, value) + if opt == '--rootdir': config.rootdirs.append(arg) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 42e634a..2522b11 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -194,7 +194,7 @@ endif RUNTEST_OPTS += \ --rootdir=. \ - --config=$(CONFIG) \ + --configfile=$(CONFIG) \ -e 'config.confdir="$(CONFIGDIR)"' \ -e 'config.platform="$(TARGETPLATFORM)"' \ -e 'config.os="$(TargetOS_CPP)"' \ @@ -205,17 +205,23 @@ RUNTEST_OPTS += \ -e 'config.exeext="$(exeext)"' \ -e 'config.top="$(TOP_ABS)"' -# Put an extra pair of quotes around non-empty program paths, -# so we don't have to in .T scripts or driver/testlib.py. -quote_path = $(if $1,"\"$1\"","") +# Wrap non-empty program paths in quotes, because they may contain spaces. Do +# it here, so we don't have to (and don't forget to do it) in the .T test +# scripts (search for '{compiler}' or '{hpc}'). This may or may not be a good +# idea. +# Use `--config` instead of `-e`, because `-e` (which calls Python's `eval` +# function) would require another pair of (escaped) quotes, which interfers +# with MinGW's magic path handling (see #10449, and +# http://www.mingw.org/wiki/Posix_path_conversion). +quote_path = $(if $1,"$1") RUNTEST_OPTS += \ - -e 'config.compiler=$(call quote_path,$(TEST_HC))' \ - -e 'config.ghc_pkg=$(call quote_path,$(GHC_PKG))' \ - -e 'config.haddock=$(call quote_path,$(HADDOCK))' \ - -e 'config.hp2ps=$(call quote_path,$(HP2PS_ABS))' \ - -e 'config.hpc=$(call quote_path,$(HPC))' \ - -e 'config.gs=$(call quote_path,$(GS))' \ - -e 'config.timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))' + --config 'compiler=$(call quote_path,$(TEST_HC))' \ + --config 'ghc_pkg=$(call quote_path,$(GHC_PKG))' \ + --config 'haddock=$(call quote_path,$(HADDOCK))' \ + --config 'hp2ps=$(call quote_path,$(HP2PS_ABS))' \ + --config 'hpc=$(call quote_path,$(HPC))' \ + --config 'gs=$(call quote_path,$(GS))' \ + --config 'timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))' ifneq "$(OUTPUT_SUMMARY)" "" RUNTEST_OPTS += \ From git at git.haskell.org Fri May 29 00:37:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 May 2015 00:37:18 +0000 (UTC) Subject: [commit: ghc] master: Add liftData function. (b0d8ba3) Message-ID: <20150529003718.EED7F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0d8ba368f031279444c851dbca499d7e272f74c/ghc >--------------------------------------------------------------- commit b0d8ba368f031279444c851dbca499d7e272f74c Author: Edward Z. Yang Date: Mon May 4 15:24:34 2015 -0700 Add liftData function. Summary: See https://mail.haskell.org/pipermail/libraries/2015-April/025480.html for the proposal and discussion Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D879 >--------------------------------------------------------------- b0d8ba368f031279444c851dbca499d7e272f74c libraries/template-haskell/Language/Haskell/TH/Quote.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Quote.hs b/libraries/template-haskell/Language/Haskell/TH/Quote.hs index 39cd2ba..66ee115 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Quote.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Quote.hs @@ -16,6 +16,7 @@ that is up to you. module Language.Haskell.TH.Quote( QuasiQuoter(..), dataToQa, dataToExpQ, dataToPatQ, + liftData, quoteFile ) where @@ -88,14 +89,19 @@ dataToQa mkCon mkLit appCon antiQ t = -- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the -- same value, in the SYB style. It is generalized to take a function --- override type-specific cases; a useful default is 'const Nothing' --- for no overriding. +-- override type-specific cases; see 'liftData' for a more commonly +-- used variant. dataToExpQ :: Data a => (forall b . Data b => b -> Maybe (Q Exp)) -> a -> Q Exp dataToExpQ = dataToQa conE litE (foldl appE) +-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which +-- works for any type with a 'Data' instance. +liftData :: Data a => a -> Q Exp +liftData = dataToExpQ (const Nothing) + -- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same -- value, in the SYB style. It takes a function to handle type-specific cases, -- alternatively, pass @const Nothing@ to get default behavior. From git at git.haskell.org Fri May 29 01:11:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 May 2015 01:11:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: ApiAnnotations tweaks (2d56598) Message-ID: <20150529011105.0D7373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2d56598932551061bc389ab0d17e7ae761b7cbda/ghc >--------------------------------------------------------------- commit 2d56598932551061bc389ab0d17e7ae761b7cbda Author: Alan Zimmerman Date: Wed May 27 17:50:55 2015 +0200 ApiAnnotations tweaks Summary: A collection of minor updates for the API Annotations. 1. The annotations for the implicity parameter is disconnected in the following type MPI = ?mpi_secret :: MPISecret 2. In the following, the annotation for one of the commas is disconeected. mkPoli = mkBila . map ((,,(),,()) <$> P.base <*> P.pos <*> P.form) 3. In the following, the annotation for the parens becomes disconnected data MaybeDefault v where SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v SetTo4 :: forall v a. (( Eq v, Show v ) => v -> MaybeDefault v -> a -> MaybeDefault [a]) Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D901 GHC Trac Issues: #10399 (cherry picked from commit c5911479f295242e16e396eb5d1369f2e4ce8de0) >--------------------------------------------------------------- 2d56598932551061bc389ab0d17e7ae761b7cbda compiler/ghc.mk | 2 + compiler/hsSyn/HsTypes.hs | 28 ++-- compiler/parser/ApiAnnotation.hs | 3 + compiler/parser/Parser.y | 25 ++-- compiler/parser/RdrHsSyn.hs | 12 +- testsuite/tests/ghc-api/annotations/.gitignore | 1 + testsuite/tests/ghc-api/annotations/Makefile | 8 ++ testsuite/tests/ghc-api/annotations/T10399.stderr | 13 ++ testsuite/tests/ghc-api/annotations/T10399.stdout | 154 +++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test10399.hs | 18 +++ testsuite/tests/ghc-api/annotations/all.T | 1 + .../tests/ghc-api/annotations/exampleTest.stdout | 2 - .../tests/ghc-api/annotations/parseTree.stdout | 4 +- .../ghc-api/annotations/{t10278.hs => t10399.hs} | 2 +- 14 files changed, 242 insertions(+), 31 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2d56598932551061bc389ab0d17e7ae761b7cbda From git at git.haskell.org Fri May 29 01:11:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 May 2015 01:11:07 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: base: fix #10298 & #7695 (25b8478) Message-ID: <20150529011107.BFFD13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/25b84781ed950d59c7bffb77a576d3c43a883ca9/ghc >--------------------------------------------------------------- commit 25b84781ed950d59c7bffb77a576d3c43a883ca9 Author: Austin Seipp Date: Tue May 19 04:56:40 2015 -0500 base: fix #10298 & #7695 Summary: This applies a patch from Reid Barton and Sylvain Henry, which fix a disasterous infinite loop when iconv fails to load locale files, as specified in #10298. The fix is a bit of a hack but should be fine - for the actual reasoning behind it, see `Note [Disaster and iconv]` for more info. In addition to this fix, we also patch up the IO Encoding utilities to recognize several variations of the 'ASCII' encoding (including its aliases) directly so that GHC can do conversions without iconv. This allows a static binary to sit in an initramfs. Authored-by: Reid Barton Authored-by: Sylvain Henry Signed-off-by: Austin Seipp Test Plan: Eyeballed it. Reviewers: rwbarton, hvr Subscribers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D898 GHC Trac Issues: #10298, #7695 (cherry picked from commit e28462de700240288519a016d0fe44d4360d9ffd) >--------------------------------------------------------------- 25b84781ed950d59c7bffb77a576d3c43a883ca9 libraries/base/GHC/IO/Encoding.hs | 14 +++++++++++++- libraries/base/GHC/TopHandler.hs | 29 ++++++++++++++++++++++++++++- 2 files changed, 41 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/IO/Encoding.hs b/libraries/base/GHC/IO/Encoding.hs index 31683b4..014b61b 100644 --- a/libraries/base/GHC/IO/Encoding.hs +++ b/libraries/base/GHC/IO/Encoding.hs @@ -235,7 +235,14 @@ mkTextEncoding e = case mb_coding_failure_mode of _ -> Nothing mkTextEncoding' :: CodingFailureMode -> String -> IO TextEncoding -mkTextEncoding' cfm enc = case [toUpper c | c <- enc, c /= '-'] of +mkTextEncoding' cfm enc + -- First, specifically match on ASCII encodings directly using + -- several possible aliases (specified by RFC 1345 & co), which + -- allows us to handle ASCII conversions without iconv at all (see + -- trac #10298). + | any (== enc) ansiEncNames = return (UTF8.mkUTF8 cfm) + -- Otherwise, handle other encoding needs via iconv. + | otherwise = case [toUpper c | c <- enc, c /= '-'] of "UTF8" -> return $ UTF8.mkUTF8 cfm "UTF16" -> return $ UTF16.mkUTF16 cfm "UTF16LE" -> return $ UTF16.mkUTF16le cfm @@ -249,6 +256,11 @@ mkTextEncoding' cfm enc = case [toUpper c | c <- enc, c /= '-'] of #else _ -> Iconv.mkIconvEncoding cfm enc #endif + where + ansiEncNames = -- ASCII aliases + [ "ANSI_X3.4-1968", "iso-ir-6", "ANSI_X3.4-1986", "ISO_646.irv:1991" + , "US-ASCII", "us", "IBM367", "cp367", "csASCII", "ASCII", "ISO646-US" + ] latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8) latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8 diff --git a/libraries/base/GHC/TopHandler.hs b/libraries/base/GHC/TopHandler.hs index d7c0038..e725196 100644 --- a/libraries/base/GHC/TopHandler.hs +++ b/libraries/base/GHC/TopHandler.hs @@ -157,13 +157,40 @@ real_handler exit se = do Just (ExitFailure n) -> exit n -- EPIPE errors received for stdout are ignored (#2699) - _ -> case fromException se of + _ -> catch (case fromException se of Just IOError{ ioe_type = ResourceVanished, ioe_errno = Just ioe, ioe_handle = Just hdl } | Errno ioe == ePIPE, hdl == stdout -> exit 0 _ -> do reportError se exit 1 + ) (disasterHandler exit) -- See Note [Disaster with iconv] + +-- don't use errorBelch() directly, because we cannot call varargs functions +-- using the FFI. +foreign import ccall unsafe "HsBase.h errorBelch2" + errorBelch :: CString -> CString -> IO () + +disasterHandler :: (Int -> IO a) -> IOError -> IO a +disasterHandler exit _ = + withCAString "%s" $ \fmt -> + withCAString msgStr $ \msg -> + errorBelch fmt msg >> exit 1 + where msgStr = "encountered an exception while trying to report an exception" + +{- Note [Disaster with iconv] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When using iconv, it's possible for things like iconv_open to fail in +restricted environments (like an initram or restricted container), but +when this happens the error raised inevitably calls `peekCString`, +which depends on the users locale, which depends on using +`iconv_open`... which causes an infinite loop. + +This occurrence is also known as tickets #10298 and #7695. So to work +around it we just set _another_ error handler and bail directly by +calling the RTS, without iconv at all. +-} -- try to flush stdout/stderr, but don't worry if we fail From git at git.haskell.org Fri May 29 21:46:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 May 2015 21:46:17 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: accept new output for T2507 and T8959a (a138fa1) Message-ID: <20150529214617.112BA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a138fa1aa9fe2b6499d023ebff4e0fd2f0f1cac8/ghc >--------------------------------------------------------------- commit a138fa1aa9fe2b6499d023ebff4e0fd2f0f1cac8 Author: Thomas Miedema Date: Fri May 29 23:01:09 2015 +0200 Testsuite: accept new output for T2507 and T8959a Unbreak the build. >--------------------------------------------------------------- a138fa1aa9fe2b6499d023ebff4e0fd2f0f1cac8 testsuite/tests/driver/T2507.stderr | 6 +++--- testsuite/tests/driver/T8959a.stderr | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/driver/T2507.stderr b/testsuite/tests/driver/T2507.stderr index 925a870..eb0878f 100644 --- a/testsuite/tests/driver/T2507.stderr +++ b/testsuite/tests/driver/T2507.stderr @@ -1,5 +1,5 @@ -T2507.hs:5:7: - Couldn't match expected type `Int' with actual type `()' +T2507.hs:5:7: error: + Couldn't match expected type ?Int? with actual type ?()? In the expression: () - In an equation for `foo': foo = () + In an equation for ?foo?: foo = () diff --git a/testsuite/tests/driver/T8959a.stderr b/testsuite/tests/driver/T8959a.stderr index f270bb6..defb34b 100644 --- a/testsuite/tests/driver/T8959a.stderr +++ b/testsuite/tests/driver/T8959a.stderr @@ -1,5 +1,5 @@ -T8959a.hs:5:7: - Couldn't match expected type `Int -> Int' with actual type `()' +T8959a.hs:5:7: error: + Couldn't match expected type ?Int -> Int? with actual type ?()? In the expression: () - In an equation for `foo': foo = () + In an equation for ?foo?: foo = () From git at git.haskell.org Sat May 30 07:46:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 07:46:09 +0000 (UTC) Subject: [commit: packages/deepseq] tag 'v1.4.0.0' created Message-ID: <20150530074609.B1AA33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/deepseq New tag : v1.4.0.0 Referencing: 2ef6dc116f31d3871bf965775e7afd26d2367d38 From git at git.haskell.org Sat May 30 15:08:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:22 +0000 (UTC) Subject: [commit: ghc] master: Build system: make more targets PHONY (5ead7d1) Message-ID: <20150530150822.C4DBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ead7d182cea63865379f51f42477e735277f97d/ghc >--------------------------------------------------------------- commit 5ead7d182cea63865379f51f42477e735277f97d Author: Thomas Miedema Date: Tue May 26 14:49:47 2015 +0200 Build system: make more targets PHONY [skip ci] >--------------------------------------------------------------- 5ead7d182cea63865379f51f42477e735277f97d Makefile | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Makefile b/Makefile index 83ef07c..e99cb84 100644 --- a/Makefile +++ b/Makefile @@ -79,9 +79,11 @@ endif @echo "===--- building final phase" $(MAKE) -r --no-print-directory -f ghc.mk phase=final $@ +.PHONY: binary-dist binary-dist: binary-dist-prep mv bindistprep/*.tar.$(TAR_COMP_EXT) . +.PHONY: binary-dist-prep binary-dist-prep: ifeq "$(mingw32_TARGET_OS)" "1" $(MAKE) -r --no-print-directory -f ghc.mk windows-binary-dist-prep @@ -91,17 +93,21 @@ else $(MAKE) -r --no-print-directory -f ghc.mk unix-binary-dist-prep endif +.PHONY: clean distclean maintainer-clean clean distclean maintainer-clean: $(MAKE) -r --no-print-directory -f ghc.mk $@ CLEANING=YES test ! -d testsuite || $(MAKE) -C testsuite $@ +.PHONY: $(filter clean_%,$(MAKECMDGOALS)) $(filter clean_%, $(MAKECMDGOALS)) : clean_% : $(MAKE) -r --no-print-directory -f ghc.mk $@ CLEANING=YES +.PHONY: bootstrapping-files show echo bootstrapping-files show echo: $(MAKE) -r --no-print-directory -f ghc.mk $@ ifeq "$(darwin_TARGET_OS)" "1" +.PHONY: framework-pkg framework-pkg: $(MAKE) -C distrib/MacOS $@ endif From git at git.haskell.org Sat May 30 15:08:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:25 +0000 (UTC) Subject: [commit: ghc] master: Build system: remove toplevel target `fast` (4c7d177) Message-ID: <20150530150825.8D20D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c7d1778e0e8ac2eae0f9055580b40e32b6e8c0a/ghc >--------------------------------------------------------------- commit 4c7d1778e0e8ac2eae0f9055580b40e32b6e8c0a Author: Thomas Miedema Date: Sat May 23 00:02:22 2015 +0200 Build system: remove toplevel target `fast` Remove the recently introduced `fast` synonym for `fasttest`, because in the subdirectories `make fast` already means `make all FAST=YES`. [skip ci] >--------------------------------------------------------------- 4c7d1778e0e8ac2eae0f9055580b40e32b6e8c0a Makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index e99cb84..74bc641 100644 --- a/Makefile +++ b/Makefile @@ -53,7 +53,7 @@ endif endif # No need to update makefiles for these targets: -REALGOALS=$(filter-out binary-dist binary-dist-prep bootstrapping-files framework-pkg clean clean_% distclean maintainer-clean show echo help test fulltest fast fasttest,$(MAKECMDGOALS)) +REALGOALS=$(filter-out binary-dist binary-dist-prep bootstrapping-files framework-pkg clean clean_% distclean maintainer-clean show echo help test fulltest fasttest,$(MAKECMDGOALS)) # configure touches certain files even if they haven't changed. This # can mean a lot of unnecessary recompilation after a re-configure, so @@ -118,8 +118,8 @@ endif endif -.PHONY: fasttest fast -fasttest fast: +.PHONY: fasttest +fasttest: $(MAKE) -C testsuite/tests CLEANUP=1 OUTPUT_SUMMARY=../../testsuite_summary.txt fast .PHONY: fulltest test From git at git.haskell.org Sat May 30 15:08:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:28 +0000 (UTC) Subject: [commit: ghc] master: Build system: use `mkdir -p` instead of `-mkdir` (a065a3a) Message-ID: <20150530150828.45E9E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a065a3ae6063eae4c45797ecc5c9b9c822534d2a/ghc >--------------------------------------------------------------- commit a065a3ae6063eae4c45797ecc5c9b9c822534d2a Author: Thomas Miedema Date: Sun May 24 12:34:05 2015 +0200 Build system: use `mkdir -p` instead of `-mkdir` Avoid unnecessary warnings. [skip ci] >--------------------------------------------------------------- a065a3ae6063eae4c45797ecc5c9b9c822534d2a utils/mkdirhier/ghc.mk | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/utils/mkdirhier/ghc.mk b/utils/mkdirhier/ghc.mk index a656577..55803f0 100644 --- a/utils/mkdirhier/ghc.mk +++ b/utils/mkdirhier/ghc.mk @@ -11,9 +11,8 @@ # ----------------------------------------------------------------------------- $(MKDIRHIER) : utils/mkdirhier/mkdirhier.sh - -mkdir $(INPLACE) - -mkdir $(INPLACE_BIN) - -mkdir $(INPLACE_LIB) + mkdir -p $(INPLACE_BIN) + mkdir -p $(INPLACE_LIB) $(call removeFiles,$@) echo '#!$(SHELL)' >> $@ cat utils/mkdirhier/mkdirhier.sh >> $@ From git at git.haskell.org Sat May 30 15:08:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:31 +0000 (UTC) Subject: [commit: ghc] master: Build system: allow missing config.mk for target clean_% (51aacde) Message-ID: <20150530150831.0A0F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/51aacde6f0eab264099330b8d69aa2deb9810917/ghc >--------------------------------------------------------------- commit 51aacde6f0eab264099330b8d69aa2deb9810917 Author: Thomas Miedema Date: Tue May 26 14:50:50 2015 +0200 Build system: allow missing config.mk for target clean_% [skip ci] >--------------------------------------------------------------- 51aacde6f0eab264099330b8d69aa2deb9810917 Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 74bc641..950126c 100644 --- a/Makefile +++ b/Makefile @@ -34,7 +34,7 @@ default : all help: @cat MAKEHELP.md -ifneq "$(filter maintainer-clean distclean clean help,$(MAKECMDGOALS))" "" +ifneq "$(filter maintainer-clean distclean clean clean_% help,$(MAKECMDGOALS))" "" -include mk/config.mk else include mk/config.mk From git at git.haskell.org Sat May 30 15:08:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:33 +0000 (UTC) Subject: [commit: ghc] master: Build system: check $CLEANING instead of $MAKECMDGOALS (4de8028) Message-ID: <20150530150833.BEB083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4de8028d702abbf74cc2abf0c2bfe0c1ec29c26d/ghc >--------------------------------------------------------------- commit 4de8028d702abbf74cc2abf0c2bfe0c1ec29c26d Author: Thomas Miedema Date: Tue May 26 16:07:40 2015 +0200 Build system: check $CLEANING instead of $MAKECMDGOALS To check if we're cleaning, always check the $CLEANING variable, instead of sometimes $CLEANING, sometimes $MAKECMDGOALS. [skip ci] >--------------------------------------------------------------- 4de8028d702abbf74cc2abf0c2bfe0c1ec29c26d ghc.mk | 8 ++++---- libraries/integer-gmp/gmp/ghc.mk | 2 +- rules/build-perl.mk | 2 +- rules/build-prog.mk | 6 +++--- testsuite/mk/boilerplate.mk | 1 + 5 files changed, 10 insertions(+), 9 deletions(-) diff --git a/ghc.mk b/ghc.mk index 2f37be8..8ce26d2 100644 --- a/ghc.mk +++ b/ghc.mk @@ -140,7 +140,7 @@ echo: include mk/tree.mk -ifeq "$(findstring clean,$(MAKECMDGOALS))" "" +ifneq "$(CLEANING)" "YES" include mk/config.mk ifeq "$(ProjectVersion)" "" $(error Please run ./configure first) @@ -155,7 +155,7 @@ include mk/custom-settings.mk SRC_CC_OPTS += $(WERROR) SRC_HC_OPTS += $(WERROR) -ifeq "$(findstring clean,$(MAKECMDGOALS))" "" +ifneq "$(CLEANING)" "YES" ifeq "$(DYNAMIC_GHC_PROGRAMS)" "YES" ifeq "$(findstring dyn,$(GhcLibWays))" "" $(error dyn is not in $$(GhcLibWays), but $$(DYNAMIC_GHC_PROGRAMS) is YES) @@ -203,7 +203,7 @@ $(eval $(call clean-target,root,inplace,inplace/bin inplace/lib)) # When we're just doing 'make clean' or 'make show', then we don't need # to build dependencies. -ifneq "$(findstring clean,$(MAKECMDGOALS))" "" +ifeq "$(CLEANING)" "YES" NO_INCLUDE_DEPS = YES NO_INCLUDE_PKGDATA = YES endif @@ -650,7 +650,7 @@ endif ifeq "$(INTEGER_LIBRARY)" "integer-gmp" BUILD_DIRS += libraries/integer-gmp/gmp -else ifneq "$(findstring clean,$(MAKECMDGOALS))" "" +else ifeq "$(CLEANING)" "YES" BUILD_DIRS += libraries/integer-gmp/gmp endif diff --git a/libraries/integer-gmp/gmp/ghc.mk b/libraries/integer-gmp/gmp/ghc.mk index 78a7cf0..9c7a2a3 100644 --- a/libraries/integer-gmp/gmp/ghc.mk +++ b/libraries/integer-gmp/gmp/ghc.mk @@ -46,7 +46,7 @@ endif ifeq "$(phase)" "final" -ifeq "$(findstring clean,$(MAKECMDGOALS))" "" +ifneq "$(CLEANING)" "YES" include libraries/integer-gmp/gmp/config.mk endif diff --git a/rules/build-perl.mk b/rules/build-perl.mk index 3f7a026..51e92f7 100644 --- a/rules/build-perl.mk +++ b/rules/build-perl.mk @@ -52,7 +52,7 @@ $(call clean-target,$1,$2,$1/$2 $$($1_$2_INPLACE)) clean_$1 : clean_$1_$2 # INPLACE_BIN etc. might be empty if we're cleaning -ifeq "$(findstring clean,$(MAKECMDGOALS))" "" +ifneq "$$(CLEANING)" "YES" ifneq "$$(BINDIST)" "YES" $1/$2/$$($1_$2_PROG).prl: $1/$$($1_PERL_SRC) $$$$(unlit_INPLACE) | $$$$(dir $$$$@)/. "$$(unlit_INPLACE)" $$(UNLIT_OPTS) $$< $$@ diff --git a/rules/build-prog.mk b/rules/build-prog.mk index 88f1b53..9395704 100644 --- a/rules/build-prog.mk +++ b/rules/build-prog.mk @@ -81,13 +81,13 @@ endif $1_$2_depfile_base = $1/$2/build/.depend ifeq "$$($1_$2_INSTALL_INPLACE)" "NO" -ifeq "$(findstring clean,$(MAKECMDGOALS))" "" +ifneq "$$(CLEANING)" "YES" $1_$2_INPLACE = $$(error $1_$2 should not be installed inplace, but INPLACE var evaluated) else $1_$2_INPLACE = endif else -ifeq "$(findstring clean,$(MAKECMDGOALS))" "" +ifneq "$$(CLEANING)" "YES" ifneq "$$($$($1_$2_PROGNAME)_INPLACE)" "" $$(error $$($1_$2_PROGNAME)_INPLACE defined twice) endif @@ -279,7 +279,7 @@ endif endif # INPLACE_BIN might be empty if we're distcleaning -ifeq "$(findstring clean,$(MAKECMDGOALS))" "" +ifneq "$$(CLEANING)" "YES" ifeq "$$($1_$2_INSTALL_INPLACE)" "YES" $$($1_$2_INPLACE) : $1/$2/build/tmp/$$($1_$2_PROG_INPLACE) | $$$$(dir $$$$@)/. $$(INSTALL) -m 755 $$< $$@ diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index 43bc4df..f8b1dcb 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -187,6 +187,7 @@ $(ghc-config-mk) : $(TOP)/mk/ghc-config $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail +# Note: $(CLEANING) is not defined in the testsuite. ifeq "$(findstring clean,$(MAKECMDGOALS))" "" include $(ghc-config-mk) endif From git at git.haskell.org Sat May 30 15:08:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:36 +0000 (UTC) Subject: [commit: ghc] master: Build system: don't set CLEANING=NO (47e00ec) Message-ID: <20150530150836.72D1F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47e00ec4a85b492a1e9f8750b4ba12963a10d76a/ghc >--------------------------------------------------------------- commit 47e00ec4a85b492a1e9f8750b4ba12963a10d76a Author: Thomas Miedema Date: Tue May 26 16:22:57 2015 +0200 Build system: don't set CLEANING=NO We only ever check if CLEANING=YES. [skip ci] >--------------------------------------------------------------- 47e00ec4a85b492a1e9f8750b4ba12963a10d76a ghc.mk | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/ghc.mk b/ghc.mk index 8ce26d2..3e7372a 100644 --- a/ghc.mk +++ b/ghc.mk @@ -100,10 +100,6 @@ else $(error Make has restarted itself $(MAKE_RESTARTS) times; is there a makefile bug? See http://ghc.haskell.org/trac/ghc/wiki/Building/Troubleshooting#Makehasrestarteditself3timesisthereamakefilebug for details) endif -ifneq "$(CLEANING)" "YES" -CLEANING = NO -endif - # ----------------------------------------------------------------------------- # Misc GNU make utils @@ -263,15 +259,13 @@ include rules/cmm-objs.mk # Suffix rules cause "make clean" to fail on Windows (trac #3233) # so we don't make any when cleaning. ifneq "$(CLEANING)" "YES" - include rules/hs-suffix-rules-srcdir.mk include rules/hs-suffix-way-rules-srcdir.mk include rules/hs-suffix-way-rules.mk include rules/hi-rule.mk include rules/c-suffix-rules.mk include rules/cmm-suffix-rules.mk - -endif # CLEANING=YES +endif # ----------------------------------------------------------------------------- # Building package-data.mk files from .cabal files From git at git.haskell.org Sat May 30 15:08:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:39 +0000 (UTC) Subject: [commit: ghc] master: Build system: whitespace and comments only (b0885e4) Message-ID: <20150530150839.2E36C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0885e467990e9843f11b2b9d5ceb5d3b3109132/ghc >--------------------------------------------------------------- commit b0885e467990e9843f11b2b9d5ceb5d3b3109132 Author: Thomas Miedema Date: Tue May 26 18:31:43 2015 +0200 Build system: whitespace and comments only [skip ci] >--------------------------------------------------------------- b0885e467990e9843f11b2b9d5ceb5d3b3109132 rules/build-prog.mk | 15 ++++++++++++--- rules/shell-wrapper.mk | 9 ++++++--- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/rules/build-prog.mk b/rules/build-prog.mk index 9395704..b32a7a0 100644 --- a/rules/build-prog.mk +++ b/rules/build-prog.mk @@ -47,6 +47,10 @@ $(call profEnd, build-prog($1,$2,$3)) endef + + + + define build-prog-vars # $1 = dir # $2 = distdir @@ -107,6 +111,10 @@ endif endef + + + + define build-prog-helper # $1 = dir # $2 = distdir @@ -181,6 +189,7 @@ $1_$2_$$($1_$2_PROGRAM_WAY)_GHC_LD_OPTS += -no-auto-link-packages -no-hs-main endif ifneq "$$(BINDIST)" "YES" + # The quadrupled $'s here are because the __LIB variables aren't # necessarily set when this part of the makefile is read $1/$2/build/tmp/$$($1_$2_PROG) $1/$2/build/tmp/$$($1_$2_PROG).dll : \ @@ -252,7 +261,7 @@ $1/$2/build/tmp/$$($1_$2_PROG) : $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c $1/$2/ $1/$2/build/tmp/$$($1_$2_PROG).dll : $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/. $$(call build-dll,$1,$2,$$($1_$2_PROGRAM_WAY),,$$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS),$$@) -else +else # $1_$2_PROG_NEEDS_C_WRAPPER=NO ifeq "$$($1_$2_LINK_WITH_GCC)" "NO" $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_HC) -o $$@ $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_HC_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_GHC_LD_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES)) @@ -261,7 +270,7 @@ else $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_CC) -o $$@ $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_CC_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_LD_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_EXTRA_CC_OPTS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES)) endif -endif +endif # $1_$2_PROG_NEEDS_C_WRAPPER # Note [lib-depends] if this program is built with stage1 or greater, we # need to depend on the libraries too. NB. since $(ALL_STAGE1_LIBS) and @@ -286,7 +295,7 @@ $$($1_$2_INPLACE) : $1/$2/build/tmp/$$($1_$2_PROG_INPLACE) | $$$$(dir $$$$@)/. endif endif -endif +endif # BINDIST=YES ifneq "$$($1_$2_INSTALL_INPLACE)" "NO" $(call all-target,$1_$2,$$($1_$2_INPLACE)) diff --git a/rules/shell-wrapper.mk b/rules/shell-wrapper.mk index ae38e65..6b84072 100644 --- a/rules/shell-wrapper.mk +++ b/rules/shell-wrapper.mk @@ -20,6 +20,7 @@ ifeq "$$($1_$2_SHELL_WRAPPER_NAME)" "" $1_$2_SHELL_WRAPPER_NAME = $1/$$($1_$2_PROGNAME).wrapper endif + ifeq "$$($1_$2_WANT_INPLACE_WRAPPER)" "YES" $1_$2_INPLACE_SHELL_WRAPPER_NAME = $$($1_$2_PROG) @@ -56,7 +57,8 @@ else endif $$(EXECUTABLE_FILE) $$@ -endif +endif # $1_$2_WANT_INPLACE_WRAPPER + ifeq "$$($1_$2_WANT_INSTALLED_WRAPPER)" "YES" @@ -88,7 +90,8 @@ install_$1_$2_wrapper: cat $$($1_$2_SHELL_WRAPPER_NAME) >> "$$(WRAPPER)" $$(EXECUTABLE_FILE) "$$(WRAPPER)" -endif +endif # $1_$2_WANT_INSTALLED_WRAPPER + ifeq "$$($1_$2_WANT_BINDIST_WRAPPER)" "YES" ifneq "$$(TargetOS_CPP)" "mingw32" @@ -109,7 +112,7 @@ endif $$(EXECUTABLE_FILE) $$@ endif -endif +endif # $1_$2_WANT_BINDIST_WRAPPER $(call profEnd, shell-wrapper($1,$2)) endef From git at git.haskell.org Sat May 30 15:08:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:41 +0000 (UTC) Subject: [commit: ghc] master: Build system: prevent "--version: Command not found" (cd0e2f5) Message-ID: <20150530150841.E2F8C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cd0e2f592c36b92abc7ddc9ebd1f74d03c51862a/ghc >--------------------------------------------------------------- commit cd0e2f592c36b92abc7ddc9ebd1f74d03c51862a Author: Thomas Miedema Date: Tue May 26 15:15:38 2015 +0200 Build system: prevent "--version: Command not found" This would happen when running `make clean` before running `./configure`. [skip ci] >--------------------------------------------------------------- cd0e2f592c36b92abc7ddc9ebd1f74d03c51862a libraries/integer-gmp/gmp/ghc.mk | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/libraries/integer-gmp/gmp/ghc.mk b/libraries/integer-gmp/gmp/ghc.mk index 9c7a2a3..2e81956 100644 --- a/libraries/integer-gmp/gmp/ghc.mk +++ b/libraries/integer-gmp/gmp/ghc.mk @@ -101,6 +101,8 @@ endif libraries/integer-gmp_dist-install_EXTRA_CC_OPTS += $(gmp_CC_OPTS) +ifneq "$(CLEANING)" "YES" +# When running `make clean` before `./configure`, CC_STAGE1 is undefined. CLANG = $(findstring clang, $(shell $(CC_STAGE1) --version)) ifeq "$(CLANG)" "clang" @@ -136,4 +138,5 @@ libraries/integer-gmp/gmp/libgmp.a libraries/integer-gmp/gmp/gmp.h: cd libraries/integer-gmp/gmp/objs && $(AR_STAGE1) x ../libgmp.a $(RANLIB_CMD) libraries/integer-gmp/gmp/libgmp.a -endif +endif # CLEANING +endif # phase From git at git.haskell.org Sat May 30 15:08:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:44 +0000 (UTC) Subject: [commit: ghc] master: Build system: prevent "./Setup: Command not found" (0bfd05e) Message-ID: <20150530150844.A9A213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0bfd05e5995884a5377e31fc24b88ce16b6b5792/ghc >--------------------------------------------------------------- commit 0bfd05e5995884a5377e31fc24b88ce16b6b5792 Author: Thomas Miedema Date: Tue May 26 15:19:08 2015 +0200 Build system: prevent "./Setup: Command not found" [skip ci] >--------------------------------------------------------------- 0bfd05e5995884a5377e31fc24b88ce16b6b5792 testsuite/timeout/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/timeout/Makefile b/testsuite/timeout/Makefile index e7335df..b910a73 100644 --- a/testsuite/timeout/Makefile +++ b/testsuite/timeout/Makefile @@ -62,7 +62,7 @@ endif endif clean distclean maintainer-clean: - -./Setup clean + test ! -f Setup || ./Setup clean $(RM) -rf install-inplace $(RM) -f calibrate.out $(RM) -f Setup Setup.exe Setup.hi Setup.o From git at git.haskell.org Sat May 30 15:08:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:47 +0000 (UTC) Subject: [commit: ghc] master: Build system: time's config files have moved (a49070e) Message-ID: <20150530150847.87BAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a49070e5b16929551b94212363c9a36a1e0f36fd/ghc >--------------------------------------------------------------- commit a49070e5b16929551b94212363c9a36a1e0f36fd Author: Thomas Miedema Date: Wed May 27 21:58:40 2015 +0200 Build system: time's config files have moved [skip ci] >--------------------------------------------------------------- a49070e5b16929551b94212363c9a36a1e0f36fd ghc.mk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghc.mk b/ghc.mk index 3e7372a..be3469a 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1316,7 +1316,7 @@ distclean : clean $(call removeFiles,libraries/directory/include/HsDirectoryConfig.h) $(call removeFiles,libraries/process/include/HsProcessConfig.h) $(call removeFiles,libraries/unix/include/HsUnixConfig.h) - $(call removeFiles,libraries/time/include/HsTimeConfig.h) + $(call removeFiles,libraries/time/lib/include/HsTimeConfig.h) # The library configure scripts also like creating autom4te.cache # directories, so clean them all up. @@ -1344,7 +1344,7 @@ maintainer-clean : distclean $(call removeFiles,libraries/directory/include/HsDirectoryConfig.h.in) $(call removeFiles,libraries/process/include/HsProcessConfig.h.in) $(call removeFiles,libraries/unix/include/HsUnixConfig.h.in) - $(call removeFiles,libraries/time/include/HsTimeConfig.h.in) + $(call removeFiles,libraries/time/lib/include/HsTimeConfig.h.in) .PHONY: all_libraries From git at git.haskell.org Sat May 30 15:08:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:50 +0000 (UTC) Subject: [commit: ghc] master: Build system: always allow me to clean haddock (48ed2f1) Message-ID: <20150530150850.5CCB53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48ed2f128ac0e550022826154e449a5cc55f2d3a/ghc >--------------------------------------------------------------- commit 48ed2f128ac0e550022826154e449a5cc55f2d3a Author: Thomas Miedema Date: Wed May 27 21:38:18 2015 +0200 Build system: always allow me to clean haddock [skip ci] >--------------------------------------------------------------- 48ed2f128ac0e550022826154e449a5cc55f2d3a ghc.mk | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ghc.mk b/ghc.mk index be3469a..d918087 100644 --- a/ghc.mk +++ b/ghc.mk @@ -651,6 +651,9 @@ endif ifeq "$(HADDOCK_DOCS)" "YES" BUILD_DIRS += utils/haddock BUILD_DIRS += utils/haddock/doc +else ifeq "$(CLEANING)" "YES" +BUILD_DIRS += utils/haddock +BUILD_DIRS += utils/haddock/doc endif BUILD_DIRS += compiler From git at git.haskell.org Sat May 30 15:08:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:53 +0000 (UTC) Subject: [commit: ghc] master: Build system: always use `make -r` (577d315) Message-ID: <20150530150853.2E08D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/577d315824440bba5e2f56d2eeba9bd8c5ee17e4/ghc >--------------------------------------------------------------- commit 577d315824440bba5e2f56d2eeba9bd8c5ee17e4 Author: Thomas Miedema Date: Wed May 20 19:57:57 2015 +0200 Build system: always use `make -r` Do what this comment was suggesting: "Ideally we'd like to have 'make -r' turned on by default, because that disables all the implicit rules, but there doesn't seem to be a good way to do that." This change doesn't seem to have much effect on the time it takes to run make. Apparently clearing .SUFFIXES was enough for that. But it does make the output of `make -d` quite a bit shorter, which is nice. Note: ghc.mk is always called indirectly, so no need to set .SUFFIXES or MAKEFLAGS there again. Differential Revision: https://phabricator.haskell.org/D915 >--------------------------------------------------------------- 577d315824440bba5e2f56d2eeba9bd8c5ee17e4 Makefile | 28 ++++++++++++++++++---------- ghc.mk | 6 ------ mk/sub-makefile.mk | 7 ++++++- testsuite/mk/boilerplate.mk | 7 +++++++ 4 files changed, 31 insertions(+), 17 deletions(-) diff --git a/Makefile b/Makefile index 950126c..9913803 100644 --- a/Makefile +++ b/Makefile @@ -10,6 +10,14 @@ # # ----------------------------------------------------------------------------- +# Eliminate use of the built-in implicit rules, and clear out the default list +# of suffixes for suffix rules. Speeds up make quite a bit. Both are needed +# for the shortest `make -d` output. +# Don't set --no-builtin-variables; some rules might stop working if you do +# (e.g. 'make clean' in testsuite/ currently relies on an implicit $RM). +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + ifeq "$(wildcard distrib/)" "" # We're in a bindist @@ -21,7 +29,7 @@ default: .PHONY: install show install show: - $(MAKE) -r --no-print-directory -f ghc.mk $@ BINDIST=YES NO_INCLUDE_DEPS=YES + $(MAKE) --no-print-directory -f ghc.mk $@ BINDIST=YES NO_INCLUDE_DEPS=YES else @@ -70,14 +78,14 @@ REALGOALS=$(filter-out binary-dist binary-dist-prep bootstrapping-files framewor $(REALGOALS) all: mk/config.mk.old mk/project.mk.old compiler/ghc.cabal.old ifneq "$(OMIT_PHASE_0)" "YES" @echo "===--- building phase 0" - $(MAKE) -r --no-print-directory -f ghc.mk phase=0 phase_0_builds + $(MAKE) --no-print-directory -f ghc.mk phase=0 phase_0_builds endif ifneq "$(OMIT_PHASE_1)" "YES" @echo "===--- building phase 1" - $(MAKE) -r --no-print-directory -f ghc.mk phase=1 phase_1_builds + $(MAKE) --no-print-directory -f ghc.mk phase=1 phase_1_builds endif @echo "===--- building final phase" - $(MAKE) -r --no-print-directory -f ghc.mk phase=final $@ + $(MAKE) --no-print-directory -f ghc.mk phase=final $@ .PHONY: binary-dist binary-dist: binary-dist-prep @@ -86,25 +94,25 @@ binary-dist: binary-dist-prep .PHONY: binary-dist-prep binary-dist-prep: ifeq "$(mingw32_TARGET_OS)" "1" - $(MAKE) -r --no-print-directory -f ghc.mk windows-binary-dist-prep + $(MAKE) --no-print-directory -f ghc.mk windows-binary-dist-prep else rm -f bindist-list - $(MAKE) -r --no-print-directory -f ghc.mk bindist BINDIST=YES - $(MAKE) -r --no-print-directory -f ghc.mk unix-binary-dist-prep + $(MAKE) --no-print-directory -f ghc.mk bindist BINDIST=YES + $(MAKE) --no-print-directory -f ghc.mk unix-binary-dist-prep endif .PHONY: clean distclean maintainer-clean clean distclean maintainer-clean: - $(MAKE) -r --no-print-directory -f ghc.mk $@ CLEANING=YES + $(MAKE) --no-print-directory -f ghc.mk $@ CLEANING=YES test ! -d testsuite || $(MAKE) -C testsuite $@ .PHONY: $(filter clean_%,$(MAKECMDGOALS)) $(filter clean_%, $(MAKECMDGOALS)) : clean_% : - $(MAKE) -r --no-print-directory -f ghc.mk $@ CLEANING=YES + $(MAKE) --no-print-directory -f ghc.mk $@ CLEANING=YES .PHONY: bootstrapping-files show echo bootstrapping-files show echo: - $(MAKE) -r --no-print-directory -f ghc.mk $@ + $(MAKE) --no-print-directory -f ghc.mk $@ ifeq "$(darwin_TARGET_OS)" "1" .PHONY: framework-pkg diff --git a/ghc.mk b/ghc.mk index d918087..5c239cd 100644 --- a/ghc.mk +++ b/ghc.mk @@ -107,12 +107,6 @@ nothing= space=$(nothing) $(nothing) comma=, -# Cancel all suffix rules. Ideally we'd like to have 'make -r' turned on -# by default, because that disables all the implicit rules, but there doesn't -# seem to be a good way to do that. This turns off all the old-style suffix -# rules, which does half the job and speeds up make quite a bit: -.SUFFIXES: - # ----------------------------------------------------------------------------- # Makefile debugging # diff --git a/mk/sub-makefile.mk b/mk/sub-makefile.mk index 0ed85c8..12f47f0 100644 --- a/mk/sub-makefile.mk +++ b/mk/sub-makefile.mk @@ -9,7 +9,12 @@ # make clean ==> make -C $(TOP) clean_dir # -# Important, otherwise we get silly built-in rules: +# Eliminate use of the built-in implicit rules, and clear out the default list +# of suffixes for suffix rules. Speeds up make quite a bit. Both are needed +# for the shortest `make -d` output. +# Don't set --no-builtin-variables; some rules might stop working if you do +# (e.g. 'make clean' in testsuite/ currently relies on an implicit $RM). +MAKEFLAGS += --no-builtin-rules .SUFFIXES: TOPMAKE = $(MAKE) -C $(TOP) diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index f8b1dcb..d5b7fb5 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -1,3 +1,10 @@ +# Eliminate use of the built-in implicit rules, and clear out the default list +# of suffixes for suffix rules. Speeds up make quite a bit. Both are needed +# for the shortest `make -d` output. +# Don't set --no-builtin-variables; some rules might stop working if you do +# (e.g. 'make clean' in testsuite/ currently relies on an implicit $RM). +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: default: all From git at git.haskell.org Sat May 30 15:08:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:56 +0000 (UTC) Subject: [commit: ghc] master: Build system: make clean in utils/ghc-pkg should not delete inplace/lib/bin (0d20d76) Message-ID: <20150530150856.0A1F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d20d769b2c2aadd62cdbf557f891e9a7bdbc510/ghc >--------------------------------------------------------------- commit 0d20d769b2c2aadd62cdbf557f891e9a7bdbc510 Author: Thomas Miedema Date: Thu May 28 11:57:07 2015 +0200 Build system: make clean in utils/ghc-pkg should not delete inplace/lib/bin Make sure $1_$2_PROG always gets assigned a value, even when cleaning. The problem with not setting the variable becomes apparent when looking at the following two lines of code: ``` $1_$2_INPLACE = $$(INPLACE_LIB)/bin/$$($1_$2_PROG) $(call clean-target,$1,$2_inplace,$$($1_$2_INPLACE)) ``` So running `make clean` in for example `utils/ghc-pkg` deletes `inplace/lib/bin/` instead of `inplace/lib/bin/ghc-pkg`. The offending code was introduced in commit 2b85372ca18115bb1d6363256fcea6f54e415bed. There is one small implication. When cleaning before configure, the variable $1_$2_PROG will now be assigned a slightly wrong value, because exeext$3 isn't known yet. But I think that's ok, as no files have been build yet, so it will just try to delete a slighly different nonexistent file. [skip ci] Differential Revision: https://phabricator.haskell.org/D916 >--------------------------------------------------------------- 0d20d769b2c2aadd62cdbf557f891e9a7bdbc510 rules/build-prog.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rules/build-prog.mk b/rules/build-prog.mk index b32a7a0..10d31c5 100644 --- a/rules/build-prog.mk +++ b/rules/build-prog.mk @@ -29,8 +29,8 @@ endif ifneq "$$($1_$2_PROG)" "" $$(error $1_$2_PROG is set) endif -$1_$2_PROG = $$($1_$2_PROGNAME)$$(exeext$3) endif +$1_$2_PROG = $$($1_$2_PROGNAME)$$(exeext$3) ifeq "$$(findstring $3,0 1 2)" "" $$(error $1/$2: stage argument to build-prog should be 0, 1, or 2) From git at git.haskell.org Sat May 30 15:08:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:08:58 +0000 (UTC) Subject: [commit: ghc] master: Build system: don't use supposedly local variable inside macro (0a159e3) Message-ID: <20150530150858.D939A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a159e3ad7a56da41a7336fcec79d9ba37cd40cb/ghc >--------------------------------------------------------------- commit 0a159e3ad7a56da41a7336fcec79d9ba37cd40cb Author: Thomas Miedema Date: Thu May 28 18:59:29 2015 +0200 Build system: don't use supposedly local variable inside macro There is no support for local variables inside `make` macros (defined using the `define` keyword), see [wiki:Building/Architecture/Idiom/Macros]. In this case `make show VALUE=INPLACE_WRAPPER` would print some bogus value ("inplace/bin/mkUserGuidePart" actually, from the last BUILD_DIRS entry in ghc.mk that calls shell-wrapper), and using that variable somewhere might be a bug. Test Plan: I checked the rules directory with the following crude regexp, and this seems the be the only real offender. grep -P '^[^ $#\t][^$]*[^+]=' rules/* What it is supposed to do (from right to left): * look for variable assignments * but not updates (+=) * where the variable name doesn't contain any dollar signs * and the line doesn't start with whitespace or a comment [skip ci] Differential Revision: https://phabricator.haskell.org/D918 >--------------------------------------------------------------- 0a159e3ad7a56da41a7336fcec79d9ba37cd40cb rules/shell-wrapper.mk | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/rules/shell-wrapper.mk b/rules/shell-wrapper.mk index 6b84072..dac9016 100644 --- a/rules/shell-wrapper.mk +++ b/rules/shell-wrapper.mk @@ -26,18 +26,18 @@ ifeq "$$($1_$2_WANT_INPLACE_WRAPPER)" "YES" $1_$2_INPLACE_SHELL_WRAPPER_NAME = $$($1_$2_PROG) ifeq "$$($1_$2_TOPDIR)" "YES" -INPLACE_WRAPPER = $$(INPLACE_LIB)/$$($1_$2_INPLACE_SHELL_WRAPPER_NAME) +$1_$2_INPLACE_WRAPPER = $$(INPLACE_LIB)/$$($1_$2_INPLACE_SHELL_WRAPPER_NAME) else -INPLACE_WRAPPER = $$(INPLACE_BIN)/$$($1_$2_INPLACE_SHELL_WRAPPER_NAME) +$1_$2_INPLACE_WRAPPER = $$(INPLACE_BIN)/$$($1_$2_INPLACE_SHELL_WRAPPER_NAME) endif -all_$1_$2 : $$(INPLACE_WRAPPER) +all_$1_$2 : $$($1_$2_INPLACE_WRAPPER) -$$(INPLACE_WRAPPER): WRAPPER=$$@ +$$($1_$2_INPLACE_WRAPPER): WRAPPER=$$@ ifeq "$$($1_$2_SHELL_WRAPPER)" "YES" -$$(INPLACE_WRAPPER): $$($1_$2_SHELL_WRAPPER_NAME) +$$($1_$2_INPLACE_WRAPPER): $$($1_$2_SHELL_WRAPPER_NAME) endif -$$(INPLACE_WRAPPER): $$($1_$2_INPLACE) +$$($1_$2_INPLACE_WRAPPER): $$($1_$2_INPLACE) $$(call removeFiles, $$@) echo '#!$$(SHELL)' >> $$@ echo 'executablename="$$(TOP)/$$<"' >> $$@ From git at git.haskell.org Sat May 30 15:09:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:09:01 +0000 (UTC) Subject: [commit: ghc] master: Build system: also clean the inplace wrapper (018fec0) Message-ID: <20150530150901.CCF003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/018fec02a8736043e3a41dd4e9a3c4a932dfc3dc/ghc >--------------------------------------------------------------- commit 018fec02a8736043e3a41dd4e9a3c4a932dfc3dc Author: Thomas Miedema Date: Thu May 28 19:26:44 2015 +0200 Build system: also clean the inplace wrapper Running `make clean` inside `utils/runghc` now does: "rm" -rf utils/runghc/dist-install "rm" -rf inplace/bin/runghc "rm" -rf inplace/lib/bin/runghc Instead of just: "rm" -rf utils/runghc/dist-install "rm" -rf inplace/lib/bin/runghc I think this was just an oversight. [skip ci] Differential Revision: https://phabricator.haskell.org/D919 >--------------------------------------------------------------- 018fec02a8736043e3a41dd4e9a3c4a932dfc3dc rules/shell-wrapper.mk | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rules/shell-wrapper.mk b/rules/shell-wrapper.mk index dac9016..f5d91e3 100644 --- a/rules/shell-wrapper.mk +++ b/rules/shell-wrapper.mk @@ -33,6 +33,8 @@ endif all_$1_$2 : $$($1_$2_INPLACE_WRAPPER) +$(call clean-target,$1,$2_inplace_wrapper,$$($1_$2_INPLACE_WRAPPER)) + $$($1_$2_INPLACE_WRAPPER): WRAPPER=$$@ ifeq "$$($1_$2_SHELL_WRAPPER)" "YES" $$($1_$2_INPLACE_WRAPPER): $$($1_$2_SHELL_WRAPPER_NAME) From git at git.haskell.org Sat May 30 15:09:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 May 2015 15:09:04 +0000 (UTC) Subject: [commit: ghc] master: Build system: don't build runghc if GhcWithInterpreter=NO (#10261) (508a3a3) Message-ID: <20150530150904.95E363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/508a3a33988d2872f580d8b727036f7f443d8b6d/ghc >--------------------------------------------------------------- commit 508a3a33988d2872f580d8b727036f7f443d8b6d Author: Thomas Miedema Date: Thu May 28 19:34:15 2015 +0200 Build system: don't build runghc if GhcWithInterpreter=NO (#10261) To test: * run `make clean` in utils/runghc * make sure inplace/bin doesn't contain runghc * set GhcWithInterpreter=NO in build.mk * run `make` * note that inplace/bin doesn't contain runghc It won't be installed either, nor will runhaskell. Differential Revision: https://phabricator.haskell.org/D920 >--------------------------------------------------------------- 508a3a33988d2872f580d8b727036f7f443d8b6d ghc.mk | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghc.mk b/ghc.mk index 5c239cd..5a1845c 100644 --- a/ghc.mk +++ b/ghc.mk @@ -661,7 +661,11 @@ BUILD_DIRS += utils/dll-split BUILD_DIRS += utils/ghc-pwd BUILD_DIRS += utils/ghc-cabal BUILD_DIRS += utils/hpc +ifeq "$(GhcWithInterpreter)" "YES" BUILD_DIRS += utils/runghc +else ifeq "$(CLEANING)" "YES" +BUILD_DIRS += utils/runghc +endif BUILD_DIRS += ghc ifneq "$(BINDIST)" "YES" From git at git.haskell.org Sun May 31 06:14:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 May 2015 06:14:05 +0000 (UTC) Subject: [commit: ghc] master: linker_unload working on Windows, fixes #8292. (7db2dec) Message-ID: <20150531061405.3CC093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7db2dec2cf4fae68f7bb490d7c7780288350b597/ghc >--------------------------------------------------------------- commit 7db2dec2cf4fae68f7bb490d7c7780288350b597 Author: Edward Z. Yang Date: Sat May 30 22:15:39 2015 -0700 linker_unload working on Windows, fixes #8292. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 7db2dec2cf4fae68f7bb490d7c7780288350b597 testsuite/tests/rts/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index d823c2b..914603d 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -217,7 +217,7 @@ test('T7919', [extra_clean(['T7919A.o','T7919A.hi', test('T8035', normal, compile_and_run, ['']) test('linker_unload', - [ extra_clean(['Test.o','Test.hi', 'linker_unload']), when(opsys('mingw32'), expect_broken(8292)) ], + [ extra_clean(['Test.o','Test.hi', 'linker_unload']) ], run_command, ['$MAKE -s --no-print-directory linker_unload']) From git at git.haskell.org Sun May 31 06:14:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 May 2015 06:14:08 +0000 (UTC) Subject: [commit: ghc] master: Don't run T9330fail on Windows, no clobber occurs. #9930 (5a65da4) Message-ID: <20150531061408.1BFBD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a65da43559908a42a701b4dbdff682dcdf2e121/ghc >--------------------------------------------------------------- commit 5a65da43559908a42a701b4dbdff682dcdf2e121 Author: Edward Z. Yang Date: Sat May 30 22:40:35 2015 -0700 Don't run T9330fail on Windows, no clobber occurs. #9930 Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 5a65da43559908a42a701b4dbdff682dcdf2e121 testsuite/tests/ghc-e/should_fail/all.T | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/ghc-e/should_fail/all.T b/testsuite/tests/ghc-e/should_fail/all.T index 8e080e9..d5400bf 100644 --- a/testsuite/tests/ghc-e/should_fail/all.T +++ b/testsuite/tests/ghc-e/should_fail/all.T @@ -18,5 +18,7 @@ test('ghc-e-fail1', [exit_code(2), req_interp, ignore_output], run_command, test('ghc-e-fail2', [exit_code(2), req_interp, ignore_output], run_command, ['$MAKE --no-print-directory -s ghc-e-fail2']) -test('T9930fail', [exit_code(2), ignore_output], run_command, +# Don't run on Windows, as executable is written to T9930.exe +# and no failure is induced. +test('T9930fail', [exit_code(2), ignore_output, when(opsys('mingw32'), skip)], run_command, ['$MAKE --no-print-directory -s T9930fail']) From git at git.haskell.org Sun May 31 11:18:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 May 2015 11:18:39 +0000 (UTC) Subject: [commit: ghc] master: Travis: use validate --quiet to prevent hitting log file limits (94fff17) Message-ID: <20150531111839.37AAE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/94fff17963af2292504d02ead819bc4340878786/ghc >--------------------------------------------------------------- commit 94fff17963af2292504d02ead819bc4340878786 Author: Thomas Miedema Date: Sun May 31 13:11:03 2015 +0200 Travis: use validate --quiet to prevent hitting log file limits Currently, this will use `make -s` instead of `make`, such that `make` doesn't echo the commands it's going to run. And second, it calls the testdriver with a lower verbosity, such that the shell commands it runs don't get printed either. >--------------------------------------------------------------- 94fff17963af2292504d02ead819bc4340878786 .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index fe48552..c740515 100644 --- a/.travis.yml +++ b/.travis.yml @@ -30,7 +30,6 @@ install: # - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils # - cabal update script: - - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/validate.mk @@ -40,4 +39,5 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=2 SKIP_PERF_TESTS=YES ./validate --fast + # use --quiet, otherwise we hit log file limits on travis. + - CPUS=2 SKIP_PERF_TESTS=YES ./validate --fast --quiet