From git at git.haskell.org Tue Jun 3 04:46:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 04:46:38 +0000 (UTC) Subject: [commit: ghc] master: fix missing space (2da439a) Message-ID: <20140603044638.8C9DC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2da439ae8b27e7a6f250831977aa887532493de6/ghc >--------------------------------------------------------------- commit 2da439ae8b27e7a6f250831977aa887532493de6 Author: Ryan Mulligan Date: Mon Jun 2 21:20:01 2014 -0700 fix missing space >--------------------------------------------------------------- 2da439ae8b27e7a6f250831977aa887532493de6 docs/users_guide/codegens.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/codegens.xml b/docs/users_guide/codegens.xml index 2eb9408..d2a805a 100644 --- a/docs/users_guide/codegens.xml +++ b/docs/users_guide/codegens.xml @@ -38,7 +38,7 @@ 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 - optand llc tools. Secondly, if you + opt and llc tools. Secondly, if you are running Mac OS X with LLVM 3.0 or greater then you also need the Clang c compiler compiler available on your PATH. From git at git.haskell.org Tue Jun 3 13:45:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 13:45:42 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Extract derived constants from nm output for various OSes differently. (b34a667) Message-ID: <20140603134542.66EBF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/b34a667f39ed627f1e3b004a2f3c13c4e5648f2a/ghc >--------------------------------------------------------------- commit b34a667f39ed627f1e3b004a2f3c13c4e5648f2a Author: Christian Maeder Date: Thu Apr 3 10:00:07 2014 +0200 Extract derived constants from nm output for various OSes differently. Fixes #8783. In order to avoid querying the nm version that does not work on Mac OS X we use the "nm -P" output that is supposed to produce (more portable) POSIX output and works on all tested OSes (MinGW, Mac OS X, Solaris and Linux using GNU nm) although slightly different (as documented). The "nm -P" output is actually only needed to recognize the output of a non-GNU Solaris nm (all other OSes produce sane outut using "nm" only). Signed-off-by: Austin Seipp >--------------------------------------------------------------- b34a667f39ed627f1e3b004a2f3c13c4e5648f2a utils/deriveConstants/DeriveConstants.hs | 37 +++++++++++++------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/utils/deriveConstants/DeriveConstants.hs b/utils/deriveConstants/DeriveConstants.hs index 10df61c..f71b15d 100644 --- a/utils/deriveConstants/DeriveConstants.hs +++ b/utils/deriveConstants/DeriveConstants.hs @@ -638,7 +638,7 @@ getWanted verbose tmpdir gccProgram gccFlags nmProgram oFile = tmpdir "tmp.o" writeFile cFile cStuff execute verbose gccProgram (gccFlags ++ ["-c", cFile, "-o", oFile]) - xs <- readProcess nmProgram [oFile] "" + xs <- readProcess nmProgram ["-P", oFile] "" let ls = lines xs ms = map parseNmLine ls m = Map.fromList $ catMaybes ms @@ -707,28 +707,21 @@ getWanted verbose tmpdir gccProgram gccFlags nmProgram doWanted (ClosurePayloadMacro {}) = [] doWanted (FieldTypeGcptrMacro {}) = [] - -- parseNmLine parses nm output that looks like - -- "0000000b C derivedConstantMAX_Vanilla_REG" + -- parseNmLine parses "nm -P" output that looks like + -- "derivedConstantMAX_Vanilla_REG C 0000000b 0000000b" (GNU nm) + -- "_derivedConstantMAX_Vanilla_REG C b 0" (Mac OS X) + -- "_derivedConstantMAX_Vanilla_REG C 000000b" (MinGW) + -- "derivedConstantMAX_Vanilla_REG D 1 b" (Solaris) -- and returns ("MAX_Vanilla_REG", 11) - parseNmLine xs0 = case break (' ' ==) xs0 of - (x1, ' ' : xs1) -> - case break (' ' ==) xs1 of - (x2, ' ' : x3) -> - case readHex x1 of - [(size, "")] -> - case x2 of - "C" -> - let x3' = case x3 of - '_' : rest -> rest - _ -> x3 - in case stripPrefix prefix x3' of - Just name -> - Just (name, size) - _ -> Nothing - _ -> Nothing - _ -> Nothing - _ -> Nothing - _ -> Nothing + parseNmLine line + = case words line of + ('_' : n) : "C" : s : _ -> mkP n s + n : "C" : s : _ -> mkP n s + [n, "D", _, s] -> mkP n s + _ -> Nothing + where mkP r s = case (stripPrefix prefix r, readHex s) of + (Just name, [(size, "")]) -> Just (name, size) + _ -> Nothing -- If an Int value is larger than 2^28 or smaller -- than -2^28, then fail. From git at git.haskell.org Tue Jun 3 13:45:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 13:45:45 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add missing stack checks to stg_ap_* functions (#9001) (92d08a6) Message-ID: <20140603134545.360B42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/92d08a6977c3357a47f6061bb71b2ae8d98dae6d/ghc >--------------------------------------------------------------- commit 92d08a6977c3357a47f6061bb71b2ae8d98dae6d Author: Simon Marlow Date: Wed May 14 12:25:08 2014 +0100 Add missing stack checks to stg_ap_* functions (#9001) (cherry picked from commit fc0ed8a7309e7cc863b8155fae6b57cb23331c44) Conflicts: testsuite/tests/codeGen/should_run/all.T >--------------------------------------------------------------- 92d08a6977c3357a47f6061bb71b2ae8d98dae6d testsuite/tests/codeGen/should_run/T9001.hs | 8 + .../should_run/{T2838.stdout => T9001.stdout} | 0 testsuite/tests/codeGen/should_run/all.T | 1 + utils/genapply/GenApply.hs | 312 +++++++++++++-------- 4 files changed, 206 insertions(+), 115 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 92d08a6977c3357a47f6061bb71b2ae8d98dae6d From git at git.haskell.org Tue Jun 3 13:45:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 13:45:47 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Only uninstall signal handlers if they were actually installed (#9068) (1456326) Message-ID: <20140603134547.7D3682406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/145632625651deb4a6f8758e838cfbefc32c9096/ghc >--------------------------------------------------------------- commit 145632625651deb4a6f8758e838cfbefc32c9096 Author: Simon Marlow Date: Wed May 14 21:10:06 2014 +0100 Only uninstall signal handlers if they were actually installed (#9068) Submitted by: tomgr (cherry picked from commit bc7d49a658a516679cc264502e72560c1d2c2314) >--------------------------------------------------------------- 145632625651deb4a6f8758e838cfbefc32c9096 rts/RtsStartup.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index aa7306f..15e48a6 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -355,8 +355,12 @@ hs_exit_(rtsBool wait_foreign) resetTerminalSettings(); #endif - // uninstall signal handlers - resetDefaultHandlers(); +#if defined(RTS_USER_SIGNALS) + if (RtsFlags.MiscFlags.install_signal_handlers) { + // uninstall signal handlers + resetDefaultHandlers(); + } +#endif /* stop timing the shutdown, we're about to print stats */ stat_endExit(); From git at git.haskell.org Tue Jun 3 13:45:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 13:45:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: rts: remove stable-names from hashtable upon free (7304d18) Message-ID: <20140603134550.6A5572406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/7304d1814a55fdcde6923feb18d33ae3a17c0d30/ghc >--------------------------------------------------------------- commit 7304d1814a55fdcde6923feb18d33ae3a17c0d30 Author: Edward Z. Yang Date: Sun May 18 21:32:10 2014 -0500 rts: remove stable-names from hashtable upon free This fixes #9078. Signed-off-by: Austin Seipp (cherry picked from commit b75d126e779e8690c675be84e8972dc023e04b9b) >--------------------------------------------------------------- 7304d1814a55fdcde6923feb18d33ae3a17c0d30 rts/Stable.c | 1 + testsuite/tests/rts/T9078.hs | 10 ++++++++++ testsuite/tests/rts/T9078.stderr | 2 ++ testsuite/tests/rts/all.T | 3 +++ 4 files changed, 16 insertions(+) diff --git a/rts/Stable.c b/rts/Stable.c index ec74b0d..431b7c6 100644 --- a/rts/Stable.c +++ b/rts/Stable.c @@ -246,6 +246,7 @@ STATIC_INLINE void freeSnEntry(snEntry *sn) { ASSERT(sn->sn_obj == NULL); + removeHashTable(addrToStableHash, (W_)sn->old, NULL); sn->addr = (P_)stable_name_free; stable_name_free = sn; } diff --git a/testsuite/tests/rts/T9078.hs b/testsuite/tests/rts/T9078.hs new file mode 100644 index 0000000..d0389f1 --- /dev/null +++ b/testsuite/tests/rts/T9078.hs @@ -0,0 +1,10 @@ +module Main where + +import Control.Monad +import System.Mem.StableName + +main :: IO () +main = replicateM_ 500000 (makeStableName foo) + +foo :: Int +foo = 1 diff --git a/testsuite/tests/rts/T9078.stderr b/testsuite/tests/rts/T9078.stderr new file mode 100644 index 0000000..901a1ca --- /dev/null +++ b/testsuite/tests/rts/T9078.stderr @@ -0,0 +1,2 @@ +cap 0: initialised +cap 0: shutting down diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 102a671..8b4fdfa 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -212,3 +212,6 @@ test('T8124', [ only_ways(threaded_ways), omit_ways(['ghci']), # The ghci way gets confused by the RTS options test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], compile_and_run, ['']) +# I couldn't reproduce 9078 with the -threaded runtime, but could easily +# with the non-threaded one. +test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) From git at git.haskell.org Tue Jun 3 13:45:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 13:45:52 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix missing unlockClosure() call in tryReadMVar (#9148) (cef8556) Message-ID: <20140603134552.E0DEB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/cef85568cbf44b3e178a523a3febbdccb18a4a1a/ghc >--------------------------------------------------------------- commit cef85568cbf44b3e178a523a3febbdccb18a4a1a Author: Simon Marlow Date: Fri May 30 08:47:26 2014 +0100 Fix missing unlockClosure() call in tryReadMVar (#9148) (cherry picked from commit 96a95f0513de785a185fd8a46c7ed2643f698295) >--------------------------------------------------------------- cef85568cbf44b3e178a523a3febbdccb18a4a1a rts/PrimOps.cmm | 1 + testsuite/tests/concurrent/should_run/all.T | 1 + testsuite/tests/concurrent/should_run/tryReadMVar2.hs | 15 +++++++++++++++ 3 files changed, 17 insertions(+) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index db65a4a..72d6e69 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -1641,6 +1641,7 @@ stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ ) LOCK_CLOSURE(mvar, info); if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) { + unlockClosure(mvar, info); return (0, stg_NO_FINALIZER_closure); } diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index d4e76c6..0b502c3 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -78,6 +78,7 @@ test('readMVar1', normal, compile_and_run, ['']) test('readMVar2', normal, compile_and_run, ['']) test('readMVar3', normal, compile_and_run, ['']) test('tryReadMVar1', normal, compile_and_run, ['']) +test('tryReadMVar2', normal, compile_and_run, ['']) test('T7970', normal, compile_and_run, ['']) diff --git a/testsuite/tests/concurrent/should_run/tryReadMVar2.hs b/testsuite/tests/concurrent/should_run/tryReadMVar2.hs new file mode 100644 index 0000000..13b8a45 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/tryReadMVar2.hs @@ -0,0 +1,15 @@ +module Main where + +import Control.Concurrent +import Control.Monad + +main = do + m <- newEmptyMVar + done <- newEmptyMVar + let q = 200000 + forkIO (do mapM (\n -> putMVar m n) [1..q]; putMVar done ()) + forkIO (do replicateM_ q $ readMVar m; putMVar done ()) + forkIO (do replicateM_ q $ tryReadMVar m; putMVar done ()) + forkIO (do replicateM_ q $ takeMVar m; putMVar done ()) + replicateM_ 4 $ takeMVar done + From git at git.haskell.org Tue Jun 3 13:46:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 13:46:34 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Document Foreign.ForeignPtr (#8475) (4ab9ecc) Message-ID: <20140603134634.A73DB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/4ab9ecc7cfc5d5e08fd9e2df6a9b508b29a4d9c4/base >--------------------------------------------------------------- commit 4ab9ecc7cfc5d5e08fd9e2df6a9b508b29a4d9c4 Author: Austin Seipp Date: Tue Jun 3 07:26:47 2014 -0500 Document Foreign.ForeignPtr (#8475) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4ab9ecc7cfc5d5e08fd9e2df6a9b508b29a4d9c4 Foreign/ForeignPtr.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs index 0017c0e..2e9b9ec 100644 --- a/Foreign/ForeignPtr.hs +++ b/Foreign/ForeignPtr.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | From git at git.haskell.org Tue Jun 3 13:46:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 13:46:52 +0000 (UTC) Subject: [commit: packages/integer-gmp] ghc-7.8: integer-gmp: do not confuse ./configure (#8783) (9e83324) Message-ID: <20140603134652.56B972406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/9e8332497645413ebced5e48974c9b711ce02582/integer-gmp >--------------------------------------------------------------- commit 9e8332497645413ebced5e48974c9b711ce02582 Author: Austin Seipp Date: Tue Jun 3 07:28:03 2014 -0500 integer-gmp: do not confuse ./configure (#8783) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9e8332497645413ebced5e48974c9b711ce02582 gmp/ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gmp/ghc.mk b/gmp/ghc.mk index a5d33ab..2214b06 100644 --- a/gmp/ghc.mk +++ b/gmp/ghc.mk @@ -146,7 +146,7 @@ libraries/integer-gmp/gmp/libgmp.a libraries/integer-gmp/gmp/gmp.h: PATH=`pwd`:$$PATH; \ export PATH; \ cd gmpbuild && \ - CC=$(CCX) NM=$(NM) AR=$(AR_STAGE1) $(SHELL) ./configure \ + CC=$(CCX) NM=$(NM) AR=$(AR_STAGE1) ./configure \ --enable-shared=no \ --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM) $(MAKE) -C libraries/integer-gmp/gmp/gmpbuild MAKEFLAGS= From git at git.haskell.org Tue Jun 3 14:59:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 14:59:26 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: annth_make, annth_compunits: Only run these tests if have_dynamic() (aede2d6) Message-ID: <20140603145926.964E62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/aede2d6bbc168724409267c3e08887f7289d22be/ghc >--------------------------------------------------------------- commit aede2d6bbc168724409267c3e08887f7289d22be Author: Joachim Breitner Date: Mon Apr 28 16:14:10 2014 +0200 annth_make, annth_compunits: Only run these tests if have_dynamic() >--------------------------------------------------------------- aede2d6bbc168724409267c3e08887f7289d22be testsuite/tests/annotations/should_compile/th/all.T | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/annotations/should_compile/th/all.T b/testsuite/tests/annotations/should_compile/th/all.T index 777cf3d..b44a0d5 100644 --- a/testsuite/tests/annotations/should_compile/th/all.T +++ b/testsuite/tests/annotations/should_compile/th/all.T @@ -6,13 +6,17 @@ setTestOpts(when(compiler_profiled(), skip)) # now, just disable the profiling ways. test('annth_make', - [req_interp, omit_ways(['profasm','profthreaded']), + [req_interp, + omit_ways(['profasm','profthreaded']), + unless(have_dynamic(),skip), clean_cmd('$MAKE -s clean_annth_make')], run_command, ['$MAKE -s --no-print-directory annth_make']) test('annth_compunits', - [req_interp, omit_ways(['profasm','profthreaded']), + [req_interp, + omit_ways(['profasm','profthreaded']), + unless(have_dynamic(),skip), clean_cmd('$MAKE -s clean_annth_compunits')], run_command, ['$MAKE -s --no-print-directory annth_compunits']) From git at git.haskell.org Tue Jun 3 16:12:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 16:12:26 +0000 (UTC) Subject: [commit: ghc] master: Rename TypeRep.Prec to TypeRep.TyPrec (09dc9a8) Message-ID: <20140603161226.2037B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/09dc9a8e3780966baeae49d720e26e979e991d0a/ghc >--------------------------------------------------------------- commit 09dc9a8e3780966baeae49d720e26e979e991d0a Author: Simon Peyton Jones Date: Tue Jun 3 13:57:42 2014 +0100 Rename TypeRep.Prec to TypeRep.TyPrec >--------------------------------------------------------------- 09dc9a8e3780966baeae49d720e26e979e991d0a compiler/typecheck/TcEvidence.lhs | 6 +++--- compiler/types/Coercion.lhs | 6 +++--- compiler/types/TypeRep.lhs | 33 +++++++++++++++++---------------- 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs index 493fa8f..45f52d4 100644 --- a/compiler/typecheck/TcEvidence.lhs +++ b/compiler/typecheck/TcEvidence.lhs @@ -353,7 +353,7 @@ pprTcCo, pprParendTcCo :: TcCoercion -> SDoc pprTcCo co = ppr_co TopPrec co pprParendTcCo co = ppr_co TyConPrec co -ppr_co :: Prec -> TcCoercion -> SDoc +ppr_co :: TyPrec -> TcCoercion -> SDoc ppr_co _ (TcRefl r ty) = angleBrackets (ppr ty) <> ppr_role r ppr_co p co@(TcTyConAppCo _ tc [_,_]) @@ -406,7 +406,7 @@ ppr_role r = underscore <> pp_role Representational -> char 'R' Phantom -> char 'P' -ppr_fun_co :: Prec -> TcCoercion -> SDoc +ppr_fun_co :: TyPrec -> TcCoercion -> SDoc ppr_fun_co p co = pprArrowChain p (split co) where split :: TcCoercion -> [SDoc] @@ -415,7 +415,7 @@ ppr_fun_co p co = pprArrowChain p (split co) = ppr_co FunPrec arg : split res split co = [ppr_co TopPrec co] -ppr_forall_co :: Prec -> TcCoercion -> SDoc +ppr_forall_co :: TyPrec -> TcCoercion -> SDoc ppr_forall_co p ty = maybeParen p FunPrec $ sep [pprForAll tvs, ppr_co TopPrec rho] diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index 6f237b0..b33eae9 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -634,7 +634,7 @@ pprCo, pprParendCo :: Coercion -> SDoc pprCo co = ppr_co TopPrec co pprParendCo co = ppr_co TyConPrec co -ppr_co :: Prec -> Coercion -> SDoc +ppr_co :: TyPrec -> Coercion -> SDoc ppr_co _ (Refl r ty) = angleBrackets (ppr ty) <> ppr_role r ppr_co p co@(TyConAppCo _ tc [_,_]) @@ -697,7 +697,7 @@ instance Outputable LeftOrRight where ppr CLeft = ptext (sLit "Left") ppr CRight = ptext (sLit "Right") -ppr_fun_co :: Prec -> Coercion -> SDoc +ppr_fun_co :: TyPrec -> Coercion -> SDoc ppr_fun_co p co = pprArrowChain p (split co) where split :: Coercion -> [SDoc] @@ -706,7 +706,7 @@ ppr_fun_co p co = pprArrowChain p (split co) = ppr_co FunPrec arg : split res split co = [ppr_co TopPrec co] -ppr_forall_co :: Prec -> Coercion -> SDoc +ppr_forall_co :: TyPrec -> Coercion -> SDoc ppr_forall_co p ty = maybeParen p FunPrec $ sep [pprForAll tvs, ppr_co TopPrec rho] diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index 31b73bb..f7a1cd3 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -42,7 +42,7 @@ module TypeRep ( pprEqPred, pprTheta, pprForAll, pprUserForAll, pprThetaArrowTy, pprClassPred, pprKind, pprParendKind, pprTyLit, suppressKinds, - Prec(..), maybeParen, pprTcApp, + TyPrec(..), maybeParen, pprTcApp, pprPrefixApp, pprArrowChain, ppr_type, -- Free variables @@ -493,12 +493,12 @@ parens around the type, except for the atomic cases. @pprParendType@ works just by setting the initial context precedence very high. \begin{code} -data Prec = TopPrec -- No parens - | FunPrec -- Function args; no parens for tycon apps - | TyConPrec -- Tycon args; no parens for atomic - deriving( Eq, Ord ) +data TyPrec = TopPrec -- No parens + | FunPrec -- Function args; no parens for tycon apps + | TyConPrec -- Tycon args; no parens for atomic + deriving( Eq, Ord ) -maybeParen :: Prec -> Prec -> SDoc -> SDoc +maybeParen :: TyPrec -> TyPrec -> SDoc -> SDoc maybeParen ctxt_prec inner_prec pretty | ctxt_prec < inner_prec = pretty | otherwise = parens pretty @@ -574,7 +574,7 @@ instance Outputable TyLit where ------------------ -- OK, here's the main printer -ppr_type :: Prec -> Type -> SDoc +ppr_type :: TyPrec -> Type -> SDoc ppr_type _ (TyVarTy tv) = ppr_tvar tv ppr_type _ (TyConApp tc [LitTy (StrTyLit n),ty]) @@ -601,7 +601,7 @@ ppr_type p fun_ty@(FunTy ty1 ty2) ppr_fun_tail other_ty = [ppr_type TopPrec other_ty] -ppr_forall_type :: Prec -> Type -> SDoc +ppr_forall_type :: TyPrec -> Type -> SDoc ppr_forall_type p ty = maybeParen p FunPrec $ ppr_sigma_type True ty -- True <=> we always print the foralls on *nested* quantifiers @@ -611,7 +611,7 @@ ppr_tvar :: TyVar -> SDoc ppr_tvar tv -- Note [Infix type variables] = parenSymOcc (getOccName tv) (ppr tv) -ppr_tylit :: Prec -> TyLit -> SDoc +ppr_tylit :: TyPrec -> TyLit -> SDoc ppr_tylit _ tl = case tl of NumTyLit n -> integer n @@ -705,7 +705,7 @@ pprTypeApp tc tys = pprTyTcApp TopPrec tc tys -- We have to use ppr on the TyCon (not its name) -- so that we get promotion quotes in the right place -pprTyTcApp :: Prec -> TyCon -> [Type] -> SDoc +pprTyTcApp :: TyPrec -> TyCon -> [Type] -> SDoc -- Used for types only; so that we can make a -- special case for type-level lists pprTyTcApp p tc tys @@ -718,7 +718,7 @@ pprTyTcApp p tc tys | otherwise = pprTcApp p ppr_type tc tys -pprTcApp :: Prec -> (Prec -> a -> SDoc) -> TyCon -> [a] -> SDoc +pprTcApp :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> SDoc -- Used for both types and coercions, hence polymorphism pprTcApp _ pp tc [ty] | tc `hasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp TopPrec ty) @@ -742,7 +742,7 @@ pprTcApp p pp tc tys | otherwise = sdocWithDynFlags (pprTcApp_help p pp tc tys) -pprTcApp_help :: Prec -> (Prec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc +pprTcApp_help :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc -- This one has accss to the DynFlags pprTcApp_help p pp tc tys dflags | not (isSymOcc (nameOccName (tyConName tc))) @@ -765,6 +765,7 @@ pprTcApp_help p pp tc tys dflags suppressKinds :: DynFlags -> Kind -> [a] -> [a] -- Given the kind of a TyCon, and the args to which it is applied, -- suppress the args that are kind args +-- C.f. Note [Suppressing kinds] in IfaceType suppressKinds dflags kind xs | gopt Opt_PrintExplicitKinds dflags = xs | otherwise = suppress kind xs @@ -774,7 +775,7 @@ suppressKinds dflags kind xs suppress _ xs = xs ---------------- -pprTyList :: Prec -> Type -> Type -> SDoc +pprTyList :: TyPrec -> Type -> Type -> SDoc -- Given a type-level list (t1 ': t2), see if we can print -- it in list notation [t1, ...]. pprTyList p ty1 ty2 @@ -798,19 +799,19 @@ pprTyList p ty1 ty2 gather ty = ([], Just ty) ---------------- -pprInfixApp :: Prec -> (Prec -> a -> SDoc) -> SDoc -> a -> a -> SDoc +pprInfixApp :: TyPrec -> (TyPrec -> a -> SDoc) -> SDoc -> a -> a -> SDoc pprInfixApp p pp pp_tc ty1 ty2 = maybeParen p FunPrec $ sep [pp FunPrec ty1, pprInfixVar True pp_tc <+> pp FunPrec ty2] -pprPrefixApp :: Prec -> SDoc -> [SDoc] -> SDoc +pprPrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc pprPrefixApp p pp_fun pp_tys | null pp_tys = pp_fun | otherwise = maybeParen p TyConPrec $ hang pp_fun 2 (sep pp_tys) ---------------- -pprArrowChain :: Prec -> [SDoc] -> SDoc +pprArrowChain :: TyPrec -> [SDoc] -> SDoc -- pprArrowChain p [a,b,c] generates a -> b -> c pprArrowChain _ [] = empty pprArrowChain p (arg:args) = maybeParen p FunPrec $ From git at git.haskell.org Tue Jun 3 16:12:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 16:12:28 +0000 (UTC) Subject: [commit: ghc] master: Fix inverted gadt-syntax flag for data families (da64c97) Message-ID: <20140603161228.A66E92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da64c97f1c0b147ea80a34fe64fe947ba7820c00/ghc >--------------------------------------------------------------- commit da64c97f1c0b147ea80a34fe64fe947ba7820c00 Author: Simon Peyton Jones Date: Tue Jun 3 13:59:01 2014 +0100 Fix inverted gadt-syntax flag for data families >--------------------------------------------------------------- da64c97f1c0b147ea80a34fe64fe947ba7820c00 compiler/typecheck/TcInstDcls.lhs | 4 ++-- compiler/typecheck/TcTyClsDecls.lhs | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 113aa65..7fa83cc 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -684,7 +684,7 @@ tcDataFamInstDecl mb_clsinfo ; checkTc (isLiftedTypeKind res_kind) $ tooFewParmsErr (tyConArity fam_tc) ; stupid_theta <- tcHsContext ctxt - ; h98_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons + ; gadt_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons -- Construct representation tycon ; rep_tc_name <- newFamInstTyConName fam_tc_name pats' @@ -707,7 +707,7 @@ tcDataFamInstDecl mb_clsinfo rep_tc = buildAlgTyCon rep_tc_name tvs' roles cType stupid_theta tc_rhs Recursive False -- No promotable to the kind level - h98_syntax parent + gadt_syntax parent -- We always assume that indexed types are recursive. Why? -- (1) Due to their open nature, we can never be sure that a -- further instance might not introduce a new recursive diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index acf0ff4..b6e2f2b 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -793,7 +793,7 @@ tcDataDefn rec_info tc_name tvs kind ; checkKind kind tc_kind ; return () } - ; h98_syntax <- dataDeclChecks tc_name new_or_data stupid_theta cons + ; gadt_syntax <- dataDeclChecks tc_name new_or_data stupid_theta cons ; tycon <- fixM $ \ tycon -> do { let res_ty = mkTyConApp tycon (mkTyVarTys final_tvs) @@ -808,7 +808,7 @@ tcDataDefn rec_info tc_name tvs kind ; return (buildAlgTyCon tc_name final_tvs roles cType stupid_theta tc_rhs (rti_is_rec rec_info tc_name) (rti_promotable rec_info) - (not h98_syntax) NoParentTyCon) } + gadt_syntax NoParentTyCon) } ; return [ATyCon tycon] } \end{code} @@ -1101,11 +1101,11 @@ dataDeclChecks :: Name -> NewOrData -> ThetaType -> [LConDecl Name] -> TcM Bool dataDeclChecks tc_name new_or_data stupid_theta cons = do { -- Check that we don't use GADT syntax in H98 world gadtSyntax_ok <- xoptM Opt_GADTSyntax - ; let h98_syntax = consUseH98Syntax cons - ; checkTc (gadtSyntax_ok || h98_syntax) (badGadtDecl tc_name) + ; let gadt_syntax = consUseGadtSyntax cons + ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name) -- Check that the stupid theta is empty for a GADT-style declaration - ; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name) + ; checkTc (null stupid_theta || not gadt_syntax) (badStupidTheta tc_name) -- Check that a newtype has exactly one constructor -- Do this before checking for empty data decls, so that @@ -1119,13 +1119,13 @@ dataDeclChecks tc_name new_or_data stupid_theta cons ; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file? ; checkTc (not (null cons) || empty_data_decls || is_boot) (emptyConDeclsErr tc_name) - ; return h98_syntax } + ; return gadt_syntax } ----------------------------------- -consUseH98Syntax :: [LConDecl a] -> Bool -consUseH98Syntax (L _ (ConDecl { con_res = ResTyGADT _ }) : _) = False -consUseH98Syntax _ = True +consUseGadtSyntax :: [LConDecl a] -> Bool +consUseGadtSyntax (L _ (ConDecl { con_res = ResTyGADT _ }) : _) = True +consUseGadtSyntax _ = False -- All constructors have same shape ----------------------------------- From git at git.haskell.org Tue Jun 3 16:12:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 16:12:31 +0000 (UTC) Subject: [commit: ghc] master: Use mkTcEqPred rather than mkEqPred (0ba74f6) Message-ID: <20140603161231.1C1F42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0ba74f6fea1f5c34ab962437eb9f300beaa0e0e8/ghc >--------------------------------------------------------------- commit 0ba74f6fea1f5c34ab962437eb9f300beaa0e0e8 Author: Simon Peyton Jones Date: Tue Jun 3 13:58:27 2014 +0100 Use mkTcEqPred rather than mkEqPred This was mostly done in an earlier commit, but I missed these two >--------------------------------------------------------------- 0ba74f6fea1f5c34ab962437eb9f300beaa0e0e8 compiler/typecheck/TcSMonad.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index ec9b6e3..e01b2fe 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1833,7 +1833,7 @@ rewriteEqEvidence :: CtEvidence -- Old evidence :: olhs ~ orhs (not swap -- It's all a form of rewwriteEvidence, specialised for equalities rewriteEqEvidence old_ev swapped nlhs nrhs lhs_co rhs_co | CtDerived { ctev_loc = loc } <- old_ev - = newDerived loc (mkEqPred nlhs nrhs) + = newDerived loc (mkTcEqPred nlhs nrhs) | NotSwapped <- swapped , isTcReflCo lhs_co -- See Note [Rewriting with Refl] @@ -1860,7 +1860,7 @@ rewriteEqEvidence old_ev swapped nlhs nrhs lhs_co rhs_co | otherwise = panic "rewriteEvidence" where - new_pred = mkEqPred nlhs nrhs + new_pred = mkTcEqPred nlhs nrhs maybeSym :: SwapFlag -> TcCoercion -> TcCoercion maybeSym IsSwapped co = mkTcSymCo co From git at git.haskell.org Tue Jun 3 16:12:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 16:12:33 +0000 (UTC) Subject: [commit: ghc] master: Do pretty-printing of TyThings via IfaceDecl (Trac #7730) (b4856f9) Message-ID: <20140603161233.B54462406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4856f9f4f0fb3db473901b247d3fa94a11c25a0/ghc >--------------------------------------------------------------- commit b4856f9f4f0fb3db473901b247d3fa94a11c25a0 Author: Simon Peyton Jones Date: Tue Jun 3 14:15:52 2014 +0100 Do pretty-printing of TyThings via IfaceDecl (Trac #7730) All the initial work on this was done fy 'archblob' (fcsernik at gmail.com); thank you! I reviewed the patch, started some tidying, up and then ended up in a huge swamp of changes, not all of which I can remember now. But: * To suppress kind arguments when we have -fno-print-explicit-kinds, - IfaceTyConApp argument types are in a tagged list IfaceTcArgs * To allow overloaded types to be printed with =>, add IfaceDFunTy to IfaceType. * When printing data/type family instances for the user, I've made them print out an informative RHS, which is a new feature. Thus ghci> info T data family T a data instance T Int = T1 Int Int data instance T Bool = T2 * In implementation terms, pprIfaceDecl has just one "context" argument, of type IfaceSyn.ShowSub, which says - How to print the binders of the decl see note [Printing IfaceDecl binders] in IfaceSyn - Which sub-comoponents (eg constructors) to print * Moved FastStringEnv from RnEnv to OccName It all took a ridiculously long time to do. But it's done! >--------------------------------------------------------------- b4856f9f4f0fb3db473901b247d3fa94a11c25a0 compiler/basicTypes/OccName.lhs | 31 +- compiler/iface/IfaceSyn.lhs | 528 ++++++++++++++------ compiler/iface/IfaceType.lhs | 548 ++++++++++++++++----- compiler/iface/LoadIface.lhs | 6 +- compiler/iface/MkIface.lhs | 68 ++- compiler/iface/TcIface.lhs | 160 +++--- compiler/main/GHC.hs | 3 +- compiler/main/PprTyThing.hs | 301 ++--------- compiler/rename/RnEnv.lhs | 20 +- compiler/typecheck/TcRnDriver.lhs | 5 +- compiler/types/FamInstEnv.lhs | 10 +- ghc/InteractiveUI.hs | 2 +- testsuite/tests/ghci/scripts/T4087.stdout | 2 +- testsuite/tests/ghci/scripts/T4175.stdout | 26 +- testsuite/tests/ghci/scripts/T5417.stdout | 2 +- testsuite/tests/ghci/scripts/T7873.stdout | 4 +- testsuite/tests/ghci/scripts/T7939.stdout | 16 +- testsuite/tests/ghci/scripts/T8674.stdout | 4 +- testsuite/tests/ghci/scripts/all.T | 1 + testsuite/tests/ghci/scripts/ghci025.stdout | 6 +- .../indexed-types/should_compile/T3017.stderr | 21 +- .../indexed-types/should_fail/ClosedFam3.stderr | 9 +- .../tests/rename/should_fail/rnfail055.stderr | 12 +- testsuite/tests/roles/should_compile/Roles1.stderr | 64 +-- .../tests/roles/should_compile/Roles14.stderr | 6 +- testsuite/tests/roles/should_compile/Roles2.stderr | 16 +- testsuite/tests/roles/should_compile/Roles3.stderr | 29 +- testsuite/tests/roles/should_compile/Roles4.stderr | 11 +- testsuite/tests/roles/should_compile/T8958.stderr | 17 +- testsuite/tests/roles/should_fail/Roles12.stderr | 2 +- .../tests/simplCore/should_compile/T4201.stdout | 6 +- .../tests/simplCore/should_compile/T4918.stdout | 4 +- testsuite/tests/th/TH_Roles2.stderr | 9 +- .../tests/typecheck/should_compile/tc231.stderr | 23 +- testsuite/tests/typecheck/should_fail/T3468.stderr | 2 +- 35 files changed, 1096 insertions(+), 878 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b4856f9f4f0fb3db473901b247d3fa94a11c25a0 From git at git.haskell.org Tue Jun 3 16:12:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 16:12:35 +0000 (UTC) Subject: [commit: ghc] master: Use IfLclName instead of OccName in IfaceEqSpec (6e8861c) Message-ID: <20140603161235.F19952406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e8861c913a4bb6ae68a57a4f3a148235905f9ee/ghc >--------------------------------------------------------------- commit 6e8861c913a4bb6ae68a57a4f3a148235905f9ee Author: Simon Peyton Jones Date: Tue Jun 3 14:23:48 2014 +0100 Use IfLclName instead of OccName in IfaceEqSpec The type variables in the IfaceEqSpec of a data constructor are really ordinarly *occurrences*, so they should be IfLclNames just like any other type variable occurence. >--------------------------------------------------------------- 6e8861c913a4bb6ae68a57a4f3a148235905f9ee compiler/iface/IfaceSyn.lhs | 6 +++--- compiler/iface/IfaceType.lhs | 2 +- compiler/iface/MkIface.lhs | 5 ++--- compiler/iface/TcIface.lhs | 4 ++-- 4 files changed, 8 insertions(+), 9 deletions(-) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index c8e7ea8..6af5bbe 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -16,7 +16,7 @@ module IfaceSyn ( module IfaceType, IfaceDecl(..), IfaceSynTyConRhs(..), IfaceClassOp(..), IfaceAT(..), - IfaceConDecl(..), IfaceConDecls(..), + IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec, IfaceExpr(..), IfaceAlt, IfaceLetBndr(..), IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..), @@ -405,7 +405,7 @@ data IfaceConDecl ifConStricts :: [IfaceBang]} -- Empty (meaning all lazy), -- or 1-1 corresp with arg tys -type IfaceEqSpec = [(OccName,IfaceType)] +type IfaceEqSpec = [(IfLclName,IfaceType)] instance HasOccName IfaceConDecl where occName = ifConOcc @@ -1183,7 +1183,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, mk_user_con_res_ty univ_tvs eq_spec = (filterOut done_univ_tv univ_tvs, sdocWithDynFlags pp_res_ty) where - gadt_env = mkFsEnv [(occNameFS occ, ty) | (occ,ty) <- eq_spec] + gadt_env = mkFsEnv eq_spec done_univ_tv (tv,_) = isJust (lookupFsEnv gadt_env tv) pp_res_ty dflags diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs index 4a19264..c55edc6 100644 --- a/compiler/iface/IfaceType.lhs +++ b/compiler/iface/IfaceType.lhs @@ -15,7 +15,7 @@ module IfaceType ( IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, -- Conversion from Type -> IfaceType - toIfaceType, toIfaceTypes, toIfaceKind, + toIfaceType, toIfaceTypes, toIfaceKind, toIfaceTyVar, toIfaceContext, toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs, toIfaceTyCon, toIfaceTyCon_name, toIfaceTcArgs, diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index e01097e..21a8047 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1646,7 +1646,7 @@ tyConToIfaceDecl env tycon ifConWrapper = isJust (dataConWrapId_maybe data_con), ifConUnivTvs = toIfaceTvBndrs univ_tvs', ifConExTvs = toIfaceTvBndrs ex_tvs', - ifConEqSpec = to_eq_spec eq_spec, + ifConEqSpec = map to_eq_spec eq_spec, ifConCtxt = tidyToIfaceContext env2 theta, ifConArgTys = map (tidyToIfaceType env2) arg_tys, ifConFields = map getOccName @@ -1659,8 +1659,7 @@ tyConToIfaceDecl env tycon -- data constructor is fully standalone (env1, univ_tvs') = tidyTyVarBndrs emptyTidyEnv univ_tvs (env2, ex_tvs') = tidyTyVarBndrs env1 ex_tvs - to_eq_spec spec = [ (getOccName (tidyTyVar env2 tv), tidyToIfaceType env2 ty) - | (tv,ty) <- spec] + to_eq_spec (tv,ty) = (toIfaceTyVar (tidyTyVar env2 tv), tidyToIfaceType env2 ty) toIfaceBang :: TidyEnv -> HsBang -> IfaceBang toIfaceBang _ HsNoBang = IfNoBang diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index e5da356..e4a415a 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -673,11 +673,11 @@ tcIfaceDataCons tycon_name tycon _ if_cons tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co ; return (HsUnpack (Just co)) } -tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)] +tcIfaceEqSpec :: IfaceEqSpec -> IfL [(TyVar, Type)] tcIfaceEqSpec spec = mapM do_item spec where - do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ) + do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ ; ty <- tcIfaceType if_ty ; return (tv,ty) } \end{code} From git at git.haskell.org Tue Jun 3 16:15:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 16:15:33 +0000 (UTC) Subject: [commit: ghc] master: Add :kind test in T7730 (d02cd1a) Message-ID: <20140603161533.566D12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d02cd1a731b0fce3f75d78f872166b1a36006151/ghc >--------------------------------------------------------------- commit d02cd1a731b0fce3f75d78f872166b1a36006151 Author: Simon Peyton Jones Date: Tue Jun 3 17:15:21 2014 +0100 Add :kind test in T7730 >--------------------------------------------------------------- d02cd1a731b0fce3f75d78f872166b1a36006151 testsuite/tests/ghci/scripts/T7730.script | 7 +++++++ testsuite/tests/ghci/scripts/T7730.stdout | 8 ++++++++ 2 files changed, 15 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T7730.script b/testsuite/tests/ghci/scripts/T7730.script new file mode 100644 index 0000000..f1e01ee --- /dev/null +++ b/testsuite/tests/ghci/scripts/T7730.script @@ -0,0 +1,7 @@ +:set -XPolyKinds +data A x y +:i A +:kind A +:set -XExistentialQuantification +data T a = forall a . MkT a +:info T diff --git a/testsuite/tests/ghci/scripts/T7730.stdout b/testsuite/tests/ghci/scripts/T7730.stdout new file mode 100644 index 0000000..e3a08c1 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T7730.stdout @@ -0,0 +1,8 @@ +type role A phantom phantom +data A (x :: k) (y :: k1) + -- Defined at :3:1 +A :: k -> k1 -> * +type role T phantom +data T (a :: k) where + MkT :: forall (k :: BOX) (a :: k) a1. a1 -> T a + -- Defined at :7:1 From git at git.haskell.org Tue Jun 3 16:26:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jun 2014 16:26:35 +0000 (UTC) Subject: [commit: ghc] master: Comments only (related to Trac #7730) (dd99434) Message-ID: <20140603162635.24C9E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd9943472d385b55f9baa56780f333a190794bcf/ghc >--------------------------------------------------------------- commit dd9943472d385b55f9baa56780f333a190794bcf Author: Simon Peyton Jones Date: Tue Jun 3 17:26:21 2014 +0100 Comments only (related to Trac #7730) >--------------------------------------------------------------- dd9943472d385b55f9baa56780f333a190794bcf compiler/iface/IfaceSyn.lhs | 2 ++ compiler/main/PprTyThing.hs | 44 ++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 42 insertions(+), 4 deletions(-) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 6af5bbe..79e2359 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -1138,6 +1138,8 @@ isIfaceDataInstance IfNoParent = False isIfaceDataInstance _ = True pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc +-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi +-- See Note [Pretty-printing TyThings] in PprTyThing pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, ifCtxt = context, ifTyVars = tyvars, ifRoles = roles, ifCons = condecls, diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index 890502c..d88b137 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -42,6 +42,42 @@ import FastString -- ----------------------------------------------------------------------------- -- Pretty-printing entities that we get from the GHC API +{- Note [Pretty-printing TyThings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We pretty-print a TyThing by converting it to an IfaceDecl, +and pretty-printing that (see ppr_ty_thing below). +Here is why: + +* When pretty-printing (a type, say), the idiomatic solution is not to + "rename type variables on the fly", but rather to "tidy" the type + (which gives each variable a distinct print-name), and then + pretty-print it (without renaming). Separate the two + concerns. Functions like tidyType do this. + +* Alas, for type constructors, TyCon, tidying does not work well, + because a TyCon includes DataCons which include Types, which mention + TyCons. And tidying can't tidy a mutually recursive data structure + graph, only trees. + +* One alternative would be to ensure that TyCons get type variables + with distinct print-names. That's ok for type variables but less + easy for kind variables. Processing data type declarations is + already so complicated that I don't think it's sensible to add the + extra requirement that it generates only "pretty" types and kinds. + +* One place the non-pretty names can show up is in GHCi. But another + is in interface files. Look at MkIface.tyThingToIfaceDecl which + converts a TyThing (i.e. TyCon, Class etc) to an IfaceDecl. And it + already does tidying as part of that conversion! Why? Because + interface files contains fast-strings, not uniques, so the names + must at least be distinct. + +So if we convert to IfaceDecl, we get a nice tidy IfaceDecl, and can +print that. Of course, that means that pretty-printing IfaceDecls +must be careful to display nice user-friendly results, but that's ok. + +See #7730, #8776 for details -} + -------------------- -- | Pretty-prints a 'FamInst' (type/data family instance) with its defining location. pprFamInst :: FamInst -> SDoc @@ -98,14 +134,14 @@ pprTyThingInContextLoc tyThing ------------------------ ppr_ty_thing :: Bool -> [OccName] -> TyThing -> SDoc --- NOTE: We pretty-print 'TyThing' via 'IfaceDecl' so that we can reuse the --- 'TyCon' tidying happening in 'tyThingToIfaceDecl'. See #8776 for details. +-- We pretty-print 'TyThing' via 'IfaceDecl' +-- See Note [Pretty-pringint TyThings] ppr_ty_thing hdr_only path ty_thing - = pprIfaceDecl (ShowSub { ss_how_much = how_much, ss_ppr_bndr = ppr_bndr }) if_decl + = pprIfaceDecl ss (tyThingToIfaceDecl ty_thing) where + ss = ShowSub { ss_how_much = how_much, ss_ppr_bndr = ppr_bndr } how_much | hdr_only = ShowHeader | otherwise = ShowSome path - if_decl = tyThingToIfaceDecl ty_thing name = getName ty_thing ppr_bndr :: OccName -> SDoc ppr_bndr | isBuiltInSyntax name From git at git.haskell.org Wed Jun 4 07:47:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jun 2014 07:47:56 +0000 (UTC) Subject: [commit: ghc] master: Set/update upstream repo url for haddock (d7a228b) Message-ID: <20140604074756.6857C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7a228b1cd2d0bd62c129ff631b4e198feced7fa/ghc >--------------------------------------------------------------- commit d7a228b1cd2d0bd62c129ff631b4e198feced7fa Author: Herbert Valerio Riedel Date: Wed Jun 4 09:35:52 2014 +0200 Set/update upstream repo url for haddock In the future, some script will use the last column to configure Git to redirect `push` operations to the respective primary Git repo. One way could be via the `pushInsteadOf` facility described in https://ghc.haskell.org/trac/ghc/wiki/WorkingConventions/Git/Submodules Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- d7a228b1cd2d0bd62c129ff631b4e198feced7fa packages | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/packages b/packages index c324d2d..1416cd8 100644 --- a/packages +++ b/packages @@ -26,7 +26,10 @@ # * 'remotepath' is where the repository is in the central repository. # It is - for submodules. # * 'upstreamurl' is the upstream Git repo location for packages -# maintained outside of GHC HQ. +# maintained outside of GHC HQ. Repositories which are hosted on +# GitHub and GHC developers are granted push-rights for are denoted by +# being specified with the `ssh://` scheme. Thus, `https://` +# repo urls denote read-only access. # # * The 'tag' determines when "sync-all get" will get the # repo. If the tag is "-" then it will always get it, but if there @@ -47,7 +50,7 @@ ghc-tarballs windows ghc-tarballs.git - libffi-tarballs - libffi-tarballs.git - utils/hsc2hs - hsc2hs.git - -utils/haddock - - - +utils/haddock - - ssh://git at github.com/haskell/haddock.git libraries/array - packages/array.git - libraries/binary - - https://github.com/kolmodin/binary.git libraries/bytestring - - https://github.com/haskell/bytestring.git From git at git.haskell.org Wed Jun 4 07:47:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jun 2014 07:47:58 +0000 (UTC) Subject: [commit: ghc] master: Export `TimerManager` from GHC.Event (re #9165) (fe59334) Message-ID: <20140604074758.C9F592406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe59334988fea384b119b7ef8372147b5c246bbf/ghc >--------------------------------------------------------------- commit fe59334988fea384b119b7ef8372147b5c246bbf Author: Herbert Valerio Riedel Date: Wed Jun 4 09:45:27 2014 +0200 Export `TimerManager` from GHC.Event (re #9165) This just addresses the specific issue raised in #9165. However, I've noticed the Haddock comments need to be improved, which will be addressed by a separate commit. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- fe59334988fea384b119b7ef8372147b5c246bbf libraries/base/GHC/Event.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Event.hs b/libraries/base/GHC/Event.hs index b49645e..9746bc7 100644 --- a/libraries/base/GHC/Event.hs +++ b/libraries/base/GHC/Event.hs @@ -11,6 +11,7 @@ module GHC.Event ( -- * Types EventManager + , TimerManager -- * Creation , getSystemEventManager @@ -39,6 +40,6 @@ module GHC.Event import GHC.Event.Manager import GHC.Event.TimerManager (TimeoutCallback, TimeoutKey, registerTimeout, - updateTimeout, unregisterTimeout) + updateTimeout, unregisterTimeout, TimerManager) import GHC.Event.Thread (getSystemEventManager, getSystemTimerManager) From git at git.haskell.org Wed Jun 4 21:47:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jun 2014 21:47:50 +0000 (UTC) Subject: [commit: ghc] master: Subsume NullaryTypeClasses by MultiParamTypeClasses (#8993) (c63a465) Message-ID: <20140604214751.1A0E52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c63a465011b99eeafbb957074e54c2e6bbf751d9/ghc >--------------------------------------------------------------- commit c63a465011b99eeafbb957074e54c2e6bbf751d9 Author: Owen Stephens Date: Thu Apr 10 17:44:11 2014 +0100 Subsume NullaryTypeClasses by MultiParamTypeClasses (#8993) MPTC now also handles the nullary case >--------------------------------------------------------------- c63a465011b99eeafbb957074e54c2e6bbf751d9 compiler/main/DynFlags.hs | 3 ++- compiler/typecheck/TcTyClsDecls.lhs | 27 +++++++++++----------- compiler/typecheck/TcValidity.lhs | 11 ++------- docs/users_guide/flags.xml | 1 + docs/users_guide/glasgow_exts.xml | 4 +++- testsuite/tests/deriving/should_fail/T7959.hs | 2 +- .../typecheck/should_fail/TcNoNullaryTC.stderr | 2 +- .../tests/typecheck/should_fail/TcNullaryTCFail.hs | 2 +- 8 files changed, 24 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c63a465011b99eeafbb957074e54c2e6bbf751d9 From git at git.haskell.org Thu Jun 5 10:04:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 10:04:14 +0000 (UTC) Subject: [commit: ghc] master: Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) (0a55a3c) Message-ID: <20140605100414.E079B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a55a3cada2fea37586b1a270c1511ed9957dbd4/ghc >--------------------------------------------------------------- commit 0a55a3cada2fea37586b1a270c1511ed9957dbd4 Author: Simon Peyton Jones Date: Thu Jun 5 11:03:45 2014 +0100 Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) We simply weren't giving anything like the right instantiating types to patSynInstArgTys in matchOneConLike. To get these instantiating types would have involved matching the result type of the pattern synonym with the pattern type, which is tiresome. So instead I changed ConPatOut so that instead of recording the type of the *whole* pattern (in old field pat_ty), it not records the *instantiating* types (in new field pat_arg_tys). Then we canuse TcHsSyn.conLikeResTy to get the pattern type when needed. There are lots of knock-on incidental effects, but they mostly made the code simpler, so I'm happy. >--------------------------------------------------------------- 0a55a3cada2fea37586b1a270c1511ed9957dbd4 compiler/basicTypes/PatSyn.lhs | 25 +++++++++++++++++++++++-- compiler/deSugar/Check.lhs | 32 +++++++++++++++----------------- compiler/deSugar/DsExpr.lhs | 2 +- compiler/deSugar/DsUtils.lhs | 3 +-- compiler/deSugar/Match.lhs | 11 +++++------ compiler/deSugar/MatchCon.lhs | 33 +++++++++++++++------------------ compiler/deSugar/MatchLit.lhs | 6 +++--- compiler/hsSyn/Convert.lhs | 4 ++-- compiler/hsSyn/HsPat.lhs | 31 ++++++++++++++++++++----------- compiler/hsSyn/HsUtils.lhs | 2 +- compiler/parser/RdrHsSyn.lhs | 2 +- compiler/rename/RnPat.lhs | 2 +- compiler/typecheck/TcHsSyn.lhs | 24 ++++++++++++++++-------- compiler/typecheck/TcPat.lhs | 18 +++++++++--------- 14 files changed, 113 insertions(+), 82 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0a55a3cada2fea37586b1a270c1511ed9957dbd4 From git at git.haskell.org Thu Jun 5 11:26:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 11:26:39 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #9023 (616f54b) Message-ID: <20140605112639.A193B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/616f54bdc28ad699f903248a5fb18dc0e5b52a52/ghc >--------------------------------------------------------------- commit 616f54bdc28ad699f903248a5fb18dc0e5b52a52 Author: Simon Peyton Jones Date: Thu Jun 5 12:26:24 2014 +0100 Test Trac #9023 >--------------------------------------------------------------- 616f54bdc28ad699f903248a5fb18dc0e5b52a52 testsuite/tests/patsyn/should_compile/T9023.hs | 6 ++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 2 files changed, 7 insertions(+) diff --git a/testsuite/tests/patsyn/should_compile/T9023.hs b/testsuite/tests/patsyn/should_compile/T9023.hs new file mode 100644 index 0000000..3a86140 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T9023.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T9023 where + +pattern P a b = Just (a, b) +foo P{} = True diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index ecc4701..d851bc3 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -9,3 +9,4 @@ test('num', normal, compile, ['']) test('incomplete', normal, compile, ['']) test('export', normal, compile, ['']) test('T8966', normal, compile, ['']) +test('T9023', normal, compile, ['']) From git at git.haskell.org Thu Jun 5 14:12:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 14:12:02 +0000 (UTC) Subject: [commit: ghc] master: Add .arcconfig file. Do not use yet. (3faf83e) Message-ID: <20140605141202.869D52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3faf83e4884203f34ad10a725dd6d13d7f4ec1de/ghc >--------------------------------------------------------------- commit 3faf83e4884203f34ad10a725dd6d13d7f4ec1de Author: Austin Seipp Date: Thu Jun 5 07:31:39 2014 -0500 Add .arcconfig file. Do not use yet. Don't use this yet - it's an experiment, a disaster, whatever. Caveat emptor. I'll probably delete everything. Do not taunt Happy Fun Ball - you have been warned. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 3faf83e4884203f34ad10a725dd6d13d7f4ec1de .arcconfig | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.arcconfig b/.arcconfig new file mode 100644 index 0000000..c8a74c3 --- /dev/null +++ b/.arcconfig @@ -0,0 +1,5 @@ +{ + "project.name" : "ghc", + "repository.callsign" : "GHC", + "phabricator.uri" : "https://phabricator.haskell.org", +} From git at git.haskell.org Thu Jun 5 14:12:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 14:12:04 +0000 (UTC) Subject: [commit: ghc] master: Add ".text.unlikely" to recognized code sections on Windows. (56ea745) Message-ID: <20140605141205.37E302406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/56ea745c3dd00c87ad86b80f91a31ced5e86e488/ghc >--------------------------------------------------------------- commit 56ea745c3dd00c87ad86b80f91a31ced5e86e488 Author: Niklas Larsson Date: Sun May 25 11:54:13 2014 +0200 Add ".text.unlikely" to recognized code sections on Windows. Fixes #9080 Signed-off-by: Austin Seipp >--------------------------------------------------------------- 56ea745c3dd00c87ad86b80f91a31ced5e86e488 rts/Linker.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/Linker.c b/rts/Linker.c index ea7c1c6..e5e61bb 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -4145,6 +4145,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strcmp(".text",(char*)secname) || 0==strcmp(".text.startup",(char*)secname) || + 0==strcmp(".text.unlikely", (char*)secname) || 0==strcmp(".rdata",(char*)secname)|| 0==strcmp(".eh_frame", (char*)secname)|| 0==strcmp(".rodata",(char*)secname)) From git at git.haskell.org Thu Jun 5 14:12:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 14:12:07 +0000 (UTC) Subject: [commit: ghc] master: Emit error in case of duplicate GRE; fixes #7241 (c226d25) Message-ID: <20140605141207.B17002406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c226d25fef519db663d0c9efe7845637423f1dca/ghc >--------------------------------------------------------------- commit c226d25fef519db663d0c9efe7845637423f1dca Author: Yuras Shumovich Date: Thu Jun 5 07:56:05 2014 -0500 Emit error in case of duplicate GRE; fixes #7241 Signed-off-by: Austin Seipp >--------------------------------------------------------------- c226d25fef519db663d0c9efe7845637423f1dca compiler/rename/RnEnv.lhs | 21 ++++++++++++++------- testsuite/tests/th/T7241.hs | 7 +++++++ testsuite/tests/th/T7241.stderr | 6 ++++++ testsuite/tests/th/T8932.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 5 files changed, 34 insertions(+), 7 deletions(-) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index bdc2cdf..a89ab1f 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -268,22 +268,29 @@ lookupExactOcc name ; return name } - (gre:_) -> return (gre_name gre) } + [gre] -> return (gre_name gre) + (gre:_) -> do {addErr dup_nm_err + ; return (gre_name gre) + } -- We can get more than one GRE here, if there are multiple - -- bindings for the same name; but there will already be a - -- reported error for the duplicate. (If we add the error - -- rather than stopping when we encounter it.) - -- So all we need do here is not crash. - -- Example is Trac #8932: + -- bindings for the same name. Sometimes they are catched later + -- by findLocalDupsRdrEnv, like in the this example (Trac #8932): -- $( [d| foo :: a->a; foo x = x |]) -- foo = True - -- Here the 'foo' in the splice turns into an Exact Name + -- But when the names are totally identical, we get panic (Trac #7241): + -- $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]]) + -- So, lets emit error here, even if it will lead to two errors in some cases. + } where exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope")) 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") , ptext (sLit "perhaps via newName, but did not bind it") , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) + dup_nm_err = hang (ptext (sLit "Duplicate exact Name") <+> quotes (ppr $ nameOccName name)) + 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") + , ptext (sLit "perhaps via newName, but bound it multiple times") + , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) ----------------------------------------------- lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name diff --git a/testsuite/tests/th/T7241.hs b/testsuite/tests/th/T7241.hs new file mode 100644 index 0000000..971a267 --- /dev/null +++ b/testsuite/tests/th/T7241.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T7241 where + +import Language.Haskell.TH + +$(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] []]) diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr new file mode 100644 index 0000000..343cdc8 --- /dev/null +++ b/testsuite/tests/th/T7241.stderr @@ -0,0 +1,6 @@ + +T7241.hs:7:3: + Duplicate exact Name ?Foo? + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr index 0e0f977..c861235 100644 --- a/testsuite/tests/th/T8932.stderr +++ b/testsuite/tests/th/T8932.stderr @@ -1,4 +1,10 @@ +T8932.hs:5:3: + Duplicate exact Name ?foo? + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful + T8932.hs:11:1: Multiple declarations of ?foo? Declared at: T8932.hs:5:3 diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 22bb7cc..ca7ead6 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -326,4 +326,5 @@ test('T8884', normal, compile, ['-v0']) test('T8954', normal, compile, ['-v0']) test('T8932', normal, compile_fail, ['-v0']) test('T8987', normal, compile_fail, ['-v0']) +test('T7241', normal, compile_fail, ['-v0']) From git at git.haskell.org Thu Jun 5 14:13:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 14:13:46 +0000 (UTC) Subject: [commit: ghc] master: Fix .arcconfig (6ad11c4) Message-ID: <20140605141346.ABF552406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ad11c467d82cb79b242463a6c34205b97a771c2/ghc >--------------------------------------------------------------- commit 6ad11c467d82cb79b242463a6c34205b97a771c2 Author: Austin Seipp Date: Thu Jun 5 09:13:30 2014 -0500 Fix .arcconfig See, what did I tell you? Broken! Signed-off-by: Austin Seipp >--------------------------------------------------------------- 6ad11c467d82cb79b242463a6c34205b97a771c2 .arcconfig | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.arcconfig b/.arcconfig index c8a74c3..b9c3932 100644 --- a/.arcconfig +++ b/.arcconfig @@ -1,5 +1,5 @@ { "project.name" : "ghc", "repository.callsign" : "GHC", - "phabricator.uri" : "https://phabricator.haskell.org", + "phabricator.uri" : "https://phabricator.haskell.org" } From git at git.haskell.org Thu Jun 5 20:08:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 20:08:30 +0000 (UTC) Subject: [commit: ghc] master: Tweak comments (4627575) Message-ID: <20140605200831.343682406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46275750b17a26a42e4e9faf1e5bc4af3febdc18/ghc >--------------------------------------------------------------- commit 46275750b17a26a42e4e9faf1e5bc4af3febdc18 Author: Gabor Greif Date: Thu Jun 5 22:03:31 2014 +0200 Tweak comments >--------------------------------------------------------------- 46275750b17a26a42e4e9faf1e5bc4af3febdc18 compiler/rename/RnEnv.lhs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index a89ab1f..d79fae4 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -273,13 +273,13 @@ lookupExactOcc name ; return (gre_name gre) } -- We can get more than one GRE here, if there are multiple - -- bindings for the same name. Sometimes they are catched later - -- by findLocalDupsRdrEnv, like in the this example (Trac #8932): + -- bindings for the same name. Sometimes they are caught later + -- by findLocalDupsRdrEnv, like in this example (Trac #8932): -- $( [d| foo :: a->a; foo x = x |]) -- foo = True - -- But when the names are totally identical, we get panic (Trac #7241): + -- But when the names are totally identical, we panic (Trac #7241): -- $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]]) - -- So, lets emit error here, even if it will lead to two errors in some cases. + -- So, let's emit an error here, even if it will lead to duplication in some cases. } where From git at git.haskell.org Thu Jun 5 20:08:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 20:08:33 +0000 (UTC) Subject: [commit: ghc] master: Typo (9ff32f9) Message-ID: <20140605200833.CF0F02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9ff32f9b9fe8642d7f2026432f7ae7b0271e50b3/ghc >--------------------------------------------------------------- commit 9ff32f9b9fe8642d7f2026432f7ae7b0271e50b3 Author: Gabor Greif Date: Sat May 24 00:56:15 2014 +0200 Typo >--------------------------------------------------------------- 9ff32f9b9fe8642d7f2026432f7ae7b0271e50b3 utils/compare_sizes/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/compare_sizes/Main.hs b/utils/compare_sizes/Main.hs index bb1685f..c64a554 100644 --- a/utils/compare_sizes/Main.hs +++ b/utils/compare_sizes/Main.hs @@ -1,4 +1,4 @@ --- This program compares the sizes of corresponding files in two tress +-- This program compares the sizes of corresponding files in two trees -- $ ./compareSizes --hi ~/ghc/darcs/ghc ~/ghc/6.12-branch/ghc -- Size | Change | Filename From git at git.haskell.org Thu Jun 5 20:25:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 20:25:30 +0000 (UTC) Subject: [commit: ghc] master: Fix compilation of cmm files with -outputdir (Trac #9050) (2a463eb) Message-ID: <20140605202530.296A32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2a463ebeba4dff6793ae16707712f1e9245225e8/ghc >--------------------------------------------------------------- commit 2a463ebeba4dff6793ae16707712f1e9245225e8 Author: Yuras Shumovich Date: Fri May 2 00:11:58 2014 +0300 Fix compilation of cmm files with -outputdir (Trac #9050) >--------------------------------------------------------------- 2a463ebeba4dff6793ae16707712f1e9245225e8 compiler/main/CodeOutput.lhs | 7 ++----- testsuite/tests/driver/T9050.cmm | 1 + testsuite/tests/driver/all.T | 4 ++++ 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index f6756b1..7ae28b3 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -192,11 +192,8 @@ outputForeignStubs dflags mod location stubs stub_c <- newTempName dflags "c" case stubs of - NoStubs -> do - -- When compiling External Core files, may need to use stub - -- files from a previous compilation - stub_h_exists <- doesFileExist stub_h - return (stub_h_exists, Nothing) + NoStubs -> + return (False, Nothing) ForeignStubs h_code c_code -> do let diff --git a/testsuite/tests/driver/T9050.cmm b/testsuite/tests/driver/T9050.cmm new file mode 100644 index 0000000..8b1a393 --- /dev/null +++ b/testsuite/tests/driver/T9050.cmm @@ -0,0 +1 @@ +// empty diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index ed0ce0f..69f4cd3 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -395,3 +395,7 @@ test('T2507', test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703']) test('T8101', normal, compile, ['-Wall -fno-code']) +def build_T9050(name, way): + return simple_build(name + '.cmm', way, '-outputdir=. ', 0, '', 0, 0, 0) +test('T9050', normal, build_T9050, []) + From git at git.haskell.org Thu Jun 5 23:26:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jun 2014 23:26:42 +0000 (UTC) Subject: [commit: ghc] master: Typo (f9def07) Message-ID: <20140605232642.C6A412406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9def077e0938513b62863f3018ad07017e79238/ghc >--------------------------------------------------------------- commit f9def077e0938513b62863f3018ad07017e79238 Author: Mateusz Kowalczyk Date: Fri Jun 6 01:26:34 2014 +0200 Typo >--------------------------------------------------------------- f9def077e0938513b62863f3018ad07017e79238 compiler/hsSyn/HsTypes.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 6f65a12..098d45f 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -163,7 +163,7 @@ mkHsWithBndrs x = HsWB { hswb_cts = x, hswb_kvs = panic "mkHsTyWithBndrs:kvs" , hswb_tvs = panic "mkHsTyWithBndrs:tvs" } --- | These names are used eary on to store the names of implicit +-- | These names are used early on to store the names of implicit -- parameters. They completely disappear after type-checking. newtype HsIPName = HsIPName FastString-- ?x deriving( Eq, Data, Typeable ) From git at git.haskell.org Fri Jun 6 10:32:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 10:32:22 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9177' created Message-ID: <20140606103222.A4BB92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9177 Referencing: b8a1a8a2657eff72bcf9ee2c174403a424dfd3fa From git at git.haskell.org Fri Jun 6 10:32:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 10:32:25 +0000 (UTC) Subject: [commit: ghc] wip/T9177: Suggest Int when user writes int (a6735a0) Message-ID: <20140606103225.1BEAB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9177 Link : http://ghc.haskell.org/trac/ghc/changeset/a6735a0dc016cca5de0afb2460f23ae972dfd9b8/ghc >--------------------------------------------------------------- commit a6735a0dc016cca5de0afb2460f23ae972dfd9b8 Author: Joachim Breitner Date: Fri Jun 6 11:47:28 2014 +0200 Suggest Int when user writes int and the other way around. This fixes #9177. >--------------------------------------------------------------- a6735a0dc016cca5de0afb2460f23ae972dfd9b8 compiler/basicTypes/OccName.lhs | 25 +++++++++++++++++++++++++ compiler/rename/RnEnv.lhs | 1 + 2 files changed, 26 insertions(+) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 487318b..b1fd831 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -83,6 +83,8 @@ module OccName ( isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace, + toRelatedNameSpace, + -- * The 'OccEnv' type OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv, lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, @@ -370,6 +372,29 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- What would this name be if used in the related name space +-- (variables <-> data construtors, type variables <-> type constructors) +toRelatedNameSpace :: OccName -> Maybe OccName +toRelatedNameSpace (OccName space name) = OccName (otherNameSpace space) `fmap` name' + where + name' | name == fsLit "[]" = Nothing -- Some special cases first + | name == fsLit "->" = Nothing + | hd == '(' = Nothing + | hd == ':' = Just tl + | startsVarSym hd = Just (':' `consFS` name) + | isUpper hd = Just (toLower hd `consFS` tl) + | isLower hd = Just (toUpper hd `consFS` tl) + | otherwise = pprTrace "toRelatedNameSpace" (ppr name) + Nothing + (hd,tl) = (headFS name, tailFS name) + +otherNameSpace :: NameSpace -> NameSpace +otherNameSpace VarName = DataName +otherNameSpace DataName = VarName +otherNameSpace TvName = TcClsName +otherNameSpace TcClsName = TvName + + {- | Other names in the compiler add aditional information to an OccName. This class provides a consistent way to access the underlying OccName. -} class HasOccName name where diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index d79fae4..d0c51d3 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -1478,6 +1478,7 @@ unknownNameSuggestErr where_look tried_rdr_name correct_name_space occ = occNameSpace occ == tried_ns && isSymOcc occ == tried_is_sym + || toRelatedNameSpace occ == Just tried_occ -- Treat operator and non-operators as non-matching -- This heuristic avoids things like -- Not in scope 'f'; perhaps you meant '+' (from Prelude) From git at git.haskell.org Fri Jun 6 10:32:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 10:32:28 +0000 (UTC) Subject: [commit: ghc] wip/T9177: Report all possible results from related name spaces (03e03ce) Message-ID: <20140606103228.93EEF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9177 Link : http://ghc.haskell.org/trac/ghc/changeset/03e03cebead92e7211697a2abde43fd7d8b03b78/ghc >--------------------------------------------------------------- commit 03e03cebead92e7211697a2abde43fd7d8b03b78 Author: Joachim Breitner Date: Fri Jun 6 12:11:48 2014 +0200 Report all possible results from related name spaces instead of just one matching directly. This is an alternative way to fix ticket #9177. >--------------------------------------------------------------- 03e03cebead92e7211697a2abde43fd7d8b03b78 compiler/basicTypes/OccName.lhs | 24 +++++++----------------- compiler/rename/RnEnv.lhs | 14 +++++++++----- 2 files changed, 16 insertions(+), 22 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index b1fd831..3d14daa 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -33,6 +33,8 @@ module OccName ( -- * The 'NameSpace' type NameSpace, -- Abstract + nameSpacesRelated, + -- ** Construction -- $real_vs_source_data_constructors tcName, clsName, tcClsName, dataName, varName, @@ -83,8 +85,6 @@ module OccName ( isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace, - toRelatedNameSpace, - -- * The 'OccEnv' type OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv, lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, @@ -372,21 +372,10 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name --- What would this name be if used in the related name space --- (variables <-> data construtors, type variables <-> type constructors) -toRelatedNameSpace :: OccName -> Maybe OccName -toRelatedNameSpace (OccName space name) = OccName (otherNameSpace space) `fmap` name' - where - name' | name == fsLit "[]" = Nothing -- Some special cases first - | name == fsLit "->" = Nothing - | hd == '(' = Nothing - | hd == ':' = Just tl - | startsVarSym hd = Just (':' `consFS` name) - | isUpper hd = Just (toLower hd `consFS` tl) - | isLower hd = Just (toUpper hd `consFS` tl) - | otherwise = pprTrace "toRelatedNameSpace" (ppr name) - Nothing - (hd,tl) = (headFS name, tailFS name) +-- Name spaces are related if there is a chance to mean the one when one writes +-- the other +nameSpacesRelated :: NameSpace -> NameSpace -> Bool +nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2 otherNameSpace :: NameSpace -> NameSpace otherNameSpace VarName = DataName @@ -395,6 +384,7 @@ otherNameSpace TvName = TcClsName otherNameSpace TcClsName = TvName + {- | Other names in the compiler add aditional information to an OccName. This class provides a consistent way to access the underlying OccName. -} class HasOccName name where diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index d0c51d3..f333a23 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -1452,7 +1452,7 @@ unknownNameSuggestErr where_look tried_rdr_name all_possibilities = [ (showPpr dflags r, (r, Left loc)) | (r,loc) <- local_possibilities local_env ] - ++ [ (showPpr dflags r, rp) | (r,rp) <- global_possibilities global_env ] + ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ] suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities perhaps = ptext (sLit "Perhaps you meant") @@ -1464,21 +1464,25 @@ unknownNameSuggestErr where_look tried_rdr_name ; return extra_err } where pp_item :: (RdrName, HowInScope) -> SDoc - pp_item (rdr, Left loc) = quotes (ppr rdr) <+> loc' -- Locally defined + pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined where loc' = case loc of UnhelpfulSpan l -> parens (ppr l) RealSrcSpan l -> parens (ptext (sLit "line") <+> int (srcSpanStartLine l)) - pp_item (rdr, Right is) = quotes (ppr rdr) <+> -- Imported + pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+> -- Imported parens (ptext (sLit "imported from") <+> ppr (is_mod is)) + pp_ns :: RdrName -> SDoc + pp_ns rdr | ns /= tried_ns = pprNameSpace ns + | otherwise = empty + where ns = rdrNameSpace rdr + tried_occ = rdrNameOcc tried_rdr_name tried_is_sym = isSymOcc tried_occ tried_ns = occNameSpace tried_occ tried_is_qual = isQual tried_rdr_name - correct_name_space occ = occNameSpace occ == tried_ns + correct_name_space occ = nameSpacesRelated (occNameSpace occ) tried_ns && isSymOcc occ == tried_is_sym - || toRelatedNameSpace occ == Just tried_occ -- Treat operator and non-operators as non-matching -- This heuristic avoids things like -- Not in scope 'f'; perhaps you meant '+' (from Prelude) From git at git.haskell.org Fri Jun 6 10:32:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 10:32:32 +0000 (UTC) Subject: [commit: ghc] wip/T9177: Add testcase for #9177 and adjust test output (b8a1a8a) Message-ID: <20140606103232.9E0A72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9177 Link : http://ghc.haskell.org/trac/ghc/changeset/b8a1a8a2657eff72bcf9ee2c174403a424dfd3fa/ghc >--------------------------------------------------------------- commit b8a1a8a2657eff72bcf9ee2c174403a424dfd3fa Author: Joachim Breitner Date: Fri Jun 6 12:28:55 2014 +0200 Add testcase for #9177 and adjust test output >--------------------------------------------------------------- b8a1a8a2657eff72bcf9ee2c174403a424dfd3fa testsuite/tests/module/mod132.stderr | 4 +++- testsuite/tests/module/mod134.stderr | 2 +- testsuite/tests/module/mod73.stderr | 6 +++--- testsuite/tests/rename/should_fail/T9177.hs | 17 +++++++++++++++++ testsuite/tests/rename/should_fail/T9177.stderr | 20 ++++++++++++++++++++ testsuite/tests/rename/should_fail/all.T | 1 + .../tests/typecheck/should_fail/tcfail062.stderr | 2 ++ 7 files changed, 47 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr index 2735a73..0a9d25c 100644 --- a/testsuite/tests/module/mod132.stderr +++ b/testsuite/tests/module/mod132.stderr @@ -1,2 +1,4 @@ -mod132.hs:6:7: Not in scope: data constructor ?Foo? +mod132.hs:6:7: + Not in scope: data constructor ?Foo? + Perhaps you meant variable ?foo? (line 6) diff --git a/testsuite/tests/module/mod134.stderr b/testsuite/tests/module/mod134.stderr index e2171a8..d6e6f0e 100644 --- a/testsuite/tests/module/mod134.stderr +++ b/testsuite/tests/module/mod134.stderr @@ -4,4 +4,4 @@ mod134.hs:6:19: Perhaps you meant one of these: ?Prelude.read? (imported from Prelude), ?Prelude.reads? (imported from Prelude), - ?Prelude.snd? (imported from Prelude) + data constructor ?Prelude.Left? (imported from Prelude) diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr index 432f61b..d19a032 100644 --- a/testsuite/tests/module/mod73.stderr +++ b/testsuite/tests/module/mod73.stderr @@ -2,6 +2,6 @@ mod73.hs:3:7: Not in scope: ?Prelude.g? Perhaps you meant one of these: - ?Prelude.id? (imported from Prelude), - ?Prelude.log? (imported from Prelude), - ?Prelude.pi? (imported from Prelude) + data constructor ?Prelude.GT? (imported from Prelude), + data constructor ?Prelude.EQ? (imported from Prelude), + data constructor ?Prelude.LT? (imported from Prelude) diff --git a/testsuite/tests/rename/should_fail/T9177.hs b/testsuite/tests/rename/should_fail/T9177.hs new file mode 100644 index 0000000..9fbb940 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9177.hs @@ -0,0 +1,17 @@ +module T9177 where + +-- the main use case +type Foo = (int) + +-- other interesting cases +type Foo2 = (integerr) + +foo3 = bar +foo4 = Fun + +-- this warning is suboptimal (fun would be illegal here) +foo5 Fun = () + +-- No errors here: +data Bar = Bar +fun x = x diff --git a/testsuite/tests/rename/should_fail/T9177.stderr b/testsuite/tests/rename/should_fail/T9177.stderr new file mode 100644 index 0000000..f87ec73 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9177.stderr @@ -0,0 +1,20 @@ + +T9177.hs:4:13: + Not in scope: type variable ?int? + Perhaps you meant type constructor or class ?Int? (imported from Prelude) + +T9177.hs:7:14: + Not in scope: type variable ?integerr? + Perhaps you meant type constructor or class ?Integer? (imported from Prelude) + +T9177.hs:9:8: + Not in scope: ?bar? + Perhaps you meant data constructor ?Bar? (line 14) + +T9177.hs:10:8: + Not in scope: data constructor ?Fun? + Perhaps you meant variable ?fun? (line 15) + +T9177.hs:11:6: + Not in scope: data constructor ?Fun? + Perhaps you meant variable ?fun? (line 15) diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index f4c3570..0f60ff6 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -114,3 +114,4 @@ test('T8448', normal, compile_fail, ['']) test('T9006', extra_clean(['T9006a.hi', 'T9006a.o']), multimod_compile_fail, ['T9006', '-v0']) +test('T9177', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail062.stderr b/testsuite/tests/typecheck/should_fail/tcfail062.stderr index 1396b53..ff4915d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail062.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail062.stderr @@ -1,6 +1,8 @@ tcfail062.hs:34:6: Not in scope: type variable ?behaviouralExpression? + Perhaps you meant type constructor or class ?BehaviouralExpression? (line 25) tcfail062.hs:34:29: Not in scope: type variable ?behaviouralExpression? + Perhaps you meant type constructor or class ?BehaviouralExpression? (line 25) From git at git.haskell.org Fri Jun 6 11:17:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 11:17:58 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9177' deleted Message-ID: <20140606111758.77D6D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T9177 From git at git.haskell.org Fri Jun 6 11:18:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 11:18:00 +0000 (UTC) Subject: [commit: ghc] master: Report all possible results from related name spaces (ae41a50) Message-ID: <20140606111800.CAE192406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ae41a50f0378c00351df5414b35026fc4bce2b44/ghc >--------------------------------------------------------------- commit ae41a50f0378c00351df5414b35026fc4bce2b44 Author: Joachim Breitner Date: Fri Jun 6 12:11:48 2014 +0200 Report all possible results from related name spaces instead of just one matching directly. This is an alternative way to fix ticket #9177. >--------------------------------------------------------------- ae41a50f0378c00351df5414b35026fc4bce2b44 compiler/basicTypes/OccName.lhs | 24 +++++++----------------- compiler/rename/RnEnv.lhs | 14 +++++++++----- 2 files changed, 16 insertions(+), 22 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index b1fd831..28aeff8 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -33,6 +33,8 @@ module OccName ( -- * The 'NameSpace' type NameSpace, -- Abstract + nameSpacesRelated, + -- ** Construction -- $real_vs_source_data_constructors tcName, clsName, tcClsName, dataName, varName, @@ -83,8 +85,6 @@ module OccName ( isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace, - toRelatedNameSpace, - -- * The 'OccEnv' type OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv, lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, @@ -372,21 +372,10 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name --- What would this name be if used in the related name space --- (variables <-> data construtors, type variables <-> type constructors) -toRelatedNameSpace :: OccName -> Maybe OccName -toRelatedNameSpace (OccName space name) = OccName (otherNameSpace space) `fmap` name' - where - name' | name == fsLit "[]" = Nothing -- Some special cases first - | name == fsLit "->" = Nothing - | hd == '(' = Nothing - | hd == ':' = Just tl - | startsVarSym hd = Just (':' `consFS` name) - | isUpper hd = Just (toLower hd `consFS` tl) - | isLower hd = Just (toUpper hd `consFS` tl) - | otherwise = pprTrace "toRelatedNameSpace" (ppr name) - Nothing - (hd,tl) = (headFS name, tailFS name) +-- Name spaces are related if there is a chance to mean the one when one writes +-- the other, i.e. variables <-> data construtors and type variables <-> type constructors +nameSpacesRelated :: NameSpace -> NameSpace -> Bool +nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2 otherNameSpace :: NameSpace -> NameSpace otherNameSpace VarName = DataName @@ -395,6 +384,7 @@ otherNameSpace TvName = TcClsName otherNameSpace TcClsName = TvName + {- | Other names in the compiler add aditional information to an OccName. This class provides a consistent way to access the underlying OccName. -} class HasOccName name where diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index d0c51d3..f333a23 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -1452,7 +1452,7 @@ unknownNameSuggestErr where_look tried_rdr_name all_possibilities = [ (showPpr dflags r, (r, Left loc)) | (r,loc) <- local_possibilities local_env ] - ++ [ (showPpr dflags r, rp) | (r,rp) <- global_possibilities global_env ] + ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ] suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities perhaps = ptext (sLit "Perhaps you meant") @@ -1464,21 +1464,25 @@ unknownNameSuggestErr where_look tried_rdr_name ; return extra_err } where pp_item :: (RdrName, HowInScope) -> SDoc - pp_item (rdr, Left loc) = quotes (ppr rdr) <+> loc' -- Locally defined + pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined where loc' = case loc of UnhelpfulSpan l -> parens (ppr l) RealSrcSpan l -> parens (ptext (sLit "line") <+> int (srcSpanStartLine l)) - pp_item (rdr, Right is) = quotes (ppr rdr) <+> -- Imported + pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+> -- Imported parens (ptext (sLit "imported from") <+> ppr (is_mod is)) + pp_ns :: RdrName -> SDoc + pp_ns rdr | ns /= tried_ns = pprNameSpace ns + | otherwise = empty + where ns = rdrNameSpace rdr + tried_occ = rdrNameOcc tried_rdr_name tried_is_sym = isSymOcc tried_occ tried_ns = occNameSpace tried_occ tried_is_qual = isQual tried_rdr_name - correct_name_space occ = occNameSpace occ == tried_ns + correct_name_space occ = nameSpacesRelated (occNameSpace occ) tried_ns && isSymOcc occ == tried_is_sym - || toRelatedNameSpace occ == Just tried_occ -- Treat operator and non-operators as non-matching -- This heuristic avoids things like -- Not in scope 'f'; perhaps you meant '+' (from Prelude) From git at git.haskell.org Fri Jun 6 11:18:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 11:18:04 +0000 (UTC) Subject: [commit: ghc] master: Add testcase for #9177 and adjust test output (d3cae19) Message-ID: <20140606111804.B0B5A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d3cae19055d6f148b6085fb5d6885a1826215aad/ghc >--------------------------------------------------------------- commit d3cae19055d6f148b6085fb5d6885a1826215aad Author: Joachim Breitner Date: Fri Jun 6 12:28:55 2014 +0200 Add testcase for #9177 and adjust test output >--------------------------------------------------------------- d3cae19055d6f148b6085fb5d6885a1826215aad testsuite/tests/module/mod132.stderr | 4 +++- testsuite/tests/module/mod134.stderr | 2 +- testsuite/tests/module/mod73.stderr | 6 +++--- testsuite/tests/rename/should_fail/T9177.hs | 17 +++++++++++++++++ testsuite/tests/rename/should_fail/T9177.stderr | 20 ++++++++++++++++++++ testsuite/tests/rename/should_fail/all.T | 1 + .../tests/typecheck/should_fail/tcfail062.stderr | 2 ++ 7 files changed, 47 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr index 2735a73..0a9d25c 100644 --- a/testsuite/tests/module/mod132.stderr +++ b/testsuite/tests/module/mod132.stderr @@ -1,2 +1,4 @@ -mod132.hs:6:7: Not in scope: data constructor ?Foo? +mod132.hs:6:7: + Not in scope: data constructor ?Foo? + Perhaps you meant variable ?foo? (line 6) diff --git a/testsuite/tests/module/mod134.stderr b/testsuite/tests/module/mod134.stderr index e2171a8..d6e6f0e 100644 --- a/testsuite/tests/module/mod134.stderr +++ b/testsuite/tests/module/mod134.stderr @@ -4,4 +4,4 @@ mod134.hs:6:19: Perhaps you meant one of these: ?Prelude.read? (imported from Prelude), ?Prelude.reads? (imported from Prelude), - ?Prelude.snd? (imported from Prelude) + data constructor ?Prelude.Left? (imported from Prelude) diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr index 432f61b..d19a032 100644 --- a/testsuite/tests/module/mod73.stderr +++ b/testsuite/tests/module/mod73.stderr @@ -2,6 +2,6 @@ mod73.hs:3:7: Not in scope: ?Prelude.g? Perhaps you meant one of these: - ?Prelude.id? (imported from Prelude), - ?Prelude.log? (imported from Prelude), - ?Prelude.pi? (imported from Prelude) + data constructor ?Prelude.GT? (imported from Prelude), + data constructor ?Prelude.EQ? (imported from Prelude), + data constructor ?Prelude.LT? (imported from Prelude) diff --git a/testsuite/tests/rename/should_fail/T9177.hs b/testsuite/tests/rename/should_fail/T9177.hs new file mode 100644 index 0000000..9fbb940 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9177.hs @@ -0,0 +1,17 @@ +module T9177 where + +-- the main use case +type Foo = (int) + +-- other interesting cases +type Foo2 = (integerr) + +foo3 = bar +foo4 = Fun + +-- this warning is suboptimal (fun would be illegal here) +foo5 Fun = () + +-- No errors here: +data Bar = Bar +fun x = x diff --git a/testsuite/tests/rename/should_fail/T9177.stderr b/testsuite/tests/rename/should_fail/T9177.stderr new file mode 100644 index 0000000..f87ec73 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9177.stderr @@ -0,0 +1,20 @@ + +T9177.hs:4:13: + Not in scope: type variable ?int? + Perhaps you meant type constructor or class ?Int? (imported from Prelude) + +T9177.hs:7:14: + Not in scope: type variable ?integerr? + Perhaps you meant type constructor or class ?Integer? (imported from Prelude) + +T9177.hs:9:8: + Not in scope: ?bar? + Perhaps you meant data constructor ?Bar? (line 14) + +T9177.hs:10:8: + Not in scope: data constructor ?Fun? + Perhaps you meant variable ?fun? (line 15) + +T9177.hs:11:6: + Not in scope: data constructor ?Fun? + Perhaps you meant variable ?fun? (line 15) diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index f4c3570..0f60ff6 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -114,3 +114,4 @@ test('T8448', normal, compile_fail, ['']) test('T9006', extra_clean(['T9006a.hi', 'T9006a.o']), multimod_compile_fail, ['T9006', '-v0']) +test('T9177', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail062.stderr b/testsuite/tests/typecheck/should_fail/tcfail062.stderr index 1396b53..ff4915d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail062.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail062.stderr @@ -1,6 +1,8 @@ tcfail062.hs:34:6: Not in scope: type variable ?behaviouralExpression? + Perhaps you meant type constructor or class ?BehaviouralExpression? (line 25) tcfail062.hs:34:29: Not in scope: type variable ?behaviouralExpression? + Perhaps you meant type constructor or class ?BehaviouralExpression? (line 25) From git at git.haskell.org Fri Jun 6 11:18:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 11:18:06 +0000 (UTC) Subject: [commit: ghc] master: Suggest Int when user writes int (009e86f) Message-ID: <20140606111807.15BFB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/009e86f5dd2bc2657be093c76ba679b7866b651a/ghc >--------------------------------------------------------------- commit 009e86f5dd2bc2657be093c76ba679b7866b651a Author: Joachim Breitner Date: Fri Jun 6 11:47:28 2014 +0200 Suggest Int when user writes int and the other way around. This fixes #9177. >--------------------------------------------------------------- 009e86f5dd2bc2657be093c76ba679b7866b651a compiler/basicTypes/OccName.lhs | 25 +++++++++++++++++++++++++ compiler/rename/RnEnv.lhs | 1 + 2 files changed, 26 insertions(+) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 487318b..b1fd831 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -83,6 +83,8 @@ module OccName ( isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace, + toRelatedNameSpace, + -- * The 'OccEnv' type OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv, lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, @@ -370,6 +372,29 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- What would this name be if used in the related name space +-- (variables <-> data construtors, type variables <-> type constructors) +toRelatedNameSpace :: OccName -> Maybe OccName +toRelatedNameSpace (OccName space name) = OccName (otherNameSpace space) `fmap` name' + where + name' | name == fsLit "[]" = Nothing -- Some special cases first + | name == fsLit "->" = Nothing + | hd == '(' = Nothing + | hd == ':' = Just tl + | startsVarSym hd = Just (':' `consFS` name) + | isUpper hd = Just (toLower hd `consFS` tl) + | isLower hd = Just (toUpper hd `consFS` tl) + | otherwise = pprTrace "toRelatedNameSpace" (ppr name) + Nothing + (hd,tl) = (headFS name, tailFS name) + +otherNameSpace :: NameSpace -> NameSpace +otherNameSpace VarName = DataName +otherNameSpace DataName = VarName +otherNameSpace TvName = TcClsName +otherNameSpace TcClsName = TvName + + {- | Other names in the compiler add aditional information to an OccName. This class provides a consistent way to access the underlying OccName. -} class HasOccName name where diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index d79fae4..d0c51d3 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -1478,6 +1478,7 @@ unknownNameSuggestErr where_look tried_rdr_name correct_name_space occ = occNameSpace occ == tried_ns && isSymOcc occ == tried_is_sym + || toRelatedNameSpace occ == Just tried_occ -- Treat operator and non-operators as non-matching -- This heuristic avoids things like -- Not in scope 'f'; perhaps you meant '+' (from Prelude) From git at git.haskell.org Fri Jun 6 11:20:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 11:20:17 +0000 (UTC) Subject: [commit: ghc] master: Update test results (last minuite changes) (6e50553) Message-ID: <20140606112017.20AD82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e50553c153f1160e3475e8c727f38b842aee96c/ghc >--------------------------------------------------------------- commit 6e50553c153f1160e3475e8c727f38b842aee96c Author: Joachim Breitner Date: Fri Jun 6 13:19:33 2014 +0200 Update test results (last minuite changes) >--------------------------------------------------------------- 6e50553c153f1160e3475e8c727f38b842aee96c testsuite/tests/rename/should_fail/T9177.stderr | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/rename/should_fail/T9177.stderr b/testsuite/tests/rename/should_fail/T9177.stderr index f87ec73..6240340 100644 --- a/testsuite/tests/rename/should_fail/T9177.stderr +++ b/testsuite/tests/rename/should_fail/T9177.stderr @@ -9,12 +9,12 @@ T9177.hs:7:14: T9177.hs:9:8: Not in scope: ?bar? - Perhaps you meant data constructor ?Bar? (line 14) + Perhaps you meant data constructor ?Bar? (line 16) T9177.hs:10:8: Not in scope: data constructor ?Fun? - Perhaps you meant variable ?fun? (line 15) + Perhaps you meant variable ?fun? (line 17) -T9177.hs:11:6: +T9177.hs:13:6: Not in scope: data constructor ?Fun? - Perhaps you meant variable ?fun? (line 15) + Perhaps you meant variable ?fun? (line 17) From git at git.haskell.org Fri Jun 6 12:06:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 12:06:15 +0000 (UTC) Subject: [commit: ghc] master: Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds (7ac600d) Message-ID: <20140606120615.E5A2A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ac600d5fcd74db1f991555de6e415030970d5f3/ghc >--------------------------------------------------------------- commit 7ac600d5fcd74db1f991555de6e415030970d5f3 Author: Simon Peyton Jones Date: Fri Jun 6 11:39:41 2014 +0100 Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds This was a serious bug, exposed by Trac #9175. The matcher and wrapper must be LocalIds, like record selectors and dictionary functions, for the reasons now documented in Note [Exported LocalIds] in Id.lhs In fixing this I found - PatSyn should have an Id inside it (apart from the wrapper and matcher) It should be a Name. Hence psId --> psName, with knock-on consequences - Tidying of PatSyns in TidyPgm was wrong - The keep-alive set in Desugar.deSugar (now) doesn't need pattern synonyms in it I also cleaned up the interface to PatSyn a little, so there's a tiny knock-on effect in Haddock; hence the haddock submodule update. It's very hard to make a test for this bug, so I haven't. >--------------------------------------------------------------- 7ac600d5fcd74db1f991555de6e415030970d5f3 compiler/basicTypes/Id.lhs | 39 +++++++++++++- compiler/basicTypes/MkId.lhs | 31 +++-------- compiler/basicTypes/PatSyn.lhs | 77 +++++++++++++++++----------- compiler/deSugar/Desugar.lhs | 21 +++----- compiler/deSugar/MatchCon.lhs | 2 +- compiler/hsSyn/Convert.lhs | 2 +- compiler/iface/MkIface.lhs | 4 +- compiler/main/HscTypes.lhs | 20 ++------ compiler/main/TidyPgm.lhs | 52 +++++++++++-------- compiler/typecheck/TcEnv.lhs | 3 +- compiler/typecheck/TcPat.lhs | 4 +- compiler/typecheck/TcPatSyn.lhs | 5 +- compiler/typecheck/TcRnDriver.lhs | 5 +- compiler/typecheck/TcRnTypes.lhs | 4 +- compiler/typecheck/TcSplice.lhs | 4 +- compiler/typecheck/TcTyClsDecls.lhs | 7 ++- compiler/vectorise/Vectorise/Monad/Naming.hs | 5 +- utils/haddock | 2 +- 18 files changed, 154 insertions(+), 133 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7ac600d5fcd74db1f991555de6e415030970d5f3 From git at git.haskell.org Fri Jun 6 14:09:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:41 +0000 (UTC) Subject: [commit: ghc] master: Sorted the language options list alphabetically, and added missing options. (6fa7577) Message-ID: <20140606140943.7A0F42406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6fa7577aa13e869e569d6feaf9b168b3b4df41e4/ghc >--------------------------------------------------------------- commit 6fa7577aa13e869e569d6feaf9b168b3b4df41e4 Author: Sjoerd Visscher Date: Fri Jun 6 13:27:11 2014 +0200 Sorted the language options list alphabetically, and added missing options. >--------------------------------------------------------------- 6fa7577aa13e869e569d6feaf9b168b3b4df41e4 docs/users_guide/flags.xml | 488 +++++++++++++++++++++++++-------------------- 1 file changed, 270 insertions(+), 218 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6fa7577aa13e869e569d6feaf9b168b3b4df41e4 From git at git.haskell.org Fri Jun 6 14:09:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:39 +0000 (UTC) Subject: [commit: ghc] master: Added link ends to role documentation. (3a2b21d) Message-ID: <20140606140943.6F05C2406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3a2b21db67e22948439f5b50e642ee1dc5adae64/ghc >--------------------------------------------------------------- commit 3a2b21db67e22948439f5b50e642ee1dc5adae64 Author: Sjoerd Visscher Date: Fri Jun 6 13:25:43 2014 +0200 Added link ends to role documentation. >--------------------------------------------------------------- 3a2b21db67e22948439f5b50e642ee1dc5adae64 docs/users_guide/glasgow_exts.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 7872a88..a35e570 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -11571,7 +11571,7 @@ described in Generative type abstraction and type-level computation, published at POPL 2011. - + Nominal, Representational, and Phantom The goal of the roles system is to track when two types have the same @@ -11628,7 +11628,7 @@ are unrelated. - + Role inference @@ -11682,7 +11682,7 @@ but role nominal for b. - + Role annotations <indexterm><primary>-XRoleAnnotations</primary></indexterm> From git at git.haskell.org Fri Jun 6 14:09:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:43 +0000 (UTC) Subject: [commit: ghc] master: Prevent line wrapping after the dash of an option. (57cc003) Message-ID: <20140606140944.1656A24071@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/57cc00329807ea3ccca7b5c2997564281d733250/ghc >--------------------------------------------------------------- commit 57cc00329807ea3ccca7b5c2997564281d733250 Author: Sjoerd Visscher Date: Fri Jun 6 13:51:40 2014 +0200 Prevent line wrapping after the dash of an option. >--------------------------------------------------------------- 57cc00329807ea3ccca7b5c2997564281d733250 mk/fptools.css | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mk/fptools.css b/mk/fptools.css index 97f276c..7a2b39b 100644 --- a/mk/fptools.css +++ b/mk/fptools.css @@ -23,6 +23,8 @@ pre { pre.screen { color: #006400 } pre.programlisting { color: maroon } +code.option { white-space: nowrap } + div.example { margin: 1ex 0em; border: solid #412e25 1px; From git at git.haskell.org Fri Jun 6 14:09:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:49 +0000 (UTC) Subject: [commit: ghc] master: Merge branch 'master' of git://git.haskell.org/ghc (5c89f88) Message-ID: <20140606140949.A8AA92406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5c89f8802e8e1e1398705fcaf22f1af3ad24304a/ghc >--------------------------------------------------------------- commit 5c89f8802e8e1e1398705fcaf22f1af3ad24304a Merge: 63e1f09 7ac600d Author: Sjoerd Visscher Date: Fri Jun 6 14:31:51 2014 +0200 Merge branch 'master' of git://git.haskell.org/ghc Conflicts: docs/users_guide/flags.xml >--------------------------------------------------------------- Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5c89f8802e8e1e1398705fcaf22f1af3ad24304a From git at git.haskell.org Fri Jun 6 14:09:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:46 +0000 (UTC) Subject: [commit: ghc] master: Added more option implication documentation. (63e1f09) Message-ID: <20140606140946.9C7E22406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63e1f0960c458787eabf8a54b3807021efe48640/ghc >--------------------------------------------------------------- commit 63e1f0960c458787eabf8a54b3807021efe48640 Author: Sjoerd Visscher Date: Fri Jun 6 14:23:59 2014 +0200 Added more option implication documentation. >--------------------------------------------------------------- 63e1f0960c458787eabf8a54b3807021efe48640 docs/users_guide/flags.xml | 80 +++++++++++++++++++++++++++------------------- 1 file changed, 48 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 63e1f0960c458787eabf8a54b3807021efe48640 From git at git.haskell.org Fri Jun 6 14:09:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:52 +0000 (UTC) Subject: [commit: ghc] master: Make DeriveTraversable imply DeriveFunctor/Foldable (3bdc78b) Message-ID: <20140606140952.34BF82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3bdc78b520c05706f8b66033b154c07ed021ac33/ghc >--------------------------------------------------------------- commit 3bdc78b520c05706f8b66033b154c07ed021ac33 Author: Sjoerd Visscher Date: Fri Jun 6 15:24:41 2014 +0200 Make DeriveTraversable imply DeriveFunctor/Foldable Implements #9069 >--------------------------------------------------------------- 3bdc78b520c05706f8b66033b154c07ed021ac33 compiler/main/DynFlags.hs | 3 +++ docs/users_guide/glasgow_exts.xml | 6 +++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4db1d2c..5f125ef 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2957,6 +2957,9 @@ impliedFlags , (Opt_ImplicitParams, turnOn, Opt_FlexibleInstances) , (Opt_JavaScriptFFI, turnOn, Opt_InterruptibleFFI) + + , (Opt_DeriveTraversable, turnOn, Opt_DeriveFunctor) + , (Opt_DeriveTraversable, turnOn, Opt_DeriveFoldable) ] optLevelFlags :: [([Int], GeneralFlag)] diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index d5dfa4d..ac8004f 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -3882,7 +3882,11 @@ defined in Data.Foldable. With , you can derive instances of the class Traversable, -defined in Data.Traversable. +defined in Data.Traversable. Since the Traversable +instance dictates the instances of Functor and +Foldable, you'll probably want to derive them too, so + implies + and . You can also use a standalone deriving declaration instead From git at git.haskell.org Fri Jun 6 14:09:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:55 +0000 (UTC) Subject: [commit: ghc] master: Added testcase for #9069 (63d7047) Message-ID: <20140606140955.6587B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63d7047a8a20c4e8b1c050b4577bbd7ee5cebafc/ghc >--------------------------------------------------------------- commit 63d7047a8a20c4e8b1c050b4577bbd7ee5cebafc Author: Sjoerd Visscher Date: Fri Jun 6 15:26:20 2014 +0200 Added testcase for #9069 >--------------------------------------------------------------- 63d7047a8a20c4e8b1c050b4577bbd7ee5cebafc testsuite/tests/deriving/should_compile/T9069.hs | 9 +++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 2 files changed, 10 insertions(+) diff --git a/testsuite/tests/deriving/should_compile/T9069.hs b/testsuite/tests/deriving/should_compile/T9069.hs new file mode 100644 index 0000000..7ab3af3 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T9069.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DeriveTraversable #-} + +module T9069 where + +import Data.Foldable +import Data.Traversable + +data Trivial a = Trivial a + deriving (Functor,Foldable,Traversable) \ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 97e2c83..f440e80 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -50,3 +50,4 @@ test('T8893', normal, compile, ['']) test('T8950', expect_broken(8950), compile, ['']) test('T8963', normal, compile, ['']) test('T7269', normal, compile, ['']) +test('T9069', normal, compile, ['']) From git at git.haskell.org Fri Jun 6 14:09:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:09:58 +0000 (UTC) Subject: [commit: ghc] master: Update mod73 test output (1178fa4) Message-ID: <20140606140958.4D0F12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1178fa4ada1ac054976f3abb2e303ad42653e303/ghc >--------------------------------------------------------------- commit 1178fa4ada1ac054976f3abb2e303ad42653e303 Author: Joachim Breitner Date: Fri Jun 6 15:03:36 2014 +0200 Update mod73 test output to what I observe on travis and on my validate machine, even though my local tree produces the previous output. >--------------------------------------------------------------- 1178fa4ada1ac054976f3abb2e303ad42653e303 testsuite/tests/module/mod73.stderr | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr index d19a032..576b0e3 100644 --- a/testsuite/tests/module/mod73.stderr +++ b/testsuite/tests/module/mod73.stderr @@ -2,6 +2,6 @@ mod73.hs:3:7: Not in scope: ?Prelude.g? Perhaps you meant one of these: - data constructor ?Prelude.GT? (imported from Prelude), + data constructor ?Prelude.LT? (imported from Prelude), data constructor ?Prelude.EQ? (imported from Prelude), - data constructor ?Prelude.LT? (imported from Prelude) + data constructor ?Prelude.GT? (imported from Prelude) From git at git.haskell.org Fri Jun 6 14:10:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 14:10:02 +0000 (UTC) Subject: [commit: ghc] master: Use UnicodeSyntax when printing (819e1f2) Message-ID: <20140606141002.A27C62406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/819e1f2c2e10268fe3edc8395f2707b93c9c6f4d/ghc >--------------------------------------------------------------- commit 819e1f2c2e10268fe3edc8395f2707b93c9c6f4d Author: Joachim Breitner Date: Fri Jun 6 15:00:52 2014 +0200 Use UnicodeSyntax when printing When printing Haskell source, and UnicodeSyntax is enabled, use the unicode sytax characters (#8959). >--------------------------------------------------------------- 819e1f2c2e10268fe3edc8395f2707b93c9c6f4d compiler/hsSyn/HsDecls.lhs | 2 +- compiler/hsSyn/HsExpr.lhs | 18 ++++++++-------- compiler/hsSyn/HsTypes.lhs | 2 +- compiler/main/DynFlags.hs | 4 ++++ compiler/main/DynFlags.hs-boot | 1 + compiler/types/TypeRep.lhs | 2 +- compiler/utils/Outputable.lhs | 31 +++++++++++++++++++------- testsuite/tests/ghci/scripts/T8959.script | 20 +++++++++++++++++ testsuite/tests/ghci/scripts/T8959.stderr | 36 +++++++++++++++++++++++++++++++ testsuite/tests/ghci/scripts/T8959.stdout | 6 ++++++ testsuite/tests/ghci/scripts/all.T | 1 + 11 files changed, 103 insertions(+), 20 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 819e1f2c2e10268fe3edc8395f2707b93c9c6f4d From git at git.haskell.org Fri Jun 6 16:56:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 16:56:55 +0000 (UTC) Subject: [commit: ghc] master: Only use UnicodeSytanx pretty printing if the locale supports it (6e4a750) Message-ID: <20140606165656.463F72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e4a75001fae1bf9251907d605b3f0b74da537cb/ghc >--------------------------------------------------------------- commit 6e4a75001fae1bf9251907d605b3f0b74da537cb Author: Joachim Breitner Date: Fri Jun 6 18:07:29 2014 +0200 Only use UnicodeSytanx pretty printing if the locale supports it using the same check as for unicode quotes. >--------------------------------------------------------------- 6e4a75001fae1bf9251907d605b3f0b74da537cb compiler/main/DynFlags.hs | 18 +++++++++--------- compiler/main/DynFlags.hs-boot | 2 +- compiler/utils/Outputable.lhs | 9 +++++---- testsuite/tests/driver/Makefile | 4 ++++ testsuite/tests/driver/T8959a.hs | 5 +++++ testsuite/tests/driver/T8959a.stderr | 5 +++++ testsuite/tests/driver/all.T | 5 +++++ 7 files changed, 34 insertions(+), 14 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index ea4d008..0c49386 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -777,7 +777,7 @@ data DynFlags = DynFlags { pprCols :: Int, traceLevel :: Int, -- Standard level is 1. Less verbose is 0. - useUnicodeQuotes :: Bool, + useUnicode :: Bool, -- | what kind of {-# SCC #-} to add automatically profAuto :: ProfAuto, @@ -1295,12 +1295,12 @@ initDynFlags dflags = do refRtldInfo <- newIORef Nothing refRtccInfo <- newIORef Nothing wrapperNum <- newIORef emptyModuleEnv - canUseUnicodeQuotes <- do let enc = localeEncoding - str = "??" - (withCString enc str $ \cstr -> - do str' <- peekCString enc cstr - return (str == str')) - `catchIOError` \_ -> return False + canUseUnicode <- do let enc = localeEncoding + str = "??" + (withCString enc str $ \cstr -> + do str' <- peekCString enc cstr + return (str == str')) + `catchIOError` \_ -> return False return dflags{ canGenerateDynamicToo = refCanGenerateDynamicToo, nextTempSuffix = refNextTempSuffix, @@ -1310,7 +1310,7 @@ initDynFlags dflags = do generatedDumps = refGeneratedDumps, llvmVersion = refLlvmVersion, nextWrapperNum = wrapperNum, - useUnicodeQuotes = canUseUnicodeQuotes, + useUnicode = canUseUnicode, rtldInfo = refRtldInfo, rtccInfo = refRtccInfo } @@ -1449,7 +1449,7 @@ defaultDynFlags mySettings = flushErr = defaultFlushErr, pprUserLength = 5, pprCols = 100, - useUnicodeQuotes = False, + useUnicode = False, traceLevel = 1, profAuto = NoProfAuto, llvmVersion = panic "defaultDynFlags: No llvmVersion", diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot index f3f472a..5cf2166 100644 --- a/compiler/main/DynFlags.hs-boot +++ b/compiler/main/DynFlags.hs-boot @@ -9,5 +9,5 @@ targetPlatform :: DynFlags -> Platform pprUserLength :: DynFlags -> Int pprCols :: DynFlags -> Int unsafeGlobalDynFlags :: DynFlags -useUnicodeQuotes :: DynFlags -> Bool +useUnicode :: DynFlags -> Bool useUnicodeSyntax :: DynFlags -> Bool diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index a933fee..e32261d 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -74,7 +74,7 @@ module Outputable ( import {-# SOURCE #-} DynFlags( DynFlags, targetPlatform, pprUserLength, pprCols, - useUnicodeQuotes, useUnicodeSyntax, + useUnicode, useUnicodeSyntax, unsafeGlobalDynFlags ) import {-# SOURCE #-} Module( Module, ModuleName, moduleName ) import {-# SOURCE #-} OccName( OccName ) @@ -459,7 +459,7 @@ cparen b d = SDoc $ Pretty.cparen b . runSDoc d -- so that we don't get `foo''. Instead we just have foo'. quotes d = sdocWithDynFlags $ \dflags -> - if useUnicodeQuotes dflags + if useUnicode dflags then char '?' <> d <> char '?' else SDoc $ \sty -> let pp_d = runSDoc d sty @@ -501,8 +501,9 @@ forAllLit = unicodeSyntax (char '?') (ptext (sLit "forall")) unicodeSyntax :: SDoc -> SDoc -> SDoc unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags -> - if useUnicodeSyntax dflags then unicode - else plain + if useUnicode dflags && useUnicodeSyntax dflags + then unicode + else plain nest :: Int -> SDoc -> SDoc -- ^ Indent 'SDoc' some specified amount diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 3603bb6..37b661c 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -556,6 +556,10 @@ T6037: T2507: -LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T2507.hs +.PHONY: T8959a +T8959a: + -LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T8959a.hs -XUnicodeSyntax + .PHONY: T703 T703: $(RM) -rf T703 diff --git a/testsuite/tests/driver/T8959a.hs b/testsuite/tests/driver/T8959a.hs new file mode 100644 index 0000000..6f8fd77 --- /dev/null +++ b/testsuite/tests/driver/T8959a.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE UnicodeSyntax #-} +module T8959a where + +foo :: Int -> Int +foo = () diff --git a/testsuite/tests/driver/T8959a.stderr b/testsuite/tests/driver/T8959a.stderr new file mode 100644 index 0000000..f270bb6 --- /dev/null +++ b/testsuite/tests/driver/T8959a.stderr @@ -0,0 +1,5 @@ + +T8959a.hs:5:7: + Couldn't match expected type `Int -> Int' with actual type `()' + In the expression: () + In an equation for `foo': foo = () diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 69f4cd3..45c7662 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -391,6 +391,11 @@ test('T2507', [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)], run_command, ['$MAKE -s --no-print-directory T2507']) +test('T8959a', + # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X + [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)], + run_command, + ['$MAKE -s --no-print-directory T8959a']) test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703']) test('T8101', normal, compile, ['-Wall -fno-code']) From git at git.haskell.org Fri Jun 6 16:56:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 16:56:58 +0000 (UTC) Subject: [commit: ghc] master: Test case: GHCi uses UnicodeSyntax if the loaded file uses it. (b021572) Message-ID: <20140606165658.976332406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0215729214859051abf78f6cf5012805fe7d764/ghc >--------------------------------------------------------------- commit b0215729214859051abf78f6cf5012805fe7d764 Author: Joachim Breitner Date: Fri Jun 6 18:42:34 2014 +0200 Test case: GHCi uses UnicodeSyntax if the loaded file uses it. Its marked as broken, as this does not work yet, but we are calling it a day here soon, so I want this to be recorded (#8959). >--------------------------------------------------------------- b0215729214859051abf78f6cf5012805fe7d764 testsuite/tests/ghci/scripts/T8959b.hs | 11 +++++++++++ testsuite/tests/ghci/scripts/T8959b.script | 1 + testsuite/tests/ghci/scripts/T8959b.stderr | 16 ++++++++++++++++ testsuite/tests/ghci/scripts/all.T | 1 + 4 files changed, 29 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T8959b.hs b/testsuite/tests/ghci/scripts/T8959b.hs new file mode 100644 index 0000000..064b267 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959b.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE UnicodeSyntax, Arrows, RankNTypes #-} +module T8959b where + +foo :: Int -> Int +foo = () + +bar :: () +bar = proc x -> do return -< x + +baz = () :: (forall a. a -> a) -> a + diff --git a/testsuite/tests/ghci/scripts/T8959b.script b/testsuite/tests/ghci/scripts/T8959b.script new file mode 100644 index 0000000..f3c23c9 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959b.script @@ -0,0 +1 @@ +:l T8959b.hs diff --git a/testsuite/tests/ghci/scripts/T8959b.stderr b/testsuite/tests/ghci/scripts/T8959b.stderr new file mode 100644 index 0000000..4f1ac7a --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959b.stderr @@ -0,0 +1,16 @@ + +T8959b.hs:5:7: + Couldn't match expected type ?Int ? Int? with actual type ?()? + In the expression: () + In an equation for ?foo?: foo = () + +T8959b.hs:8:7: + Couldn't match expected type ?()? with actual type ?t0 ? m0 t0? + In the expression: proc x -> do { return ? x } + In an equation for ?bar?: bar = proc x -> do { return ? x } + +T8959b.hs:10:7: + Couldn't match expected type ?(? a2. a2 ? a2) ? a1? + with actual type ?()? + In the expression: () ? (? a. a -> a) -> a + In an equation for ?baz?: baz = () ? (? a. a -> a) -> a diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index b0a9912..161e14b 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -173,3 +173,4 @@ test('T8831', normal, ghci_script, ['T8831.script']) test('T8917', normal, ghci_script, ['T8917.script']) test('T8931', normal, ghci_script, ['T8931.script']) test('T8959', normal, ghci_script, ['T8959.script']) +test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script']) From git at git.haskell.org Fri Jun 6 17:03:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 17:03:44 +0000 (UTC) Subject: [commit: ghc] master: Fix discarding of unreachable code in the register allocator (#9155) (e577a52) Message-ID: <20140606170344.401FD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e577a52363ee7ee8a07f1d863988332ae8fbf2e4/ghc >--------------------------------------------------------------- commit e577a52363ee7ee8a07f1d863988332ae8fbf2e4 Author: Simon Marlow Date: Fri Jun 6 09:52:13 2014 +0100 Fix discarding of unreachable code in the register allocator (#9155) A previous fix to this was wrong: f5879acd018494b84233f26fba828ce376d0f81d and left some unreachable code behind. So rather than try to be clever and do this at the same time as the strongly-connected-component analysis, I'm doing a separate reachability pass first. >--------------------------------------------------------------- e577a52363ee7ee8a07f1d863988332ae8fbf2e4 compiler/nativeGen/RegAlloc/Liveness.hs | 14 +++++++---- compiler/utils/Digraph.lhs | 32 ++++++++++--------------- testsuite/tests/codeGen/should_compile/T9155.hs | 30 +++++++++++++++++++++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 4 files changed, 53 insertions(+), 24 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index e5e80b2..1cb6dc8 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -671,14 +671,20 @@ sccBlocks sccBlocks blocks entries = map (fmap get_node) sccs where - sccs = stronglyConnCompFromG graph roots - - graph = graphFromEdgedVertices nodes - -- nodes :: [(NatBasicBlock instr, Unique, [Unique])] nodes = [ (block, id, getOutEdges instrs) | block@(BasicBlock id instrs) <- blocks ] + g1 = graphFromEdgedVertices nodes + + reachable :: BlockSet + reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ] + + g2 = graphFromEdgedVertices [ node | node@(_,id,_) <- nodes + , id `setMember` reachable ] + + sccs = stronglyConnCompG g2 + get_node (n, _, _) = n getOutEdges :: Instruction instr => [instr] -> [BlockId] diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs index a89eb71..d22380f 100644 --- a/compiler/utils/Digraph.lhs +++ b/compiler/utils/Digraph.lhs @@ -15,10 +15,10 @@ module Digraph( Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices, SCC(..), Node, flattenSCC, flattenSCCs, - stronglyConnCompG, stronglyConnCompFromG, + stronglyConnCompG, topologicalSortG, dfsTopSortG, verticesG, edgesG, hasVertexG, - reachableG, transposeG, + reachableG, reachablesG, transposeG, outdegreeG, indegreeG, vertexGroupsG, emptyG, componentsG, @@ -258,14 +258,6 @@ stronglyConnCompG :: Graph node -> [SCC node] stronglyConnCompG graph = decodeSccs graph forest where forest = {-# SCC "Digraph.scc" #-} scc (gr_int_graph graph) --- Find the set of strongly connected components starting from the --- given roots. This is a good way to discard unreachable nodes at --- the same time as computing SCCs. -stronglyConnCompFromG :: Graph node -> [node] -> [SCC node] -stronglyConnCompFromG graph roots = decodeSccs graph forest - where forest = {-# SCC "Digraph.scc" #-} sccFrom (gr_int_graph graph) vs - vs = [ v | Just v <- map (gr_node_to_vertex graph) roots ] - decodeSccs :: Graph node -> Forest Vertex -> [SCC node] decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest = map decode forest @@ -315,7 +307,13 @@ dfsTopSortG graph = reachableG :: Graph node -> node -> [node] reachableG graph from = map (gr_vertex_to_node graph) result where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from) - result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) from_vertex + result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex] + +reachablesG :: Graph node -> [node] -> [node] +reachablesG graph froms = map (gr_vertex_to_node graph) result + where result = {-# SCC "Digraph.reachable" #-} + reachable (gr_int_graph graph) vs + vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ] hasVertexG :: Graph node -> node -> Bool hasVertexG graph node = isJust $ gr_node_to_vertex graph node @@ -548,9 +546,6 @@ postorderF ts = foldr (.) id $ map postorder ts postOrd :: IntGraph -> [Vertex] postOrd g = postorderF (dff g) [] -postOrdFrom :: IntGraph -> [Vertex] -> [Vertex] -postOrdFrom g vs = postorderF (dfs g vs) [] - topSort :: IntGraph -> [Vertex] topSort = reverse . postOrd \end{code} @@ -574,9 +569,6 @@ undirected g = buildG (bounds g) (edges g ++ reverseE g) \begin{code} scc :: IntGraph -> Forest Vertex scc g = dfs g (reverse (postOrd (transpose g))) - -sccFrom :: IntGraph -> [Vertex] -> Forest Vertex -sccFrom g vs = reverse (dfs (transpose g) (reverse (postOrdFrom g vs))) \end{code} ------------------------------------------------------------ @@ -602,11 +594,11 @@ forward g tree pre = mapT select g ------------------------------------------------------------ \begin{code} -reachable :: IntGraph -> Vertex -> [Vertex] -reachable g v = preorderF (dfs g [v]) +reachable :: IntGraph -> [Vertex] -> [Vertex] +reachable g vs = preorderF (dfs g vs) path :: IntGraph -> Vertex -> Vertex -> Bool -path g v w = w `elem` (reachable g v) +path g v w = w `elem` (reachable g [v]) \end{code} ------------------------------------------------------------ diff --git a/testsuite/tests/codeGen/should_compile/T9155.hs b/testsuite/tests/codeGen/should_compile/T9155.hs new file mode 100644 index 0000000..6fac0bc --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T9155.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module M () where + +import Data.Bits ((.&.)) + +bitsSet :: Int -> Int -> Bool +bitsSet mask i + = (i .&. mask == mask) + +class Eq b => BitMask b where + assocBitMask :: [(b,Int)] + + fromBitMask :: Int -> b + fromBitMask i + = walk assocBitMask + where + walk [] = error "Graphics.UI.WX.Types.fromBitMask: empty list" + walk [(x,0)] = x + walk ((x,m):xs) | bitsSet m i = x + | otherwise = walk xs + +data Align = AlignLeft + | AlignCentre + deriving Eq + +instance BitMask Align where + assocBitMask + = [(AlignCentre,512) + ,(AlignLeft, 256) + ] diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 487b6b6..ae8d0dd 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -22,3 +22,4 @@ test('massive_array', test('T7237', normal, compile, ['']) test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, ['']) test('T8205', normal, compile, ['-O0']) +test('T9155', normal, compile, ['-O2']) From git at git.haskell.org Fri Jun 6 21:44:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jun 2014 21:44:53 +0000 (UTC) Subject: [commit: ghc] master: supress warning of bang wildcard pattern-binding (i.e. let !_ = rhs). This fixes #9127 (fbdebd3) Message-ID: <20140606214453.2013B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fbdebd30b9ff3ca76243791723b85959c6860083/ghc >--------------------------------------------------------------- commit fbdebd30b9ff3ca76243791723b85959c6860083 Author: Guido Zayas Date: Fri Jun 6 18:34:14 2014 +0200 supress warning of bang wildcard pattern-binding (i.e. let !_ = rhs). This fixes #9127 >--------------------------------------------------------------- fbdebd30b9ff3ca76243791723b85959c6860083 compiler/rename/RnBinds.lhs | 5 +++-- testsuite/tests/rename/should_compile/T9127.hs | 5 +++++ .../tests/rename/should_compile/T9127.stderr | 0 testsuite/tests/rename/should_compile/all.T | 1 + 4 files changed, 9 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 7d3224e..e65d317 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -476,8 +476,9 @@ rnBind _ bind@(PatBind { pat_lhs = pat bndrs = collectPatBinders pat bind' = bind { pat_rhs = grhss', bind_fvs = fvs' } is_wild_pat = case pat of - L _ (WildPat {}) -> True - _ -> False + L _ (WildPat {}) -> True + L _ (BangPat (L _ (WildPat {}))) -> True -- #9127 + _ -> False -- Warn if the pattern binds no variables, except for the -- entirely-explicit idiom _ = rhs diff --git a/testsuite/tests/rename/should_compile/T9127.hs b/testsuite/tests/rename/should_compile/T9127.hs new file mode 100644 index 0000000..c8e827f --- /dev/null +++ b/testsuite/tests/rename/should_compile/T9127.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE BangPatterns #-} +module T9127 where + +f = let !_ = 2 * 2 + in 2*2 diff --git a/libraries/base/tests/IO/misc001.stdout b/testsuite/tests/rename/should_compile/T9127.stderr similarity index 100% copy from libraries/base/tests/IO/misc001.stdout copy to testsuite/tests/rename/should_compile/T9127.stderr diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 0ce4ca1..4ed92bd 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -214,3 +214,4 @@ test('T7969', 'T7969.imports'])], run_command, ['$MAKE -s --no-print-directory T7969']) +test('T9127', normal, compile, ['']) From git at git.haskell.org Sat Jun 7 07:58:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 7 Jun 2014 07:58:39 +0000 (UTC) Subject: [commit: ghc] master: s/-hi-diffs/-ddump-hi-diffs/ in docs (#9179) (ab3f95b) Message-ID: <20140607075839.40A232406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab3f95bdfc5c001c7dd3158c52bad604d28aabf3/ghc >--------------------------------------------------------------- commit ab3f95bdfc5c001c7dd3158c52bad604d28aabf3 Author: Joachim Breitner Date: Sat Jun 7 09:57:32 2014 +0200 s/-hi-diffs/-ddump-hi-diffs/ in docs (#9179) >--------------------------------------------------------------- ab3f95bdfc5c001c7dd3158c52bad604d28aabf3 docs/users_guide/gone_wrong.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/gone_wrong.xml b/docs/users_guide/gone_wrong.xml index 114b06c..bb5fcb0 100644 --- a/docs/users_guide/gone_wrong.xml +++ b/docs/users_guide/gone_wrong.xml @@ -146,7 +146,7 @@ must be re-compiled. A useful option to alert you when interfaces change is - -hi-diffs + -ddump-hi-diffs option. It will run diff on the changed interface file, before and after, when applicable. @@ -167,7 +167,7 @@ % rm *.o # scrub your object files -% make my_prog # re-make your program; use -hi-diffs to highlight changes; +% make my_prog # re-make your program; use -ddump-hi-diffs to highlight changes; # as mentioned above, use -dcore-lint to be more paranoid % ./my_prog ... # retry... From git at git.haskell.org Sat Jun 7 08:09:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 7 Jun 2014 08:09:48 +0000 (UTC) Subject: [commit: ghc] master: Test case for #9181 (:browse GHC.TypeLits panic) (b36bc2f) Message-ID: <20140607080948.3C0AE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b36bc2f5a9757c2b7e6967893cf2883846b8ce91/ghc >--------------------------------------------------------------- commit b36bc2f5a9757c2b7e6967893cf2883846b8ce91 Author: Joachim Breitner Date: Sat Jun 7 10:09:40 2014 +0200 Test case for #9181 (:browse GHC.TypeLits panic) >--------------------------------------------------------------- b36bc2f5a9757c2b7e6967893cf2883846b8ce91 testsuite/tests/ghci/scripts/T9181.script | 1 + testsuite/tests/ghci/scripts/all.T | 1 + 2 files changed, 2 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T9181.script b/testsuite/tests/ghci/scripts/T9181.script new file mode 100644 index 0000000..b2239b9 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9181.script @@ -0,0 +1 @@ +:browse GHC.TypeLits diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 161e14b..1ae9105 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -174,3 +174,4 @@ test('T8917', normal, ghci_script, ['T8917.script']) test('T8931', normal, ghci_script, ['T8931.script']) test('T8959', normal, ghci_script, ['T8959.script']) test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script']) +test('T9181', expect_broken(9181), ghci_script, ['T9181.script']) From git at git.haskell.org Sat Jun 7 10:06:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 7 Jun 2014 10:06:45 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T8959' created Message-ID: <20140607100645.60C472406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T8959 Referencing: 4a4e684f4334a93fc2a52abb1e959989d3e61ed0 From git at git.haskell.org Sat Jun 7 10:06:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 7 Jun 2014 10:06:48 +0000 (UTC) Subject: [commit: ghc] wip/T8959: Pass the information on UnicodeSyntax from error location to the pretty-printer (4a4e684) Message-ID: <20140607100648.806712406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8959 Link : http://ghc.haskell.org/trac/ghc/changeset/4a4e684f4334a93fc2a52abb1e959989d3e61ed0/ghc >--------------------------------------------------------------- commit 4a4e684f4334a93fc2a52abb1e959989d3e61ed0 Author: Joachim Breitner Date: Sat Jun 7 12:05:51 2014 +0200 Pass the information on UnicodeSyntax from error location to the pretty-printer This improves upon #8959. >--------------------------------------------------------------- 4a4e684f4334a93fc2a52abb1e959989d3e61ed0 compiler/llvmGen/LlvmCodeGen/Base.hs | 4 +-- compiler/main/DynFlags.hs | 2 +- compiler/main/ErrUtils.lhs | 29 +++++++++++------ compiler/utils/Outputable.lhs | 63 ++++++++++++++++++++---------------- 4 files changed, 58 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 4a4e684f4334a93fc2a52abb1e959989d3e61ed0 From git at git.haskell.org Sat Jun 7 12:51:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 7 Jun 2014 12:51:17 +0000 (UTC) Subject: [commit: ghc] master: Pretty-print built in synonym families in interfaces (96a8980) Message-ID: <20140607125117.5778E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/96a8980183ed12a354db1b92f271b98bccce9ae8/ghc >--------------------------------------------------------------- commit 96a8980183ed12a354db1b92f271b98bccce9ae8 Author: Joachim Breitner Date: Sat Jun 7 13:18:55 2014 +0200 Pretty-print built in synonym families in interfaces This closes #9181. >--------------------------------------------------------------- 96a8980183ed12a354db1b92f271b98bccce9ae8 compiler/iface/IfaceSyn.lhs | 5 ++++ compiler/iface/MkIface.lhs | 2 +- compiler/iface/TcIface.lhs | 2 ++ testsuite/tests/ghci/scripts/T9181.stdout | 50 +++++++++++++++++++++++++++++++ testsuite/tests/ghci/scripts/all.T | 2 +- 5 files changed, 59 insertions(+), 2 deletions(-) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 79e2359..afd7363 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -275,6 +275,7 @@ data IfaceSynTyConRhs [IfaceAxBranch] -- for pretty printing purposes only | IfaceAbstractClosedSynFamilyTyCon | IfaceSynonymTyCon IfaceType + | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only instance Binary IfaceSynTyConRhs where put_ bh IfaceOpenSynFamilyTyCon = putByte bh 0 @@ -282,6 +283,8 @@ instance Binary IfaceSynTyConRhs where >> put_ bh br put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2 put_ bh (IfaceSynonymTyCon ty) = putByte bh 3 >> put_ bh ty + put_ _ IfaceBuiltInSynFamTyCon + = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" empty get bh = do { h <- getByte bh ; case h of @@ -1255,6 +1258,7 @@ pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars pp_rhs IfaceOpenSynFamilyTyCon = ppShowIface ss (ptext (sLit "open")) pp_rhs IfaceAbstractClosedSynFamilyTyCon = ppShowIface ss (ptext (sLit "closed, abstract")) pp_rhs (IfaceClosedSynFamilyTyCon _ (_:_)) = ptext (sLit "where") + pp_rhs IfaceBuiltInSynFamTyCon = ppShowIface ss (ptext (sLit "built-in")) pp_rhs _ = panic "pprIfaceDecl syn" pp_branches (IfaceClosedSynFamilyTyCon ax brs) @@ -1635,6 +1639,7 @@ freeNamesIfSynRhs IfaceOpenSynFamilyTyCon = emptyNameSet freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax br) = unitNameSet ax &&& fnList freeNamesIfAxBranch br freeNamesIfSynRhs IfaceAbstractClosedSynFamilyTyCon = emptyNameSet +freeNamesIfSynRhs IfaceBuiltInSynFamTyCon = emptyNameSet freeNamesIfContext :: IfaceContext -> NameSet freeNamesIfContext = fnList freeNamesIfType diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index e3c0ac3..f2d2058 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1626,7 +1626,7 @@ tyConToIfaceDecl env tycon = IfaceSynonymTyCon (tidyToIfaceType env1 ty) to_ifsyn_rhs (BuiltInSynFamTyCon {}) - = pprPanic "toIfaceDecl: BuiltInFamTyCon" (ppr tycon) + = IfaceBuiltInSynFamTyCon ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index e4a415a..1a2a447 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -494,6 +494,8 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, tc_syn_rhs IfaceAbstractClosedSynFamilyTyCon = return AbstractClosedSynFamilyTyCon tc_syn_rhs (IfaceSynonymTyCon ty) = do { rhs_ty <- tcIfaceType ty ; return (SynonymTyCon rhs_ty) } + tc_syn_rhs IfaceBuiltInSynFamTyCon = pprPanic "tc_iface_decl" + (ptext (sLit "IfaceBuiltInSynFamTyCon in interface file")) tc_iface_decl _parent ignore_prags (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ, diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout new file mode 100644 index 0000000..fb9cf5d --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9181.stdout @@ -0,0 +1,50 @@ +type family (GHC.TypeLits.*) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +type family (GHC.TypeLits.+) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +type family (GHC.TypeLits.-) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +type (GHC.TypeLits.<=) (x :: GHC.TypeLits.Nat) + (y :: GHC.TypeLits.Nat) = + (x GHC.TypeLits.<=? y) ~ 'True +type family (GHC.TypeLits.<=?) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + Bool +type family GHC.TypeLits.CmpNat (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + Ordering +type family GHC.TypeLits.CmpSymbol (a :: GHC.TypeLits.Symbol) + (b :: GHC.TypeLits.Symbol) :: + Ordering +class GHC.TypeLits.KnownNat (n :: GHC.TypeLits.Nat) where + GHC.TypeLits.natSing :: GHC.TypeLits.SNat n +class GHC.TypeLits.KnownSymbol (n :: GHC.TypeLits.Symbol) where + GHC.TypeLits.symbolSing :: GHC.TypeLits.SSymbol n +data GHC.TypeLits.Nat +data GHC.TypeLits.SomeNat where + GHC.TypeLits.SomeNat :: GHC.TypeLits.KnownNat n => + (Data.Proxy.Proxy n) -> GHC.TypeLits.SomeNat +data GHC.TypeLits.SomeSymbol where + GHC.TypeLits.SomeSymbol :: GHC.TypeLits.KnownSymbol n => + (Data.Proxy.Proxy n) -> GHC.TypeLits.SomeSymbol +data GHC.TypeLits.Symbol +type family (GHC.TypeLits.^) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +GHC.TypeLits.natVal :: + GHC.TypeLits.KnownNat n => proxy n -> Integer +GHC.TypeLits.sameNat :: + (GHC.TypeLits.KnownNat a, GHC.TypeLits.KnownNat b) => + Data.Proxy.Proxy a + -> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b) +GHC.TypeLits.sameSymbol :: + (GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) => + Data.Proxy.Proxy a + -> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b) +GHC.TypeLits.someNatVal :: Integer -> Maybe GHC.TypeLits.SomeNat +GHC.TypeLits.someSymbolVal :: String -> GHC.TypeLits.SomeSymbol +GHC.TypeLits.symbolVal :: + GHC.TypeLits.KnownSymbol n => proxy n -> String diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 1ae9105..b71dfd1 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -174,4 +174,4 @@ test('T8917', normal, ghci_script, ['T8917.script']) test('T8931', normal, ghci_script, ['T8931.script']) test('T8959', normal, ghci_script, ['T8959.script']) test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script']) -test('T9181', expect_broken(9181), ghci_script, ['T9181.script']) +test('T9181', normal, ghci_script, ['T9181.script']) From git at git.haskell.org Sun Jun 8 10:21:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jun 2014 10:21:47 +0000 (UTC) Subject: [commit: ghc] master: Fix obscure problem with using the system linker (#8935) (2f8b4c9) Message-ID: <20140608102147.C8E222406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f8b4c9330b455d4cb31c186c747a7db12a69251/ghc >--------------------------------------------------------------- commit 2f8b4c9330b455d4cb31c186c747a7db12a69251 Author: Simon Marlow Date: Sun Jun 8 09:46:20 2014 +0100 Fix obscure problem with using the system linker (#8935) See Note [RTLD_LOCAL] for a summary of the problem and solution, and >--------------------------------------------------------------- 2f8b4c9330b455d4cb31c186c747a7db12a69251 compiler/ghci/Linker.lhs | 72 ++++++++++++++++++++++++++++++++---------------- rts/Linker.c | 43 +++++++++++++++++++++++------ 2 files changed, 83 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2f8b4c9330b455d4cb31c186c747a7db12a69251 From git at git.haskell.org Sun Jun 8 10:21:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jun 2014 10:21:50 +0000 (UTC) Subject: [commit: ghc] master: Raise exceptions when blocked in bad FDs (fixes Trac #4934) (9fd507e) Message-ID: <20140608102150.591202406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9fd507e5758f4141ac2619f0db57136bcab035c6/ghc >--------------------------------------------------------------- commit 9fd507e5758f4141ac2619f0db57136bcab035c6 Author: Sergei Trofimovich Date: Fri May 23 23:58:06 2014 +0300 Raise exceptions when blocked in bad FDs (fixes Trac #4934) Before the patch any call to 'select()' with 'bad_fd' led to: - unblocking of all threads - hiding exception for 'threadWaitRead bad_fd' The patch fixes both cases in this way: after 'select()' failure we iterate over each blocked descriptor and poll individually to see it's actual status, which is: - READY (move to run queue) - BLOCKED (leave in blocked queue) - INVALID (send an IOErrror exception) Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 9fd507e5758f4141ac2619f0db57136bcab035c6 libraries/base/GHC/Event/Thread.hs | 6 +- rts/Prelude.h | 2 + rts/RtsStartup.c | 1 + rts/package.conf.in | 2 + rts/posix/Select.c | 179 +++++++++++++++++++++++++++---------- rts/win32/libHSbase.def | 3 +- 6 files changed, 144 insertions(+), 49 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9fd507e5758f4141ac2619f0db57136bcab035c6 From git at git.haskell.org Sun Jun 8 10:21:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jun 2014 10:21:52 +0000 (UTC) Subject: [commit: ghc] master: Don't use showPass in the backend (#8973) (c025817) Message-ID: <20140608102152.D0B9E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0258176ad255ac42a68df75ac4287630a6c82c0/ghc >--------------------------------------------------------------- commit c0258176ad255ac42a68df75ac4287630a6c82c0 Author: Simon Marlow Date: Sun Jun 8 11:17:57 2014 +0100 Don't use showPass in the backend (#8973) >--------------------------------------------------------------- c0258176ad255ac42a68df75ac4287630a6c82c0 compiler/cmm/CmmPipeline.hs | 2 -- compiler/codeGen/StgCmm.hs | 5 +---- compiler/main/CodeOutput.lhs | 1 - compiler/main/HscMain.hs | 23 +++++++++++++++-------- 4 files changed, 16 insertions(+), 15 deletions(-) diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 825ffb8..4314695 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -38,8 +38,6 @@ cmmPipeline :: HscEnv -- Compilation env including cmmPipeline hsc_env topSRT prog = do let dflags = hsc_dflags hsc_env - showPass dflags "CPSZ" - tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog (topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index 740ab5f..efc89fe 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -39,7 +39,6 @@ import DataCon import Name import TyCon import Module -import ErrUtils import Outputable import Stream import BasicTypes @@ -62,9 +61,7 @@ codeGen :: DynFlags codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info - = do { liftIO $ showPass dflags "New CodeGen" - - -- cg: run the code generator, and yield the resulting CmmGroup + = do { -- cg: run the code generator, and yield the resulting CmmGroup -- Using an IORef to store the state is a bit crude, but otherwise -- we would need to add a state monad layer. ; cgref <- liftIO $ newIORef =<< initC diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 7ae28b3..c0a609b 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -74,7 +74,6 @@ codeOutput dflags this_mod filenm location foreign_stubs pkg_deps cmm_stream ; return cmm } - ; showPass dflags "CodeOutput" ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs ; case hscTarget dflags of { HscAsm -> outputAsm dflags this_mod filenm linted_cmm_stream; diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 9b6c4d7..ea31ed7 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1150,8 +1150,15 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do ------------------ Code generation ------------------ - cmms <- {-# SCC "NewCodeGen" #-} - tryNewCodeGen hsc_env this_mod data_tycons + -- The back-end is streamed: each top-level function goes + -- from Stg all the way to asm before dealing with the next + -- top-level function, so showPass isn't very useful here. + -- Hence we have one showPass for the whole backend, the + -- next showPass after this will be "Assembler". + showPass dflags "CodeGen" + + cmms <- {-# SCC "StgCmm" #-} + doCodeGen hsc_env this_mod data_tycons cost_centre_info stg_binds hpc_info @@ -1228,15 +1235,15 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do -------------------- Stuff for new code gen --------------------- -tryNewCodeGen :: HscEnv -> Module -> [TyCon] - -> CollectedCCs - -> [StgBinding] - -> HpcInfo - -> IO (Stream IO CmmGroup ()) +doCodeGen :: HscEnv -> Module -> [TyCon] + -> CollectedCCs + -> [StgBinding] + -> HpcInfo + -> IO (Stream IO CmmGroup ()) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. -tryNewCodeGen hsc_env this_mod data_tycons +doCodeGen hsc_env this_mod data_tycons cost_centre_info stg_binds hpc_info = do let dflags = hsc_dflags hsc_env From git at git.haskell.org Sun Jun 8 10:21:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jun 2014 10:21:55 +0000 (UTC) Subject: [commit: ghc] master: Remove unused --run-cps/--run-cpsz options (70f58eb) Message-ID: <20140608102155.652342406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70f58ebfefd47b724a3b0aa3aca50442f937e6eb/ghc >--------------------------------------------------------------- commit 70f58ebfefd47b724a3b0aa3aca50442f937e6eb Author: Simon Marlow Date: Sun Jun 8 10:24:25 2014 +0100 Remove unused --run-cps/--run-cpsz options >--------------------------------------------------------------- 70f58ebfefd47b724a3b0aa3aca50442f937e6eb compiler/main/DynFlags.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0c49386..7222af3 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -406,8 +406,6 @@ data GeneralFlag | Opt_SuppressUniques -- temporary flags - | Opt_RunCPS - | Opt_RunCPSZ | Opt_AutoLinkPackages | Opt_ImplicitImportQualified @@ -2668,8 +2666,6 @@ fFlags = [ ( "break-on-error", Opt_BreakOnError, nop ), ( "print-evld-with-show", Opt_PrintEvldWithShow, nop ), ( "print-bind-contents", Opt_PrintBindContents, nop ), - ( "run-cps", Opt_RunCPS, nop ), - ( "run-cpsz", Opt_RunCPSZ, nop ), ( "vectorise", Opt_Vectorise, nop ), ( "vectorisation-avoidance", Opt_VectorisationAvoidance, nop ), ( "regs-graph", Opt_RegsGraph, nop ), From git at git.haskell.org Sun Jun 8 21:32:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jun 2014 21:32:28 +0000 (UTC) Subject: [commit: ghc] wip/ext-solver: Refactor and fix bug. (a705a08) Message-ID: <20140608213228.E888F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ext-solver Link : http://ghc.haskell.org/trac/ghc/changeset/a705a086cf4cc74c3db2e85318230f69bb70362b/ghc >--------------------------------------------------------------- commit a705a086cf4cc74c3db2e85318230f69bb70362b Author: Iavor S. Diatchki Date: Sun Jun 8 14:32:16 2014 -0700 Refactor and fix bug. Now we start a new copy of the solver for each major action we need to perform (improvement or solving). This does lead to a little repeated work but not much: we just end asserting the givens in nested implications multiple times. Since implications tend not be nested very many times, and usually there aren't many givens anyway, this should not be a problem. Note that we are still making extensive use if the solver's incremental abilities: each of the major actions we perform makes multiple calls to the solver, and it is important that we can reuse the state we've already built up. >--------------------------------------------------------------- a705a086cf4cc74c3db2e85318230f69bb70362b compiler/typecheck/TcInteract.lhs | 64 ++++++++++++++++++++++++--------------- compiler/typecheck/TcSMonad.lhs | 37 +++------------------- compiler/typecheck/TcTypeNats.hs | 33 ++++++-------------- 3 files changed, 52 insertions(+), 82 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a705a086cf4cc74c3db2e85318230f69bb70362b From git at git.haskell.org Mon Jun 9 01:37:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 01:37:49 +0000 (UTC) Subject: [commit: ghc] wip/ext-solver: Remember to stop the solver when done. Also more debugging. (ee59040) Message-ID: <20140609013749.B00782406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ext-solver Link : http://ghc.haskell.org/trac/ghc/changeset/ee5904026fddc859289762c3d8b820e60bc4790d/ghc >--------------------------------------------------------------- commit ee5904026fddc859289762c3d8b820e60bc4790d Author: Iavor S. Diatchki Date: Sun Jun 8 16:24:45 2014 -0700 Remember to stop the solver when done. Also more debugging. >--------------------------------------------------------------- ee5904026fddc859289762c3d8b820e60bc4790d compiler/typecheck/TcInteract.lhs | 72 ++++++++++++++++++++++----------------- 1 file changed, 40 insertions(+), 32 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 07eb8f2..babaeb6 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -48,6 +48,8 @@ import Unique( hasKey ) import FastString ( sLit, fsLit ) import DynFlags import Util + +import System.IO(hPutStrLn,stderr) \end{code} ********************************************************************** @@ -142,7 +144,8 @@ solveInteractWithExtern inGivenStage cts interactExternSolver :: Bool -- ^ Are we in given stage? -> TcS Bool -- ^ Did we generatew new work. interactExternSolver inGivenStage = - do iSet <- getTcSInerts + do extSol $ hPutStrLn stderr $ "=== EXT SOL: " ++ (if inGivenStage then "[G]" else "[W/D]") + iSet <- getTcSInerts let iCans = inert_cans iSet relevantCt @@ -168,44 +171,42 @@ interactExternSolver inGivenStage = (vcat $ map ppr othersList)) - sol <- extSol $ newExternalSolver "cvc4" - [ "--incremental", "--lang=smtlib2" ] - - extSol $ extSolAssert sol othersList + withSol $ \sol -> + do extSol $ extSolAssert sol othersList - res <- extSol $ extSolImprove sol inGivenStage relList - case res of + res <- extSol $ extSolImprove sol inGivenStage relList + case res of - -- Kick-out constraints that lead to a contradiciton - -- and add them as insoluable. - ExtSolContradiction bad_feqs ok_feqs -> - do rebuildInerts ok_feqs - mapM_ emitInsoluble bad_feqs - return False + -- Kick-out constraints that lead to a contradiciton + -- and add them as insoluable. + ExtSolContradiction bad_feqs ok_feqs -> + do rebuildInerts ok_feqs + mapM_ emitInsoluble bad_feqs + return False - -- Consistent - ExtSolOk newWork + -- Consistent + ExtSolOk newWork - -- We found some new work to do. - | not (null newWork) -> - do updWorkListTcS (extendWorkListEqs newWork) - return True + -- We found some new work to do. + | not (null newWork) -> + do updWorkListTcS (extendWorkListEqs newWork) + return True - -- Nothing else to do. - | inGivenStage -> return False + -- Nothing else to do. + | inGivenStage -> return False - -- No new work, try to solve wanted constraints. - | otherwise -> - do let (wanteds, derived) = partition isWantedCt relList - (solved, unsolved) <- extSol $ extSolSolve sol wanteds - case solved of - [] -> return False -- Shortcut for common case. - _ -> do rebuildInerts (unsolved ++ derived) - let setEv (ev,ct) = - setEvBind (ctev_evar (cc_ev ct)) ev - mapM_ setEv solved - return False + -- No new work, try to solve wanted constraints. + | otherwise -> + do let (wanteds, derived) = partition isWantedCt relList + (solved, unsolved) <- extSol $ extSolSolve sol wanteds + case solved of + [] -> return False -- Shortcut for common case. + _ -> do rebuildInerts (unsolved ++ derived) + let setEv (ev,ct) = + setEvBind (ctev_evar (cc_ev ct)) ev + mapM_ setEv solved + return False where addCt ct mp = @@ -213,6 +214,13 @@ interactExternSolver inGivenStage = CFunEqCan { cc_fun = tc, cc_tyargs = tys } -> addFunEq mp tc tys ct _ -> panic "Not FunEq constraint while rebuilding external work." + withSol k = do s <- extSol (newExternalSolver "cvc4" + [ "--incremental", "--lang=smtlib2" ]) + + a <- k s + extSol (extSolStop s) + return a + type WorkItem = Ct From git at git.haskell.org Mon Jun 9 01:37:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 01:37:52 +0000 (UTC) Subject: [commit: ghc] wip/ext-solver: Bugfix: avoid non-termination. (a1b3e4d) Message-ID: <20140609013752.4CD582406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ext-solver Link : http://ghc.haskell.org/trac/ghc/changeset/a1b3e4d0ded3f434dbfca9fe92ed7fbc42f2bf0c/ghc >--------------------------------------------------------------- commit a1b3e4d0ded3f434dbfca9fe92ed7fbc42f2bf0c Author: Iavor S. Diatchki Date: Sun Jun 8 18:37:35 2014 -0700 Bugfix: avoid non-termination. When we compute new derived work, we need to check that the result is not already in the inert set. If we don't do this, we keep finding the same constraints over and over again, if they don't do anything to the inert set. >--------------------------------------------------------------- a1b3e4d0ded3f434dbfca9fe92ed7fbc42f2bf0c compiler/typecheck/TcInteract.lhs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index babaeb6..3d057ae 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -156,6 +156,8 @@ interactExternSolver inGivenStage = relList = bagToList relFeqs othersList = funEqsToList otherFeqs + eqs = inert_eqs iCans + {- `survived` should be a sub-set of the inert funeqs. This function rebuilds the inert set, after we've remove a constraint (e.g., because they were solved, or caused a contradiciton. -} @@ -189,8 +191,11 @@ interactExternSolver inGivenStage = ExtSolOk newWork -- We found some new work to do. - | not (null newWork) -> - do updWorkListTcS (extendWorkListEqs newWork) + | let reallyNew + | inGivenStage = newWork + | otherwise = filter (notKnownEq eqs) newWork + , not (null reallyNew) -> + do updWorkListTcS (extendWorkListEqs reallyNew) return True -- Nothing else to do. @@ -208,7 +213,17 @@ interactExternSolver inGivenStage = mapM_ setEv solved return False + where + notKnownEq eqs ct = + case getEqPredTys_maybe (ctPred ct) of + Just (_,tvt,ty) + | Just tv <- getTyVar_maybe tvt -> + all (not . tcEqType ty) + [ t | CTyEqCan { cc_rhs = t } <- findTyEqs eqs tv ] + _ -> True + + addCt ct mp = case ct of CFunEqCan { cc_fun = tc, cc_tyargs = tys } -> addFunEq mp tc tys ct From git at git.haskell.org Mon Jun 9 12:06:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 12:06:34 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add ".text.unlikely" to recognized code sections on Windows. (b10b1a6) Message-ID: <20140609120634.640982406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/b10b1a6099d43b8b6b1fbae7a548668cdcf51bd3/ghc >--------------------------------------------------------------- commit b10b1a6099d43b8b6b1fbae7a548668cdcf51bd3 Author: Niklas Larsson Date: Sun May 25 11:54:13 2014 +0200 Add ".text.unlikely" to recognized code sections on Windows. Fixes #9080 Signed-off-by: Austin Seipp (cherry picked from commit 56ea745c3dd00c87ad86b80f91a31ced5e86e488) >--------------------------------------------------------------- b10b1a6099d43b8b6b1fbae7a548668cdcf51bd3 rts/Linker.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/Linker.c b/rts/Linker.c index 26c7bc9..47b4008 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -4053,6 +4053,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strcmp(".text",(char*)secname) || 0==strcmp(".text.startup",(char*)secname) || + 0==strcmp(".text.unlikely", (char*)secname) || 0==strcmp(".rdata",(char*)secname)|| 0==strcmp(".eh_frame", (char*)secname)|| 0==strcmp(".rodata",(char*)secname)) From git at git.haskell.org Mon Jun 9 12:06:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 12:06:36 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix discarding of unreachable code in the register allocator (#9155) (e0a036c) Message-ID: <20140609120637.413FC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/e0a036cda266fe68b73d87fd087e9b300589bcdf/ghc >--------------------------------------------------------------- commit e0a036cda266fe68b73d87fd087e9b300589bcdf Author: Simon Marlow Date: Fri Jun 6 09:52:13 2014 +0100 Fix discarding of unreachable code in the register allocator (#9155) A previous fix to this was wrong: f5879acd018494b84233f26fba828ce376d0f81d and left some unreachable code behind. So rather than try to be clever and do this at the same time as the strongly-connected-component analysis, I'm doing a separate reachability pass first. (cherry picked from commit e577a52363ee7ee8a07f1d863988332ae8fbf2e4) >--------------------------------------------------------------- e0a036cda266fe68b73d87fd087e9b300589bcdf compiler/nativeGen/RegAlloc/Liveness.hs | 14 +++++++---- compiler/utils/Digraph.lhs | 32 ++++++++++--------------- testsuite/tests/codeGen/should_compile/T9155.hs | 30 +++++++++++++++++++++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 4 files changed, 53 insertions(+), 24 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index 6dd4cec..d431993 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -665,14 +665,20 @@ sccBlocks sccBlocks blocks entries = map (fmap get_node) sccs where - sccs = stronglyConnCompFromG graph roots - - graph = graphFromEdgedVertices nodes - -- nodes :: [(NatBasicBlock instr, Unique, [Unique])] nodes = [ (block, id, getOutEdges instrs) | block@(BasicBlock id instrs) <- blocks ] + g1 = graphFromEdgedVertices nodes + + reachable :: BlockSet + reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ] + + g2 = graphFromEdgedVertices [ node | node@(_,id,_) <- nodes + , id `setMember` reachable ] + + sccs = stronglyConnCompG g2 + get_node (n, _, _) = n getOutEdges :: Instruction instr => [instr] -> [BlockId] diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs index cc68430..6dba912 100644 --- a/compiler/utils/Digraph.lhs +++ b/compiler/utils/Digraph.lhs @@ -15,10 +15,10 @@ module Digraph( Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices, SCC(..), Node, flattenSCC, flattenSCCs, - stronglyConnCompG, stronglyConnCompFromG, + stronglyConnCompG, topologicalSortG, dfsTopSortG, verticesG, edgesG, hasVertexG, - reachableG, transposeG, + reachableG, reachablesG, transposeG, outdegreeG, indegreeG, vertexGroupsG, emptyG, componentsG, @@ -258,14 +258,6 @@ stronglyConnCompG :: Graph node -> [SCC node] stronglyConnCompG graph = decodeSccs graph forest where forest = {-# SCC "Digraph.scc" #-} scc (gr_int_graph graph) --- Find the set of strongly connected components starting from the --- given roots. This is a good way to discard unreachable nodes at --- the same time as computing SCCs. -stronglyConnCompFromG :: Graph node -> [node] -> [SCC node] -stronglyConnCompFromG graph roots = decodeSccs graph forest - where forest = {-# SCC "Digraph.scc" #-} sccFrom (gr_int_graph graph) vs - vs = [ v | Just v <- map (gr_node_to_vertex graph) roots ] - decodeSccs :: Graph node -> Forest Vertex -> [SCC node] decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest = map decode forest @@ -315,7 +307,13 @@ dfsTopSortG graph = reachableG :: Graph node -> node -> [node] reachableG graph from = map (gr_vertex_to_node graph) result where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from) - result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) from_vertex + result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex] + +reachablesG :: Graph node -> [node] -> [node] +reachablesG graph froms = map (gr_vertex_to_node graph) result + where result = {-# SCC "Digraph.reachable" #-} + reachable (gr_int_graph graph) vs + vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ] hasVertexG :: Graph node -> node -> Bool hasVertexG graph node = isJust $ gr_node_to_vertex graph node @@ -548,9 +546,6 @@ postorderF ts = foldr (.) id $ map postorder ts postOrd :: IntGraph -> [Vertex] postOrd g = postorderF (dff g) [] -postOrdFrom :: IntGraph -> [Vertex] -> [Vertex] -postOrdFrom g vs = postorderF (dfs g vs) [] - topSort :: IntGraph -> [Vertex] topSort = reverse . postOrd \end{code} @@ -574,9 +569,6 @@ undirected g = buildG (bounds g) (edges g ++ reverseE g) \begin{code} scc :: IntGraph -> Forest Vertex scc g = dfs g (reverse (postOrd (transpose g))) - -sccFrom :: IntGraph -> [Vertex] -> Forest Vertex -sccFrom g vs = reverse (dfs (transpose g) (reverse (postOrdFrom g vs))) \end{code} ------------------------------------------------------------ @@ -602,11 +594,11 @@ forward g tree pre = mapT select g ------------------------------------------------------------ \begin{code} -reachable :: IntGraph -> Vertex -> [Vertex] -reachable g v = preorderF (dfs g [v]) +reachable :: IntGraph -> [Vertex] -> [Vertex] +reachable g vs = preorderF (dfs g vs) path :: IntGraph -> Vertex -> Vertex -> Bool -path g v w = w `elem` (reachable g v) +path g v w = w `elem` (reachable g [v]) \end{code} ------------------------------------------------------------ diff --git a/testsuite/tests/codeGen/should_compile/T9155.hs b/testsuite/tests/codeGen/should_compile/T9155.hs new file mode 100644 index 0000000..6fac0bc --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T9155.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module M () where + +import Data.Bits ((.&.)) + +bitsSet :: Int -> Int -> Bool +bitsSet mask i + = (i .&. mask == mask) + +class Eq b => BitMask b where + assocBitMask :: [(b,Int)] + + fromBitMask :: Int -> b + fromBitMask i + = walk assocBitMask + where + walk [] = error "Graphics.UI.WX.Types.fromBitMask: empty list" + walk [(x,0)] = x + walk ((x,m):xs) | bitsSet m i = x + | otherwise = walk xs + +data Align = AlignLeft + | AlignCentre + deriving Eq + +instance BitMask Align where + assocBitMask + = [(AlignCentre,512) + ,(AlignLeft, 256) + ] diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 487b6b6..ae8d0dd 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -22,3 +22,4 @@ test('massive_array', test('T7237', normal, compile, ['']) test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, ['']) test('T8205', normal, compile, ['-O0']) +test('T9155', normal, compile, ['-O2']) From git at git.haskell.org Mon Jun 9 12:06:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 12:06:39 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix compilation of cmm files with -outputdir (Trac #9050) (2f5a760) Message-ID: <20140609120639.7A4DC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/2f5a760fbefe8372257ecf27d2af7f34d8a1c05c/ghc >--------------------------------------------------------------- commit 2f5a760fbefe8372257ecf27d2af7f34d8a1c05c Author: Yuras Shumovich Date: Fri May 2 00:11:58 2014 +0300 Fix compilation of cmm files with -outputdir (Trac #9050) (cherry picked from commit 2a463ebeba4dff6793ae16707712f1e9245225e8) >--------------------------------------------------------------- 2f5a760fbefe8372257ecf27d2af7f34d8a1c05c compiler/main/CodeOutput.lhs | 7 ++----- testsuite/tests/driver/T9050.cmm | 1 + testsuite/tests/driver/all.T | 4 ++++ 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index b8b1872..4a69aac 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -190,11 +190,8 @@ outputForeignStubs dflags mod location stubs stub_c <- newTempName dflags "c" case stubs of - NoStubs -> do - -- When compiling External Core files, may need to use stub - -- files from a previous compilation - stub_h_exists <- doesFileExist stub_h - return (stub_h_exists, Nothing) + NoStubs -> + return (False, Nothing) ForeignStubs h_code c_code -> do let diff --git a/testsuite/tests/driver/T9050.cmm b/testsuite/tests/driver/T9050.cmm new file mode 100644 index 0000000..8b1a393 --- /dev/null +++ b/testsuite/tests/driver/T9050.cmm @@ -0,0 +1 @@ +// empty diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index ed0ce0f..69f4cd3 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -395,3 +395,7 @@ test('T2507', test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703']) test('T8101', normal, compile, ['-Wall -fno-code']) +def build_T9050(name, way): + return simple_build(name + '.cmm', way, '-outputdir=. ', 0, '', 0, 0, 0) +test('T9050', normal, build_T9050, []) + From git at git.haskell.org Mon Jun 9 12:06:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 12:06:42 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Emit error in case of duplicate GRE; fixes #7241 (53e65ef) Message-ID: <20140609120642.310A92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/53e65efdb76fb3463da4f37954f4d397cdc42cd6/ghc >--------------------------------------------------------------- commit 53e65efdb76fb3463da4f37954f4d397cdc42cd6 Author: Yuras Shumovich Date: Thu Jun 5 07:56:05 2014 -0500 Emit error in case of duplicate GRE; fixes #7241 Signed-off-by: Austin Seipp (cherry picked from commit c226d25fef519db663d0c9efe7845637423f1dca) Conflicts: testsuite/tests/th/all.T >--------------------------------------------------------------- 53e65efdb76fb3463da4f37954f4d397cdc42cd6 compiler/rename/RnEnv.lhs | 21 ++++++++++++++------- testsuite/tests/th/T7241.hs | 7 +++++++ testsuite/tests/th/T7241.stderr | 6 ++++++ testsuite/tests/th/T8932.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 5 files changed, 34 insertions(+), 7 deletions(-) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index cfd1f48..c4dae11 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -270,22 +270,29 @@ lookupExactOcc name ; return name } - (gre:_) -> return (gre_name gre) } + [gre] -> return (gre_name gre) + (gre:_) -> do {addErr dup_nm_err + ; return (gre_name gre) + } -- We can get more than one GRE here, if there are multiple - -- bindings for the same name; but there will already be a - -- reported error for the duplicate. (If we add the error - -- rather than stopping when we encounter it.) - -- So all we need do here is not crash. - -- Example is Trac #8932: + -- bindings for the same name. Sometimes they are catched later + -- by findLocalDupsRdrEnv, like in the this example (Trac #8932): -- $( [d| foo :: a->a; foo x = x |]) -- foo = True - -- Here the 'foo' in the splice turns into an Exact Name + -- But when the names are totally identical, we get panic (Trac #7241): + -- $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]]) + -- So, lets emit error here, even if it will lead to two errors in some cases. + } where exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope")) 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") , ptext (sLit "perhaps via newName, but did not bind it") , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) + dup_nm_err = hang (ptext (sLit "Duplicate exact Name") <+> quotes (ppr $ nameOccName name)) + 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") + , ptext (sLit "perhaps via newName, but bound it multiple times") + , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) ----------------------------------------------- lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name diff --git a/testsuite/tests/th/T7241.hs b/testsuite/tests/th/T7241.hs new file mode 100644 index 0000000..971a267 --- /dev/null +++ b/testsuite/tests/th/T7241.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T7241 where + +import Language.Haskell.TH + +$(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] []]) diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr new file mode 100644 index 0000000..343cdc8 --- /dev/null +++ b/testsuite/tests/th/T7241.stderr @@ -0,0 +1,6 @@ + +T7241.hs:7:3: + Duplicate exact Name ?Foo? + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr index 0e0f977..c861235 100644 --- a/testsuite/tests/th/T8932.stderr +++ b/testsuite/tests/th/T8932.stderr @@ -1,4 +1,10 @@ +T8932.hs:5:3: + Duplicate exact Name ?foo? + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful + T8932.hs:11:1: Multiple declarations of ?foo? Declared at: T8932.hs:5:3 diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index cbe08ad..841b41b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -322,3 +322,4 @@ test('T8759a', normal, compile_fail, ['-v0']) test('T8884', normal, compile, ['-v0']) test('T8932', normal, compile_fail, ['-v0']) test('T8954', normal, compile, ['-v0']) +test('T7241', normal, compile_fail, ['-v0']) From git at git.haskell.org Mon Jun 9 12:06:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 12:06:44 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix obscure problem with using the system linker (#8935) (72bd832) Message-ID: <20140609120644.B92862406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/72bd832eb87975c504654a65f9c88daaa478f677/ghc >--------------------------------------------------------------- commit 72bd832eb87975c504654a65f9c88daaa478f677 Author: Simon Marlow Date: Sun Jun 8 09:46:20 2014 +0100 Fix obscure problem with using the system linker (#8935) See Note [RTLD_LOCAL] for a summary of the problem and solution, and (cherry picked from commit 2f8b4c9330b455d4cb31c186c747a7db12a69251) >--------------------------------------------------------------- 72bd832eb87975c504654a65f9c88daaa478f677 compiler/ghci/Linker.lhs | 72 ++++++++++++++++++++++++++++++++---------------- rts/Linker.c | 43 +++++++++++++++++++++++------ 2 files changed, 83 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 72bd832eb87975c504654a65f9c88daaa478f677 From git at git.haskell.org Mon Jun 9 12:31:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 12:31:48 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: 7.8.3 release notes. (8d457be) Message-ID: <20140609123149.106C52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/8d457befc8704a9e127155a1f91ab1e73f446a5b/ghc >--------------------------------------------------------------- commit 8d457befc8704a9e127155a1f91ab1e73f446a5b Author: Austin Seipp Date: Mon Jun 9 07:31:40 2014 -0500 7.8.3 release notes. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8d457befc8704a9e127155a1f91ab1e73f446a5b docs/users_guide/7.8.3-notes.xml | 47 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 44 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/7.8.3-notes.xml b/docs/users_guide/7.8.3-notes.xml index 1b88f5b..9d71cf5 100644 --- a/docs/users_guide/7.8.3-notes.xml +++ b/docs/users_guide/7.8.3-notes.xml @@ -3,8 +3,8 @@ Release notes for version 7.8.3 - The 7.8.3 release is a bugfix release. The changes relative to - 7.8.2 are listed below. + The 7.8.3 release is a bugfix release. The major bugfixes relative + to 7.8.2 are listed below. @@ -13,7 +13,48 @@ - TODO FIXME + A bug in the register allocator which would cause GHC to + crash during compilation has been fixed (issue #9155). + + + + + A segmentation fault for compiled programs using + makeStableName has been fixed (issue + #9078). + + + + + A bugfix in the runtime system that could cause a + segmentation fault has now been fixed (issue #9045). + + + + + A bug in the code generator that could cause segmentation + faults has been fixed (issue #9001). + + + + + A bug which caused gcc to error when + compiling large assembly source files has been fixed + (issue #8768). + + + + + Several memory leaks and bugs in the runtime system and C + libraries have been fixed. These issues were found using + Coverity Scan. + + + + + A bug which caused the runtime system to uninstall signal + handlers when they were not installed was fixed (issue + #9068). From git at git.haskell.org Mon Jun 9 13:01:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:01:40 +0000 (UTC) Subject: [commit: ghc] master: Check that an associated type mentions at least one type variable from the class (66bddbb) Message-ID: <20140609130140.2FA822406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/66bddbb27fd9c383f85005b8c6e1961d25d7a7dd/ghc >--------------------------------------------------------------- commit 66bddbb27fd9c383f85005b8c6e1961d25d7a7dd Author: Simon Peyton Jones Date: Mon Jun 9 13:28:51 2014 +0100 Check that an associated type mentions at least one type variable from the class Fixes Trac #9167 >--------------------------------------------------------------- 66bddbb27fd9c383f85005b8c6e1961d25d7a7dd compiler/typecheck/TcTyClsDecls.lhs | 18 +++++++++++------- testsuite/tests/indexed-types/should_fail/T2888.stderr | 5 +++++ testsuite/tests/indexed-types/should_fail/T9167.hs | 6 ++++++ testsuite/tests/indexed-types/should_fail/T9167.stderr | 5 +++++ testsuite/tests/indexed-types/should_fail/all.T | 3 ++- testsuite/tests/typecheck/should_fail/tcfail116.stderr | 2 +- 6 files changed, 30 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 94fefbb..4239530 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1620,7 +1620,7 @@ checkValidClass cls -- since there is no possible ambiguity ; let grown_tyvars = growThetaTyVars theta (mkVarSet tyvars) ; checkTc (arity == 0 || tyVarsOfType tau `intersectsVarSet` grown_tyvars) - (noClassTyVarErr cls sel_id) + (noClassTyVarErr cls (ptext (sLit "class method") <+> quotes (ppr sel_id))) ; case dm of GenDefMeth dm_name -> do { dm_id <- tcLookupId dm_name @@ -1643,8 +1643,12 @@ checkValidClass cls -- type variable. What a mess! check_at_defs (fam_tc, defs) - = tcAddDefaultAssocDeclCtxt (tyConName fam_tc) $ - mapM_ (checkValidTyFamInst mb_clsinfo fam_tc) defs + = do { traceTc "check-at" (ppr fam_tc $$ ppr (tyConTyVars fam_tc) $$ ppr tyvars) + ; checkTc (any (`elem` tyvars) (tyConTyVars fam_tc)) + (noClassTyVarErr cls (ptext (sLit "associated type") <+> quotes (ppr fam_tc))) + + ; tcAddDefaultAssocDeclCtxt (tyConName fam_tc) $ + mapM_ (checkValidTyFamInst mb_clsinfo fam_tc) defs } mb_clsinfo = Just (cls, mkVarEnv [ (tv, mkTyVarTy tv) | tv <- tyvars ]) @@ -2067,11 +2071,11 @@ classFunDepsErr cls = vcat [ptext (sLit "Fundeps in class") <+> quotes (ppr cls), parens (ptext (sLit "Use FunctionalDependencies to allow fundeps"))] -noClassTyVarErr :: Class -> Var -> SDoc -noClassTyVarErr clas op - = sep [ptext (sLit "The class method") <+> quotes (ppr op), +noClassTyVarErr :: Class -> SDoc -> SDoc +noClassTyVarErr clas what + = sep [ptext (sLit "The") <+> what, ptext (sLit "mentions none of the type variables of the class") <+> - ppr clas <+> hsep (map ppr (classTyVars clas))] + quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))] recSynErr :: [LTyClDecl Name] -> TcRn () recSynErr syn_decls diff --git a/testsuite/tests/indexed-types/should_fail/T2888.stderr b/testsuite/tests/indexed-types/should_fail/T2888.stderr new file mode 100644 index 0000000..df217dd --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2888.stderr @@ -0,0 +1,5 @@ + +T2888.hs:6:1: + The associated type ?D? + mentions none of the type variables of the class ?C w? + In the class declaration for ?C? diff --git a/testsuite/tests/indexed-types/should_fail/T9167.hs b/testsuite/tests/indexed-types/should_fail/T9167.hs new file mode 100644 index 0000000..2d2f555 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9167.hs @@ -0,0 +1,6 @@ + {-# LANGUAGE TypeFamilies #-} + +module T9167 where + +class C a where + type F b diff --git a/testsuite/tests/indexed-types/should_fail/T9167.stderr b/testsuite/tests/indexed-types/should_fail/T9167.stderr new file mode 100644 index 0000000..ec230fa --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9167.stderr @@ -0,0 +1,5 @@ + +T9167.hs:5:1: + The associated type ?F? + mentions none of the type variables of the class ?C a? + In the class declaration for ?C? diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 003b51d..d60f15f 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -47,7 +47,7 @@ test('T2157', normal, compile_fail, ['']) test('T2203a', normal, compile_fail, ['']) test('T2627b', normal, compile_fail, ['']) test('T2693', normal, compile_fail, ['']) -test('T2888', normal, compile, ['']) +test('T2888', normal, compile_fail, ['']) test('T3092', normal, compile_fail, ['']) test('NoMatchErr', normal, compile_fail, ['']) test('T2677', normal, compile_fail, ['']) @@ -120,4 +120,5 @@ test('T8368', normal, compile_fail, ['']) test('T8368a', normal, compile_fail, ['']) test('T8518', normal, compile_fail, ['']) test('T9036', normal, compile_fail, ['']) +test('T9167', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail116.stderr b/testsuite/tests/typecheck/should_fail/tcfail116.stderr index 0fdafcf..51b89ef 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail116.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail116.stderr @@ -1,6 +1,6 @@ tcfail116.hs:5:1: The class method ?bug? - mentions none of the type variables of the class Foo a + mentions none of the type variables of the class ?Foo a? When checking the class method: bug :: () In the class declaration for ?Foo? From git at git.haskell.org Mon Jun 9 13:01:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:01:42 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation for -fwarn-unused-binds (aa18a46) Message-ID: <20140609130142.9D7972406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa18a46d85a4995f0daea63d44e627f11d03ce95/ghc >--------------------------------------------------------------- commit aa18a46d85a4995f0daea63d44e627f11d03ce95 Author: Simon Peyton Jones Date: Mon Jun 9 13:58:23 2014 +0100 Improve documentation for -fwarn-unused-binds >--------------------------------------------------------------- aa18a46d85a4995f0daea63d44e627f11d03ce95 docs/users_guide/using.xml | 53 ++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 44 insertions(+), 9 deletions(-) diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index d762ff6..e404d07 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -1736,15 +1736,50 @@ f "2" = 2 unused binds, warning binds, unused Report any function definitions (and local bindings) - which are unused. For top-level functions, the warning is - only given if the binding is not exported. - A definition is regarded as "used" if (a) it is exported, or (b) it is - mentioned in the right hand side of another definition that is used, or (c) the - function it defines begins with an underscore. The last case provides a - way to suppress unused-binding warnings selectively. - Notice that a variable - is reported as unused even if it appears in the right-hand side of another - unused binding. + which are unused. More precisely: + + + Warn if a binding brings into scope a variable that is not used, + except if the variable's name starts with an underscore. The "starts-with-underscore" + condition provides a way to selectively disable the warning. + + + A variable is regarded as "used" if + + It is exported, or + It appears in the right hand side of a binding that binds at + least one used variable that is used + + For example + +module A (f) where +f = let (p,q) = rhs1 in t p -- Warning about unused q +t = rhs3 -- No warning: f is used, and hence so is t +g = h x -- Warning: g unused +h = rhs2 -- Warning: h is only used in the right-hand side of another unused binding +_w = True -- No warning: _w starts with an underscore + + + + + Warn if a pattern binding binds no variables at all, unless it is a lone, possibly-banged, wild-card pattern. + For example: + +Just _ = rhs3 -- Warning: unused pattern binding +(_, _) = rhs4 -- Warning: unused pattern binding +_ = rhs3 -- No warning: lone wild-card pattern +!_ = rhs4 -- No warning: banged wild-card pattern; behaves like seq + + The motivation for allowing lone wild-card patterns is they + are not very different from _v = rhs3, + which elicits no warning; and they can be useful to add a type + constraint, e.g. _ = x::Int. A lone + banged wild-card pattern is is useful as an alternative + (to seq) way to force evaluation. + + + + From git at git.haskell.org Mon Jun 9 13:01:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:01:45 +0000 (UTC) Subject: [commit: ghc] master: Document -fwarn-inline-rule-shadowing (Trac #9166) (52509d8) Message-ID: <20140609130145.319602406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/52509d8f07f64c95ff4f6090755f51992c501d0c/ghc >--------------------------------------------------------------- commit 52509d8f07f64c95ff4f6090755f51992c501d0c Author: Simon Peyton Jones Date: Mon Jun 9 13:59:42 2014 +0100 Document -fwarn-inline-rule-shadowing (Trac #9166) >--------------------------------------------------------------- 52509d8f07f64c95ff4f6090755f51992c501d0c docs/users_guide/glasgow_exts.xml | 11 +++++++++-- docs/users_guide/using.xml | 10 ++++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index ac8004f..0c3dd46 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -10912,8 +10912,8 @@ not be substituted, and the rule would not fire. - -How rules interact with INLINE/NOINLINE and CONLIKE pragmas + +How rules interact with INLINE/NOINLINE pragmas Ordinary inlining happens at the same time as rule rewriting, which may lead to unexpected @@ -10939,7 +10939,14 @@ would have been a better chance that f's RULE might fire. The way to get predictable behaviour is to use a NOINLINE pragma, or an INLINE[phase] pragma, on f, to ensure that it is not inlined until its RULEs have had a chance to fire. +The warning flag (see ) +warns about this situation. + + + +How rules interact with CONLIKE pragmas + GHC is very cautious about duplicating work. For example, consider diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index e404d07..921d5a3 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -1866,6 +1866,16 @@ _ = rhs3 -- No warning: lone wild-card pattern + + : + + + Warn if a rewrite RULE might fail to fire because the function might be + inlined before the rule has a chance to fire. See . + + + + If you're feeling really paranoid, the From git at git.haskell.org Mon Jun 9 13:01:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:01:48 +0000 (UTC) Subject: [commit: ghc] master: Document explicit import/export of data constructors (Trac #8753) (59cdb99) Message-ID: <20140609130148.215552406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59cdb992df5bd8bdc563b30c2103c323a7d57f15/ghc >--------------------------------------------------------------- commit 59cdb992df5bd8bdc563b30c2103c323a7d57f15 Author: Simon Peyton Jones Date: Mon Jun 9 14:01:18 2014 +0100 Document explicit import/export of data constructors (Trac #8753) I also added sub-sections to the pattern synonym documentation >--------------------------------------------------------------- 59cdb992df5bd8bdc563b30c2103c323a7d57f15 docs/users_guide/glasgow_exts.xml | 77 +++++++++++++++++++++++---------------- 1 file changed, 46 insertions(+), 31 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 0c3dd46..63c1a2e 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -971,25 +971,27 @@ right-hand side. -The semantics of a unidirectional pattern synonym declaration and -usage are as follows: - - +The syntax and semantics of pattern synonyms are elaborated in the +following subsections. +See the Wiki +page for more details. + - Syntax: + Syntax and scoping of pattern synonyms A pattern synonym declaration can be either unidirectional or bidirectional. The syntax for unidirectional pattern synonyms is: - pattern Name args <- pat - and the syntax for bidirectional pattern synonyms is: - pattern Name args = pat + Either prefix or infix syntax can be + used. + Pattern synonym declarations can only occur in the top level of a module. In particular, they are not allowed as local @@ -997,20 +999,6 @@ bidirectional. The syntax for unidirectional pattern synonyms is: technical restriction that will be lifted in later versions. - The name of the pattern synonym itself is in the same namespace as - proper data constructors. Either prefix or infix syntax can be - used. In export/import specifications, you have to prefix pattern - names with the pattern keyword, e.g.: - - - module Example (pattern Single) where - pattern Single x = [x] - - - - Scoping: - - The variables in the left-hand side of the definition are bound by the pattern on the right-hand side. For bidirectional pattern synonyms, all the variables of the right-hand side must also occur @@ -1022,10 +1010,35 @@ bidirectional. The syntax for unidirectional pattern synonyms is: Pattern synonyms cannot be defined recursively. + - + Import and export of pattern synonyms + + + The name of the pattern synonym itself is in the same namespace as + proper data constructors. In an export or import specification, + you must prefix pattern + names with the pattern keyword, e.g.: + + module Example (pattern Single) where + pattern Single x = [x] + +Without the pattern prefix, Single would +be interpreted as a type constructor in the export list. + + +You may also use the pattern keyword in an import/export +specification to import or export an ordinary data constructor. For example: + + import Data.Maybe( pattern Just ) + +would bring into scope the data constructor Just from the +Maybe type, without also bringing the type constructor +Maybe into scope. + + - Typing: + Typing of pattern synonyms Given a pattern synonym definition of the form @@ -1100,10 +1113,9 @@ pattern (Show b) => ExNumPat b :: (Num a, Eq a) => T a ExNumPat :: (Show b, Num a, Eq a) => b -> T t + - - - Matching: +Matching of pattern synonyms A pattern synonym occurrence in a pattern is evaluated by first @@ -1125,8 +1137,6 @@ f' _ = False Note that the strictness of f differs from that of g defined below: - - g [True, True] = True g _ = False @@ -1136,9 +1146,8 @@ g _ = False *Main> g (False:undefined) False - - + @@ -2465,6 +2474,12 @@ disambiguate this case, thus: The extension is implied by and (for some reason) by . + +In addition, with you can prefix the name of +a data constructor in an import or export list with the keyword pattern, +to allow the import or export of a data constructor without its parent type constructor +(see ). + From git at git.haskell.org Mon Jun 9 13:08:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:08:07 +0000 (UTC) Subject: [commit: ghc] master: Suggest -fprint-explicit-kinds when only kind variables are ambiguous (4b4d81a) Message-ID: <20140609130807.64AFC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b4d81a6b97555a8dbeda2e6387ee151af962473/ghc >--------------------------------------------------------------- commit 4b4d81a6b97555a8dbeda2e6387ee151af962473 Author: Simon Peyton Jones Date: Mon Jun 9 14:07:54 2014 +0100 Suggest -fprint-explicit-kinds when only kind variables are ambiguous This was triggered by looking at Trac #9171. See Note [Suggest -fprint-explicit-kinds] in TcErrors >--------------------------------------------------------------- 4b4d81a6b97555a8dbeda2e6387ee151af962473 compiler/typecheck/TcErrors.lhs | 46 ++++++++++++++++------ testsuite/tests/indexed-types/should_fail/T9171.hs | 10 +++++ .../tests/indexed-types/should_fail/T9171.stderr | 23 +++++++++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 4 files changed, 68 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 88894b4..6992fa9 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -1285,26 +1285,48 @@ flattening any further. After all, there can be no instance declarations that match such things. And flattening under a for-all is problematic anyway; consider C (forall a. F a) +Note [Suggest -fprint-explicit-kinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It can be terribly confusing to get an error message like (Trac #9171) + Couldn't match expected type ?GetParam Base (GetParam Base Int)? + with actual type ?GetParam Base (GetParam Base Int)? +The reason may be that the kinds don't match up. Typically you'll get +more useful information, but not when it's as a result of ambiguity. +This test suggests -fprint-explicit-kinds when all the ambiguous type +variables are kind variables. + \begin{code} mkAmbigMsg :: Ct -> (Bool, SDoc) mkAmbigMsg ct - | isEmptyVarSet ambig_tv_set = (False, empty) - | otherwise = (True, msg) + | null ambig_tkvs = (False, empty) + | otherwise = (True, msg) where - ambig_tv_set = filterVarSet isAmbiguousTyVar (tyVarsOfCt ct) - ambig_tvs = varSetElems ambig_tv_set - - is_or_are | isSingleton ambig_tvs = text "is" - | otherwise = text "are" + ambig_tkv_set = filterVarSet isAmbiguousTyVar (tyVarsOfCt ct) + ambig_tkvs = varSetElems ambig_tkv_set + (ambig_kvs, ambig_tvs) = partition isKindVar ambig_tkvs - msg | any isRuntimeUnkSkol ambig_tvs -- See Note [Runtime skolems] + msg | any isRuntimeUnkSkol ambig_tkvs -- See Note [Runtime skolems] = vcat [ ptext (sLit "Cannot resolve unknown runtime type") <> plural ambig_tvs <+> pprQuotedList ambig_tvs , ptext (sLit "Use :print or :force to determine these types")] - | otherwise - = vcat [ text "The type variable" <> plural ambig_tvs - <+> pprQuotedList ambig_tvs - <+> is_or_are <+> text "ambiguous" ] + + | not (null ambig_tvs) + = pp_ambig (ptext (sLit "type")) ambig_tvs + + | otherwise -- All ambiguous kind variabes; suggest -fprint-explicit-kinds + = vcat [ pp_ambig (ptext (sLit "kind")) ambig_kvs + , sdocWithDynFlags suggest_explicit_kinds ] + + pp_ambig what tkvs + = ptext (sLit "The") <+> what <+> ptext (sLit "variable") <> plural tkvs + <+> pprQuotedList tkvs <+> is_or_are tkvs <+> ptext (sLit "ambiguous") + + is_or_are [_] = text "is" + is_or_are _ = text "are" + + suggest_explicit_kinds dflags -- See Note [Suggest -fprint-explicit-kinds] + | gopt Opt_PrintExplicitKinds dflags = empty + | otherwise = ptext (sLit "Use -fprint-explicit-kinds to see the kind arguments") pprSkol :: SkolemInfo -> SrcLoc -> SDoc pprSkol UnkSkol _ diff --git a/testsuite/tests/indexed-types/should_fail/T9171.hs b/testsuite/tests/indexed-types/should_fail/T9171.hs new file mode 100644 index 0000000..72a2d70 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9171.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds, TypeFamilies #-} + +module T9171 where +data Base + +type family GetParam (p::k1) (t::k2) :: k3 + +type instance GetParam Base t = t + +foo = undefined :: GetParam Base (GetParam Base Int) diff --git a/testsuite/tests/indexed-types/should_fail/T9171.stderr b/testsuite/tests/indexed-types/should_fail/T9171.stderr new file mode 100644 index 0000000..1751d40 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9171.stderr @@ -0,0 +1,23 @@ + +T9171.hs:10:1: + Couldn't match expected type ?GetParam Base (GetParam Base Int)? + with actual type ?GetParam Base (GetParam Base Int)? + NB: ?GetParam? is a type function, and may not be injective + The kind variable ?k0? is ambiguous + Use -fprint-explicit-kinds to see the kind arguments + When checking that ?foo? + has the inferred type ?forall (k :: BOX). + GetParam Base (GetParam Base Int)? + Probable cause: the inferred type is ambiguous + +T9171.hs:10:20: + Couldn't match expected type ?GetParam Base (GetParam Base Int)? + with actual type ?GetParam Base (GetParam Base Int)? + NB: ?GetParam? is a type function, and may not be injective + The kind variable ?k0? is ambiguous + Use -fprint-explicit-kinds to see the kind arguments + In the ambiguity check for: + forall (k :: BOX). GetParam Base (GetParam Base Int) + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In an expression type signature: GetParam Base (GetParam Base Int) + In the expression: undefined :: GetParam Base (GetParam Base Int) diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index d60f15f..a5adfaa 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -121,4 +121,5 @@ test('T8368a', normal, compile_fail, ['']) test('T8518', normal, compile_fail, ['']) test('T9036', normal, compile_fail, ['']) test('T9167', normal, compile_fail, ['']) +test('T9171', normal, compile_fail, ['']) From git at git.haskell.org Mon Jun 9 13:15:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:15:24 +0000 (UTC) Subject: [commit: ghc] master: Better warning message for orphan instances (Ticket #9178) (877a957) Message-ID: <20140609131524.9EC222406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/877a9577280f4b6aa6ef47f7a27d9b741b8234cf/ghc >--------------------------------------------------------------- commit 877a9577280f4b6aa6ef47f7a27d9b741b8234cf Author: Dr. Heinrich H?rdegen Date: Fri Jun 6 19:11:27 2014 +0200 Better warning message for orphan instances (Ticket #9178) Including a test case. >--------------------------------------------------------------- 877a9577280f4b6aa6ef47f7a27d9b741b8234cf compiler/iface/MkIface.lhs | 7 +++++++ .../tests/{annotations => warnings}/should_compile/Makefile | 0 testsuite/tests/warnings/should_compile/T9178.hs | 9 +++++++++ testsuite/tests/warnings/should_compile/T9178.stderr | 8 ++++++++ testsuite/tests/warnings/should_compile/T9178DataType.hs | 5 +++++ testsuite/tests/warnings/should_compile/all.T | 3 +++ 6 files changed, 32 insertions(+) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index f2d2058..760f349 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -879,6 +879,13 @@ instOrphWarn :: DynFlags -> PrintUnqualified -> ClsInst -> WarnMsg instOrphWarn dflags unqual inst = mkWarnMsg dflags (getSrcSpan inst) unqual $ hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst) + $$ text "To avoid this" + $$ nest 4 (vcat posibilities) + where + posibilities = + text "move the instance declaration to the module of the class or of the type, or" : + text "wrap the type with a newtype and declare the instance on the new type." : + [] ruleOrphWarn :: DynFlags -> PrintUnqualified -> Module -> IfaceRule -> WarnMsg ruleOrphWarn dflags unqual mod rule diff --git a/testsuite/tests/annotations/should_compile/Makefile b/testsuite/tests/warnings/should_compile/Makefile similarity index 100% copy from testsuite/tests/annotations/should_compile/Makefile copy to testsuite/tests/warnings/should_compile/Makefile diff --git a/testsuite/tests/warnings/should_compile/T9178.hs b/testsuite/tests/warnings/should_compile/T9178.hs new file mode 100644 index 0000000..9171381 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T9178.hs @@ -0,0 +1,9 @@ + + +module T9178 where + +import T9178DataType + + +instance Show T9178_Type where + show _ = undefined \ No newline at end of file diff --git a/testsuite/tests/warnings/should_compile/T9178.stderr b/testsuite/tests/warnings/should_compile/T9178.stderr new file mode 100644 index 0000000..6f4b6c0 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T9178.stderr @@ -0,0 +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 + 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/T9178DataType.hs b/testsuite/tests/warnings/should_compile/T9178DataType.hs new file mode 100644 index 0000000..e274117 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T9178DataType.hs @@ -0,0 +1,5 @@ + + +module T9178DataType where + +data T9178_Type diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T new file mode 100644 index 0000000..f6747bf --- /dev/null +++ b/testsuite/tests/warnings/should_compile/all.T @@ -0,0 +1,3 @@ +test('T9178', extra_clean(['T9178.o', 'T9178DataType.o', + 'T9178.hi', 'T9178DataType.hi']), + multimod_compile, ['T9178', '-Wall']) \ No newline at end of file From git at git.haskell.org Mon Jun 9 13:19:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:19:38 +0000 (UTC) Subject: [commit: ghc] master: Ship xhtml, terminfo, haskeline (#8919) (4caadb7) Message-ID: <20140609131939.0D0622406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4caadb7cbee5c176abb99df25c4cc1657ae57f40/ghc >--------------------------------------------------------------- commit 4caadb7cbee5c176abb99df25c4cc1657ae57f40 Author: Jens Petersen Date: Mon Jun 9 08:19:08 2014 -0500 Ship xhtml, terminfo, haskeline (#8919) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4caadb7cbee5c176abb99df25c4cc1657ae57f40 ghc.mk | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/ghc.mk b/ghc.mk index 76eab17..3beab67 100644 --- a/ghc.mk +++ b/ghc.mk @@ -425,13 +425,6 @@ PACKAGES_STAGE2 += haskell98 PACKAGES_STAGE2 += haskell2010 endif -# We normally install only the packages down to this point -REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) -ifneq "$(Stage1Only)" "YES" -REGULAR_INSTALL_PACKAGES += compiler -endif -REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) - PACKAGES_STAGE1 += xhtml ifeq "$(Windows_Target)" "NO" ifneq "$(TargetOS_CPP)" "ios" @@ -440,6 +433,13 @@ endif endif PACKAGES_STAGE1 += haskeline +# We normally install only the packages down to this point +REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) +ifneq "$(Stage1Only)" "YES" +REGULAR_INSTALL_PACKAGES += compiler +endif +REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) + # If we have built the programs with dynamic libraries, then # ghc will be dynamically linked against haskeline.so etc, so # we need the dynamic libraries of everything down to here From git at git.haskell.org Mon Jun 9 13:30:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 13:30:34 +0000 (UTC) Subject: [commit: ghc] master: Add .arclint file (25fb4fe) Message-ID: <20140609133034.AA71D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/25fb4fe8c6d9b04bf180a209ad4b4cb630a46ec5/ghc >--------------------------------------------------------------- commit 25fb4fe8c6d9b04bf180a209ad4b4cb630a46ec5 Author: Austin Seipp Date: Mon Jun 9 08:29:27 2014 -0500 Add .arclint file Signed-off-by: Austin Seipp >--------------------------------------------------------------- 25fb4fe8c6d9b04bf180a209ad4b4cb630a46ec5 .arclint | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/.arclint b/.arclint new file mode 100644 index 0000000..db6299d --- /dev/null +++ b/.arclint @@ -0,0 +1,19 @@ +{ + "linters": { + "filename": { + "type": "filename" + }, + "generated": { + "type": "generated" + }, + "merge-conflict": { + "type": "merge-conflict" + }, + "nolint": { + "type": "nolint" + }, + "text": { + "type": "text" + } + } +} From git at git.haskell.org Mon Jun 9 16:08:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 16:08:17 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Ship xhtml, terminfo, haskeline (#8919) (f31b042) Message-ID: <20140609160817.E3AEF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f31b042c25b9c51efdbe84c1cb6f65f49534c14d/ghc >--------------------------------------------------------------- commit f31b042c25b9c51efdbe84c1cb6f65f49534c14d Author: Jens Petersen Date: Mon Jun 9 08:41:36 2014 -0500 Ship xhtml, terminfo, haskeline (#8919) Signed-off-by: Austin Seipp (cherry picked from commit 4caadb7cbee5c176abb99df25c4cc1657ae57f40) >--------------------------------------------------------------- f31b042c25b9c51efdbe84c1cb6f65f49534c14d ghc.mk | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/ghc.mk b/ghc.mk index eeb0d6a..67d0cbd 100644 --- a/ghc.mk +++ b/ghc.mk @@ -425,13 +425,6 @@ PACKAGES_STAGE2 += haskell98 PACKAGES_STAGE2 += haskell2010 endif -# We normally install only the packages down to this point -REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) -ifeq "$(Stage1Only)" "NO" -REGULAR_INSTALL_PACKAGES += compiler -endif -REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) - PACKAGES_STAGE1 += xhtml ifeq "$(Windows_Target)" "NO" ifneq "$(TargetOS_CPP)" "ios" @@ -440,6 +433,13 @@ endif endif PACKAGES_STAGE1 += haskeline +# We normally install only the packages down to this point +REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) +ifeq "$(Stage1Only)" "NO" +REGULAR_INSTALL_PACKAGES += compiler +endif +REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) + # If we have built the programs with dynamic libraries, then # ghc will be dynamically linked against haskeline.so etc, so # we need the dynamic libraries of everything down to here From git at git.haskell.org Mon Jun 9 16:08:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 16:08:20 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Release notes (32b4bf3) Message-ID: <20140609160820.54A132406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/32b4bf33989bdda4dffed1866f7a61a7da4ca275/ghc >--------------------------------------------------------------- commit 32b4bf33989bdda4dffed1866f7a61a7da4ca275 Author: Austin Seipp Date: Mon Jun 9 11:08:01 2014 -0500 Release notes Signed-off-by: Austin Seipp >--------------------------------------------------------------- 32b4bf33989bdda4dffed1866f7a61a7da4ca275 docs/users_guide/7.8.3-notes.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/7.8.3-notes.xml b/docs/users_guide/7.8.3-notes.xml index 9d71cf5..1345e4e 100644 --- a/docs/users_guide/7.8.3-notes.xml +++ b/docs/users_guide/7.8.3-notes.xml @@ -57,6 +57,18 @@ #9068). + + + The libraries haskeline, + xhtml, terminfo, + transformers, and + haskeline are now exported and + registered in the package database. They previously + shipped with GHC but were not registered, leading to + errors where shared objects could be overwritten. (issue + #8919). + + From git at git.haskell.org Mon Jun 9 18:59:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 18:59:12 +0000 (UTC) Subject: [commit: ghc] master: Make Ptr's parameter phantom (1946922) Message-ID: <20140609185912.435382406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1946922c61df427e59f8a00572fd4dd6501abd98/ghc >--------------------------------------------------------------- commit 1946922c61df427e59f8a00572fd4dd6501abd98 Author: Joachim Breitner Date: Mon Jun 9 20:55:22 2014 +0200 Make Ptr's parameter phantom and implement castPtr with coerce, which gives 12% less allocation in reverse-complem 7.3% less allocation in fasta. Binary sizes fell 0.1%. as reported and discussed in #9163. >--------------------------------------------------------------- 1946922c61df427e59f8a00572fd4dd6501abd98 libraries/base/Data/Coerce.hs | 3 +-- libraries/base/GHC/Ptr.lhs | 10 ++++++++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Coerce.hs b/libraries/base/Data/Coerce.hs index fb38b36..9199835 100644 --- a/libraries/base/Data/Coerce.hs +++ b/libraries/base/Data/Coerce.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE AutoDeriveTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/GHC/Ptr.lhs b/libraries/base/GHC/Ptr.lhs index c959d1e..341512b 100644 --- a/libraries/base/GHC/Ptr.lhs +++ b/libraries/base/GHC/Ptr.lhs @@ -31,13 +31,13 @@ import GHC.Show import GHC.Num import GHC.List ( length, replicate ) import Numeric ( showHex ) +import Data.Coerce #include "MachDeps.h" ------------------------------------------------------------------------ -- Data pointers. -type role Ptr representational data Ptr a = Ptr Addr# deriving (Eq, Ord) -- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an -- array of objects, which may be marshalled to or from Haskell values @@ -49,6 +49,10 @@ data Ptr a = Ptr Addr# deriving (Eq, Ord) -- to access the pointer. For example you might write small foreign -- functions to get or set the fields of a C @struct at . +-- The role of Ptr's parameter is phantom, as there is relation between +-- the Haskell representation and whathever the user puts at the end of the +-- pointer. And phantom is useful to implement castPtr (see #9163) + -- |The constant 'nullPtr' contains a distinguished value of 'Ptr' -- that is not associated with a valid memory location. nullPtr :: Ptr a @@ -56,7 +60,7 @@ nullPtr = Ptr nullAddr# -- |The 'castPtr' function casts a pointer from one type to another. castPtr :: Ptr a -> Ptr b -castPtr (Ptr addr) = Ptr addr +castPtr = coerce -- |Advances the given address by the given offset in bytes. plusPtr :: Ptr a -> Int -> Ptr b @@ -124,6 +128,8 @@ data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- > foreign import ccall "dynamic" -- > mkFun :: FunPtr IntFunction -> IntFunction +-- The role of FunPtr is representational, to be on the safe side (see #9163) + -- |The constant 'nullFunPtr' contains a -- distinguished value of 'FunPtr' that is not -- associated with a valid memory location. From git at git.haskell.org Mon Jun 9 19:04:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 19:04:39 +0000 (UTC) Subject: [commit: ghc] master: Update test results with new orphan instance warning (707bde5) Message-ID: <20140609190439.76C052406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/707bde533dcb16bf8f5a30179d098b343e54fe7b/ghc >--------------------------------------------------------------- commit 707bde533dcb16bf8f5a30179d098b343e54fe7b Author: Joachim Breitner Date: Mon Jun 9 21:03:32 2014 +0200 Update test results with new orphan instance warning It seems that the patch in #9178 was not fully validated. >--------------------------------------------------------------- 707bde533dcb16bf8f5a30179d098b343e54fe7b testsuite/tests/typecheck/should_compile/T4912.stderr | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/typecheck/should_compile/T4912.stderr b/testsuite/tests/typecheck/should_compile/T4912.stderr index 50d2deb..0e0920f 100644 --- a/testsuite/tests/typecheck/should_compile/T4912.stderr +++ b/testsuite/tests/typecheck/should_compile/T4912.stderr @@ -1,4 +1,12 @@ -T4912.hs:10:10: Warning: Orphan instance: instance Foo TheirData +T4912.hs:10:10: Warning: + Orphan instance: instance 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 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. From git at git.haskell.org Mon Jun 9 20:58:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jun 2014 20:58:31 +0000 (UTC) Subject: [commit: ghc] master: Revert "Make Ptr's parameter phantom" (f251afe) Message-ID: <20140609205831.C38A82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f251afe4e450317c99defab9eeba63a0a998780b/ghc >--------------------------------------------------------------- commit f251afe4e450317c99defab9eeba63a0a998780b Author: Joachim Breitner Date: Mon Jun 9 22:58:03 2014 +0200 Revert "Make Ptr's parameter phantom" This reverts commit 1946922c61df427e59f8a00572fd4dd6501abd98, as it trips the build system over, and I don't see why. >--------------------------------------------------------------- f251afe4e450317c99defab9eeba63a0a998780b libraries/base/Data/Coerce.hs | 3 ++- libraries/base/GHC/Ptr.lhs | 10 ++-------- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/libraries/base/Data/Coerce.hs b/libraries/base/Data/Coerce.hs index 9199835..fb38b36 100644 --- a/libraries/base/Data/Coerce.hs +++ b/libraries/base/Data/Coerce.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE AutoDeriveTypeable #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/GHC/Ptr.lhs b/libraries/base/GHC/Ptr.lhs index 341512b..c959d1e 100644 --- a/libraries/base/GHC/Ptr.lhs +++ b/libraries/base/GHC/Ptr.lhs @@ -31,13 +31,13 @@ import GHC.Show import GHC.Num import GHC.List ( length, replicate ) import Numeric ( showHex ) -import Data.Coerce #include "MachDeps.h" ------------------------------------------------------------------------ -- Data pointers. +type role Ptr representational data Ptr a = Ptr Addr# deriving (Eq, Ord) -- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an -- array of objects, which may be marshalled to or from Haskell values @@ -49,10 +49,6 @@ data Ptr a = Ptr Addr# deriving (Eq, Ord) -- to access the pointer. For example you might write small foreign -- functions to get or set the fields of a C @struct at . --- The role of Ptr's parameter is phantom, as there is relation between --- the Haskell representation and whathever the user puts at the end of the --- pointer. And phantom is useful to implement castPtr (see #9163) - -- |The constant 'nullPtr' contains a distinguished value of 'Ptr' -- that is not associated with a valid memory location. nullPtr :: Ptr a @@ -60,7 +56,7 @@ nullPtr = Ptr nullAddr# -- |The 'castPtr' function casts a pointer from one type to another. castPtr :: Ptr a -> Ptr b -castPtr = coerce +castPtr (Ptr addr) = Ptr addr -- |Advances the given address by the given offset in bytes. plusPtr :: Ptr a -> Int -> Ptr b @@ -128,8 +124,6 @@ data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- > foreign import ccall "dynamic" -- > mkFun :: FunPtr IntFunction -> IntFunction --- The role of FunPtr is representational, to be on the safe side (see #9163) - -- |The constant 'nullFunPtr' contains a -- distinguished value of 'FunPtr' that is not -- associated with a valid memory location. From git at git.haskell.org Tue Jun 10 07:26:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jun 2014 07:26:46 +0000 (UTC) Subject: [commit: ghc] master: Make Ptr's parameter phantom (5bdbd51) Message-ID: <20140610072646.A00662406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5bdbd510a78f0c17d702fa9399cc0501cfd00fac/ghc >--------------------------------------------------------------- commit 5bdbd510a78f0c17d702fa9399cc0501cfd00fac Author: Joachim Breitner Date: Mon Jun 9 20:55:22 2014 +0200 Make Ptr's parameter phantom and implement castPtr with coerce, which gives 12% less allocation in reverse-complem 7.3% less allocation in fasta. Binary sizes fell 0.1%. as reported and discussed in #9163. >--------------------------------------------------------------- 5bdbd510a78f0c17d702fa9399cc0501cfd00fac libraries/base/Data/Coerce.hs | 6 ++++-- libraries/base/GHC/Ptr.lhs | 10 ++++++++-- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Coerce.hs b/libraries/base/Data/Coerce.hs index fb38b36..653a857 100644 --- a/libraries/base/Data/Coerce.hs +++ b/libraries/base/Data/Coerce.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE AutoDeriveTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | @@ -26,3 +25,6 @@ module Data.Coerce ) where import GHC.Prim (coerce) import GHC.Types (Coercible) + +import GHC.Base () -- for build ordering + diff --git a/libraries/base/GHC/Ptr.lhs b/libraries/base/GHC/Ptr.lhs index c959d1e..341512b 100644 --- a/libraries/base/GHC/Ptr.lhs +++ b/libraries/base/GHC/Ptr.lhs @@ -31,13 +31,13 @@ import GHC.Show import GHC.Num import GHC.List ( length, replicate ) import Numeric ( showHex ) +import Data.Coerce #include "MachDeps.h" ------------------------------------------------------------------------ -- Data pointers. -type role Ptr representational data Ptr a = Ptr Addr# deriving (Eq, Ord) -- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an -- array of objects, which may be marshalled to or from Haskell values @@ -49,6 +49,10 @@ data Ptr a = Ptr Addr# deriving (Eq, Ord) -- to access the pointer. For example you might write small foreign -- functions to get or set the fields of a C @struct at . +-- The role of Ptr's parameter is phantom, as there is relation between +-- the Haskell representation and whathever the user puts at the end of the +-- pointer. And phantom is useful to implement castPtr (see #9163) + -- |The constant 'nullPtr' contains a distinguished value of 'Ptr' -- that is not associated with a valid memory location. nullPtr :: Ptr a @@ -56,7 +60,7 @@ nullPtr = Ptr nullAddr# -- |The 'castPtr' function casts a pointer from one type to another. castPtr :: Ptr a -> Ptr b -castPtr (Ptr addr) = Ptr addr +castPtr = coerce -- |Advances the given address by the given offset in bytes. plusPtr :: Ptr a -> Int -> Ptr b @@ -124,6 +128,8 @@ data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- > foreign import ccall "dynamic" -- > mkFun :: FunPtr IntFunction -> IntFunction +-- The role of FunPtr is representational, to be on the safe side (see #9163) + -- |The constant 'nullFunPtr' contains a -- distinguished value of 'FunPtr' that is not -- associated with a valid memory location. From git at git.haskell.org Tue Jun 10 12:52:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jun 2014 12:52:01 +0000 (UTC) Subject: [commit: ghc] master: Improve the API doc description of the SmallArray primitive types (faddad7) Message-ID: <20140610125201.3B71D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/faddad7ec6e5738987d5571ad23054a5aa39c193/ghc >--------------------------------------------------------------- commit faddad7ec6e5738987d5571ad23054a5aa39c193 Author: Duncan Coutts Date: Tue Jun 10 13:50:59 2014 +0100 Improve the API doc description of the SmallArray primitive types Say how it differs from Array in terms of size and performance. These are primitives so it's also ok to talk a bit about implementation details like card tables. >--------------------------------------------------------------- faddad7ec6e5738987d5571ad23054a5aa39c193 compiler/prelude/primops.txt.pp | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index dfc1421..764ba10 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -843,8 +843,22 @@ primop CasArrayOp "casArray#" GenPrimOp section "Small Arrays" {Operations on {\tt SmallArray\#}. A {\tt SmallArray\#} works - just like an {\tt Array\#}, except that its implementation is - optimized for small arrays (i.e. no more than 128 elements.)} + just like an {\tt Array\#}, but with different space use and + performance characteristics (that are often useful with small + arrays). The {\tt SmallArray\#} and {\tt SmallMutableArray#} + lack a `card table'. The purpose of a card table is to avoid + having to scan every element of the array on each GC by + keeping track of which elements have changed since the last GC + and only scanning those that have changed. So the consequence + of there being no card table is that the representation is + somewhat smaller and the writes are somewhat faster (because + the card table does not need to be updated). The disadvantage + of course is that for a {\tt SmallMutableArray#} the whole + array has to be scanned on each GC. Thus it is best suited for + use cases where the mutable array is not long lived, e.g. + where a mutable array is initialised quickly and then frozen + to become an immutable {\tt SmallArray\#}. + } ------------------------------------------------------------------------ From git at git.haskell.org Tue Jun 10 14:15:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jun 2014 14:15:37 +0000 (UTC) Subject: [commit: ghc] master: Fire "map/coerce" only in phase 1 (f764aac) Message-ID: <20140610141537.C2C202406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f764aac57fdf3eefef6bada0a62aae5e95cec847/ghc >--------------------------------------------------------------- commit f764aac57fdf3eefef6bada0a62aae5e95cec847 Author: Joachim Breitner Date: Tue Jun 10 16:13:17 2014 +0200 Fire "map/coerce" only in phase 1 I just noticed a lot of warnings Rules.findBest: rule overlap (Rule 1 wins) Rule 1: "map" Rule 2: "map/coerce" which can easily be avoided by acitivating map/coerce only from phase 1 on. >--------------------------------------------------------------- f764aac57fdf3eefef6bada0a62aae5e95cec847 libraries/base/GHC/Base.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 1c8e144..f4f3454 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -406,7 +406,7 @@ mapFB c f = \x ys -> c (f x) ys -- -- http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf -{-# RULES "map/coerce" map coerce = coerce #-} +{-# RULES [1] "map/coerce" map coerce = coerce #-} \end{code} From git at git.haskell.org Tue Jun 10 15:18:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jun 2014 15:18:25 +0000 (UTC) Subject: [commit: ghc] master: Forgot to amend before pushing... (fdf370e) Message-ID: <20140610151825.E96A92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fdf370eb68bd2aa333845e8a7f19c4dd792d12d0/ghc >--------------------------------------------------------------- commit fdf370eb68bd2aa333845e8a7f19c4dd792d12d0 Author: Joachim Breitner Date: Tue Jun 10 17:18:19 2014 +0200 Forgot to amend before pushing... >--------------------------------------------------------------- fdf370eb68bd2aa333845e8a7f19c4dd792d12d0 libraries/base/GHC/Base.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index f4f3454..2236a14 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -406,7 +406,7 @@ mapFB c f = \x ys -> c (f x) ys -- -- http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf -{-# RULES [1] "map/coerce" map coerce = coerce #-} +{-# RULES "map/coerce" [1] map coerce = coerce #-} \end{code} From git at git.haskell.org Tue Jun 10 20:04:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jun 2014 20:04:58 +0000 (UTC) Subject: [commit: ghc] master: Make better use of the x86 addressing mode (0e6bc84) Message-ID: <20140610200458.3269B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e6bc84ca958f6da8c10c2ed489f87d8c4c9b463/ghc >--------------------------------------------------------------- commit 0e6bc84ca958f6da8c10c2ed489f87d8c4c9b463 Author: Johan Tibell Date: Sat Jun 7 15:03:29 2014 +0200 Make better use of the x86 addressing mode We now emit movq %rdi,16(%r14,%rsi,8) instead of leaq 16(%r14),%rax movq %rdi,(%rax,%rsi,8) This helps e.g. byte array indexing. >--------------------------------------------------------------- 0e6bc84ca958f6da8c10c2ed489f87d8c4c9b463 compiler/nativeGen/X86/CodeGen.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index e71a1dd..fa93767 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -805,6 +805,8 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps | is32BitInteger y = add_int rep x y add_code rep x y = trivialCode rep (ADD size) (Just (ADD size)) x y where size = intSize rep + -- TODO: There are other interesting patterns we want to replace + -- with a LEA, e.g. `(x + offset) + (y << shift)`. -------------------- sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register @@ -1025,6 +1027,13 @@ getAmode' is32Bit (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _), b@(CmmLit _)]) = getAmode' is32Bit (CmmMachOp (MO_Add rep) [b,a]) +-- Matches: (x + offset) + (y << shift) +getAmode' _ (CmmMachOp (MO_Add _) [CmmRegOff x offset, + CmmMachOp (MO_Shl _) + [y, CmmLit (CmmInt shift _)]]) + | shift == 0 || shift == 1 || shift == 2 || shift == 3 + = x86_complex_amode (CmmReg x) y shift (fromIntegral offset) + getAmode' _ (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]]) | shift == 0 || shift == 1 || shift == 2 || shift == 3 From eir at cis.upenn.edu Wed Jun 11 13:22:59 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Wed, 11 Jun 2014 09:22:59 -0400 Subject: [commit: ghc] master: Update mod73 test output (1178fa4) In-Reply-To: <20140606140958.4D0F12406D@ghc.haskell.org> References: <20140606140958.4D0F12406D@ghc.haskell.org> Message-ID: This test case is failing on my machine, too. Is it perhaps possible to sort the output to avoid these wibbles? I looked at the code and it's not immediately obvious to me the best place to do this... Thanks, Richard On Jun 6, 2014, at 10:09 AM, git at ghc.haskell.org wrote: > Repository : ssh://git at git.haskell.org/ghc > > On branch : master > Link : http://ghc.haskell.org/trac/ghc/changeset/1178fa4ada1ac054976f3abb2e303ad42653e303/ghc > >> --------------------------------------------------------------- > > commit 1178fa4ada1ac054976f3abb2e303ad42653e303 > Author: Joachim Breitner > Date: Fri Jun 6 15:03:36 2014 +0200 > > Update mod73 test output > > to what I observe on travis and on my validate machine, even though my > local tree produces the previous output. > > >> --------------------------------------------------------------- > > 1178fa4ada1ac054976f3abb2e303ad42653e303 > testsuite/tests/module/mod73.stderr | 4 ++-- > 1 file changed, 2 insertions(+), 2 deletions(-) > > diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr > index d19a032..576b0e3 100644 > --- a/testsuite/tests/module/mod73.stderr > +++ b/testsuite/tests/module/mod73.stderr > @@ -2,6 +2,6 @@ > mod73.hs:3:7: > Not in scope: ?Prelude.g? > Perhaps you meant one of these: > - data constructor ?Prelude.GT? (imported from Prelude), > + data constructor ?Prelude.LT? (imported from Prelude), > data constructor ?Prelude.EQ? (imported from Prelude), > - data constructor ?Prelude.LT? (imported from Prelude) > + data constructor ?Prelude.GT? (imported from Prelude) > > _______________________________________________ > ghc-commits mailing list > ghc-commits at haskell.org > http://www.haskell.org/mailman/listinfo/ghc-commits > From git at git.haskell.org Wed Jun 11 13:32:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:10 +0000 (UTC) Subject: [commit: ghc] master: Make FunPtr's role be phantom; add comments. (9e6c6b4) Message-ID: <20140611133210.A49382406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e6c6b4206cd893434e49cd893eb67081eeffe99/ghc >--------------------------------------------------------------- commit 9e6c6b4206cd893434e49cd893eb67081eeffe99 Author: Richard Eisenberg Date: Tue Jun 10 13:38:06 2014 -0400 Make FunPtr's role be phantom; add comments. This change also updates castFunPtr to make it free at runtime. This fixes #9163. >--------------------------------------------------------------- 9e6c6b4206cd893434e49cd893eb67081eeffe99 compiler/typecheck/TcForeign.lhs | 23 ++++++++++++++++++++-- libraries/base/GHC/Ptr.lhs | 20 ++++++++++--------- libraries/ghc-prim/GHC/Types.hs | 11 +++++++++-- testsuite/tests/roles/should_compile/Roles2.stderr | 1 + 4 files changed, 42 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index c2f812b..8370e0a 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -94,6 +94,20 @@ parameters. Similarly, we don't need to look in AppTy's, because nothing headed by an AppTy will be marshalable. +Note [FFI type roles] +~~~~~~~~~~~~~~~~~~~~~ +The 'go' helper function within normaliseFfiType' always produces +representational coercions. But, in the "children_only" case, we need to +use these coercions in a TyConAppCo. Accordingly, the roles on the coercions +must be twiddled to match the expectation of the enclosing TyCon. However, +we cannot easily go from an R coercion to an N one, so we forbid N roles +on FFI type constructors. Currently, only two such type constructors exist: +IO and FunPtr. Thus, this is not an onerous burden. + +If we ever want to lift this restriction, we would need to make 'go' take +the target role as a parameter. This wouldn't be hard, but it's a complication +not yet necessary and so is not yet implemented. + \begin{code} -- normaliseFfiType takes the type from an FFI declaration, and -- evaluates any type synonyms, type functions, and newtypes. However, @@ -116,7 +130,8 @@ normaliseFfiType' env ty0 = go initRecTc ty0 -- We don't want to look through the IO newtype, even if it is -- in scope, so we have a special case for it: | tc_key `elem` [ioTyConKey, funPtrTyConKey] - -- Those *must* have R roles on their parameters! + -- These *must not* have nominal roles on their parameters! + -- See Note [FFI type roles] = children_only | isNewTyCon tc -- Expand newtypes @@ -146,7 +161,11 @@ normaliseFfiType' env ty0 = go initRecTc ty0 children_only = do xs <- mapM (go rec_nts) tys let (cos, tys', gres) = unzip3 xs - return ( mkTyConAppCo Representational tc cos + -- the (repeat Representational) is because 'go' always + -- returns R coercions + cos' = zipWith3 downgradeRole (tyConRoles tc) + (repeat Representational) cos + return ( mkTyConAppCo Representational tc cos' , mkTyConApp tc tys', unionManyBags gres) nt_co = mkUnbranchedAxInstCo Representational (newTyConCo tc) tys nt_rhs = newTyConInstRhs tc tys diff --git a/libraries/base/GHC/Ptr.lhs b/libraries/base/GHC/Ptr.lhs index 341512b..a55f01e 100644 --- a/libraries/base/GHC/Ptr.lhs +++ b/libraries/base/GHC/Ptr.lhs @@ -31,13 +31,18 @@ import GHC.Show import GHC.Num import GHC.List ( length, replicate ) import Numeric ( showHex ) -import Data.Coerce #include "MachDeps.h" ------------------------------------------------------------------------ -- Data pointers. +-- The role of Ptr's parameter is phantom, as there is no relation between +-- the Haskell representation and whathever the user puts at the end of the +-- pointer. And phantom is useful to implement castPtr (see #9163) + +-- redundant role annotation checks that this doesn't change +type role Ptr phantom data Ptr a = Ptr Addr# deriving (Eq, Ord) -- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an -- array of objects, which may be marshalled to or from Haskell values @@ -49,10 +54,6 @@ data Ptr a = Ptr Addr# deriving (Eq, Ord) -- to access the pointer. For example you might write small foreign -- functions to get or set the fields of a C @struct at . --- The role of Ptr's parameter is phantom, as there is relation between --- the Haskell representation and whathever the user puts at the end of the --- pointer. And phantom is useful to implement castPtr (see #9163) - -- |The constant 'nullPtr' contains a distinguished value of 'Ptr' -- that is not associated with a valid memory location. nullPtr :: Ptr a @@ -86,7 +87,10 @@ minusPtr (Ptr a1) (Ptr a2) = I# (minusAddr# a1 a2) ------------------------------------------------------------------------ -- Function pointers for the default calling convention. -type role FunPtr representational +-- 'FunPtr' has a phantom role for similar reasons to 'Ptr'. Note +-- that 'FunPtr's role cannot become nominal without changes elsewhere +-- in GHC. See Note [FFI type roles] in TcForeign. +type role FunPtr phantom data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- ^ A value of type @'FunPtr' a@ is a pointer to a function callable -- from foreign code. The type @a@ will normally be a /foreign type/, @@ -128,8 +132,6 @@ data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- > foreign import ccall "dynamic" -- > mkFun :: FunPtr IntFunction -> IntFunction --- The role of FunPtr is representational, to be on the safe side (see #9163) - -- |The constant 'nullFunPtr' contains a -- distinguished value of 'FunPtr' that is not -- associated with a valid memory location. @@ -138,7 +140,7 @@ nullFunPtr = FunPtr nullAddr# -- |Casts a 'FunPtr' to a 'FunPtr' of a different type. castFunPtr :: FunPtr a -> FunPtr b -castFunPtr (FunPtr addr) = FunPtr addr +castFunPtr = coerce -- |Casts a 'FunPtr' to a 'Ptr'. -- diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index 44351d8..f6f4233 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples #-} +{-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples, + RoleAnnotations #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Types @@ -80,7 +81,13 @@ at some point, directly or indirectly, from @Main.main at . or the '>>' and '>>=' operations from the 'Monad' class. -} newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) - +type role IO representational +{- +The above role annotation is redundant but is included because this role +is significant in the normalisation of FFI types. Specifically, if this +role were to become nominal (which would be very strange, indeed!), changes +elsewhere in GHC would be necessary. See [FFI type roles] in TcForeign. +-} {- Note [Kind-changing of (~) and Coercible] diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr index e6f9bcd..2c7ab6c 100644 --- a/testsuite/tests/roles/should_compile/Roles2.stderr +++ b/testsuite/tests/roles/should_compile/Roles2.stderr @@ -1,6 +1,7 @@ TYPE SIGNATURES TYPE CONSTRUCTORS data T1 a = K1 (IO a) + type role T2 phantom data T2 a = K2 (FunPtr a) COERCION AXIOMS Dependent modules: [] From git at git.haskell.org Wed Jun 11 13:32:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:13 +0000 (UTC) Subject: [commit: ghc] master: Add comments about instances of type-level (==). (8dcfdf9) Message-ID: <20140611133213.23F092406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8dcfdf9b1a9fc553e205eaee8d855c8a72e0562f/ghc >--------------------------------------------------------------- commit 8dcfdf9b1a9fc553e205eaee8d855c8a72e0562f Author: Richard Eisenberg Date: Tue Jun 10 14:41:55 2014 -0400 Add comments about instances of type-level (==). >--------------------------------------------------------------- 8dcfdf9b1a9fc553e205eaee8d855c8a72e0562f libraries/base/Data/Type/Equality.hs | 55 ++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 464f7d2..626e817 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -127,6 +127,61 @@ instance TestEquality ((:~:) a) where type family (a :: k) == (b :: k) :: Bool infix 4 == +{- +This comment explains more about why a poly-kinded instance for (==) is +not provided. To be concrete, here would be the poly-kinded instance: + +type family EqPoly (a :: k) (b :: k) where + EqPoly a a = True + EqPoly a b = False +type instance (a :: k) == (b :: k) = EqPoly a b + +Note that this overlaps with every other instance -- if this were defined, +it would be the only instance for (==). + +Now, consider +data Nat = Zero | Succ Nat + +Suppose I want +foo :: (Succ n == Succ m) ~ True => ((n == m) :~: True) +foo = Refl + +This would not type-check with the poly-kinded instance. `Succ n == Succ m` +quickly becomes `EqPoly (Succ n) (Succ m)` but then is stuck. We don't know +enough about `n` and `m` to reduce further. + +On the other hand, consider this: + +type family EqNat (a :: Nat) (b :: Nat) where + EqNat Zero Zero = True + EqNat (Succ n) (Succ m) = EqNat n m + EqNat n m = False +type instance (a :: Nat) == (b :: Nat) = EqNat a b + +With this instance, `foo` type-checks fine. `Succ n == Succ m` becomes `EqNat +(Succ n) (Succ m)` which becomes `EqNat n m`. Thus, we can conclude `(n == m) +~ True` as desired. + +So, the Nat-specific instance allows strictly more reductions, and is thus +preferable to the poly-kinded instance. But, if we introduce the poly-kinded +instance, we are barred from writing the Nat-specific instance, due to +overlap. + +Even better than the current instance for * would be one that does this sort +of recursion for all datatypes, something like this: + +type family EqStar (a :: *) (b :: *) where + EqStar Bool Bool = True + EqStar (a,b) (c,d) = a == c && b == d + EqStar (Maybe a) (Maybe b) = a == b + ... + EqStar a b = False + +The problem is the (...) is extensible -- we would want to add new cases for +all datatypes in scope. This is not currently possible for closed type +families. +-} + -- all of the following closed type families are local to this module type family EqStar (a :: *) (b :: *) where EqStar a a = True From git at git.haskell.org Wed Jun 11 13:32:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:15 +0000 (UTC) Subject: [commit: ghc] master: Clarify error message. See #9167. (1153194) Message-ID: <20140611133215.7957F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1153194ca1ec867ca01675a902cdf7dab72b5dab/ghc >--------------------------------------------------------------- commit 1153194ca1ec867ca01675a902cdf7dab72b5dab Author: Richard Eisenberg Date: Tue Jun 10 14:31:04 2014 -0400 Clarify error message. See #9167. >--------------------------------------------------------------- 1153194ca1ec867ca01675a902cdf7dab72b5dab compiler/typecheck/TcTyClsDecls.lhs | 2 +- testsuite/tests/indexed-types/should_fail/T2888.stderr | 2 +- testsuite/tests/indexed-types/should_fail/T9167.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail116.stderr | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 4239530..1b7ad4c 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -2074,7 +2074,7 @@ classFunDepsErr cls noClassTyVarErr :: Class -> SDoc -> SDoc noClassTyVarErr clas what = sep [ptext (sLit "The") <+> what, - ptext (sLit "mentions none of the type variables of the class") <+> + ptext (sLit "mentions none of the type or kind variables of the class") <+> quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))] recSynErr :: [LTyClDecl Name] -> TcRn () diff --git a/testsuite/tests/indexed-types/should_fail/T2888.stderr b/testsuite/tests/indexed-types/should_fail/T2888.stderr index df217dd..3d2c221 100644 --- a/testsuite/tests/indexed-types/should_fail/T2888.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2888.stderr @@ -1,5 +1,5 @@ T2888.hs:6:1: The associated type ?D? - mentions none of the type variables of the class ?C w? + mentions none of the type or kind variables of the class ?C w? In the class declaration for ?C? diff --git a/testsuite/tests/indexed-types/should_fail/T9167.stderr b/testsuite/tests/indexed-types/should_fail/T9167.stderr index ec230fa..1bd21ae 100644 --- a/testsuite/tests/indexed-types/should_fail/T9167.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9167.stderr @@ -1,5 +1,5 @@ T9167.hs:5:1: The associated type ?F? - mentions none of the type variables of the class ?C a? + mentions none of the type or kind variables of the class ?C a? In the class declaration for ?C? diff --git a/testsuite/tests/typecheck/should_fail/tcfail116.stderr b/testsuite/tests/typecheck/should_fail/tcfail116.stderr index 51b89ef..0136173 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail116.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail116.stderr @@ -1,6 +1,6 @@ tcfail116.hs:5:1: The class method ?bug? - mentions none of the type variables of the class ?Foo a? + mentions none of the type or kind variables of the class ?Foo a? When checking the class method: bug :: () In the class declaration for ?Foo? From git at git.haskell.org Wed Jun 11 13:32:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:17 +0000 (UTC) Subject: [commit: ghc] master: Refine deprecation warnings in template-haskell. (0f584ae) Message-ID: <20140611133218.01AF62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f584ae391dc62ab4bd81939503b3b5b4e47e570/ghc >--------------------------------------------------------------- commit 0f584ae391dc62ab4bd81939503b3b5b4e47e570 Author: Richard Eisenberg Date: Tue Jun 10 14:49:16 2014 -0400 Refine deprecation warnings in template-haskell. >--------------------------------------------------------------- 0f584ae391dc62ab4bd81939503b3b5b4e47e570 libraries/template-haskell/Language/Haskell/TH/Lib.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs index 345f16b..3ac16d1 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs @@ -526,14 +526,14 @@ sigT t k equalityT :: TypeQ equalityT = return EqualityT -{-# DEPRECATED classP "Constraint constructors are just type constructors, frob this code as 'constraintT'." #-} +{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-} classP :: Name -> [Q Type] -> Q Pred classP cla tys = do tysl <- sequence tys return (foldl AppT (ConT cla) tysl) -{-# DEPRECATED equalP "Constraint constructors are just type constructors, frob this code as 'equalT'." #-} +{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-} equalP :: TypeQ -> TypeQ -> PredQ equalP tleft tright = do From git at git.haskell.org Wed Jun 11 13:32:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:20 +0000 (UTC) Subject: [commit: ghc] master: Fix #9097. (051d694) Message-ID: <20140611133220.B65032406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/051d694fc978ad28ac3043d296cafddd3c2a7050/ghc >--------------------------------------------------------------- commit 051d694fc978ad28ac3043d296cafddd3c2a7050 Author: Richard Eisenberg Date: Tue Jun 10 15:21:47 2014 -0400 Fix #9097. `Any` is now an abstract (that is, no equations) closed type family. >--------------------------------------------------------------- 051d694fc978ad28ac3043d296cafddd3c2a7050 compiler/prelude/TysPrim.lhs | 16 ++++------------ compiler/prelude/primops.txt.pp | 9 ++++++--- 2 files changed, 10 insertions(+), 15 deletions(-) diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index ae9a11e..0547c91 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -701,7 +701,7 @@ threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructor Any of kind forall k. k -> k has these properties: +The type constructor Any of kind forall k. k has these properties: * It is defined in module GHC.Prim, and exported so that it is available to users. For this reason it's treated like any other @@ -714,7 +714,7 @@ The type constructor Any of kind forall k. k -> k has these properties: g :: ty ~ (Fst ty, Snd ty) If Any was a *data* type, then we'd get inconsistency because 'ty' could be (Any '(k1,k2)) and then we'd have an equality with Any on - one side and '(,) on the other + one side and '(,) on the other. See also #9097. * It is lifted, and hence represented by a pointer @@ -771,20 +771,12 @@ anyTy :: Type anyTy = mkTyConTy anyTyCon anyTyCon :: TyCon -anyTyCon = mkLiftedPrimTyCon anyTyConName kind [Nominal] PtrRep - where kind = ForAllTy kKiVar (mkTyVarTy kKiVar) - -{- Can't do this yet without messing up kind proxies --- RAE: I think you can now. -anyTyCon :: TyCon -anyTyCon = mkSynTyCon anyTyConName kind [kKiVar] +anyTyCon = mkSynTyCon anyTyConName kind [kKiVar] [Nominal] syn_rhs NoParentTyCon where kind = ForAllTy kKiVar (mkTyVarTy kKiVar) - syn_rhs = SynFamilyTyCon { synf_open = False, synf_injective = True } - -- NB Closed, injective --} + syn_rhs = AbstractClosedSynFamilyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = TyConApp anyTyCon [kind] diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 764ba10..4851315 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2437,7 +2437,7 @@ pseudoop "seq" { Evaluates its first argument to head normal form, and then returns its second argument as the result. } -primtype Any k +primtype Any { The type constructor {\tt Any} is type to which you can unsafely coerce any lifted type, and back. @@ -2462,8 +2462,11 @@ primtype Any k {\tt length (Any *) ([] (Any *))} - Note that {\tt Any} is kind polymorphic, and takes a kind {\tt k} as its - first argument. The kind of {\tt Any} is thus {\tt forall k. k -> k}.} + Above, we print kinds explicitly, as if with + {\tt -fprint-explicit-kinds}. + + Note that {\tt Any} is kind polymorphic; its kind is thus + {\tt forall k. k}.} primtype AnyK { The kind {\tt AnyK} is the kind level counterpart to {\tt Any}. In a From git at git.haskell.org Wed Jun 11 13:32:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:22 +0000 (UTC) Subject: [commit: ghc] master: Fix #9085. (6a1d7f9) Message-ID: <20140611133222.EDAAB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6a1d7f9736098d47463a71323d28ece792a59e52/ghc >--------------------------------------------------------------- commit 6a1d7f9736098d47463a71323d28ece792a59e52 Author: Richard Eisenberg Date: Tue Jun 10 15:25:36 2014 -0400 Fix #9085. Inaccessible equations in a closed type family now leads to a warning, not an error. This echoes what happens at the term level. >--------------------------------------------------------------- 6a1d7f9736098d47463a71323d28ece792a59e52 compiler/typecheck/TcTyClsDecls.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 1b7ad4c..c21631f 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1466,8 +1466,8 @@ checkValidClosedCoAxiom (CoAxiom { co_ax_branches = branches, co_ax_tc = tc }) -- ones and hence is inaccessible check_accessibility prev_branches cur_branch = do { when (cur_branch `isDominatedBy` prev_branches) $ - setSrcSpan (coAxBranchSpan cur_branch) $ - addErrTc $ inaccessibleCoAxBranch tc cur_branch + addWarnAt (coAxBranchSpan cur_branch) $ + inaccessibleCoAxBranch tc cur_branch ; return (cur_branch : prev_branches) } checkFieldCompat :: Name -> DataCon -> DataCon -> TyVarSet @@ -2167,7 +2167,7 @@ wrongNamesInInstGroup first cur inaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc inaccessibleCoAxBranch tc fi - = ptext (sLit "Inaccessible family instance equation:") $$ + = ptext (sLit "Overlapped type family instance equation:") $$ (pprCoAxBranch tc fi) badRoleAnnot :: Name -> Role -> Role -> SDoc From git at git.haskell.org Wed Jun 11 13:32:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:25 +0000 (UTC) Subject: [commit: ghc] master: Fix #9062. (e79e2c3) Message-ID: <20140611133225.ED3502406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e79e2c3996181a1179cf4a1357981f4ed9759203/ghc >--------------------------------------------------------------- commit e79e2c3996181a1179cf4a1357981f4ed9759203 Author: Richard Eisenberg Date: Tue Jun 10 15:33:18 2014 -0400 Fix #9062. Removed (pprEqPred (coercionKind co)) in favor of (pprType (coercionType co)). Also had to make "~R#" a *symbolic* identifier and BuiltInSyntax to squelch prefix notation and module prefixes in output. These changes are both sensible independent of #9062. >--------------------------------------------------------------- e79e2c3996181a1179cf4a1357981f4ed9759203 compiler/basicTypes/OccName.lhs | 3 +++ compiler/coreSyn/CoreUtils.lhs | 2 +- compiler/coreSyn/PprCore.lhs | 2 +- compiler/prelude/TysPrim.lhs | 12 ++++++++++-- compiler/types/OptCoercion.lhs | 4 ++-- compiler/types/Type.lhs | 2 +- compiler/types/TypeRep.lhs | 15 +-------------- testsuite/tests/roles/should_compile/Roles13.stderr | 3 +-- 8 files changed, 20 insertions(+), 23 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 28aeff8..087298f 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -898,9 +898,12 @@ isLexConSym cs -- Infix type or data constructors | otherwise = startsConSym (headFS cs) isLexVarSym fs -- Infix identifiers e.g. "+" + | fs == (fsLit "~R#") = True + | otherwise = case (if nullFS fs then [] else unpackFS fs) of [] -> False (c:cs) -> startsVarSym c && all isVarSymChar cs + -- See Note [Classification of generated names] ------------- startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 6f21c4e..3bf07fe 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -217,7 +217,7 @@ mkCast expr co -- if to_ty `eqType` from_ty -- then expr -- else - WARN(not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ pprEqPred (coercionKind co)) + WARN(not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ ppr (coercionType co)) (Cast expr co) \end{code} diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 35c0630..f86a911 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -121,7 +121,7 @@ ppr_expr add_par (Cast expr co) if gopt Opt_SuppressCoercions dflags then ptext (sLit "...") else parens $ - sep [ppr co, dcolon <+> pprEqPred (coercionKind co)] + sep [ppr co, dcolon <+> ppr (coercionType co)] ppr_expr add_par expr@(Lam _ _) diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 0547c91..de151fd 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -159,7 +159,15 @@ mkPrimTc fs unique tycon = mkWiredInName gHC_PRIM (mkTcOccFS fs) unique (ATyCon tycon) -- Relevant TyCon - UserSyntax -- None are built-in syntax + UserSyntax + +mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name +mkBuiltInPrimTc fs unique tycon + = mkWiredInName gHC_PRIM (mkTcOccFS fs) + unique + (ATyCon tycon) -- Relevant TyCon + BuiltInSyntax + charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon @@ -176,7 +184,7 @@ statePrimTyConName = mkPrimTc (fsLit "State#") statePrimTyConKey stat voidPrimTyConName = mkPrimTc (fsLit "Void#") voidPrimTyConKey voidPrimTyCon proxyPrimTyConName = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon eqPrimTyConName = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon -eqReprPrimTyConName = mkPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon +eqReprPrimTyConName = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon arrayPrimTyConName = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon byteArrayPrimTyConName = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs index 12787b2..dc7ab78 100644 --- a/compiler/types/OptCoercion.lhs +++ b/compiler/types/OptCoercion.lhs @@ -88,8 +88,8 @@ opt_co env sym co = pprTrace "opt_co {" (ppr sym <+> ppr co $$ ppr env) $ co1 `seq` pprTrace "opt_co done }" (ppr co1) $ - (WARN( not same_co_kind, ppr co <+> dcolon <+> pprEqPred (Pair s1 t1) - $$ ppr co1 <+> dcolon <+> pprEqPred (Pair s2 t2) ) + (WARN( not same_co_kind, ppr co <+> dcolon <+> ppr (coercionType co) + $$ ppr co1 <+> dcolon <+> ppr (coercionType co1) ) WARN( not (coreEqCoercion co1 simple_result), (text "env=" <+> ppr env) $$ (text "input=" <+> ppr co) $$ diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 13ceb44..0e93c96 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -130,7 +130,7 @@ module Type ( -- * Pretty-printing pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing, pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll, pprSigmaType, - pprEqPred, pprTheta, pprThetaArrowTy, pprClassPred, + pprTheta, pprThetaArrowTy, pprClassPred, pprKind, pprParendKind, pprSourceTyCon, -- * Tidying type related things up for printing diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index 2a38a5d..c93a653 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -39,7 +39,7 @@ module TypeRep ( -- Pretty-printing pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs, pprTyThing, pprTyThingCategory, pprSigmaType, - pprEqPred, pprTheta, pprForAll, pprUserForAll, + pprTheta, pprForAll, pprUserForAll, pprThetaArrowTy, pprClassPred, pprKind, pprParendKind, pprTyLit, suppressKinds, TyPrec(..), maybeParen, pprTcApp, @@ -82,7 +82,6 @@ import CoAxiom import PrelNames import Outputable import FastString -import Pair import Util import DynFlags @@ -515,18 +514,6 @@ pprKind, pprParendKind :: Kind -> SDoc pprKind = pprType pprParendKind = pprParendType ------------------- -pprEqPred :: Pair Type -> SDoc --- NB: Maybe move to Coercion? It's only called after coercionKind anyway. -pprEqPred (Pair ty1 ty2) - = sep [ ppr_type FunPrec ty1 - , nest 2 (ptext (sLit "~#")) - , ppr_type FunPrec ty2] - -- Precedence looks like (->) so that we get - -- Maybe a ~ Bool - -- (a->a) ~ Bool - -- Note parens on the latter! - ------------ pprClassPred :: Class -> [Type] -> SDoc pprClassPred clas tys = pprTypeApp (classTyCon clas) tys diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr index 647e59b..b0dda24 100644 --- a/testsuite/tests/roles/should_compile/Roles13.stderr +++ b/testsuite/tests/roles/should_compile/Roles13.stderr @@ -13,8 +13,7 @@ Roles13.convert = `cast` (_R -> Roles13.NTCo:Wrap[0] Roles13.NTCo:Age[0] :: (Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age) - ~# - (Roles13.Wrap Roles13.Age -> GHC.Types.Int)) + ~R# (Roles13.Wrap Roles13.Age -> GHC.Types.Int)) From git at git.haskell.org Wed Jun 11 13:32:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:29 +0000 (UTC) Subject: [commit: ghc] master: Fix #9111. (9dbf340) Message-ID: <20140611133229.7596F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9dbf3409716fe0ec2a57688124d1ee903db77f0e/ghc >--------------------------------------------------------------- commit 9dbf3409716fe0ec2a57688124d1ee903db77f0e Author: Richard Eisenberg Date: Tue Jun 10 17:44:32 2014 -0400 Fix #9111. Data.Typeable.Internal should now derive instances for all types defined in modules beneath it. Still to do: Typeable instances for type literals, but that's a very separate matter. >--------------------------------------------------------------- 9dbf3409716fe0ec2a57688124d1ee903db77f0e libraries/base/Data/Typeable/Internal.hs | 59 ++++++++++++++++++++++++++++++-- 1 file changed, 57 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index fa18bf9..1bee846 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -50,6 +50,7 @@ module Data.Typeable.Internal ( import GHC.Base import GHC.Word import GHC.Show +import GHC.Read ( Read ) import Data.Maybe import Data.Proxy import GHC.Num @@ -57,13 +58,20 @@ import GHC.Real -- import GHC.IORef -- import GHC.IOArray -- import GHC.MVar -import GHC.ST ( ST ) +import GHC.ST ( ST, STret ) import GHC.STRef ( STRef ) import GHC.Ptr ( Ptr, FunPtr ) -- import GHC.Stable -import GHC.Arr ( Array, STArray ) +import GHC.Arr ( Array, STArray, Ix ) import Data.Type.Coercion import Data.Type.Equality +import Text.ParserCombinators.ReadP ( ReadP ) +import Text.Read.Lex ( Lexeme, Number ) +import Text.ParserCombinators.ReadPrec ( ReadPrec ) +import GHC.Float ( FFFormat, RealFloat, Floating ) +import Data.Bits ( Bits, FiniteBits ) +import GHC.Enum ( Bounded, Enum ) +import Control.Monad ( MonadPlus ) -- import Data.Int import GHC.Fingerprint.Type @@ -316,6 +324,7 @@ deriving instance Typeable IO deriving instance Typeable Array deriving instance Typeable ST +deriving instance Typeable STret deriving instance Typeable STRef deriving instance Typeable STArray @@ -351,8 +360,54 @@ deriving instance Typeable Word64 deriving instance Typeable TyCon deriving instance Typeable TypeRep +deriving instance Typeable Fingerprint deriving instance Typeable RealWorld deriving instance Typeable Proxy +deriving instance Typeable KProxy deriving instance Typeable (:~:) deriving instance Typeable Coercion + +deriving instance Typeable ReadP +deriving instance Typeable Lexeme +deriving instance Typeable Number +deriving instance Typeable ReadPrec + +deriving instance Typeable FFFormat + +------------------------------------------------------- +-- +-- Generate Typeable instances for standard classes +-- +------------------------------------------------------- + +deriving instance Typeable (~) +deriving instance Typeable Coercible +deriving instance Typeable TestEquality +deriving instance Typeable TestCoercion + +deriving instance Typeable Eq +deriving instance Typeable Ord + +deriving instance Typeable Bits +deriving instance Typeable FiniteBits +deriving instance Typeable Num +deriving instance Typeable Real +deriving instance Typeable Integral +deriving instance Typeable Fractional +deriving instance Typeable RealFrac +deriving instance Typeable Floating +deriving instance Typeable RealFloat + +deriving instance Typeable Bounded +deriving instance Typeable Enum +deriving instance Typeable Ix + +deriving instance Typeable Show +deriving instance Typeable Read + +deriving instance Typeable Functor +deriving instance Typeable Monad +deriving instance Typeable MonadPlus + +deriving instance Typeable Typeable From git at git.haskell.org Wed Jun 11 13:32:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:32 +0000 (UTC) Subject: [commit: ghc] master: Test #9097. (7b10d01) Message-ID: <20140611133233.11E162406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7b10d013a50a9fe4f100a2cb8b02a28e8d398357/ghc >--------------------------------------------------------------- commit 7b10d013a50a9fe4f100a2cb8b02a28e8d398357 Author: Richard Eisenberg Date: Tue Jun 10 16:06:00 2014 -0400 Test #9097. >--------------------------------------------------------------- 7b10d013a50a9fe4f100a2cb8b02a28e8d398357 testsuite/tests/indexed-types/should_fail/T9097.hs | 10 ++++++++++ testsuite/tests/indexed-types/should_fail/T9097.stderr | 5 +++++ testsuite/tests/indexed-types/should_fail/all.T | 2 +- 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/indexed-types/should_fail/T9097.hs b/testsuite/tests/indexed-types/should_fail/T9097.hs new file mode 100644 index 0000000..b18b90b --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9097.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} + +module T9097 where + +import GHC.Exts + +type family Foo x where + Foo True = False + Foo False = False + Foo Any = True diff --git a/testsuite/tests/indexed-types/should_fail/T9097.stderr b/testsuite/tests/indexed-types/should_fail/T9097.stderr new file mode 100644 index 0000000..02dfc33 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9097.stderr @@ -0,0 +1,5 @@ + +T9097.hs:10:3: + Illegal type synonym family application in instance: Any + In the equations for closed type family ?Foo? + In the type family declaration for ?Foo? diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index a5adfaa..9d3f851 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -122,4 +122,4 @@ test('T8518', normal, compile_fail, ['']) test('T9036', normal, compile_fail, ['']) test('T9167', normal, compile_fail, ['']) test('T9171', normal, compile_fail, ['']) - +test('T9097', normal, compile_fail, ['']) From git at git.haskell.org Wed Jun 11 13:32:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:36 +0000 (UTC) Subject: [commit: ghc] master: Test #9085. (f502617) Message-ID: <20140611133236.56F592406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f502617065c8716a062c83fc923c3b3a2395c4a8/ghc >--------------------------------------------------------------- commit f502617065c8716a062c83fc923c3b3a2395c4a8 Author: Richard Eisenberg Date: Wed Jun 11 08:29:27 2014 -0400 Test #9085. >--------------------------------------------------------------- f502617065c8716a062c83fc923c3b3a2395c4a8 testsuite/tests/indexed-types/should_compile/T9085.hs | 7 +++++++ testsuite/tests/indexed-types/should_compile/T9085.stderr | 4 ++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 12 insertions(+) diff --git a/testsuite/tests/indexed-types/should_compile/T9085.hs b/testsuite/tests/indexed-types/should_compile/T9085.hs new file mode 100644 index 0000000..13c9321 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T9085.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +module T9085 where + +type family F a where + F a = Int + F Bool = Bool diff --git a/testsuite/tests/indexed-types/should_compile/T9085.stderr b/testsuite/tests/indexed-types/should_compile/T9085.stderr new file mode 100644 index 0000000..ee968e0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T9085.stderr @@ -0,0 +1,4 @@ + +T9085.hs:7:3: Warning: + Overlapped type family instance equation: + F Bool = Bool diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 5f30446..7c41be8 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -243,3 +243,4 @@ test('T8889', normal, compile, ['']) test('T8913', normal, compile, ['']) test('T8978', normal, compile, ['']) test('T8979', normal, compile, ['']) +test('T9085', normal, compile, ['']) From git at git.haskell.org Wed Jun 11 13:32:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 13:32:38 +0000 (UTC) Subject: [commit: ghc] master: Test #9111. (f73d42f) Message-ID: <20140611133242.B800C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f73d42f0c88153bcfec23d8f35d0721272539867/ghc >--------------------------------------------------------------- commit f73d42f0c88153bcfec23d8f35d0721272539867 Author: Richard Eisenberg Date: Wed Jun 11 08:34:58 2014 -0400 Test #9111. >--------------------------------------------------------------- f73d42f0c88153bcfec23d8f35d0721272539867 libraries/base/tests/T9111.hs | 10 ++++++++++ libraries/base/tests/all.T | 2 ++ 2 files changed, 12 insertions(+) diff --git a/libraries/base/tests/T9111.hs b/libraries/base/tests/T9111.hs new file mode 100644 index 0000000..b2d1716 --- /dev/null +++ b/libraries/base/tests/T9111.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DataKinds #-} + +module T9111 where + +import Data.Typeable + +a = typeRep (Proxy :: Proxy 'True) +b = typeRep (Proxy :: Proxy Typeable) +c = typeRep (Proxy :: Proxy (~)) +d = typeRep (Proxy :: Proxy 'Left) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 31c6344..12a2410 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -166,3 +166,5 @@ test('T8766', , only_ways(['normal'])], compile_and_run, ['-O']) + +test('T9111', normal, compile, ['']) From git at git.haskell.org Wed Jun 11 18:23:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 18:23:34 +0000 (UTC) Subject: [commit: ghc] master: Typo in variable name, no functional change (a9ff7d0) Message-ID: <20140611182334.C71B22406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9ff7d0819fce392a243549c08299b897f04d555/ghc >--------------------------------------------------------------- commit a9ff7d0819fce392a243549c08299b897f04d555 Author: Gabor Greif Date: Wed Jun 11 01:00:58 2014 +0200 Typo in variable name, no functional change >--------------------------------------------------------------- a9ff7d0819fce392a243549c08299b897f04d555 compiler/iface/MkIface.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 760f349..de99e98 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -880,9 +880,9 @@ instOrphWarn dflags unqual inst = mkWarnMsg dflags (getSrcSpan inst) unqual $ hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst) $$ text "To avoid this" - $$ nest 4 (vcat posibilities) + $$ nest 4 (vcat possibilities) where - posibilities = + possibilities = text "move the instance declaration to the module of the class or of the type, or" : text "wrap the type with a newtype and declare the instance on the new type." : [] From git at git.haskell.org Wed Jun 11 18:23:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 18:23:37 +0000 (UTC) Subject: [commit: ghc] master: Some typos in comments (edd5764) Message-ID: <20140611182337.ADFD62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/edd5764509c7df65e3f5409888cbacf58435d11e/ghc >--------------------------------------------------------------- commit edd5764509c7df65e3f5409888cbacf58435d11e Author: Gabor Greif Date: Wed Jun 11 01:37:01 2014 +0200 Some typos in comments >--------------------------------------------------------------- edd5764509c7df65e3f5409888cbacf58435d11e compiler/basicTypes/OccName.lhs | 2 +- compiler/coreSyn/CoreTidy.lhs | 4 ++-- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 +- compiler/main/PprTyThing.hs | 2 +- compiler/nativeGen/AsmCodeGen.lhs | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 087298f..1248432 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -128,7 +128,7 @@ import Data.Data %* * %************************************************************************ -FastStringEnv can't be in FastString becuase the env depends on UniqFM +FastStringEnv can't be in FastString because the env depends on UniqFM \begin{code} type FastStringEnv a = UniqFM a -- Keyed by FastString diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs index af1e12c..4754aa5 100644 --- a/compiler/coreSyn/CoreTidy.lhs +++ b/compiler/coreSyn/CoreTidy.lhs @@ -256,11 +256,11 @@ Consider False -> 2# in ...) -The z# binding is ok becuase the RHS is ok-for-speculation, +The z# binding is ok because the RHS is ok-for-speculation, but Lint will complain unless it can *see* that. So we preserve the evaluated-ness on 'y' in tidyBndr. -(Another alterantive would be to tidy unboxed lets into cases, +(Another alternative would be to tidy unboxed lets into cases, but that seems more indirect and surprising.) diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 342b94f..5175535 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -804,7 +804,7 @@ genSwitch cond maybe_ids = do let pairs = [ (ix, id) | (ix,Just id) <- zip [0..] maybe_ids ] let labels = map (\(ix, b) -> (mkIntLit ty ix, blockIdToLlvm b)) pairs - -- out of range is undefied, so lets just branch to first label + -- out of range is undefined, so let's just branch to first label let (_, defLbl) = head labels let s1 = Switch vc defLbl labels diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index d88b137..d993ab8 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -82,7 +82,7 @@ See #7730, #8776 for details -} -- | Pretty-prints a 'FamInst' (type/data family instance) with its defining location. pprFamInst :: FamInst -> SDoc -- * For data instances we go via pprTyThing of the represntational TyCon, --- becuase there is already much cleverness associated with printing +-- because there is already much cleverness associated with printing -- data type declarations that I don't want to duplicate -- * For type instances we print directly here; there is no TyCon -- to give to pprTyThing diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 82193b4..e53bb11 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -606,7 +606,7 @@ makeImportsDoc dflags imports then text ".section .note.GNU-stack,\"\", at progbits" else empty) $$ - -- And just because every other compiler does, lets stick in + -- And just because every other compiler does, let's stick in -- an identifier directive: .ident "GHC x.y.z" (if platformHasIdentDirective platform then let compilerIdent = text "GHC" <+> text cProjectVersion From git at git.haskell.org Wed Jun 11 19:57:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 19:57:12 +0000 (UTC) Subject: [commit: ghc] master: Improve error message in Trac #8883 (56f8777) Message-ID: <20140611195713.3CAFD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/56f8777f99d9fd849ca6f1151fead3f62707f308/ghc >--------------------------------------------------------------- commit 56f8777f99d9fd849ca6f1151fead3f62707f308 Author: Simon Peyton Jones Date: Tue Jun 10 17:50:22 2014 +0100 Improve error message in Trac #8883 The improvement is to report the inferred type in the error message, as suggested in email on ghc-deves (10 Jun 14). >--------------------------------------------------------------- 56f8777f99d9fd849ca6f1151fead3f62707f308 compiler/typecheck/TcBinds.lhs | 96 +++++++++++++--------- compiler/typecheck/TcValidity.lhs | 3 + .../tests/indexed-types/should_fail/T1897b.stderr | 4 +- .../tests/indexed-types/should_fail/T2693.stderr | 3 +- .../tests/indexed-types/should_fail/T9171.stderr | 5 +- .../tests/typecheck/should_compile/tc168.stderr | 4 +- .../tests/typecheck/should_fail/T1897a.stderr | 4 +- testsuite/tests/typecheck/should_fail/T8142.stderr | 4 +- testsuite/tests/typecheck/should_fail/T8883.stderr | 9 +- testsuite/tests/typecheck/should_fail/all.T | 1 + .../tests/typecheck/should_fail/tcfail080.stderr | 6 +- 11 files changed, 82 insertions(+), 57 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 56f8777f99d9fd849ca6f1151fead3f62707f308 From git at git.haskell.org Wed Jun 11 19:57:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 19:57:15 +0000 (UTC) Subject: [commit: ghc] master: Comments only explaining the imports for GHC.Integer, GHC.Tuple (7817ec1) Message-ID: <20140611195715.7DBDF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7817ec16d186a59f169202c930e211bda553777b/ghc >--------------------------------------------------------------- commit 7817ec16d186a59f169202c930e211bda553777b Author: Simon Peyton Jones Date: Tue Jun 10 17:57:37 2014 +0100 Comments only explaining the imports for GHC.Integer, GHC.Tuple See Note [Depend on GHC.Integer] Note [Depend on GHC.Tuple] This came up when Joachim got an unexpected missing-dependency error when fiddling with Data.Coerce. >--------------------------------------------------------------- 7817ec16d186a59f169202c930e211bda553777b libraries/base/GHC/Base.lhs | 40 ++++++++++++++++++++++++++++++++-------- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 2236a14..5c362d4 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -114,14 +114,8 @@ import GHC.Prim import GHC.Err import {-# SOURCE #-} GHC.IO (failIO) --- This is not strictly speaking required by this module, but is an --- implicit dependency whenever () or tuples are mentioned, so adding it --- as an import here helps to get the dependencies right in the new --- build system. -import GHC.Tuple () --- Likewise we need Integer when deriving things like Eq instances, and --- this is a convenient place to force it to be built -import GHC.Integer () +import GHC.Tuple () -- Note [Depend on GHC.Tuple] +import GHC.Integer () -- Note [Depend on GHC.Integer] infixr 9 . infixr 5 ++ @@ -132,6 +126,36 @@ infixr 0 $ default () -- Double isn't available yet \end{code} +Note [Depend on GHC.Integer] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Integer type is special because TidyPgm uses +GHC.Integer.Type.mkInteger to construct Integer literal values +Currently it reads the interface file whether or not the current +module *has* any Integer literals, so it's important that +GHC.Integer.Type (in patckage integer-gmp or integer-simple) is +compiled before any other module. (There's a hack in GHC to disable +this for packages ghc-prim, integer-gmp, integer-simple, which aren't +allowed to contain any Integer literals.) + +Likewise we implicitly need Integer when deriving things like Eq +instances. + +The danger is that if the build system doesn't know about the dependency +on Integer, it'll compile some base module before GHC.Integer.Type, +resulting in: + Failed to load interface for ?GHC.Integer.Type? + There are files missing in the ?integer-gmp? package, + +Bottom line: we make GHC.Base depend on GHC.Integer; and everything +else either depends on GHC.Base, or does not have NoImplicitPrelude +(ane hence depends on Prelude). + +Note [Depend on GHC.Tuple] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Similarly, tuple syntax (or ()) creates an implicit dependency on +GHC.Tuple, so we use the same ruse as for Integer --- see Note [Depend on +GHC.Integer] --- to explain this to the build system. We make GHC.Base +depend on GHC.Tuple, and everything else depends on GHC.Base or Prelude. %********************************************************* %* * From git at git.haskell.org Wed Jun 11 19:57:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 19:57:17 +0000 (UTC) Subject: [commit: ghc] master: Fix tyConToIfaceDecl (Trac #9190) (e5257f8) Message-ID: <20140611195718.348C02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e5257f8fe20f5278c23693f1523e298e6fdaa064/ghc >--------------------------------------------------------------- commit e5257f8fe20f5278c23693f1523e298e6fdaa064 Author: Simon Peyton Jones Date: Wed Jun 11 15:09:55 2014 +0100 Fix tyConToIfaceDecl (Trac #9190) There are three bugs here, one serious * We were failing to tidy the type arguments in an IfTyConParent This is what was causing Trac #9190. * toIfaceTcArgs is careful to suppress kind arguments, but there was a clone, tidyToIfaceTcArgs in IfaceSyn which didn't. Now the latter goes via the former. * When pretty-printing a IfaceDecl for an algebraic data type, and doing so in Haskell-98 syntax, we were silently assuming that the universal type variables of the TyCon and the DataCon were the same. But that has not been true for some time. Result: a very confusing display. Solution: during the conversion to IfaceSyn, take the opportunity to make the universal type variables line up exactly. This is very easy to do, makes the pretty-printing easy, and leaves open the future possiblity of not serialising the universal type variables of the data constructor. >--------------------------------------------------------------- e5257f8fe20f5278c23693f1523e298e6fdaa064 compiler/iface/MkIface.lhs | 67 +++++++++++++++++-------------- testsuite/tests/ghci/scripts/T4087.stdout | 2 +- testsuite/tests/polykinds/T7438.stderr | 2 +- 3 files changed, 38 insertions(+), 33 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e5257f8fe20f5278c23693f1523e298e6fdaa064 From git at git.haskell.org Wed Jun 11 19:57:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 19:57:20 +0000 (UTC) Subject: [commit: ghc] master: White space only (748bec4) Message-ID: <20140611195720.590F02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/748bec483b8e1c8ae69e68903f5c3d5bd93e92be/ghc >--------------------------------------------------------------- commit 748bec483b8e1c8ae69e68903f5c3d5bd93e92be Author: Simon Peyton Jones Date: Tue Jun 10 17:57:49 2014 +0100 White space only >--------------------------------------------------------------- 748bec483b8e1c8ae69e68903f5c3d5bd93e92be compiler/typecheck/TcType.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index b093d80..a952ce7 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -480,7 +480,7 @@ pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_untch = untch }) pprUserTypeCtxt :: UserTypeCtxt -> SDoc pprUserTypeCtxt (InfSigCtxt n) = ptext (sLit "the inferred type for") <+> quotes (ppr n) pprUserTypeCtxt (FunSigCtxt n) = ptext (sLit "the type signature for") <+> quotes (ppr n) -pprUserTypeCtxt (RuleSigCtxt n) = ptext (sLit "a RULE for") <+> quotes (ppr n) +pprUserTypeCtxt (RuleSigCtxt n) = ptext (sLit "a RULE for") <+> quotes (ppr n) pprUserTypeCtxt ExprSigCtxt = ptext (sLit "an expression type signature") pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c) pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c) From git at git.haskell.org Wed Jun 11 19:57:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 19:57:22 +0000 (UTC) Subject: [commit: ghc] master: Simplify variable naming in tcDataKindSig (c8295c0) Message-ID: <20140611195722.C0C702406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c8295c0bd58485db5572d3c35427d321bdf1b7d0/ghc >--------------------------------------------------------------- commit c8295c0bd58485db5572d3c35427d321bdf1b7d0 Author: Simon Peyton Jones Date: Wed Jun 11 19:49:50 2014 +0100 Simplify variable naming in tcDataKindSig Now that we are very consistent about tidying when converting to IfaceSyn, we don't need to worry about accidental capture of the "extra" type variables in tcDataKindSig. (Previously we gave them weird names like $a.) However, it is nicer for the user if we don't gratuitously re-use an in-scope name, so we take care not to do that . >--------------------------------------------------------------- c8295c0bd58485db5572d3c35427d321bdf1b7d0 compiler/typecheck/TcHsType.lhs | 46 +++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index cf00a36..69579ad 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -54,6 +54,7 @@ import TcType import Type import TypeRep( Type(..) ) -- For the mkNakedXXX stuff import Kind +import RdrName( lookupLocalRdrOcc ) import Var import VarSet import TyCon @@ -73,6 +74,7 @@ import Outputable import FastString import Util +import Data.Maybe( isNothing ) import Control.Monad ( unless, when, zipWithM ) import PrelNames( ipClassName, funTyConKey ) \end{code} @@ -1318,20 +1320,22 @@ tcDataKindSig kind = do { checkTc (isLiftedTypeKind res_kind) (badKindSig kind) ; span <- getSrcSpanM ; us <- newUniqueSupply + ; rdr_env <- getLocalRdrEnv ; let uniqs = uniqsFromSupply us - ; return [ mk_tv span uniq str kind - | ((kind, str), uniq) <- arg_kinds `zip` dnames `zip` uniqs ] } + occs = [ occ | str <- strs + , let occ = mkOccName tvName str + , isNothing (lookupLocalRdrOcc rdr_env occ) ] + -- Note [Avoid name clashes for associated data types] + + ; return [ mk_tv span uniq occ kind + | ((kind, occ), uniq) <- arg_kinds `zip` occs `zip` uniqs ] } where (arg_kinds, res_kind) = splitKindFunTys kind - mk_tv loc uniq str kind = mkTyVar name kind - where - name = mkInternalName uniq occ loc - occ = mkOccName tvName str - - dnames = map ('$' :) names -- Note [Avoid name clashes for associated data types] + mk_tv loc uniq occ kind + = mkTyVar (mkInternalName uniq occ loc) kind - names :: [String] - names = [ c:cs | cs <- "" : names, c <- ['a'..'z'] ] + strs :: [String] + strs = [ c:cs | cs <- "" : strs, c <- ['a'..'z'] ] badKindSig :: Kind -> SDoc badKindSig kind @@ -1343,19 +1347,17 @@ Note [Avoid name clashes for associated data types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider class C a b where data D b :: * -> * -When typechecking the decl for D, we'll invent an extra type variable for D, -to fill out its kind. We *don't* want this type variable to be 'a', because -in an .hi file we'd get +When typechecking the decl for D, we'll invent an extra type variable +for D, to fill out its kind. Ideally we don't want this type variable +to be 'a', because when pretty printing we'll get class C a b where - data D b a -which makes it look as if there are *two* type indices. But there aren't! -So we use $a instead, which cannot clash with a user-written type variable. -Remember that type variable binders in interface files are just FastStrings, -not proper Names. - -(The tidying phase can't help here because we don't tidy TyCons. Another -alternative would be to record the number of indexing parameters in the -interface file.) + data D b a0 +(NB: the tidying happens in the conversion to IfaceSyn, which happens +as part of pretty-printing a TyThing.) + +That's why we look in the LocalRdrEnv to see what's in scope. This is +important only to get nice-looking output when doing ":info C" in GHCi. +It isn't essential for correctness. %************************************************************************ From git at git.haskell.org Wed Jun 11 19:57:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 19:57:25 +0000 (UTC) Subject: [commit: ghc] master: Fix a serious, but rare, strictness analyser bug (Trac #9128) (7d9feb2) Message-ID: <20140611195725.8C4E32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d9feb264a4fc3c15d1e5f88f2e7a04202ed9743/ghc >--------------------------------------------------------------- commit 7d9feb264a4fc3c15d1e5f88f2e7a04202ed9743 Author: Simon Peyton Jones Date: Wed Jun 11 19:53:06 2014 +0100 Fix a serious, but rare, strictness analyser bug (Trac #9128) In a special case for trivial RHSs (see DmdAnal.unpackTrivial), I'd forgotten to include a demand for the RHS itself. See Note [Remember to demand the function itself]. Thanks to David Terei for guiding me to the bug, at PLDI in Edinburgh. >--------------------------------------------------------------- 7d9feb264a4fc3c15d1e5f88f2e7a04202ed9743 compiler/stranal/DmdAnal.lhs | 11 ++++++++++- testsuite/tests/simplCore/should_run/T9128.hs | 12 ++++++++++++ .../tests/simplCore/should_run/T9128.stdout | 0 testsuite/tests/simplCore/should_run/all.T | 2 ++ 4 files changed, 24 insertions(+), 1 deletion(-) diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index bd7b5c3..f240be4 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -596,7 +596,16 @@ dmdAnalRhs :: TopLevelFlag dmdAnalRhs top_lvl rec_flag env id rhs | Just fn <- unpackTrivial rhs -- See Note [Demand analysis for trivial right-hand sides] , let fn_str = getStrictness env fn - = (fn_str, emptyDmdEnv, set_idStrictness env id fn_str, rhs) + fn_fv | isLocalId fn = unitVarEnv fn topDmd + | otherwise = emptyDmdEnv + -- Note [Remember to demand the function itself] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- fn_fv: don't forget to produce a demand for fn itself + -- Lacking this caused Trac #9128 + -- The demand is very conservative (topDmd), but that doesn't + -- matter; trivial bindings are usually inlined, so it only + -- kicks in for top-level bindings and NOINLINE bindings + = (fn_str, fn_fv, set_idStrictness env id fn_str, rhs) | otherwise = (sig_ty, lazy_fv, id', mkLams bndrs' body') diff --git a/testsuite/tests/simplCore/should_run/T9128.hs b/testsuite/tests/simplCore/should_run/T9128.hs new file mode 100644 index 0000000..73aa39b --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T9128.hs @@ -0,0 +1,12 @@ +module Main where + +newtype T a = MkT a + +-- Trac #9128: we treated x as absent!!!! + +f x = let {-# NOINLINE h #-} + h = case x of MkT g -> g + in + h (h (h (h (h (h True))))) + +main = print (f (MkT id)) diff --git a/libraries/base/tests/IO/IOError002.stdout b/testsuite/tests/simplCore/should_run/T9128.stdout similarity index 100% copy from libraries/base/tests/IO/IOError002.stdout copy to testsuite/tests/simplCore/should_run/T9128.stdout diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 530e4e5..e36fb00 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -65,3 +65,5 @@ test('T7924', exit_code(1), compile_and_run, ['']) # Run this test *without* optimisation too test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, ['']) + +test('T9128', normal, compile_and_run, ['']) From git at git.haskell.org Wed Jun 11 19:57:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 19:57:27 +0000 (UTC) Subject: [commit: ghc] master: Fix Windows build (wibble to fix for Trac #4934) (7f467d0) Message-ID: <20140611195727.CAE042406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7f467d0fbb1424f638a0d39caf57b9c0198421a8/ghc >--------------------------------------------------------------- commit 7f467d0fbb1424f638a0d39caf57b9c0198421a8 Author: Simon Peyton Jones Date: Wed Jun 11 20:54:58 2014 +0100 Fix Windows build (wibble to fix for Trac #4934) >--------------------------------------------------------------- 7f467d0fbb1424f638a0d39caf57b9c0198421a8 rts/RtsStartup.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index c9f5880..8e7e11d 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -209,12 +209,12 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)nonTermination_closure); getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure); getStablePtr((StgPtr)nestedAtomically_closure); - getStablePtr((StgPtr)blockedOnBadFD_closure); getStablePtr((StgPtr)runSparks_closure); getStablePtr((StgPtr)ensureIOManagerIsRunning_closure); getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure); #ifndef mingw32_HOST_OS + getStablePtr((StgPtr)blockedOnBadFD_closure); getStablePtr((StgPtr)runHandlers_closure); #endif From git at git.haskell.org Wed Jun 11 23:00:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jun 2014 23:00:47 +0000 (UTC) Subject: [commit: ghc] master: Catch two typos (165ac4a) Message-ID: <20140611230047.A25532406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/165ac4af4a1002eff5f5a474bc21bc443c8f8c63/ghc >--------------------------------------------------------------- commit 165ac4af4a1002eff5f5a474bc21bc443c8f8c63 Author: Gabor Greif Date: Thu Jun 12 00:57:26 2014 +0200 Catch two typos >--------------------------------------------------------------- 165ac4af4a1002eff5f5a474bc21bc443c8f8c63 libraries/base/GHC/Base.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 5c362d4..6a089ee 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -148,12 +148,12 @@ resulting in: Bottom line: we make GHC.Base depend on GHC.Integer; and everything else either depends on GHC.Base, or does not have NoImplicitPrelude -(ane hence depends on Prelude). +(and hence depends on Prelude). Note [Depend on GHC.Tuple] ~~~~~~~~~~~~~~~~~~~~~~~~~~ Similarly, tuple syntax (or ()) creates an implicit dependency on -GHC.Tuple, so we use the same ruse as for Integer --- see Note [Depend on +GHC.Tuple, so we use the same rule as for Integer --- see Note [Depend on GHC.Integer] --- to explain this to the build system. We make GHC.Base depend on GHC.Tuple, and everything else depends on GHC.Base or Prelude. From git at git.haskell.org Thu Jun 12 10:51:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jun 2014 10:51:05 +0000 (UTC) Subject: [commit: ghc] master: Improve IfaceSyn a bit further (a600c91) Message-ID: <20140612105105.976192406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a600c913a8bf5f55405c3c7b4b739626688b54d8/ghc >--------------------------------------------------------------- commit a600c913a8bf5f55405c3c7b4b739626688b54d8 Author: Simon Peyton Jones Date: Thu Jun 12 11:50:34 2014 +0100 Improve IfaceSyn a bit further This patch has three main bits: * The most substantial change is that IfaceConDecl no longer records its universal type variables, because they are always the same as those of the parent TyCon. A bit less fuss and clutter. * Add a synonym for IfTopBndr = OccName, and explain why it's an OccName not a FastString * Make the ifMinDef field be a (BooleanFormula IfLclName) rather than (BooleanFormula OccName). These really are occurrences (not binders), and should be treated like other occurences. The first and third change the format of interface files, so you'll need to recompile. >--------------------------------------------------------------- a600c913a8bf5f55405c3c7b4b739626688b54d8 compiler/iface/IfaceSyn.lhs | 1512 ++++++++++++++++++++++--------------------- compiler/iface/MkIface.lhs | 3 +- compiler/iface/TcIface.lhs | 13 +- 3 files changed, 796 insertions(+), 732 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a600c913a8bf5f55405c3c7b4b739626688b54d8 From git at git.haskell.org Thu Jun 12 16:23:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jun 2014 16:23:45 +0000 (UTC) Subject: [commit: ghc] master: Better debug printing (b60df0f) Message-ID: <20140612162345.26B262406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b60df0fa017eac8800a3848650dbad09acb6f1b8/ghc >--------------------------------------------------------------- commit b60df0fa017eac8800a3848650dbad09acb6f1b8 Author: Simon Peyton Jones Date: Thu Jun 12 16:35:37 2014 +0100 Better debug printing >--------------------------------------------------------------- b60df0fa017eac8800a3848650dbad09acb6f1b8 compiler/basicTypes/OccName.lhs | 7 +++++-- compiler/rename/RnTypes.lhs | 13 +++++++++---- compiler/utils/UniqFM.lhs | 11 +++++++++-- 3 files changed, 23 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 1248432..2de1fdd 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -90,7 +90,7 @@ module OccName ( lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C, extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv, - alterOccEnv, + alterOccEnv, pprOccEnv, -- * The 'OccSet' type OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, @@ -462,7 +462,10 @@ filterOccEnv x (A y) = A $ filterUFM x y alterOccEnv fn (A y) k = A $ alterUFM fn y k instance Outputable a => Outputable (OccEnv a) where - ppr (A x) = ppr x + ppr x = pprOccEnv ppr x + +pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc +pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env type OccSet = UniqSet OccName diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index d051d72..2f9bfdd 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -362,8 +362,9 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside kvs_from_tv_bndrs = [ kv | L _ (KindedTyVar _ kind) <- tvs , let (_, kvs) = extractHsTyRdrTyVars kind , kv <- kvs ] - all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) $ - nub (kv_bndrs ++ kvs_from_tv_bndrs) + all_kvs' = nub (kv_bndrs ++ kvs_from_tv_bndrs) + all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) all_kvs' + overlap_kvs = [ kv | kv <- all_kvs, any ((==) kv . hsLTyVarName) tvs ] -- These variables appear both as kind and type variables -- in the same declaration; eg type family T (x :: *) (y :: x) @@ -397,8 +398,12 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside ; (tv_bndrs', fvs1) <- mapFvRn rn_tv_bndr tvs ; (res, fvs2) <- bindLocalNamesFV (map hsLTyVarName tv_bndrs') $ - do { env <- getLocalRdrEnv - ; traceRn (text "bhtv" <+> (ppr tvs $$ ppr all_kvs $$ ppr env)) + do { inner_rdr_env <- getLocalRdrEnv + ; traceRn (text "bhtv" <+> vcat + [ ppr tvs, ppr kv_bndrs, ppr kvs_from_tv_bndrs + , ppr $ map (`elemLocalRdrEnv` rdr_env) all_kvs' + , ppr $ map (getUnique . rdrNameOcc) all_kvs' + , ppr all_kvs, ppr rdr_env, ppr inner_rdr_env ]) ; thing_inside (HsQTvs { hsq_tvs = tv_bndrs', hsq_kvs = kv_names }) } ; return (res, fvs1 `plusFV` fvs2) } } diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs index 8797330..d8e08f5 100644 --- a/compiler/utils/UniqFM.lhs +++ b/compiler/utils/UniqFM.lhs @@ -60,9 +60,10 @@ module UniqFM ( eltsUFM, keysUFM, splitUFM, ufmToSet_Directly, ufmToList, - joinUFM + joinUFM, pprUniqFM ) where +import FastString import Unique ( Uniquable(..), Unique, getKey ) import Outputable @@ -319,5 +320,11 @@ joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, \begin{code} instance Outputable a => Outputable (UniqFM a) where - ppr ufm = ppr (ufmToList ufm) + ppr ufm = pprUniqFM ppr ufm + +pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc +pprUniqFM ppr_elt ufm + = brackets $ fsep $ punctuate comma $ + [ ppr uq <+> ptext (sLit ":->") <+> ppr_elt elt + | (uq, elt) <- ufmToList ufm ] \end{code} From git at git.haskell.org Thu Jun 12 16:23:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jun 2014 16:23:47 +0000 (UTC) Subject: [commit: ghc] master: Line up kind and type variables correctly when desugaring TH brackets (571f0ad) Message-ID: <20140612162347.DE7EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/571f0adccda687098d59f63524357f4ac98e72fb/ghc >--------------------------------------------------------------- commit 571f0adccda687098d59f63524357f4ac98e72fb Author: Simon Peyton Jones Date: Thu Jun 12 16:36:59 2014 +0100 Line up kind and type variables correctly when desugaring TH brackets This bug was causing Trac #9199 >--------------------------------------------------------------- 571f0adccda687098d59f63524357f4ac98e72fb compiler/deSugar/DsMeta.hs | 13 ++++++++----- testsuite/tests/th/T9199.hs | 9 +++++++++ testsuite/tests/th/all.T | 1 + 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 687cf55..b5d1b0f 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -63,6 +63,7 @@ import DynFlags import FastString import ForeignCall import Util +import TcRnMonad( traceOptIf ) import Data.Maybe import Control.Monad @@ -707,12 +708,14 @@ addTyVarBinds :: LHsTyVarBndrs Name -- the binders to -- the computations passed as the second argument is executed in that extended -- meta environment and gets the *new* names on Core-level as an argument -addTyVarBinds tvs m - = do { freshNames <- mkGenSyms (hsLKiTyVarNames tvs) - ; term <- addBinds freshNames $ - do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs `zip` freshNames) +addTyVarBinds (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs }) m + = do { fresh_kv_names <- mkGenSyms kvs + ; fresh_tv_names <- mkGenSyms (map hsLTyVarName tvs) + ; let fresh_names = fresh_kv_names ++ fresh_tv_names + ; term <- addBinds fresh_names $ + do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (tvs `zip` fresh_tv_names) ; m kbs } - ; wrapGenSyms freshNames term } + ; wrapGenSyms fresh_names term } where mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v) diff --git a/testsuite/tests/th/T9199.hs b/testsuite/tests/th/T9199.hs new file mode 100644 index 0000000..aa41198 --- /dev/null +++ b/testsuite/tests/th/T9199.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell, PolyKinds, TypeFamilies #-} + +module T9160 where + +$( [d| class C (a :: k) where + type F (a :: k) :: * + |] + ) + diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index ca7ead6..6e86d30 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -327,4 +327,5 @@ test('T8954', normal, compile, ['-v0']) test('T8932', normal, compile_fail, ['-v0']) test('T8987', normal, compile_fail, ['-v0']) test('T7241', normal, compile_fail, ['-v0']) +test('T9199', normal, compile, ['-v0']) From git at git.haskell.org Thu Jun 12 16:23:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jun 2014 16:23:50 +0000 (UTC) Subject: [commit: ghc] master: Fix elemLocalRdrEnv (Trac #9160) (b637585) Message-ID: <20140612162351.9AEE42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b637585dcbfc1ba53aa49bcb9b730cd08fea4b59/ghc >--------------------------------------------------------------- commit b637585dcbfc1ba53aa49bcb9b730cd08fea4b59 Author: Simon Peyton Jones Date: Thu Jun 12 16:42:37 2014 +0100 Fix elemLocalRdrEnv (Trac #9160) This was pretty obscure. elemLocalRdrEnv was utterly wrong (replied False when it should reply True) when given an Exact Name. That doesn't happen often, but it does happen in the result of a TH splice. The result was that an associated type didn't get a type variable that lined up with its parent class (elemLocalRdrEnv is used in RnTypes.bindHsTyVars), and that messed up the singletons package. I've made a completely different test case to show up the bug: indexed_types/should_fail/T9160 I also refactored RdrName.LocalRdrEnv to be a record with named fields, which makes the code more robust and easy to understand. >--------------------------------------------------------------- b637585dcbfc1ba53aa49bcb9b730cd08fea4b59 compiler/basicTypes/RdrName.lhs | 60 +++++++++++++++------- testsuite/tests/indexed-types/should_fail/T9160.hs | 19 +++++++ .../tests/indexed-types/should_fail/T9160.stderr | 11 ++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 4 files changed, 72 insertions(+), 19 deletions(-) diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index ceab808..ebfb71a 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -331,49 +331,71 @@ instance Ord RdrName where -- It is keyed by OccName, because we never use it for qualified names -- We keep the current mapping, *and* the set of all Names in scope -- Reason: see Note [Splicing Exact Names] in RnEnv -type LocalRdrEnv = (OccEnv Name, NameSet) +data LocalRdrEnv = LRE { lre_env :: OccEnv Name + , lre_in_scope :: NameSet } + +instance Outputable LocalRdrEnv where + ppr (LRE {lre_env = env, lre_in_scope = ns}) + = hang (ptext (sLit "LocalRdrEnv {")) + 2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env + , ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetToList ns)) + ] <+> char '}') + where + ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name + -- So we can see if the keys line up correctly emptyLocalRdrEnv :: LocalRdrEnv -emptyLocalRdrEnv = (emptyOccEnv, emptyNameSet) +emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv, lre_in_scope = emptyNameSet } extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv -- The Name should be a non-top-level thing -extendLocalRdrEnv (env, ns) name +extendLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) name = WARN( isExternalName name, ppr name ) - ( extendOccEnv env (nameOccName name) name - , addOneToNameSet ns name - ) + LRE { lre_env = extendOccEnv env (nameOccName name) name + , lre_in_scope = addOneToNameSet ns name } extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv -extendLocalRdrEnvList (env, ns) names +extendLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) names = WARN( any isExternalName names, ppr names ) - ( extendOccEnvList env [(nameOccName n, n) | n <- names] - , addListToNameSet ns names - ) + LRE { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names] + , lre_in_scope = addListToNameSet ns names } lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name -lookupLocalRdrEnv (env, _) (Unqual occ) = lookupOccEnv env occ -lookupLocalRdrEnv _ _ = Nothing +lookupLocalRdrEnv (LRE { lre_env = env }) (Unqual occ) = lookupOccEnv env occ +lookupLocalRdrEnv _ _ = Nothing lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name -lookupLocalRdrOcc (env, _) occ = lookupOccEnv env occ +lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool -elemLocalRdrEnv rdr_name (env, _) - | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env - | otherwise = False +elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns }) + = case rdr_name of + Unqual occ -> occ `elemOccEnv` env + Exact name -> name `elemNameSet` ns -- See Note [Local bindings with Exact Names] + Qual {} -> False + Orig {} -> False localRdrEnvElts :: LocalRdrEnv -> [Name] -localRdrEnvElts (env, _) = occEnvElts env +localRdrEnvElts (LRE { lre_env = env }) = occEnvElts env inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool -- This is the point of the NameSet -inLocalRdrEnvScope name (_, ns) = name `elemNameSet` ns +inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv -delLocalRdrEnvList (env, ns) occs = (delListFromOccEnv env occs, ns) +delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs + = LRE { lre_env = delListFromOccEnv env occs + , lre_in_scope = ns } \end{code} +Note [Local bindings with Exact Names] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With Template Haskell we can make local bindings that have Exact Names. +Computing shadowing etc may use elemLocalRdrEnv (at least it certainly +does so in RnTpes.bindHsTyVars), so for an Exact Name we must consult +the in-scope-name-set. + + %************************************************************************ %* * GlobalRdrEnv diff --git a/testsuite/tests/indexed-types/should_fail/T9160.hs b/testsuite/tests/indexed-types/should_fail/T9160.hs new file mode 100644 index 0000000..64ae3b9 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9160.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances, TemplateHaskell, PolyKinds, TypeFamilies #-} + +module T9160 where +import Language.Haskell.TH + +$( do { cls_nm <- newName "C" + ; a_nm <- newName "a" + ; k_nm <- newName "k" + ; f_nm <- newName "F" + ; return [ClassD [] cls_nm [KindedTV a_nm (VarT k_nm)] [] + [FamilyD TypeFam f_nm [] (Just (VarT k_nm))]] } ) + +-- Splices in: +-- class C (a :: k) where +-- type F :: k + +instance C (a :: *) where + type F = Maybe -- Should be illegal + diff --git a/testsuite/tests/indexed-types/should_fail/T9160.stderr b/testsuite/tests/indexed-types/should_fail/T9160.stderr new file mode 100644 index 0000000..7a476d4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9160.stderr @@ -0,0 +1,11 @@ +Loading package ghc-prim ... linking ... done. +Loading package integer-gmp ... linking ... done. +Loading package base ... linking ... done. +Loading package pretty-1.1.1.1 ... linking ... done. +Loading package template-haskell ... linking ... done. + +T9160.hs:18:8: + Type indexes must match class instance head + Found ?* -> *? but expected ?*? + In the type instance declaration for ?F? + In the instance declaration for ?C (a :: *)? diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 9d3f851..2c5ae68 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -123,3 +123,4 @@ test('T9036', normal, compile_fail, ['']) test('T9167', normal, compile_fail, ['']) test('T9171', normal, compile_fail, ['']) test('T9097', normal, compile_fail, ['']) +test('T9160', normal, compile_fail, ['']) From git at git.haskell.org Thu Jun 12 16:23:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jun 2014 16:23:52 +0000 (UTC) Subject: [commit: ghc] master: Bytes allocated by haddock.base has crept up (again) (970e5d9) Message-ID: <20140612162353.113532406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/970e5d99fb658b73975e38865efeb0b3dd2f90e8/ghc >--------------------------------------------------------------- commit 970e5d99fb658b73975e38865efeb0b3dd2f90e8 Author: Simon Peyton Jones Date: Thu Jun 12 17:23:25 2014 +0100 Bytes allocated by haddock.base has crept up (again) I don't know why, and I don't like the steady increase. But I don't think my changes here are the cause. >--------------------------------------------------------------- 970e5d99fb658b73975e38865efeb0b3dd2f90e8 testsuite/tests/perf/haddock/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 6a2ed82..3ad24f1 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -30,7 +30,7 @@ test('haddock.base', # 2013-02-10: 52237984 (x86/OSX) # 2014-01-22: 62189068 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 7128342344, 5) + [(wordsize(64), 7498123680, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -40,6 +40,7 @@ test('haddock.base', # 2013-09-18: 6294339840 (x86_64/Linux) # 2013-11-21: 6756213256 (x86_64/Linux) # 2014-01-12: 7128342344 (x86_64/Linux) + # 2014-06-12: 7498123680 (x86_64/Linux) ,(platform('i386-unknown-mingw32'), 3548581572, 5) # 2013-02-10: 3358693084 (x86/Windows) # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) From git at git.haskell.org Thu Jun 12 21:48:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jun 2014 21:48:38 +0000 (UTC) Subject: [commit: ghc] master: Remove forgotten redundant import (632fcf1) Message-ID: <20140612214838.18A4C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/632fcf1f90b65201500250d5d13617ba778e310a/ghc >--------------------------------------------------------------- commit 632fcf1f90b65201500250d5d13617ba778e310a Author: Simon Peyton Jones Date: Thu Jun 12 22:48:09 2014 +0100 Remove forgotten redundant import >--------------------------------------------------------------- 632fcf1f90b65201500250d5d13617ba778e310a compiler/deSugar/DsMeta.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index b5d1b0f..435f5c7 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -63,7 +63,6 @@ import DynFlags import FastString import ForeignCall import Util -import TcRnMonad( traceOptIf ) import Data.Maybe import Control.Monad From git at git.haskell.org Fri Jun 13 15:39:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jun 2014 15:39:23 +0000 (UTC) Subject: [commit: ghc] master: Fixes #95 :edit command should jump to the last error (ce19d50) Message-ID: <20140613153923.691112406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce19d5079ea85d3190e837a1fc60000fbd82134d/ghc >--------------------------------------------------------------- commit ce19d5079ea85d3190e837a1fc60000fbd82134d Author: Lorenzo Tabacchini Date: Sun Jun 8 10:54:39 2014 +0200 Fixes #95 :edit command should jump to the last error >--------------------------------------------------------------- ce19d5079ea85d3190e837a1fc60000fbd82134d docs/users_guide/ghci.xml | 4 +- ghc/GhciMonad.hs | 4 +- ghc/InteractiveUI.hs | 83 ++++++++++++++++++++--------- testsuite/tests/ghci/prog013/Bad.hs | 3 ++ testsuite/tests/ghci/prog013/Good.hs | 3 ++ testsuite/tests/ghci/prog013/prog013.T | 2 + testsuite/tests/ghci/prog013/prog013.script | 8 +++ testsuite/tests/ghci/prog013/prog013.stderr | 9 ++++ testsuite/tests/ghci/prog013/prog013.stdout | 4 ++ 9 files changed, 94 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 ce19d5079ea85d3190e837a1fc60000fbd82134d From git at git.haskell.org Fri Jun 13 20:46:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jun 2014 20:46:55 +0000 (UTC) Subject: [commit: ghc] wip/ext-solver: Comments: a simple example showing the incompleteness of the current approach. (79ad1d2) Message-ID: <20140613204656.1AD382406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ext-solver Link : http://ghc.haskell.org/trac/ghc/changeset/79ad1d20c5500e17ce5daaf93b171131669bddad/ghc >--------------------------------------------------------------- commit 79ad1d20c5500e17ce5daaf93b171131669bddad Author: Iavor S. Diatchki Date: Fri Jun 13 13:21:30 2014 -0700 Comments: a simple example showing the incompleteness of the current approach. >--------------------------------------------------------------- 79ad1d20c5500e17ce5daaf93b171131669bddad compiler/typecheck/TcTypeNats.hs | 56 ++++++++++++++-------------------------- 1 file changed, 19 insertions(+), 37 deletions(-) diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs index e1e451e..bd60f8f 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/typecheck/TcTypeNats.hs @@ -1075,6 +1075,9 @@ solverFindConstraidction proc viRef others ours = Returns the solved constraints (with evidence), and all other constraints. -} {- +Note [In What Order to Solve Wanteds?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + Consider this example: ex4 :: p a -> p b -> p ((a + a) + b) -> p (2 * a + b) @@ -1107,52 +1110,31 @@ We can't do this because we've lost the information about `w`. To avoid this, we first try to solve equations that have the same varibal on the RHS (e.g., F xs ~ a, G ys ~ a). -However, this is not quite enough. Here is another tricky example: - -data T :: Nat -> * where - Even :: T (n + 1) -> T (2 * (n + 1)) - -addT :: T m -> T n -> T (m + n) -addT (Even x) (Even y) = Even (addT x y) - - -x :: T (a + 1) -y :: T (b + 1) - -[G] m = 2 * (a + 1) -[G] n = 2 * (b + 1) - -addT x y :: T ((a + 1) + (b + 1)) - -[W] (a + 1) + (b + 1) = x + 1 -- Applying Even is OK -[W] 2 * (x + 1) = m + n -- The result is correct - -After canonicalization: - -[G] a + 1 = t1 -[G] b + 1 = t2 -[G] 2 * t1 = m -[G] 2 * t2 = n +-} -[W] t1 + t2 = t3 -[W] x + 1 = t3 -[W] 2 * t3 = t4 -[W] m + n = t4 -The issue here seems to be that `x = a + b + 1`, but this intermediate -value is not named anywhere. What to do? +{- +Note [Incompleteness of the General Approach] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Another tricky example, which illustrates the incompleteness of +the general method: -XXX: BUG The following incorrect program causes infinte improvement +x :: f (n + 2) +x = undefined -addT :: T m -> T n -> T (m + n) -addT (Even x) (Even y) = Even (addT x x) +y :: f (m + 1) +y = x +The definition for `x` is accepted, but `y` is rejected. +The reason is that to accept it we need to infer that `m` must +be instantiated to `n + 1`. The current system does not support this +kind of improvement, because it only ever tries to instantiate variables +to constants or other variables and here we need to instantiate `m` +with a more complex expression, namely, `n + 1`. -} - - solverSimplify :: SolverProcess -> IORef VarInfo -> [Ct] -> IO ([(EvTerm,Ct)], [Ct]) solverSimplify proc viRef cts = From git at git.haskell.org Sat Jun 14 21:51:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jun 2014 21:51:45 +0000 (UTC) Subject: [commit: ghc] master: Implement `Typeable` support for type-level literals (#8778). (0354fb3) Message-ID: <20140614215145.3CC6B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0354fb3676e5b0044601c8e0a5f8039f0cac0c8d/ghc >--------------------------------------------------------------- commit 0354fb3676e5b0044601c8e0a5f8039f0cac0c8d Author: Iavor S. Diatchki Date: Sat Jun 14 14:08:23 2014 -0700 Implement `Typeable` support for type-level literals (#8778). >--------------------------------------------------------------- 0354fb3676e5b0044601c8e0a5f8039f0cac0c8d compiler/types/Unify.lhs | 41 +++++++++++++++++++++++++++++++- libraries/base/Data/Typeable/Internal.hs | 38 +++++++++++++++++++++++++++++ libraries/base/GHC/TypeLits.hs | 19 +++++++++++---- 3 files changed, 93 insertions(+), 5 deletions(-) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index 24aa7a7..b668186 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -39,8 +39,10 @@ import Type import TyCon import TypeRep import Util +import PrelNames(typeNatKindConNameKey, typeSymbolKindConNameKey) +import Unique(hasKey) -import Control.Monad (liftM, ap) +import Control.Monad (liftM, ap, unless, guard) import Control.Applicative (Applicative(..)) \end{code} @@ -173,6 +175,8 @@ match menv subst (TyVarTy tv1) ty2 then Nothing -- Occurs check else do { subst1 <- match_kind menv subst (tyVarKind tv1) (typeKind ty2) -- Note [Matching kinds] + ; guard (validKindShape (tyVarKind tv1) ty2) + -- Note [Kinds Containing Only Literals] ; return (extendVarEnv subst1 tv1' ty2) } | otherwise -- tv1 is not a template tyvar @@ -205,6 +209,37 @@ match _ subst (LitTy x) (LitTy y) | x == y = return subst match _ _ _ _ = Nothing + +{- Note [Kinds Containing Only Literals] + +The kinds `Nat` and `Symbol` contain only literal types (e.g., 17, "Hi", etc.). +As such, they can only ever match and unify with a type variable or a literal +type. We check for this during matching and unification, and reject +binding variables to types that have an unacceptable shape. + +This helps us avoid "overlapping instance" errors in the presence of +very general instances. The main motivating example for this is the +implementation of `Typeable`, which conatins the instances: + +... => Typeable (f a) where ... +... => Typeable (a :: Nat) where ... + +Without the explicit check these look like they overlap, and are rejected. +The two do not overlap, however, because nothing of kind `Nat` can be +of the form `f a`. +-} + +validKindShape :: Kind -> Type -> Bool +validKindShape k ty + | Just (tc,[]) <- splitTyConApp_maybe k + , tc `hasKey` typeNatKindConNameKey || + tc `hasKey` typeSymbolKindConNameKey = case ty of + TyVarTy _ -> True + LitTy _ -> True + _ -> False +validKindShape _ _ = True + + -------------- match_kind :: MatchEnv -> TvSubstEnv -> Kind -> Kind -> Maybe TvSubstEnv -- Match the kind of the template tyvar with the kind of Type @@ -653,6 +688,10 @@ uUnrefined subst tv1 ty2 ty2' -- ty2 is not a type variable -- See Note [Fine-grained unification] | otherwise = do { subst' <- unify subst k1 k2 + -- Note [Kinds Containing Only Literals] + ; let ki = substTy (mkOpenTvSubst subst') k1 + ; unless (validKindShape ki ty2') + surelyApart ; bindTv subst' tv1 ty2 } -- Bind tyvar to the synonym if poss where k1 = tyVarKind tv1 diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 1bee846..0e42bcd 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -22,6 +22,8 @@ , PolyKinds , ConstraintKinds , DeriveDataTypeable + , DataKinds + , UndecidableInstances , StandaloneDeriving #-} module Data.Typeable.Internal ( @@ -63,6 +65,7 @@ import GHC.STRef ( STRef ) import GHC.Ptr ( Ptr, FunPtr ) -- import GHC.Stable import GHC.Arr ( Array, STArray, Ix ) +import GHC.TypeLits ( Nat, Symbol, KnownNat, KnownSymbol, natVal', symbolVal' ) import Data.Type.Coercion import Data.Type.Equality import Text.ParserCombinators.ReadP ( ReadP ) @@ -411,3 +414,38 @@ deriving instance Typeable Monad deriving instance Typeable MonadPlus deriving instance Typeable Typeable + + + +-------------------------------------------------------------------------------- +-- Instances for type literals + +instance KnownNat n => Typeable (n :: Nat) where + typeRep# p = mkTyConApp tc [] + where + tc = TyCon + { tyConHash = fingerprintString (mk pack modu nm) + , tyConPackage = pack + , tyConModule = modu + , tyConName = nm + } + pack = "base" + modu = "GHC.TypeLits" + nm = show (natVal' p) + mk a b c = a ++ " " ++ b ++ " " ++ c + + +instance KnownSymbol s => Typeable (s :: Symbol) where + typeRep# p = mkTyConApp tc [] + where + tc = TyCon + { tyConHash = fingerprintString (mk pack modu nm) + , tyConPackage = pack + , tyConModule = modu + , tyConName = nm + } + pack = "base" + modu = "GHC.TypeLits" + nm = show (symbolVal' p) + mk a b c = a ++ " " ++ b ++ " " ++ c + diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index 53a6004..cc76bc9 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -10,6 +10,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UndecidableInstances #-} -- for compiling instances of (==) {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} {-| This module is an internal GHC module. It declares the constants used in the implementation of type-level natural numbers. The programmer interface @@ -23,8 +24,8 @@ module GHC.TypeLits Nat, Symbol -- * Linking type and value level - , KnownNat, natVal - , KnownSymbol, symbolVal + , KnownNat, natVal, natVal' + , KnownSymbol, symbolVal, symbolVal' , SomeNat(..), SomeSymbol(..) , someNatVal, someSymbolVal , sameNat, sameSymbol @@ -41,9 +42,9 @@ import GHC.Num(Integer) import GHC.Base(String) import GHC.Show(Show(..)) import GHC.Read(Read(..)) -import GHC.Prim(magicDict) +import GHC.Prim(magicDict, Proxy#) import Data.Maybe(Maybe(..)) -import Data.Proxy(Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Type.Equality(type (==), (:~:)(Refl)) import Unsafe.Coerce(unsafeCoerce) @@ -80,6 +81,16 @@ symbolVal :: forall n proxy. KnownSymbol n => proxy n -> String symbolVal _ = case symbolSing :: SSymbol n of SSymbol x -> x +-- | /Since: 4.7.0.0/ +natVal' :: forall n. KnownNat n => Proxy# n -> Integer +natVal' _ = case natSing :: SNat n of + SNat x -> x + +-- | /Since: 4.7.0.0/ +symbolVal' :: forall n. KnownSymbol n => Proxy# n -> String +symbolVal' _ = case symbolSing :: SSymbol n of + SSymbol x -> x + -- | This type represents unknown type-level natural numbers. From git at git.haskell.org Mon Jun 16 12:57:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jun 2014 12:57:07 +0000 (UTC) Subject: [commit: ghc] master: Fix recomputation of TypeRep in the instance for Typeable (s a) (#9203) (5ffc68b) Message-ID: <20140616125707.3A55C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ffc68bb75d34414987b5d1e5aa4f9061a7a7383/ghc >--------------------------------------------------------------- commit 5ffc68bb75d34414987b5d1e5aa4f9061a7a7383 Author: Simon Marlow Date: Fri Jun 13 16:57:16 2014 +0100 Fix recomputation of TypeRep in the instance for Typeable (s a) (#9203) Summary: Every time we called typeRep on a type application, we were recomputing the TypeRep. This showed up in a benchmark I had: #9203. Test Plan: Benchmark from #9203. Reviewers: simonpj, austin Subscribers: simonmar, relrod Differential Revision: https://phabricator.haskell.org/D19 >--------------------------------------------------------------- 5ffc68bb75d34414987b5d1e5aa4f9061a7a7383 libraries/base/Data/Typeable/Internal.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 0e42bcd..eae2109 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -263,7 +263,9 @@ type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a -- | Kind-polymorphic Typeable instance for type application instance (Typeable s, Typeable a) => Typeable (s a) where - typeRep# _ = typeRep# (proxy# :: Proxy# s) `mkAppTy` typeRep# (proxy# :: Proxy# a) + typeRep# = \_ -> rep + where rep = typeRep# (proxy# :: Proxy# s) + `mkAppTy` typeRep# (proxy# :: Proxy# a) ----------------- Showing TypeReps -------------------- From git at git.haskell.org Mon Jun 16 22:59:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jun 2014 22:59:28 +0000 (UTC) Subject: [commit: ghc] master: Update the incorrect comment on when function was introduced. (e09be5f) Message-ID: <20140616225930.781EA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e09be5ff6e92593ba8e1202b1574a62a17b329ba/ghc >--------------------------------------------------------------- commit e09be5ff6e92593ba8e1202b1574a62a17b329ba Author: Iavor S. Diatchki Date: Mon Jun 16 15:56:19 2014 -0700 Update the incorrect comment on when function was introduced. >--------------------------------------------------------------- e09be5ff6e92593ba8e1202b1574a62a17b329ba libraries/base/GHC/TypeLits.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index cc76bc9..7ae6fb0 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -81,12 +81,12 @@ symbolVal :: forall n proxy. KnownSymbol n => proxy n -> String symbolVal _ = case symbolSing :: SSymbol n of SSymbol x -> x --- | /Since: 4.7.0.0/ +-- | /Since: 4.7.1.0/ natVal' :: forall n. KnownNat n => Proxy# n -> Integer natVal' _ = case natSing :: SNat n of SNat x -> x --- | /Since: 4.7.0.0/ +-- | /Since: 4.7.1.0/ symbolVal' :: forall n. KnownSymbol n => Proxy# n -> String symbolVal' _ = case symbolSing :: SSymbol n of SSymbol x -> x From git at git.haskell.org Mon Jun 16 22:59:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jun 2014 22:59:31 +0000 (UTC) Subject: [commit: ghc] master: Redo instance to be more efficient (see #8778, #9203) (836981c) Message-ID: <20140616225931.69C572406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/836981c7dec5c794ca94408468535cc018dc2e82/ghc >--------------------------------------------------------------- commit 836981c7dec5c794ca94408468535cc018dc2e82 Author: Iavor S. Diatchki Date: Mon Jun 16 15:58:49 2014 -0700 Redo instance to be more efficient (see #8778, #9203) >--------------------------------------------------------------- 836981c7dec5c794ca94408468535cc018dc2e82 libraries/base/Data/Typeable/Internal.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index eae2109..5b1cde4 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -423,8 +423,9 @@ deriving instance Typeable Typeable -- Instances for type literals instance KnownNat n => Typeable (n :: Nat) where - typeRep# p = mkTyConApp tc [] + typeRep# = \_ -> rep where + rep = mkTyConApp tc [] tc = TyCon { tyConHash = fingerprintString (mk pack modu nm) , tyConPackage = pack @@ -433,13 +434,14 @@ instance KnownNat n => Typeable (n :: Nat) where } pack = "base" modu = "GHC.TypeLits" - nm = show (natVal' p) + nm = show (natVal' (proxy# :: Proxy# n)) mk a b c = a ++ " " ++ b ++ " " ++ c instance KnownSymbol s => Typeable (s :: Symbol) where - typeRep# p = mkTyConApp tc [] + typeRep# = \_ -> rep where + rep = mkTyConApp tc [] tc = TyCon { tyConHash = fingerprintString (mk pack modu nm) , tyConPackage = pack @@ -448,6 +450,6 @@ instance KnownSymbol s => Typeable (s :: Symbol) where } pack = "base" modu = "GHC.TypeLits" - nm = show (symbolVal' p) + nm = show (symbolVal' (proxy# :: Proxy# s)) mk a b c = a ++ " " ++ b ++ " " ++ c From git at git.haskell.org Tue Jun 17 11:42:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jun 2014 11:42:34 +0000 (UTC) Subject: [commit: ghc] master: Optimise the Typeable instance for type app a bit, and add a perf test (00fc4ba) Message-ID: <20140617114234.E677F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00fc4ba2363b466d1178ae6bcaec628c9cde4758/ghc >--------------------------------------------------------------- commit 00fc4ba2363b466d1178ae6bcaec628c9cde4758 Author: Simon Marlow Date: Tue Jun 17 11:47:40 2014 +0100 Optimise the Typeable instance for type app a bit, and add a perf test Test Plan: validate Reviewers: simonpj, austin Subscribers: simonmar, relrod Differential Revision: https://phabricator.haskell.org/D20 >--------------------------------------------------------------- 00fc4ba2363b466d1178ae6bcaec628c9cde4758 libraries/base/Data/Typeable/Internal.hs | 17 ++++++++++++++--- .../tests/perf/should_run/T9203.hs | 3 --- .../tests/perf/should_run/T9203.stdout | 0 testsuite/tests/perf/should_run/all.T | 8 ++++++++ 4 files changed, 22 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 5b1cde4..a09d4ad 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Unsafe #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | @@ -263,9 +264,19 @@ type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a -- | Kind-polymorphic Typeable instance for type application instance (Typeable s, Typeable a) => Typeable (s a) where - typeRep# = \_ -> rep - where rep = typeRep# (proxy# :: Proxy# s) - `mkAppTy` typeRep# (proxy# :: Proxy# a) + typeRep# = \_ -> rep -- Note [Memoising typeOf] + where !ty1 = typeRep# (proxy# :: Proxy# s) + !ty2 = typeRep# (proxy# :: Proxy# a) + !rep = ty1 `mkAppTy` ty2 + +{- Note [Memoising typeOf] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +See #3245, #9203 + +IMPORTANT: we don't want to recalculate the TypeRep once per call with +the proxy argument. This is what went wrong in #3245 and #9203. So we +help GHC by manually keeping the 'rep' *outside* the lambda. +-} ----------------- Showing TypeReps -------------------- diff --git a/libraries/base/tests/dynamic003.hs b/testsuite/tests/perf/should_run/T9203.hs similarity index 69% copy from libraries/base/tests/dynamic003.hs copy to testsuite/tests/perf/should_run/T9203.hs index fae8bdb..500fd8c 100644 --- a/libraries/base/tests/dynamic003.hs +++ b/testsuite/tests/perf/should_run/T9203.hs @@ -1,8 +1,5 @@ module Main where --- Test generation of large TypeReps --- (can be used as a benchmark) - import Data.Typeable f :: Typeable a => Int -> a -> TypeRep diff --git a/libraries/base/tests/dynamic003.stdout b/testsuite/tests/perf/should_run/T9203.stdout similarity index 100% copy from libraries/base/tests/dynamic003.stdout copy to testsuite/tests/perf/should_run/T9203.stdout diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 8030251..94fd2a3 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -366,3 +366,11 @@ test('InlineCloneArrayAlloc', only_ways(['normal'])], compile_and_run, ['-O2']) + +test('T9203', + [stats_num_field('bytes allocated', + [ (wordsize(32), 50000000, 5) + , (wordsize(64), 95747304, 5) ]), + only_ways(['normal'])], + compile_and_run, + ['-O2']) From git at git.haskell.org Tue Jun 17 11:42:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jun 2014 11:42:37 +0000 (UTC) Subject: [commit: ghc] master: accept T9181 output (e38fe3b) Message-ID: <20140617114237.59E372406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e38fe3b294fa431155b65db7d8fc9cdb54cbf0da/ghc >--------------------------------------------------------------- commit e38fe3b294fa431155b65db7d8fc9cdb54cbf0da Author: Simon Marlow Date: Tue Jun 17 12:41:15 2014 +0100 accept T9181 output Not sure if my patch changed this, but it looks reasonable. >--------------------------------------------------------------- e38fe3b294fa431155b65db7d8fc9cdb54cbf0da testsuite/tests/ghci/scripts/T9181.stdout | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout index fb9cf5d..e1ac00c 100644 --- a/testsuite/tests/ghci/scripts/T9181.stdout +++ b/testsuite/tests/ghci/scripts/T9181.stdout @@ -36,6 +36,8 @@ type family (GHC.TypeLits.^) (a :: GHC.TypeLits.Nat) GHC.TypeLits.Nat GHC.TypeLits.natVal :: GHC.TypeLits.KnownNat n => proxy n -> Integer +GHC.TypeLits.natVal' :: + GHC.TypeLits.KnownNat n => GHC.Prim.Proxy# n -> Integer GHC.TypeLits.sameNat :: (GHC.TypeLits.KnownNat a, GHC.TypeLits.KnownNat b) => Data.Proxy.Proxy a @@ -48,3 +50,5 @@ GHC.TypeLits.someNatVal :: Integer -> Maybe GHC.TypeLits.SomeNat GHC.TypeLits.someSymbolVal :: String -> GHC.TypeLits.SomeSymbol GHC.TypeLits.symbolVal :: GHC.TypeLits.KnownSymbol n => proxy n -> String +GHC.TypeLits.symbolVal' :: + GHC.TypeLits.KnownSymbol n => GHC.Prim.Proxy# n -> String From git at git.haskell.org Tue Jun 17 22:09:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jun 2014 22:09:19 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Revert "Fix obscure problem with using the system linker (#8935)" (559ae1e) Message-ID: <20140617220919.BF6AC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/559ae1e8b6e0229070d371cb90b23655b70e1b77/ghc >--------------------------------------------------------------- commit 559ae1e8b6e0229070d371cb90b23655b70e1b77 Author: Austin Seipp Date: Tue Jun 17 17:09:02 2014 -0500 Revert "Fix obscure problem with using the system linker (#8935)" This reverts commit 72bd832eb87975c504654a65f9c88daaa478f677. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 559ae1e8b6e0229070d371cb90b23655b70e1b77 compiler/ghci/Linker.lhs | 72 ++++++++++++++++-------------------------------- rts/Linker.c | 43 ++++++----------------------- 2 files changed, 32 insertions(+), 83 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 559ae1e8b6e0229070d371cb90b23655b70e1b77 From git at git.haskell.org Wed Jun 18 07:06:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jun 2014 07:06:27 +0000 (UTC) Subject: [commit: ghc] master: Haddock: haddock-library release and Travis stuff (652c9e6) Message-ID: <20140618070627.743292406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/652c9e69914b12aa1bbc7d5f01c42503a78a2ecd/ghc >--------------------------------------------------------------- commit 652c9e69914b12aa1bbc7d5f01c42503a78a2ecd Author: Mateusz Kowalczyk Date: Wed Jun 18 09:05:50 2014 +0200 Haddock: haddock-library release and Travis stuff Updates submodule. >--------------------------------------------------------------- 652c9e69914b12aa1bbc7d5f01c42503a78a2ecd utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 276f201..dd3fee8 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 276f201de589999690e49491089c7e7ec9cfbf3f +Subproject commit dd3fee863579c88e49aa2b955cbc58e3c094ae4d From git at git.haskell.org Wed Jun 18 17:22:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jun 2014 17:22:01 +0000 (UTC) Subject: [commit: ghc] master: Only comments: add notes explaining the various oddities of the `Typeable` implementation for type-level literals. (2ba1a56) Message-ID: <20140618172201.77DC82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ba1a560a92f4de0938d03c48b0f2e00e382d6b6/ghc >--------------------------------------------------------------- commit 2ba1a560a92f4de0938d03c48b0f2e00e382d6b6 Author: Iavor S. Diatchki Date: Wed Jun 18 10:21:06 2014 -0700 Only comments: add notes explaining the various oddities of the `Typeable` implementation for type-level literals. >--------------------------------------------------------------- 2ba1a560a92f4de0938d03c48b0f2e00e382d6b6 libraries/base/Data/Typeable/Internal.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index a09d4ad..4912de9 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -433,7 +433,23 @@ deriving instance Typeable Typeable -------------------------------------------------------------------------------- -- Instances for type literals +{- Note [Potential Collisions in `Nat` and `Symbol` instances] + +Kinds resulting from lifted types have finately many type-constructors. +This is not the case for `Nat` and `Symbol`, which both contain *infinately* +many type constructors (e.g., `Nat` has 0, 1, 2, 3, etc.). One might think +that this would increase the chance of hash-collisions in the type but this +is not the case because the finger-print stored in a `TypeRep` identifies +the whole *type* and not just the type constructor. This is why the chance +of collisions for `Nat` and `Symbol` is not any worse than it is for other +lifted types with infinately many inhabitants. Indeed, `Nat` is +isomorphic to (lifted) `[()]` and `Symbol` is isomprohic to `[Char]`. +-} + +-- See `Note [Kinds Containing Only Literals]` in `types/Unify.hs` for +-- an explanation of how we avoid overlap with `Typeable (f a)`. instance KnownNat n => Typeable (n :: Nat) where + -- See #9203 for an explanation of why this is written as `\_ -> rep`. typeRep# = \_ -> rep where rep = mkTyConApp tc [] @@ -449,7 +465,10 @@ instance KnownNat n => Typeable (n :: Nat) where mk a b c = a ++ " " ++ b ++ " " ++ c +-- See `Note [Kinds Containing Only Literals]` in `types/Unify.hs` for +-- an explanation of how we avoid overlap with `Typeable (f a)`. instance KnownSymbol s => Typeable (s :: Symbol) where + -- See #9203 for an explanation of why this is written as `\_ -> rep`. typeRep# = \_ -> rep where rep = mkTyConApp tc [] From git at git.haskell.org Wed Jun 18 22:00:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jun 2014 22:00:54 +0000 (UTC) Subject: [commit: ghc] master: In progress Backpack implementation docs. (2a41db3) Message-ID: <20140618220054.B9C072406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2a41db332d9738198418513fe99abb04a0619928/ghc >--------------------------------------------------------------- commit 2a41db332d9738198418513fe99abb04a0619928 Author: Edward Z. Yang Date: Wed Jun 18 22:59:23 2014 +0100 In progress Backpack implementation docs. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 2a41db332d9738198418513fe99abb04a0619928 docs/backpack/.gitignore | 10 ++ docs/backpack/Makefile | 2 + docs/backpack/arch.png | Bin 0 -> 107562 bytes docs/backpack/backpack-impl.bib | 17 +++ docs/backpack/backpack-impl.tex | 298 ++++++++++++++++++++++++++++++++++++++++ docs/backpack/diagrams.pdf | Bin 0 -> 145951 bytes docs/backpack/diagrams.xoj | Bin 0 -> 141272 bytes docs/backpack/pkgdb.png | Bin 0 -> 96706 bytes 8 files changed, 327 insertions(+) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2a41db332d9738198418513fe99abb04a0619928 From git at git.haskell.org Wed Jun 18 23:32:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jun 2014 23:32:01 +0000 (UTC) Subject: [commit: ghc] master: haddock-library: allow 7.4.x building (46ec4ae) Message-ID: <20140618233202.107FB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46ec4aefbfdde4e22e5e6cbfc66f36459ac1cb1b/ghc >--------------------------------------------------------------- commit 46ec4aefbfdde4e22e5e6cbfc66f36459ac1cb1b Author: Mateusz Kowalczyk Date: Thu Jun 19 01:31:39 2014 +0200 haddock-library: allow 7.4.x building Updates submodule >--------------------------------------------------------------- 46ec4aefbfdde4e22e5e6cbfc66f36459ac1cb1b utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index dd3fee8..5412c26 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit dd3fee863579c88e49aa2b955cbc58e3c094ae4d +Subproject commit 5412c262f403e52be45d607b34eb3a5806ea2a76 From git at git.haskell.org Thu Jun 19 09:51:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jun 2014 09:51:43 +0000 (UTC) Subject: [commit: ghc] master: Typo (453e0fd) Message-ID: <20140619095143.5155F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/453e0fde4ebf9fc21817e3c0924da083f02c187a/ghc >--------------------------------------------------------------- commit 453e0fde4ebf9fc21817e3c0924da083f02c187a Author: Jose Pedro Magalhaes Date: Thu Jun 19 10:51:22 2014 +0100 Typo >--------------------------------------------------------------- 453e0fde4ebf9fc21817e3c0924da083f02c187a libraries/base/Data/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 510fe15..25f2875 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -323,7 +323,7 @@ class Typeable a => Data a where -- | A generic query that processes the immediate subterms and returns a list -- of results. The list is given in the same order as originally specified - -- in the declaratoin of the data constructors. + -- in the declaration of the data constructors. gmapQ :: (forall d. Data d => d -> u) -> a -> [u] gmapQ f = gmapQr (:) [] f From git at git.haskell.org Thu Jun 19 11:34:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jun 2014 11:34:16 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (3d81359) Message-ID: <20140619113417.1589C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3d8135935f727f90210ae20a2fb329058536a2f4/ghc >--------------------------------------------------------------- commit 3d8135935f727f90210ae20a2fb329058536a2f4 Author: Gabor Greif Date: Wed Jun 18 20:39:38 2014 +0200 Typos in comments >--------------------------------------------------------------- 3d8135935f727f90210ae20a2fb329058536a2f4 libraries/base/Data/Typeable/Internal.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 4912de9..e962752 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -435,15 +435,15 @@ deriving instance Typeable Typeable {- Note [Potential Collisions in `Nat` and `Symbol` instances] -Kinds resulting from lifted types have finately many type-constructors. -This is not the case for `Nat` and `Symbol`, which both contain *infinately* +Kinds resulting from lifted types have finitely many type-constructors. +This is not the case for `Nat` and `Symbol`, which both contain *infinitely* many type constructors (e.g., `Nat` has 0, 1, 2, 3, etc.). One might think that this would increase the chance of hash-collisions in the type but this -is not the case because the finger-print stored in a `TypeRep` identifies +is not the case because the fingerprint stored in a `TypeRep` identifies the whole *type* and not just the type constructor. This is why the chance of collisions for `Nat` and `Symbol` is not any worse than it is for other -lifted types with infinately many inhabitants. Indeed, `Nat` is -isomorphic to (lifted) `[()]` and `Symbol` is isomprohic to `[Char]`. +lifted types with infinitely many inhabitants. Indeed, `Nat` is +isomorphic to (lifted) `[()]` and `Symbol` is isomorphic to `[Char]`. -} -- See `Note [Kinds Containing Only Literals]` in `types/Unify.hs` for From git at git.haskell.org Thu Jun 19 14:58:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jun 2014 14:58:59 +0000 (UTC) Subject: [commit: ghc] master: Finish the rest of the writeup. (a52bf96) Message-ID: <20140619145859.687872406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a52bf967bbdc5698bb1e4014de2cee9dee494f50/ghc >--------------------------------------------------------------- commit a52bf967bbdc5698bb1e4014de2cee9dee494f50 Author: Edward Z. Yang Date: Thu Jun 19 15:58:42 2014 +0100 Finish the rest of the writeup. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a52bf967bbdc5698bb1e4014de2cee9dee494f50 docs/backpack/backpack-impl.tex | 323 ++++++++++++++++++++++++++++++---------- 1 file changed, 242 insertions(+), 81 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a52bf967bbdc5698bb1e4014de2cee9dee494f50 From git at git.haskell.org Thu Jun 19 21:20:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jun 2014 21:20:53 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (b1888aa) Message-ID: <20140619212053.C1DAE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1888aae3a506bbf7eb13dffac14c34093161a3f/ghc >--------------------------------------------------------------- commit b1888aae3a506bbf7eb13dffac14c34093161a3f Author: Gabor Greif Date: Thu Jun 19 23:19:54 2014 +0200 Typos in comments >--------------------------------------------------------------- b1888aae3a506bbf7eb13dffac14c34093161a3f libraries/base/GHC/Event/TimerManager.hs | 2 +- libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs index f94f061..f581330 100644 --- a/libraries/base/GHC/Event/TimerManager.hs +++ b/libraries/base/GHC/Event/TimerManager.hs @@ -98,7 +98,7 @@ become roots for all subsequent minor GCs. When the thunks eventually get evaluated they will each create a new intermediate 'TimeoutQueue' that immediately becomes garbage. Since the thunks serve as roots until the next major GC these intermediate -'TimeoutQueue's will get copied unnecesarily in the next minor GC, +'TimeoutQueue's will get copied unnecessarily in the next minor GC, increasing GC time. This problem is known as "floating garbage". Keeping a list of edits doesn't stop this from happening but makes the diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 589c66a..3172cbb 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -369,7 +369,7 @@ location = Q qLocation -- a single 'Q' computation, but not about the order in which splices are run. -- -- Note: for various murky reasons, stdout and stderr handles are not --- necesarily flushed when the compiler finishes running, so you should +-- necessarily flushed when the compiler finishes running, so you should -- flush them yourself. runIO :: IO a -> Q a runIO m = Q (qRunIO m) From git at git.haskell.org Fri Jun 20 07:16:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 07:16:56 +0000 (UTC) Subject: [commit: ghc] master: A bit more tracing of functional dependencies (b6693d3) Message-ID: <20140620071656.758EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6693d3096c810b925af1899b45867482bcc81cf/ghc >--------------------------------------------------------------- commit b6693d3096c810b925af1899b45867482bcc81cf Author: Simon Peyton Jones Date: Wed Jun 18 11:59:30 2014 +0100 A bit more tracing of functional dependencies >--------------------------------------------------------------- b6693d3096c810b925af1899b45867482bcc81cf compiler/typecheck/TcInteract.lhs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 5870938..42e0465 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -1481,7 +1481,9 @@ doTopReactDict inerts fl cls xis = do { instEnvs <- getInstEnvs ; let fd_eqns = improveFromInstEnv instEnvs pred ; fd_work <- rewriteWithFunDeps fd_eqns loc - ; unless (null fd_work) (updWorkListTcS (extendWorkListEqs fd_work)) + ; unless (null fd_work) $ + do { traceTcS "Addig FD work" (ppr pred $$ vcat (map pprEquation fd_eqns) $$ ppr fd_work) + ; updWorkListTcS (extendWorkListEqs fd_work) } ; return NoTopInt } -------------------- From git at git.haskell.org Fri Jun 20 07:16:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 07:16:58 +0000 (UTC) Subject: [commit: ghc] master: Tidy up the printing of single-predicate contexts (0ceb84e) Message-ID: <20140620071659.1F8132406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0ceb84e9668ba05d9a0ec49046ad7b4c2557a484/ghc >--------------------------------------------------------------- commit 0ceb84e9668ba05d9a0ec49046ad7b4c2557a484 Author: Simon Peyton Jones Date: Thu Jun 19 09:01:51 2014 +0100 Tidy up the printing of single-predicate contexts This covers things like Eq a => blah and (?x::Int) => blah where there is just one predicate. Previously we used an ad-hoc test to decide whether to parenthesise it, but acutally there is a much simpler solution: just use the existing precedence mechamism. This applies both to Type and HsType. >--------------------------------------------------------------- 0ceb84e9668ba05d9a0ec49046ad7b4c2557a484 compiler/hsSyn/HsTypes.lhs | 81 +++++++++------------- compiler/types/Type.lhs | 10 +-- compiler/types/Type.lhs-boot | 1 - compiler/types/TypeRep.lhs | 50 ++++++++----- .../tests/deSugar/should_compile/T2431.stderr | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 4 +- testsuite/tests/ghci/scripts/T2766.stdout | 2 +- .../haddock/haddock_examples/haddock.Test.stderr | 2 +- .../should_compile_flag_haddock/haddockA023.stderr | 2 +- .../should_compile_flag_haddock/haddockA026.stderr | 2 +- .../should_compile_flag_haddock/haddockA027.stderr | 4 +- .../indexed-types/should_fail/NoMatchErr.stderr | 2 +- .../tests/indexed-types/should_fail/T1900.stderr | 2 +- testsuite/tests/perf/compiler/T5837.stderr | 2 +- testsuite/tests/polykinds/T7278.stderr | 2 +- .../typecheck/should_fail/ContextStack2.stderr | 2 +- testsuite/tests/typecheck/should_fail/T7609.stderr | 2 +- testsuite/tests/typecheck/should_fail/T7778.stderr | 2 +- .../tests/typecheck/should_fail/T8392a.stderr | 2 +- testsuite/tests/typecheck/should_fail/T8806.stderr | 2 +- .../tests/typecheck/should_fail/tcfail032.stderr | 4 +- .../tests/typecheck/should_fail/tcfail058.stderr | 2 +- .../tests/typecheck/should_fail/tcfail215.stderr | 2 +- 23 files changed, 88 insertions(+), 98 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0ceb84e9668ba05d9a0ec49046ad7b4c2557a484 From git at git.haskell.org Fri Jun 20 07:17:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 07:17:01 +0000 (UTC) Subject: [commit: ghc] master: Add a new section to the manual about hiding things that a module doesn't export (cdc7431) Message-ID: <20140620071701.60E202406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cdc74311a23beef47d1418349d492a17bf62ed6f/ghc >--------------------------------------------------------------- commit cdc74311a23beef47d1418349d492a17bf62ed6f Author: Simon Peyton Jones Date: Thu Jun 19 09:24:50 2014 +0100 Add a new section to the manual about hiding things that a module doesn't export See Trac #9216 >--------------------------------------------------------------- cdc74311a23beef47d1418349d492a17bf62ed6f docs/users_guide/glasgow_exts.xml | 39 +++++++++++++++++++++++++++++++++++---- 1 file changed, 35 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 63c1a2e..ce353e8 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2400,6 +2400,35 @@ necessary to enable them. +Import and export extensions + + + Hiding things the imported module doesn't export + + +Technically in Haskell 2010 this is illegal: + +module A( f ) where + f = True + +module B where + import A hiding( g ) -- A does not export g + g = f + +The import A hiding( g ) in module B +is technically an error (Haskell Report, 5.3.1) +because A does not export g. +However GHC allows it, in the interests of supporting backward compatibility; for example, a newer version of +A might export g, and you want B to work +in either case. + + +The warning -fwarn-dodgy-imports, which is off by default but included with -W, +warns if you hide something that the imported module does not export. + + + + Package-qualified imports With the flag, GHC allows @@ -2424,9 +2453,9 @@ import "network" Network.Socket packages when APIs change. It can lead to fragile dependencies in the common case: modules occasionally move from one package to another, rendering any package-qualified imports broken. - + - + Safe imports With the , @@ -2444,9 +2473,9 @@ import safe qualified Network.Socket as NS safely imported. For a description of when a import is considered safe see - + - + Explicit namespaces in import/export In an import or export list, such as @@ -2480,6 +2509,8 @@ a data constructor in an import or export list with the keyword pattern to allow the import or export of a data constructor without its parent type constructor (see ). + + From git at git.haskell.org Fri Jun 20 07:17:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 07:17:04 +0000 (UTC) Subject: [commit: ghc] master: Make splitStrProdDmd (and similarly Use) more robust (2e362dd) Message-ID: <20140620071704.6F1912406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2e362ddebf2286409b7423d3dd49152117c1ae56/ghc >--------------------------------------------------------------- commit 2e362ddebf2286409b7423d3dd49152117c1ae56 Author: Simon Peyton Jones Date: Thu Jun 19 09:46:24 2014 +0100 Make splitStrProdDmd (and similarly Use) more robust The issue here is avoiding a GHC crash when a program uses unsafeCoerce is a dangerous (or even outright-wrong) way. See Trac #9208 >--------------------------------------------------------------- 2e362ddebf2286409b7423d3dd49152117c1ae56 compiler/basicTypes/Demand.lhs | 52 ++++++------- testsuite/tests/stranal/should_compile/T9208.hs | 98 +++++++++++++++++++++++++ testsuite/tests/stranal/should_compile/all.T | 2 +- 3 files changed, 123 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 2e362ddebf2286409b7423d3dd49152117c1ae56 From git at git.haskell.org Fri Jun 20 07:17:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 07:17:06 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation of defaulting rules with OverloadedStrings (aec9e75) Message-ID: <20140620071706.836A82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aec9e75bb09f6a99d77d3aeea255229ffb1925fa/ghc >--------------------------------------------------------------- commit aec9e75bb09f6a99d77d3aeea255229ffb1925fa Author: Simon Peyton Jones Date: Thu Jun 19 09:44:30 2014 +0100 Improve documentation of defaulting rules with OverloadedStrings See #9206 >--------------------------------------------------------------- aec9e75bb09f6a99d77d3aeea255229ffb1925fa docs/users_guide/glasgow_exts.xml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index ce353e8..e959a1f 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5253,21 +5253,30 @@ it explicitly (for example, to give an instance declaration for it), you can imp from module GHC.Exts. -Haskell's defaulting mechanism is extended to cover string literals, when is specified. +Haskell's defaulting mechanism (Haskell Report, Section 4.3.4) +is extended to cover string literals, when is specified. Specifically: -Each type in a default declaration must be an +Each type in a default declaration must be an instance of Num or of IsString. -The standard defaulting rule (Haskell Report, Section 4.3.4) +If no default declaration is given, then it is just as if the module +contained the declaration default( Integer, Double, String). + + + +The standard defaulting rule is extended thus: defaulting applies when all the unresolved constraints involve standard classes or IsString; and at least one is a numeric class or IsString. +So, for example, the expression length "foo" will give rise +to an ambiguous use of IsString a0 which, becuase of the above +rules, will default to String. A small example: From git at git.haskell.org Fri Jun 20 07:17:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 07:17:09 +0000 (UTC) Subject: [commit: ghc] master: Reject forall types in constraints in signatures (9c621e9) Message-ID: <20140620071709.6CF9E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9c621e9b1c7d8a02b48f06f041da605ce27f4d80/ghc >--------------------------------------------------------------- commit 9c621e9b1c7d8a02b48f06f041da605ce27f4d80 Author: Simon Peyton Jones Date: Thu Jun 19 17:26:11 2014 +0100 Reject forall types in constraints in signatures Fixes Trac #9196. Thanks to archblob for an initial stab at this. In the end I fixed it in the kind checker rather than the subsequent validity check, (a) so that the error messages look more uniform, and (b) so that I did not need to meddle with isPredTy. >--------------------------------------------------------------- 9c621e9b1c7d8a02b48f06f041da605ce27f4d80 compiler/typecheck/TcHsType.lhs | 6 +++++- testsuite/tests/typecheck/should_fail/T7019.stderr | 9 ++++----- testsuite/tests/typecheck/should_fail/T7019a.stderr | 7 ++----- testsuite/tests/typecheck/should_fail/T8806.stderr | 2 +- testsuite/tests/typecheck/should_fail/T9196.hs | 8 ++++++++ testsuite/tests/typecheck/should_fail/T9196.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 2 ++ 7 files changed, 30 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 69579ad..59aafea 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -396,7 +396,11 @@ tc_hs_type hs_ty@(HsAppTy ty1 ty2) exp_kind (fun_ty, arg_tys) = splitHsAppTys ty1 [ty2] --------- Foralls -tc_hs_type hs_ty@(HsForAllTy _ hs_tvs context ty) exp_kind +tc_hs_type hs_ty@(HsForAllTy _ hs_tvs context ty) exp_kind@(EK exp_k _) + | isConstraintKind exp_k + = failWithTc (hang (ptext (sLit "Illegal constraint:")) 2 (ppr hs_ty)) + + | otherwise = tcHsTyVarBndrs hs_tvs $ \ tvs' -> -- Do not kind-generalise here! See Note [Kind generalisation] do { ctxt' <- tcHsContext context diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr index dd967c8..6e47926 100644 --- a/testsuite/tests/typecheck/should_fail/T7019.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019.stderr @@ -1,6 +1,5 @@ -T7019.hs:14:10: - Illegal polymorphic or qualified type: C c - In the context: (C c) - While checking an instance declaration - In the instance declaration for ?Monad (Free c)? +T7019.hs:11:12: + Illegal constraint: forall a. c (Free c a) + In the type ?forall a. c (Free c a)? + In the type declaration for ?C? diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr index 301a6cd..f888931 100644 --- a/testsuite/tests/typecheck/should_fail/T7019a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr @@ -1,7 +1,4 @@ -T7019a.hs:11:1: - Illegal polymorphic or qualified type: - forall b. Context (Associated a b) - In the context: (forall b. Context (Associated a b)) - While checking the super-classes of class ?Class? +T7019a.hs:11:8: + Illegal constraint: forall b. Context (Associated a b) In the class declaration for ?Class? diff --git a/testsuite/tests/typecheck/should_fail/T8806.stderr b/testsuite/tests/typecheck/should_fail/T8806.stderr index 5d50c4e..ab88b7f 100644 --- a/testsuite/tests/typecheck/should_fail/T8806.stderr +++ b/testsuite/tests/typecheck/should_fail/T8806.stderr @@ -4,5 +4,5 @@ T8806.hs:5:6: In the type signature for ?f?: f :: Int => Int T8806.hs:8:7: - Expected a constraint, but ?Int? has kind ?*? + Illegal constraint: Int => Show a In the type signature for ?g?: g :: (Int => Show a) => Int diff --git a/testsuite/tests/typecheck/should_fail/T9196.hs b/testsuite/tests/typecheck/should_fail/T9196.hs new file mode 100644 index 0000000..11d713b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9196.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes #-} +module T9196 where + +f :: (forall a. Eq a) => a -> a +f x = x + +g :: (Eq a => Ord a) => a -> a +g x = x diff --git a/testsuite/tests/typecheck/should_fail/T9196.stderr b/testsuite/tests/typecheck/should_fail/T9196.stderr new file mode 100644 index 0000000..6f5a204 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9196.stderr @@ -0,0 +1,8 @@ + +T9196.hs:4:7: + Illegal constraint: forall a. Eq a + In the type signature for ?f?: f :: (forall a. Eq a) => a -> a + +T9196.hs:7:7: + Illegal constraint: Eq a => Ord a + In the type signature for ?g?: g :: (Eq a => Ord a) => a -> a diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 676c910..a1dab9d 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -333,3 +333,5 @@ test('T8806', normal, compile_fail, ['']) test('T8912', normal, compile_fail, ['']) test('T9033', normal, compile_fail, ['']) test('T8883', normal, compile_fail, ['']) +test('T9196', normal, compile_fail, ['']) + From git at git.haskell.org Fri Jun 20 07:17:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 07:17:11 +0000 (UTC) Subject: [commit: ghc] master: Comment typo (64224f1) Message-ID: <20140620071711.BE4472406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64224f19d1cccd1104e323016a1481ddaa9db464/ghc >--------------------------------------------------------------- commit 64224f19d1cccd1104e323016a1481ddaa9db464 Author: Simon Peyton Jones Date: Thu Jun 19 14:11:07 2014 +0100 Comment typo >--------------------------------------------------------------- 64224f19d1cccd1104e323016a1481ddaa9db464 compiler/typecheck/TcSimplify.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 50fcbac..843e050 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1124,7 +1124,7 @@ An alternative we considered was to equalities mentions any of the ic_givens of this implication. This seems like the Right Thing, but it's more code, and more work at runtime, so we are using the FlatSkolOrigin idea intead. It's less -obvious that it works, but I htink it does, and it's simple and efficient. +obvious that it works, but I think it does, and it's simple and efficient. Note [Float equalities from under a skolem binding] From git at git.haskell.org Fri Jun 20 16:19:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 16:19:56 +0000 (UTC) Subject: [commit: ghc] master: More fixes and updates to implementation document (e47baaf) Message-ID: <20140620161956.84F852406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e47baafadb6394a72b8c01142b54fff4b97c055d/ghc >--------------------------------------------------------------- commit e47baafadb6394a72b8c01142b54fff4b97c055d Author: Edward Z. Yang Date: Fri Jun 20 17:19:40 2014 +0100 More fixes and updates to implementation document Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- e47baafadb6394a72b8c01142b54fff4b97c055d docs/backpack/backpack-impl.tex | 340 +++++++++++++++++++++++++++++++--------- docs/backpack/diagrams.xoj | Bin 141272 -> 118800 bytes 2 files changed, 264 insertions(+), 76 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e47baafadb6394a72b8c01142b54fff4b97c055d From git at git.haskell.org Fri Jun 20 16:21:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jun 2014 16:21:25 +0000 (UTC) Subject: [commit: ghc] master: Update documentation to follow 2dc3b476aff28 (48abb88) Message-ID: <20140620162125.A46C32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48abb88b20d1204dfaaf613194ab110fe43f0491/ghc >--------------------------------------------------------------- commit 48abb88b20d1204dfaaf613194ab110fe43f0491 Author: Edward Z. Yang Date: Thu Jun 19 09:25:59 2014 -0700 Update documentation to follow 2dc3b476aff28 Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 48abb88b20d1204dfaaf613194ab110fe43f0491 compiler/main/PackageConfig.hs | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index acedd7e..514a2e0 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -47,16 +47,11 @@ defaultPackageConfig = emptyInstalledPackageInfo -- $package_naming -- #package_naming# --- Mostly the compiler deals in terms of 'PackageName's, which don't --- have the version suffix. This is so that we don't need to know the --- version for the @-package-name@ flag, or know the versions of --- wired-in packages like @base@ & @rts at . Versions are confined to the --- package sub-system. --- --- This means that in theory you could have multiple base packages installed --- (for example), and switch between them using @-package@\/@-hide-package at . --- --- A 'PackageId' is a string of the form @-@. +-- Mostly the compiler deals in terms of 'PackageId's, which have the +-- form @-@. You're expected to pass in the version for +-- the @-package-name@ flag. However, for wired-in packages like @base@ +-- & @rts@, we don't necessarily know what the version is, so these are +-- handled specially; see #wired_in_packages#. -- | Turn a Cabal 'PackageIdentifier' into a GHC 'PackageId' mkPackageId :: PackageIdentifier -> PackageId From git at git.haskell.org Sat Jun 21 15:25:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Jun 2014 15:25:20 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add fake entries into the global kind environment for pattern synonyms. (cbb3ec3) Message-ID: <20140621152521.060292406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/cbb3ec3e62a16169d7a3227cb70d93e0acd20b0d/ghc >--------------------------------------------------------------- commit cbb3ec3e62a16169d7a3227cb70d93e0acd20b0d Author: Dr. ERDI Gergo Date: Sat Jun 21 22:37:50 2014 +0800 Add fake entries into the global kind environment for pattern synonyms. This is needed to give meaningful error messages (instead of internal panics) when a program tries to lift a pattern synonym into a kind. (fixes T9161) >--------------------------------------------------------------- cbb3ec3e62a16169d7a3227cb70d93e0acd20b0d compiler/typecheck/TcBinds.lhs | 23 ++++++++++++++++------- compiler/typecheck/TcHsType.lhs | 1 - testsuite/tests/patsyn/should_fail/T9161-1.hs | 7 +++++++ testsuite/tests/patsyn/should_fail/T9161-1.stderr | 4 ++++ testsuite/tests/patsyn/should_fail/T9161-2.hs | 9 +++++++++ testsuite/tests/patsyn/should_fail/T9161-2.stderr | 5 +++++ testsuite/tests/patsyn/should_fail/all.T | 2 ++ 7 files changed, 43 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 08a5af4..c961073 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -280,19 +280,28 @@ tcValBinds :: TopLevelFlag -> TcM ([(RecFlag, LHsBinds TcId)], thing) tcValBinds top_lvl binds sigs thing_inside - = do { -- Typecheck the signature - (poly_ids, sig_fn) <- tcTySigs sigs + = do { -- Add fake entries for pattern synonyms so that + -- precise error messages can be generated when + -- trying to use a pattern synonym as a kind + traceTc "Fake lifted patsyns:" (vcat (map ppr patsyns)) + -- Typecheck the signature + ; (poly_ids, sig_fn) <- tcExtendKindEnv2 [(patsyn, fakePatSynCon) | patsyn <- patsyns] $ + tcTySigs sigs ; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds) -- Extend the envt right away with all -- the Ids declared with type signatures -- Use tcExtendIdEnv2 to avoid extending the TcIdBinder stack - ; (binds', thing) <- tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ - tcBindGroups top_lvl sig_fn prag_fn - binds thing_inside - - ; return (binds', thing) } + ; tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ + tcBindGroups top_lvl sig_fn prag_fn + binds thing_inside } + where + patsyns = [ name + | (_, lbinds) <- binds + , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds + ] + fakePatSynCon = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" ------------------------ tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index cf00a36..0136d75 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -619,7 +619,6 @@ tcTyVar :: Name -> TcM (TcType, TcKind) tcTyVar name -- Could be a tyvar, a tycon, or a datacon = do { traceTc "lk1" (ppr name) ; thing <- tcLookup name - ; traceTc "lk2" (ppr name <+> ppr thing) ; case thing of ATyVar _ tv | isKindVar tv diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.hs b/testsuite/tests/patsyn/should_fail/T9161-1.hs new file mode 100644 index 0000000..c14eb54 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds #-} + +pattern PATTERN = () + +wrongLift :: PATTERN +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.stderr b/testsuite/tests/patsyn/should_fail/T9161-1.stderr new file mode 100644 index 0000000..1f05196 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.stderr @@ -0,0 +1,4 @@ + +T9161-1.hs:6:14: + Pattern synonym ?PATTERN? used as a type + In the type signature for ?wrongLift?: wrongLift :: PATTERN diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.hs b/testsuite/tests/patsyn/should_fail/T9161-2.hs new file mode 100644 index 0000000..941d23e --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-} + +pattern PATTERN = () + +data Proxy (tag :: k) (a :: *) + +wrongLift :: Proxy PATTERN () +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.stderr b/testsuite/tests/patsyn/should_fail/T9161-2.stderr new file mode 100644 index 0000000..8d21be5 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.stderr @@ -0,0 +1,5 @@ + +T9161-2.hs:8:20: + Pattern synonym ?PATTERN? used as a type + In the type signature for ?wrongLift?: + wrongLift :: Proxy PATTERN () diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 897808e..bff6bdf 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -4,3 +4,5 @@ test('unidir', normal, compile_fail, ['']) test('local', normal, compile_fail, ['']) test('T8961', normal, multimod_compile_fail, ['T8961','']) test('as-pattern', normal, compile_fail, ['']) +test('T9161-1', normal, compile_fail, ['']) +test('T9161-2', normal, compile_fail, ['']) From git at git.haskell.org Sat Jun 21 15:25:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Jun 2014 15:25:23 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms's head updated: Add fake entries into the global kind environment for pattern synonyms. (cbb3ec3) Message-ID: <20140621152523.32BE52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/pattern-synonyms' now includes: b1436f5 Fix yet another bug in 'deriving' for polykinded classes (Trac #7269) db869e7 Add missing test file T7269 6ed5430 Replace DeriveDataTypeable by AutoDeriveTypeable ac2796e Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. fb74d71 Assert that matcher-derived PatSyn types match the (redundant) stored types in IfacePatSyn 2745dfb Test Trac #9144 b95dbb5 T4006, environment001, T3307 all work on msys2 8668c54 Use mkTcEqPred rather than mkEqPred in the type checker 3c1f2f7 No need to call defaultKind in mkTcEqPred e80089e Fix comment typo a518500 Update Haddock submodule. dcc6e04 Update T4891, T8639_api to follow 73c08ab10 (GHCi naming changes) 6c5017a Add .gitignore for autogenerated test files. cd14075 Fix bitrotted GHC API test T6145. a23f131 Add missing stderr file for tcrun045. fc6a952 s/implict/implicit/i a53fc11 Refresh recomp006 error message. 0c1974c Remove obsolete -fno-warn-amp from spec001 723095b Per-capability nursery weak pointer lists, fixes #9075 5a392ca Disable FixEither tests in TcCoercible a8d81af mkHiPath & mkObjPath didn't need to be in IO 994d5e3 Remove deprecated -optdep options 660c3f9 Just formatting 96a95f0 Fix missing unlockClosure() call in tryReadMVar (#9148) 9e10963 Improve Note [Order of Coercible Instances] about Trac #9117 2da439a fix missing space cbb3ec3 Add fake entries into the global kind environment for pattern synonyms. From git at git.haskell.org Sat Jun 21 17:39:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Jun 2014 17:39:22 +0000 (UTC) Subject: [commit: ghc] master: Add fake entries into the global kind environment for pattern synonyms. (aa3166f) Message-ID: <20140621173922.8A1422406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa3166f42361cb605e046f4a063be3f9e1f48015/ghc >--------------------------------------------------------------- commit aa3166f42361cb605e046f4a063be3f9e1f48015 Author: Dr. ERDI Gergo Date: Sat Jun 21 22:37:50 2014 +0800 Add fake entries into the global kind environment for pattern synonyms. This is needed to give meaningful error messages (instead of internal panics) when a program tries to lift a pattern synonym into a kind. (fixes T9161) >--------------------------------------------------------------- aa3166f42361cb605e046f4a063be3f9e1f48015 compiler/typecheck/TcBinds.lhs | 23 ++++++++++++++++------- compiler/typecheck/TcHsType.lhs | 1 - testsuite/tests/patsyn/should_fail/T9161-1.hs | 7 +++++++ testsuite/tests/patsyn/should_fail/T9161-1.stderr | 4 ++++ testsuite/tests/patsyn/should_fail/T9161-2.hs | 9 +++++++++ testsuite/tests/patsyn/should_fail/T9161-2.stderr | 5 +++++ testsuite/tests/patsyn/should_fail/all.T | 2 ++ 7 files changed, 43 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 516d4fc..273ef82 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -281,19 +281,28 @@ tcValBinds :: TopLevelFlag -> TcM ([(RecFlag, LHsBinds TcId)], thing) tcValBinds top_lvl binds sigs thing_inside - = do { -- Typecheck the signature - (poly_ids, sig_fn) <- tcTySigs sigs + = do { -- Add fake entries for pattern synonyms so that + -- precise error messages can be generated when + -- trying to use a pattern synonym as a kind + traceTc "Fake lifted patsyns:" (vcat (map ppr patsyns)) + -- Typecheck the signature + ; (poly_ids, sig_fn) <- tcExtendKindEnv2 [(patsyn, fakePatSynCon) | patsyn <- patsyns] $ + tcTySigs sigs ; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds) -- Extend the envt right away with all -- the Ids declared with type signatures -- Use tcExtendIdEnv2 to avoid extending the TcIdBinder stack - ; (binds', thing) <- tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ - tcBindGroups top_lvl sig_fn prag_fn - binds thing_inside - - ; return (binds', thing) } + ; tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ + tcBindGroups top_lvl sig_fn prag_fn + binds thing_inside } + where + patsyns = [ name + | (_, lbinds) <- binds + , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds + ] + fakePatSynCon = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" ------------------------ tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 59aafea..eb3dd32 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -625,7 +625,6 @@ tcTyVar :: Name -> TcM (TcType, TcKind) tcTyVar name -- Could be a tyvar, a tycon, or a datacon = do { traceTc "lk1" (ppr name) ; thing <- tcLookup name - ; traceTc "lk2" (ppr name <+> ppr thing) ; case thing of ATyVar _ tv | isKindVar tv diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.hs b/testsuite/tests/patsyn/should_fail/T9161-1.hs new file mode 100644 index 0000000..c14eb54 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds #-} + +pattern PATTERN = () + +wrongLift :: PATTERN +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.stderr b/testsuite/tests/patsyn/should_fail/T9161-1.stderr new file mode 100644 index 0000000..1f05196 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.stderr @@ -0,0 +1,4 @@ + +T9161-1.hs:6:14: + Pattern synonym ?PATTERN? used as a type + In the type signature for ?wrongLift?: wrongLift :: PATTERN diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.hs b/testsuite/tests/patsyn/should_fail/T9161-2.hs new file mode 100644 index 0000000..941d23e --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-} + +pattern PATTERN = () + +data Proxy (tag :: k) (a :: *) + +wrongLift :: Proxy PATTERN () +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.stderr b/testsuite/tests/patsyn/should_fail/T9161-2.stderr new file mode 100644 index 0000000..8d21be5 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.stderr @@ -0,0 +1,5 @@ + +T9161-2.hs:8:20: + Pattern synonym ?PATTERN? used as a type + In the type signature for ?wrongLift?: + wrongLift :: Proxy PATTERN () diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 897808e..bff6bdf 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -4,3 +4,5 @@ test('unidir', normal, compile_fail, ['']) test('local', normal, compile_fail, ['']) test('T8961', normal, multimod_compile_fail, ['T8961','']) test('as-pattern', normal, compile_fail, ['']) +test('T9161-1', normal, compile_fail, ['']) +test('T9161-2', normal, compile_fail, ['']) From git at git.haskell.org Sat Jun 21 17:40:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Jun 2014 17:40:09 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms's head updated: Add fake entries into the global kind environment for pattern synonyms. (aa3166f) Message-ID: <20140621174009.147302406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/pattern-synonyms' now includes: 09dc9a8 Rename TypeRep.Prec to TypeRep.TyPrec 0ba74f6 Use mkTcEqPred rather than mkEqPred da64c97 Fix inverted gadt-syntax flag for data families b4856f9 Do pretty-printing of TyThings via IfaceDecl (Trac #7730) 6e8861c Use IfLclName instead of OccName in IfaceEqSpec d02cd1a Add :kind test in T7730 dd99434 Comments only (related to Trac #7730) d7a228b Set/update upstream repo url for haddock fe59334 Export `TimerManager` from GHC.Event (re #9165) c63a465 Subsume NullaryTypeClasses by MultiParamTypeClasses (#8993) 0a55a3c Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) 616f54b Test Trac #9023 3faf83e Add .arcconfig file. Do not use yet. 56ea745 Add ".text.unlikely" to recognized code sections on Windows. c226d25 Emit error in case of duplicate GRE; fixes #7241 6ad11c4 Fix .arcconfig 9ff32f9 Typo 4627575 Tweak comments 2a463eb Fix compilation of cmm files with -outputdir (Trac #9050) f9def07 Typo 009e86f Suggest Int when user writes int ae41a50 Report all possible results from related name spaces d3cae19 Add testcase for #9177 and adjust test output 6e50553 Update test results (last minuite changes) 3a2b21d Added link ends to role documentation. 6fa7577 Sorted the language options list alphabetically, and added missing options. 57cc003 Prevent line wrapping after the dash of an option. 7ac600d Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds 63e1f09 Added more option implication documentation. 5c89f88 Merge branch 'master' of git://git.haskell.org/ghc 3bdc78b Make DeriveTraversable imply DeriveFunctor/Foldable 63d7047 Added testcase for #9069 1178fa4 Update mod73 test output 819e1f2 Use UnicodeSyntax when printing 6e4a750 Only use UnicodeSytanx pretty printing if the locale supports it b021572 Test case: GHCi uses UnicodeSyntax if the loaded file uses it. e577a52 Fix discarding of unreachable code in the register allocator (#9155) fbdebd3 supress warning of bang wildcard pattern-binding (i.e. let !_ = rhs). This fixes #9127 ab3f95b s/-hi-diffs/-ddump-hi-diffs/ in docs (#9179) b36bc2f Test case for #9181 (:browse GHC.TypeLits panic) 96a8980 Pretty-print built in synonym families in interfaces 2f8b4c9 Fix obscure problem with using the system linker (#8935) 9fd507e Raise exceptions when blocked in bad FDs (fixes Trac #4934) 70f58eb Remove unused --run-cps/--run-cpsz options c025817 Don't use showPass in the backend (#8973) 66bddbb Check that an associated type mentions at least one type variable from the class aa18a46 Improve documentation for -fwarn-unused-binds 52509d8 Document -fwarn-inline-rule-shadowing (Trac #9166) 59cdb99 Document explicit import/export of data constructors (Trac #8753) 4b4d81a Suggest -fprint-explicit-kinds when only kind variables are ambiguous 877a957 Better warning message for orphan instances (Ticket #9178) 4caadb7 Ship xhtml, terminfo, haskeline (#8919) 25fb4fe Add .arclint file 1946922 Make Ptr's parameter phantom 707bde5 Update test results with new orphan instance warning f251afe Revert "Make Ptr's parameter phantom" 5bdbd51 Make Ptr's parameter phantom faddad7 Improve the API doc description of the SmallArray primitive types f764aac Fire "map/coerce" only in phase 1 fdf370e Forgot to amend before pushing... 0e6bc84 Make better use of the x86 addressing mode 9e6c6b4 Make FunPtr's role be phantom; add comments. 1153194 Clarify error message. See #9167. 8dcfdf9 Add comments about instances of type-level (==). 0f584ae Refine deprecation warnings in template-haskell. 051d694 Fix #9097. 6a1d7f9 Fix #9085. e79e2c3 Fix #9062. 7b10d01 Test #9097. 9dbf340 Fix #9111. f502617 Test #9085. f73d42f Test #9111. a9ff7d0 Typo in variable name, no functional change edd5764 Some typos in comments 56f8777 Improve error message in Trac #8883 7817ec1 Comments only explaining the imports for GHC.Integer, GHC.Tuple 748bec4 White space only e5257f8 Fix tyConToIfaceDecl (Trac #9190) c8295c0 Simplify variable naming in tcDataKindSig 7d9feb2 Fix a serious, but rare, strictness analyser bug (Trac #9128) 7f467d0 Fix Windows build (wibble to fix for Trac #4934) 165ac4a Catch two typos a600c91 Improve IfaceSyn a bit further b60df0f Better debug printing 571f0ad Line up kind and type variables correctly when desugaring TH brackets b637585 Fix elemLocalRdrEnv (Trac #9160) 970e5d9 Bytes allocated by haddock.base has crept up (again) 632fcf1 Remove forgotten redundant import ce19d50 Fixes #95 :edit command should jump to the last error 0354fb3 Implement `Typeable` support for type-level literals (#8778). 5ffc68b Fix recomputation of TypeRep in the instance for Typeable (s a) (#9203) e09be5f Update the incorrect comment on when function was introduced. 836981c Redo instance to be more efficient (see #8778, #9203) 00fc4ba Optimise the Typeable instance for type app a bit, and add a perf test e38fe3b accept T9181 output 652c9e6 Haddock: haddock-library release and Travis stuff 2ba1a56 Only comments: add notes explaining the various oddities of the `Typeable` implementation for type-level literals. 2a41db3 In progress Backpack implementation docs. 46ec4ae haddock-library: allow 7.4.x building 453e0fd Typo 3d81359 Typos in comments a52bf96 Finish the rest of the writeup. b1888aa Typos in comments b6693d3 A bit more tracing of functional dependencies 0ceb84e Tidy up the printing of single-predicate contexts cdc7431 Add a new section to the manual about hiding things that a module doesn't export aec9e75 Improve documentation of defaulting rules with OverloadedStrings 2e362dd Make splitStrProdDmd (and similarly Use) more robust 64224f1 Comment typo 9c621e9 Reject forall types in constraints in signatures e47baaf More fixes and updates to implementation document 48abb88 Update documentation to follow 2dc3b476aff28 aa3166f Add fake entries into the global kind environment for pattern synonyms. From git at git.haskell.org Sun Jun 22 11:21:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jun 2014 11:21:11 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9023' created Message-ID: <20140622112111.B6A0C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9023 Referencing: 1b45c6b4959762209dbcabf3290feb8673a60b23 From git at git.haskell.org Sun Jun 22 11:21:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jun 2014 11:21:14 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. (e0fbf1e) Message-ID: <20140622112114.43ECA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/e0fbf1e3bc062b7ce3f1c515a135fd9f3d49e2ee/ghc >--------------------------------------------------------------- commit e0fbf1e3bc062b7ce3f1c515a135fd9f3d49e2ee Author: Dr. ERDI Gergo Date: Tue May 27 21:16:41 2014 +0800 Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. Also updates haddock submodule to accomodate tweaks in PatSyn representation Conflicts: compiler/typecheck/TcPatSyn.lhs utils/haddock >--------------------------------------------------------------- e0fbf1e3bc062b7ce3f1c515a135fd9f3d49e2ee compiler/basicTypes/PatSyn.lhs | 103 +++++++++++++++++++++++++++++----------- compiler/coreSyn/CorePrep.lhs | 1 + compiler/iface/BuildTyCl.lhs | 81 ++++++++----------------------- compiler/iface/IfaceSyn.lhs | 28 ++++++----- compiler/iface/LoadIface.lhs | 3 +- compiler/iface/MkIface.lhs | 13 ++--- compiler/iface/TcIface.lhs | 35 +++++--------- compiler/main/HscTypes.lhs | 20 ++++---- compiler/main/TidyPgm.lhs | 2 +- compiler/typecheck/TcPat.lhs | 4 +- compiler/typecheck/TcPatSyn.lhs | 34 +++++++------ 11 files changed, 169 insertions(+), 155 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e0fbf1e3bc062b7ce3f1c515a135fd9f3d49e2ee From git at git.haskell.org Sun Jun 22 11:21:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jun 2014 11:21:17 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) (1fc4f6b) Message-ID: <20140622112117.84F422406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/1fc4f6b973a4fb14b2b15143b2774ec597b4da0f/ghc >--------------------------------------------------------------- commit 1fc4f6b973a4fb14b2b15143b2774ec597b4da0f Author: Simon Peyton Jones Date: Thu Jun 5 11:03:45 2014 +0100 Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) We simply weren't giving anything like the right instantiating types to patSynInstArgTys in matchOneConLike. To get these instantiating types would have involved matching the result type of the pattern synonym with the pattern type, which is tiresome. So instead I changed ConPatOut so that instead of recording the type of the *whole* pattern (in old field pat_ty), it not records the *instantiating* types (in new field pat_arg_tys). Then we canuse TcHsSyn.conLikeResTy to get the pattern type when needed. There are lots of knock-on incidental effects, but they mostly made the code simpler, so I'm happy. Conflicts: compiler/typecheck/TcPat.lhs >--------------------------------------------------------------- 1fc4f6b973a4fb14b2b15143b2774ec597b4da0f compiler/basicTypes/PatSyn.lhs | 25 +++++++++++++++++++++++-- compiler/deSugar/Check.lhs | 32 +++++++++++++++----------------- compiler/deSugar/DsExpr.lhs | 2 +- compiler/deSugar/DsUtils.lhs | 3 +-- compiler/deSugar/Match.lhs | 11 +++++------ compiler/deSugar/MatchCon.lhs | 33 +++++++++++++++------------------ compiler/deSugar/MatchLit.lhs | 6 +++--- compiler/hsSyn/Convert.lhs | 4 ++-- compiler/hsSyn/HsPat.lhs | 31 ++++++++++++++++++++----------- compiler/hsSyn/HsUtils.lhs | 2 +- compiler/parser/RdrHsSyn.lhs | 2 +- compiler/rename/RnPat.lhs | 2 +- compiler/typecheck/TcHsSyn.lhs | 24 ++++++++++++++++-------- compiler/typecheck/TcPat.lhs | 19 ++++++++++--------- 14 files changed, 114 insertions(+), 82 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1fc4f6b973a4fb14b2b15143b2774ec597b4da0f From git at git.haskell.org Sun Jun 22 11:21:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jun 2014 11:21:21 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Test Trac #9023 (1b45c6b) Message-ID: <20140622112123.6FF3D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/1b45c6b4959762209dbcabf3290feb8673a60b23/ghc >--------------------------------------------------------------- commit 1b45c6b4959762209dbcabf3290feb8673a60b23 Author: Simon Peyton Jones Date: Thu Jun 5 12:26:24 2014 +0100 Test Trac #9023 >--------------------------------------------------------------- 1b45c6b4959762209dbcabf3290feb8673a60b23 testsuite/tests/patsyn/should_compile/T9023.hs | 6 ++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 2 files changed, 7 insertions(+) diff --git a/testsuite/tests/patsyn/should_compile/T9023.hs b/testsuite/tests/patsyn/should_compile/T9023.hs new file mode 100644 index 0000000..3a86140 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T9023.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T9023 where + +pattern P a b = Just (a, b) +foo P{} = True diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index ecc4701..d851bc3 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -9,3 +9,4 @@ test('num', normal, compile, ['']) test('incomplete', normal, compile, ['']) test('export', normal, compile, ['']) test('T8966', normal, compile, ['']) +test('T9023', normal, compile, ['']) From git at git.haskell.org Sun Jun 22 16:37:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jun 2014 16:37:41 +0000 (UTC) Subject: [commit: ghc] master: Simplify package dump for -v4 (b6352c9) Message-ID: <20140622163742.172A42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6352c9912536929537dcebac9d02d4f995c1657/ghc >--------------------------------------------------------------- commit b6352c9912536929537dcebac9d02d4f995c1657 Author: Edward Z. Yang Date: Sun Jun 22 08:42:56 2014 -0700 Simplify package dump for -v4 Summary: Previously, on -v4 and greater, we dumped out the entire package database, including lots of metadata that GHC doesn't really care about, and is guaranteed to correspond to the equivalent in the local/global package databases on disk. So, to make this output more useful, on -v4 we instead just print package IDs, and the exposed and trusted flags (E and T, which can be tweaked at runtime). Signed-off-by: Edward Z. Yang Test Plan: successful validate Reviewers: simonpj Subscribers: simonmar, relrod Differential Revision: https://phabricator.haskell.org/D24 >--------------------------------------------------------------- b6352c9912536929537dcebac9d02d4f995c1657 compiler/main/Packages.lhs | 22 ++++++++++++++++++---- ghc/Main.hs | 8 +++++--- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index bb37e44..bb2e048 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -10,7 +10,7 @@ module Packages ( -- * The PackageConfigMap PackageConfigMap, emptyPackageConfigMap, lookupPackage, - extendPackageConfigMap, dumpPackages, + extendPackageConfigMap, dumpPackages, simpleDumpPackages, -- * Reading the package config, and processing cmdline args PackageState(..), @@ -1080,12 +1080,26 @@ isDllName dflags _this_pkg this_mod name -- ----------------------------------------------------------------------------- -- Displaying packages --- | Show package info on console, if verbosity is >= 3 +-- | Show (very verbose) package info on console, if verbosity is >= 5 dumpPackages :: DynFlags -> IO () -dumpPackages dflags +dumpPackages = dumpPackages' showInstalledPackageInfo + +dumpPackages' :: (InstalledPackageInfo -> String) -> DynFlags -> IO () +dumpPackages' showIPI dflags = do let pkg_map = pkgIdMap (pkgState dflags) putMsg dflags $ - vcat (map (text . showInstalledPackageInfo + vcat (map (text . showIPI . packageConfigToInstalledPackageInfo) (eltsUFM pkg_map)) + +-- | Show simplified package info on console, if verbosity == 4. +-- The idea is to only print package id, and any information that might +-- be different from the package databases (exposure, trust) +simpleDumpPackages :: DynFlags -> IO () +simpleDumpPackages = dumpPackages' showIPI + where showIPI ipi = let InstalledPackageId i = installedPackageId ipi + e = if exposed ipi then "E" else " " + t = if trusted ipi then "T" else " " + in e ++ t ++ " " ++ i + \end{code} diff --git a/ghc/Main.hs b/ghc/Main.hs index 86f1af3..2bb156c 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -33,7 +33,7 @@ import InteractiveUI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) import Config import Constants import HscTypes -import Packages ( dumpPackages ) +import Packages ( dumpPackages, simpleDumpPackages ) import DriverPhases import BasicTypes ( failed ) import StaticFlags @@ -209,8 +209,10 @@ main' postLoadMode dflags0 args flagWarnings = do hsc_env <- GHC.getSession ---------------- Display configuration ----------- - when (verbosity dflags6 >= 4) $ - liftIO $ dumpPackages dflags6 + case verbosity dflags6 of + v | v == 4 -> liftIO $ simpleDumpPackages dflags6 + | v >= 5 -> liftIO $ dumpPackages dflags6 + | otherwise -> return () when (verbosity dflags6 >= 3) $ do liftIO $ hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags) From git at git.haskell.org Mon Jun 23 06:28:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 06:28:19 +0000 (UTC) Subject: [commit: ghc] master: Fix #9047 (b847481) Message-ID: <20140623062819.1C84D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b84748121e777d098198f2583d11a9424c1b1650/ghc >--------------------------------------------------------------- commit b84748121e777d098198f2583d11a9424c1b1650 Author: Austin Seipp Date: Mon Jun 23 00:07:10 2014 -0500 Fix #9047 Signed-off-by: Austin Seipp >--------------------------------------------------------------- b84748121e777d098198f2583d11a9424c1b1650 compiler/main/DriverPipeline.hs | 46 ++++++++++++++++++++++------------------- compiler/main/DynFlags.hs | 2 ++ compiler/main/SysTools.lhs | 7 +++++-- 3 files changed, 32 insertions(+), 23 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 39df2a1..b90a821 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1206,6 +1206,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags -- might be a hierarchical module. liftIO $ createDirectoryIfMissing True (takeDirectory output_fn) + ccInfo <- liftIO $ getCompilerInfo dflags let runAssembler inputFilename outputFilename = liftIO $ as_prog dflags ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] @@ -1220,7 +1221,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags ++ (if platformArch (targetPlatform dflags) == ArchSPARC then [SysTools.Option "-mcpu=v9"] else []) - + ++ (if ccInfo == AppleClang51 + then [SysTools.Option "-Qunused-arguments"] + else []) ++ [ SysTools.Option "-x" , if with_cpp then SysTools.Option "assembler-with-cpp" @@ -2129,26 +2132,27 @@ joinObjectFiles dflags o_files output_fn = do let mySettings = settings dflags ldIsGnuLd = sLdIsGnuLd mySettings osInfo = platformOS (targetPlatform dflags) - ld_r args ccInfo = SysTools.runLink dflags ([ - SysTools.Option "-nostdlib", - SysTools.Option "-Wl,-r" - ] - ++ (if ccInfo == Clang then [] - else [SysTools.Option "-nodefaultlibs"]) - ++ (if osInfo == OSFreeBSD - then [SysTools.Option "-L/usr/lib"] - else []) - -- gcc on sparc sets -Wl,--relax implicitly, but - -- -r and --relax are incompatible for ld, so - -- disable --relax explicitly. - ++ (if platformArch (targetPlatform dflags) == ArchSPARC - && ldIsGnuLd - then [SysTools.Option "-Wl,-no-relax"] - else []) - ++ map SysTools.Option ld_build_id - ++ [ SysTools.Option "-o", - SysTools.FileOption "" output_fn ] - ++ args) + ld_r args cc = SysTools.runLink dflags ([ + SysTools.Option "-nostdlib", + SysTools.Option "-Wl,-r" + ] + ++ (if any (cc ==) [Clang, AppleClang, AppleClang51] + then [] + else [SysTools.Option "-nodefaultlibs"]) + ++ (if osInfo == OSFreeBSD + then [SysTools.Option "-L/usr/lib"] + else []) + -- gcc on sparc sets -Wl,--relax implicitly, but + -- -r and --relax are incompatible for ld, so + -- disable --relax explicitly. + ++ (if platformArch (targetPlatform dflags) == ArchSPARC + && ldIsGnuLd + then [SysTools.Option "-Wl,-no-relax"] + else []) + ++ map SysTools.Option ld_build_id + ++ [ SysTools.Option "-o", + SysTools.FileOption "" output_fn ] + ++ args) -- suppress the generation of the .note.gnu.build-id section, -- which we don't need and sometimes causes ld to emit a diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7222af3..f82c404 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3757,6 +3757,8 @@ data LinkerInfo data CompilerInfo = GCC | Clang + | AppleClang + | AppleClang51 | UnknownCC deriving Eq diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index dc9642d..51d5af1 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -788,12 +788,15 @@ getCompilerInfo' dflags = do -- Regular clang | any ("clang version" `isPrefixOf`) stde = return Clang + -- XCode 5.1 clang + | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = + return AppleClang51 -- XCode 5 clang | any ("Apple LLVM version" `isPrefixOf`) stde = - return Clang + return AppleClang -- XCode 4.1 clang | any ("Apple clang version" `isPrefixOf`) stde = - return Clang + return AppleClang -- Unknown linker. | otherwise = fail "invalid -v output, or compiler is unsupported" From git at git.haskell.org Mon Jun 23 06:40:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 06:40:14 +0000 (UTC) Subject: [commit: ghc] master: Fix up b84748121e777d (95f95ed) Message-ID: <20140623064014.210402406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/95f95ed6281adf9616d87b97470d68fb54c0b7f3/ghc >--------------------------------------------------------------- commit 95f95ed6281adf9616d87b97470d68fb54c0b7f3 Author: Austin Seipp Date: Mon Jun 23 01:31:15 2014 -0500 Fix up b84748121e777d I forgot to amend this to my last commit. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 95f95ed6281adf9616d87b97470d68fb54c0b7f3 compiler/main/DriverPipeline.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index b90a821..0eae3bb 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1221,7 +1221,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags ++ (if platformArch (targetPlatform dflags) == ArchSPARC then [SysTools.Option "-mcpu=v9"] else []) - ++ (if ccInfo == AppleClang51 + ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51] then [SysTools.Option "-Qunused-arguments"] else []) ++ [ SysTools.Option "-x" From git at git.haskell.org Mon Jun 23 06:53:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 06:53:22 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #9047 (52222f9) Message-ID: <20140623065322.DE9D52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/52222f9e0bedc9b08b46619f8ed4d09f645d6ed4/ghc >--------------------------------------------------------------- commit 52222f9e0bedc9b08b46619f8ed4d09f645d6ed4 Author: Austin Seipp Date: Mon Jun 23 00:07:10 2014 -0500 Fix #9047 Signed-off-by: Austin Seipp (cherry picked from commit b84748121e777d098198f2583d11a9424c1b1650) >--------------------------------------------------------------- 52222f9e0bedc9b08b46619f8ed4d09f645d6ed4 compiler/main/DriverPipeline.hs | 46 ++++++++++++++++++++++------------------- compiler/main/DynFlags.hs | 2 ++ compiler/main/SysTools.lhs | 7 +++++-- 3 files changed, 32 insertions(+), 23 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index b93cef1..299422d 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1216,6 +1216,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags -- might be a hierarchical module. liftIO $ createDirectoryIfMissing True (takeDirectory output_fn) + ccInfo <- liftIO $ getCompilerInfo dflags let runAssembler inputFilename outputFilename = liftIO $ as_prog dflags ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] @@ -1230,7 +1231,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags ++ (if platformArch (targetPlatform dflags) == ArchSPARC then [SysTools.Option "-mcpu=v9"] else []) - + ++ (if ccInfo == AppleClang51 + then [SysTools.Option "-Qunused-arguments"] + else []) ++ [ SysTools.Option "-x" , if with_cpp then SysTools.Option "assembler-with-cpp" @@ -2139,26 +2142,27 @@ joinObjectFiles dflags o_files output_fn = do let mySettings = settings dflags ldIsGnuLd = sLdIsGnuLd mySettings osInfo = platformOS (targetPlatform dflags) - ld_r args ccInfo = SysTools.runLink dflags ([ - SysTools.Option "-nostdlib", - SysTools.Option "-Wl,-r" - ] - ++ (if ccInfo == Clang then [] - else [SysTools.Option "-nodefaultlibs"]) - ++ (if osInfo == OSFreeBSD - then [SysTools.Option "-L/usr/lib"] - else []) - -- gcc on sparc sets -Wl,--relax implicitly, but - -- -r and --relax are incompatible for ld, so - -- disable --relax explicitly. - ++ (if platformArch (targetPlatform dflags) == ArchSPARC - && ldIsGnuLd - then [SysTools.Option "-Wl,-no-relax"] - else []) - ++ map SysTools.Option ld_build_id - ++ [ SysTools.Option "-o", - SysTools.FileOption "" output_fn ] - ++ args) + ld_r args cc = SysTools.runLink dflags ([ + SysTools.Option "-nostdlib", + SysTools.Option "-Wl,-r" + ] + ++ (if any (cc ==) [Clang, AppleClang, AppleClang51] + then [] + else [SysTools.Option "-nodefaultlibs"]) + ++ (if osInfo == OSFreeBSD + then [SysTools.Option "-L/usr/lib"] + else []) + -- gcc on sparc sets -Wl,--relax implicitly, but + -- -r and --relax are incompatible for ld, so + -- disable --relax explicitly. + ++ (if platformArch (targetPlatform dflags) == ArchSPARC + && ldIsGnuLd + then [SysTools.Option "-Wl,-no-relax"] + else []) + ++ map SysTools.Option ld_build_id + ++ [ SysTools.Option "-o", + SysTools.FileOption "" output_fn ] + ++ args) -- suppress the generation of the .note.gnu.build-id section, -- which we don't need and sometimes causes ld to emit a diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index e744952..ad004a2 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3749,6 +3749,8 @@ data LinkerInfo data CompilerInfo = GCC | Clang + | AppleClang + | AppleClang51 | UnknownCC deriving Eq diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 53240fa..1af1c5e 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -786,12 +786,15 @@ getCompilerInfo' dflags = do -- Regular clang | any ("clang version" `isPrefixOf`) stde = return Clang + -- XCode 5.1 clang + | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = + return AppleClang51 -- XCode 5 clang | any ("Apple LLVM version" `isPrefixOf`) stde = - return Clang + return AppleClang -- XCode 4.1 clang | any ("Apple clang version" `isPrefixOf`) stde = - return Clang + return AppleClang -- Unknown linker. | otherwise = fail "invalid -v output, or compiler is unsupported" From git at git.haskell.org Mon Jun 23 06:53:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 06:53:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix up b84748121e777d (fd4169f) Message-ID: <20140623065325.5B9F02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/fd4169f9caf6922e3e5ea9c31f497f7220fc62b8/ghc >--------------------------------------------------------------- commit fd4169f9caf6922e3e5ea9c31f497f7220fc62b8 Author: Austin Seipp Date: Mon Jun 23 01:31:15 2014 -0500 Fix up b84748121e777d I forgot to amend this to my last commit. Signed-off-by: Austin Seipp (cherry picked from commit 95f95ed6281adf9616d87b97470d68fb54c0b7f3) >--------------------------------------------------------------- fd4169f9caf6922e3e5ea9c31f497f7220fc62b8 compiler/main/DriverPipeline.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 299422d..d2d2bc0 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1231,7 +1231,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags ++ (if platformArch (targetPlatform dflags) == ArchSPARC then [SysTools.Option "-mcpu=v9"] else []) - ++ (if ccInfo == AppleClang51 + ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51] then [SysTools.Option "-Qunused-arguments"] else []) ++ [ SysTools.Option "-x" From git at git.haskell.org Mon Jun 23 07:38:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 07:38:48 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix over-zealous unused-import warning (a35a031) Message-ID: <20140623073848.4159C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/a35a0315e3e928b4d9758c71e1a7ef8e034d16f9/ghc >--------------------------------------------------------------- commit a35a0315e3e928b4d9758c71e1a7ef8e034d16f9 Author: Simon Peyton Jones Date: Fri May 2 12:09:52 2014 +0100 Fix over-zealous unused-import warning See Note [Un-warnable import decls] in RnNames. Fixes Trac #9061. (cherry picked from commit 9f3e39d5f8686e511ffca406a6e056dec4095e53) >--------------------------------------------------------------- a35a0315e3e928b4d9758c71e1a7ef8e034d16f9 compiler/rename/RnNames.lhs | 24 ++++++++++++++++++++---- testsuite/tests/module/T9061.hs | 6 ++++++ testsuite/tests/module/all.T | 1 + 3 files changed, 27 insertions(+), 4 deletions(-) diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 56ee969..bddafe0 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -1285,7 +1285,7 @@ type ImportDeclUsage warnUnusedImportDecls :: TcGblEnv -> RnM () warnUnusedImportDecls gbl_env = do { uses <- readMutVar (tcg_used_rdrnames gbl_env) - ; let imports = filter explicit_import (tcg_rn_imports gbl_env) + ; let imports = filterOut un_warnable_import (tcg_rn_imports gbl_env) rdr_env = tcg_rdr_env gbl_env ; let usage :: [ImportDeclUsage] @@ -1299,11 +1299,27 @@ warnUnusedImportDecls gbl_env ; whenGOptM Opt_D_dump_minimal_imports $ printMinimalImports usage } where - explicit_import (L _ decl) = not (ideclImplicit decl) - -- Filter out the implicit Prelude import - -- which we do not want to bleat about + un_warnable_import (L _ decl) -- See Note [Un-warnable import decls] + | ideclImplicit decl + = True + | Just (True, hides) <- ideclHiding decl + , not (null hides) + , pRELUDE_NAME == unLoc (ideclName decl) + = True + | otherwise + = False \end{code} +Note [Un-warnable import decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We do not warn about the implicit import of Prelude, since the user can't remove it + +We do not warn about + import Prelude hiding( x, y ) +because even if nothing else from Prelude is used, it may be essential to hide +x,y to avoid name-shadowing warnings. Example (Trac #9061) + import Prelude hiding( log ) + f x = log where log = () Note [The ImportMap] ~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/module/T9061.hs b/testsuite/tests/module/T9061.hs new file mode 100644 index 0000000..1417dca --- /dev/null +++ b/testsuite/tests/module/T9061.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -fwarn-unused-imports #-} +module T9061 where + +import Prelude hiding (log) + +f = log where log = () diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index 8eaa1d5..926cbb5 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -334,3 +334,4 @@ test('T414', normal, compile_fail, ['']) test('T414a', normal, compile, ['']) test('T414b', normal, compile, ['']) test('T3776', normal, compile, ['']) +test('T9061', normal, compile, ['']) From git at git.haskell.org Mon Jun 23 07:38:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 07:38:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Second go at fixing #9061 (f98d2c2) Message-ID: <20140623073851.90B4B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f98d2c279e5757d3156427c834281d2ce2ab92db/ghc >--------------------------------------------------------------- commit f98d2c279e5757d3156427c834281d2ce2ab92db Author: Simon Peyton Jones Date: Tue May 6 08:20:28 2014 +0100 Second go at fixing #9061 My first attempt introduce a bug in -fprint-minimal-imports, but fortunately a regression test caught it. (cherry picked from commit 5b73dc5fda1941d51827ea72614782c10a355a3d) >--------------------------------------------------------------- f98d2c279e5757d3156427c834281d2ce2ab92db compiler/rename/RnNames.lhs | 46 +++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index bddafe0..2fb7d4f 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -1285,11 +1285,14 @@ type ImportDeclUsage warnUnusedImportDecls :: TcGblEnv -> RnM () warnUnusedImportDecls gbl_env = do { uses <- readMutVar (tcg_used_rdrnames gbl_env) - ; let imports = filterOut un_warnable_import (tcg_rn_imports gbl_env) + ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env) + -- This whole function deals only with *user* imports + -- both for warning about unnecessary ones, and for + -- deciding the minimal ones rdr_env = tcg_rdr_env gbl_env ; let usage :: [ImportDeclUsage] - usage = findImportUsage imports rdr_env (Set.elems uses) + usage = findImportUsage user_imports rdr_env (Set.elems uses) ; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr (Set.elems uses) , ptext (sLit "Import usage") <+> ppr usage]) @@ -1298,28 +1301,8 @@ warnUnusedImportDecls gbl_env ; whenGOptM Opt_D_dump_minimal_imports $ printMinimalImports usage } - where - un_warnable_import (L _ decl) -- See Note [Un-warnable import decls] - | ideclImplicit decl - = True - | Just (True, hides) <- ideclHiding decl - , not (null hides) - , pRELUDE_NAME == unLoc (ideclName decl) - = True - | otherwise - = False \end{code} -Note [Un-warnable import decls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We do not warn about the implicit import of Prelude, since the user can't remove it - -We do not warn about - import Prelude hiding( x, y ) -because even if nothing else from Prelude is used, it may be essential to hide -x,y to avoid name-shadowing warnings. Example (Trac #9061) - import Prelude hiding( log ) - f x = log where log = () Note [The ImportMap] ~~~~~~~~~~~~~~~~~~~~ @@ -1433,6 +1416,11 @@ warnUnusedImport :: ImportDeclUsage -> RnM () warnUnusedImport (L loc decl, used, unused) | Just (False,[]) <- ideclHiding decl = return () -- Do not warn for 'import M()' + + | Just (True, hides) <- ideclHiding decl + , not (null hides) + , pRELUDE_NAME == unLoc (ideclName decl) + = return () -- Note [Do not warn about Prelude hiding] | null used = addWarnAt loc msg1 -- Nothing used; drop entire decl | null unused = return () -- Everything imported is used; nop | otherwise = addWarnAt loc msg2 -- Some imports are unused @@ -1452,6 +1440,19 @@ warnUnusedImport (L loc decl, used, unused) pp_not_used = text "is redundant" \end{code} +Note [Do not warn about Prelude hiding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We do not warn about + import Prelude hiding( x, y ) +because even if nothing else from Prelude is used, it may be essential to hide +x,y to avoid name-shadowing warnings. Example (Trac #9061) + import Prelude hiding( log ) + f x = log where log = () + + + +Note [Printing minimal imports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To print the minimal imports we walk over the user-supplied import decls, and simply trim their import lists. NB that @@ -1462,6 +1463,7 @@ decls, and simply trim their import lists. NB that \begin{code} printMinimalImports :: [ImportDeclUsage] -> RnM () +-- See Note [Printing minimal imports] printMinimalImports imports_w_usage = do { imports' <- mapM mk_minimal imports_w_usage ; this_mod <- getModule From git at git.haskell.org Mon Jun 23 07:38:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 07:38:53 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix a serious, but rare, strictness analyser bug (Trac #9128) (020350b) Message-ID: <20140623073853.4D3822406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/020350be1da87eacf23e804d2290137bdfec89db/ghc >--------------------------------------------------------------- commit 020350be1da87eacf23e804d2290137bdfec89db Author: Simon Peyton Jones Date: Wed Jun 11 19:53:06 2014 +0100 Fix a serious, but rare, strictness analyser bug (Trac #9128) In a special case for trivial RHSs (see DmdAnal.unpackTrivial), I'd forgotten to include a demand for the RHS itself. See Note [Remember to demand the function itself]. Thanks to David Terei for guiding me to the bug, at PLDI in Edinburgh. (cherry picked from commit 7d9feb264a4fc3c15d1e5f88f2e7a04202ed9743) >--------------------------------------------------------------- 020350be1da87eacf23e804d2290137bdfec89db compiler/stranal/DmdAnal.lhs | 11 ++++++++++- testsuite/tests/simplCore/should_run/T9128.hs | 12 ++++++++++++ .../cgrun033.stdout => simplCore/should_run/T9128.stdout} | 0 testsuite/tests/simplCore/should_run/all.T | 2 ++ 4 files changed, 24 insertions(+), 1 deletion(-) diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 1d27a53..31996cb 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -597,7 +597,16 @@ dmdAnalRhs :: TopLevelFlag dmdAnalRhs top_lvl rec_flag env id rhs | Just fn <- unpackTrivial rhs -- See Note [Demand analysis for trivial right-hand sides] , let fn_str = getStrictness env fn - = (fn_str, emptyDmdEnv, set_idStrictness env id fn_str, rhs) + fn_fv | isLocalId fn = unitVarEnv fn topDmd + | otherwise = emptyDmdEnv + -- Note [Remember to demand the function itself] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- fn_fv: don't forget to produce a demand for fn itself + -- Lacking this caused Trac #9128 + -- The demand is very conservative (topDmd), but that doesn't + -- matter; trivial bindings are usually inlined, so it only + -- kicks in for top-level bindings and NOINLINE bindings + = (fn_str, fn_fv, set_idStrictness env id fn_str, rhs) | otherwise = (sig_ty, lazy_fv, id', mkLams bndrs' body') diff --git a/testsuite/tests/simplCore/should_run/T9128.hs b/testsuite/tests/simplCore/should_run/T9128.hs new file mode 100644 index 0000000..73aa39b --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T9128.hs @@ -0,0 +1,12 @@ +module Main where + +newtype T a = MkT a + +-- Trac #9128: we treated x as absent!!!! + +f x = let {-# NOINLINE h #-} + h = case x of MkT g -> g + in + h (h (h (h (h (h True))))) + +main = print (f (MkT id)) diff --git a/testsuite/tests/codeGen/should_run/cgrun033.stdout b/testsuite/tests/simplCore/should_run/T9128.stdout similarity index 100% copy from testsuite/tests/codeGen/should_run/cgrun033.stdout copy to testsuite/tests/simplCore/should_run/T9128.stdout diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 430d61f..ed7de1c 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -63,3 +63,5 @@ test('T7924', exit_code(1), compile_and_run, ['']) # Run this test *without* optimisation too test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, ['']) + +test('T9128', normal, compile_and_run, ['']) From git at git.haskell.org Mon Jun 23 07:38:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 07:38:55 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: In splitHsFunType, take account of prefix (->) (1662245) Message-ID: <20140623073855.E7C642406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/16622452317fe235afc2a053686f46b7d30733a2/ghc >--------------------------------------------------------------- commit 16622452317fe235afc2a053686f46b7d30733a2 Author: Simon Peyton Jones Date: Mon May 12 16:02:36 2014 +0100 In splitHsFunType, take account of prefix (->) This fixes Trac #9096 (cherry picked from commit 770e16fceee60db0c2f79e3b77f6fc619bc1d864) >--------------------------------------------------------------- 16622452317fe235afc2a053686f46b7d30733a2 compiler/hsSyn/HsTypes.lhs | 31 ++++++++++++++++++++++++------- testsuite/tests/gadt/T9096.hs | 6 ++++++ testsuite/tests/gadt/all.T | 1 + 3 files changed, 31 insertions(+), 7 deletions(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 28c6a2b..6f65a12 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -45,6 +45,7 @@ import HsLit import Name( Name ) import RdrName( RdrName ) import DataCon( HsBang(..) ) +import TysPrim( funTyConName ) import Type import HsDoc import BasicTypes @@ -506,15 +507,31 @@ splitLHsClassTy_maybe ty HsKindSig ty _ -> checkl ty args _ -> Nothing --- Splits HsType into the (init, last) parts +-- splitHsFunType decomposes a type (t1 -> t2 ... -> tn) -- Breaks up any parens in the result type: -- splitHsFunType (a -> (b -> c)) = ([a,b], c) -splitHsFunType :: LHsType name -> ([LHsType name], LHsType name) -splitHsFunType (L _ (HsFunTy x y)) = (x:args, res) - where - (args, res) = splitHsFunType y -splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty -splitHsFunType other = ([], other) +-- Also deals with (->) t1 t2; that is why it only works on LHsType Name +-- (see Trac #9096) +splitHsFunType :: LHsType Name -> ([LHsType Name], LHsType Name) +splitHsFunType (L _ (HsParTy ty)) + = splitHsFunType ty + +splitHsFunType (L _ (HsFunTy x y)) + | (args, res) <- splitHsFunType y + = (x:args, res) + +splitHsFunType orig_ty@(L _ (HsAppTy t1 t2)) + = go t1 [t2] + where -- Look for (->) t1 t2, possibly with parenthesisation + go (L _ (HsTyVar fn)) tys | fn == funTyConName + , [t1,t2] <- tys + , (args, res) <- splitHsFunType t2 + = (t1:args, res) + go (L _ (HsAppTy t1 t2)) tys = go t1 (t2:tys) + go (L _ (HsParTy ty)) tys = go ty tys + go _ _ = ([], orig_ty) -- Failure to match + +splitHsFunType other = ([], other) \end{code} diff --git a/testsuite/tests/gadt/T9096.hs b/testsuite/tests/gadt/T9096.hs new file mode 100644 index 0000000..d778798 --- /dev/null +++ b/testsuite/tests/gadt/T9096.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} + +module T9096 where + +data Foo a where + MkFoo :: (->) a (Foo a) diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 9192891..52a8812 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -122,3 +122,4 @@ test('T7321', ['$MAKE -s --no-print-directory T7321']) test('T7974', normal, compile, ['']) test('T7558', normal, compile_fail, ['']) +test('T9096', normal, compile, ['']) From git at git.haskell.org Mon Jun 23 07:39:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 07:39:35 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Fix recomputation of TypeRep in Typeable instance (#9203) (0f8dac5) Message-ID: <20140623073935.6B9892406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/0f8dac5367af6e611985b958ea1dd4d3e266588a/base >--------------------------------------------------------------- commit 0f8dac5367af6e611985b958ea1dd4d3e266588a Author: Austin Seipp Date: Mon Jun 23 02:12:09 2014 -0500 Fix recomputation of TypeRep in Typeable instance (#9203) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 0f8dac5367af6e611985b958ea1dd4d3e266588a Data/Typeable/Internal.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Data/Typeable/Internal.hs b/Data/Typeable/Internal.hs index 4b9db90..1b3ce75 100644 --- a/Data/Typeable/Internal.hs +++ b/Data/Typeable/Internal.hs @@ -252,7 +252,9 @@ type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a -- | Kind-polymorphic Typeable instance for type application instance (Typeable s, Typeable a) => Typeable (s a) where - typeRep# _ = typeRep# (proxy# :: Proxy# s) `mkAppTy` typeRep# (proxy# :: Proxy# a) + typeRep# = \_ -> rep + where rep = typeRep# (proxy# :: Proxy# s) + `mkAppTy` typeRep# (proxy# :: Proxy# a) ----------------- Showing TypeReps -------------------- From git at git.haskell.org Mon Jun 23 08:19:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 08:19:51 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Make the unifier a fixpoint even for the free kind vars of a tyvar (1aeea20) Message-ID: <20140623081951.3C38A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/1aeea208f042cf7e4e87ac5444398ac689cac99d/ghc >--------------------------------------------------------------- commit 1aeea208f042cf7e4e87ac5444398ac689cac99d Author: Simon Peyton Jones Date: Fri May 23 07:47:17 2014 +0100 Make the unifier a fixpoint even for the free kind vars of a tyvar The (pure) unifier tcUnifyTys returns an idempotent substitution. But previously the kinds of type variables free in the range of the subst could have un-substituted kind variables. This patch fixes that, fixing Trac #9106. See Note [Finding the substitution fixpoint] in Unify (cherry picked from commit d8d97113c24e7216be36c9cdfc58e91f26528f06) >--------------------------------------------------------------- 1aeea208f042cf7e4e87ac5444398ac689cac99d compiler/types/Unify.lhs | 46 ++++++++++++++++++++++++++++------ testsuite/tests/polykinds/T9106.hs | 14 +++++++++++ testsuite/tests/polykinds/T9106.stderr | 8 ++++++ testsuite/tests/polykinds/all.T | 1 + 4 files changed, 62 insertions(+), 7 deletions(-) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index d56a3f6..f2b45e8 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -23,7 +23,6 @@ module Unify ( -- Side-effect free unification tcUnifyTy, tcUnifyTys, BindFlag(..), - niFixTvSubst, niSubstTvSet, UnifyResultM(..), UnifyResult, tcUnifyTysFG @@ -470,19 +469,52 @@ During unification we use a TvSubstEnv that is (a) non-idempotent (b) loop-free; ie repeatedly applying it yields a fixed point +Note [Finding the substitution fixpoint] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Finding the fixpoint of a non-idempotent substitution arising from a +unification is harder than it looks, because of kinds. Consider + T k (H k (f:k)) ~ T * (g:*) +If we unify, we get the substitution + [ k -> * + , g -> H k (f:k) ] +To make it idempotent we don't want to get just + [ k -> * + , g -> H * (f:k) ] +We also want to substitute inside f's kind, to get + [ k -> * + , g -> H k (f:*) ] +If we don't do this, we may apply the substitition to something, +and get an ill-formed type, i.e. one where typeKind will fail. +This happened, for example, in Trac #9106. + +This is the reason for extending env with [f:k -> f:*], in the +definition of env' in niFixTvSubst + \begin{code} niFixTvSubst :: TvSubstEnv -> TvSubst -- Find the idempotent fixed point of the non-idempotent substitution +-- See Note [Finding the substitution fixpoint] -- ToDo: use laziness instead of iteration? niFixTvSubst env = f env where - f e | not_fixpoint = f (mapVarEnv (substTy subst) e) - | otherwise = subst + f env | not_fixpoint = f (mapVarEnv (substTy subst') env) + | otherwise = subst where - range_tvs = foldVarEnv (unionVarSet . tyVarsOfType) emptyVarSet e - subst = mkTvSubst (mkInScopeSet range_tvs) e - not_fixpoint = foldVarSet ((||) . in_domain) False range_tvs - in_domain tv = tv `elemVarEnv` e + not_fixpoint = foldVarSet ((||) . in_domain) False all_range_tvs + in_domain tv = tv `elemVarEnv` env + + range_tvs = foldVarEnv (unionVarSet . tyVarsOfType) emptyVarSet env + all_range_tvs = closeOverKinds range_tvs + subst = mkTvSubst (mkInScopeSet all_range_tvs) env + + -- env' extends env by replacing any free type with + -- that same tyvar with a substituted kind + -- See note [Finding the substitution fixpoint] + env' = extendVarEnvList env [ (rtv, mkTyVarTy $ setTyVarKind rtv $ + substTy subst $ tyVarKind rtv) + | rtv <- varSetElems range_tvs + , not (in_domain rtv) ] + subst' = mkTvSubst (mkInScopeSet all_range_tvs) env' niSubstTvSet :: TvSubstEnv -> TyVarSet -> TyVarSet -- Apply the non-idempotent substitution to a set of type variables, diff --git a/testsuite/tests/polykinds/T9106.hs b/testsuite/tests/polykinds/T9106.hs new file mode 100644 index 0000000..eaf0364 --- /dev/null +++ b/testsuite/tests/polykinds/T9106.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE MultiParamTypeClasses, DataKinds, FunctionalDependencies, + KindSignatures, PolyKinds, FlexibleInstances, FlexibleContexts, + UndecidableInstances #-} + +module T9106 where + +import GHC.TypeLits + +class FunctorN (n :: Nat) f (a :: *) (fa :: *) | n f a -> fa where + +instance FunctorN 0 f a a where + +instance FunctorN n f a (f fa) + diff --git a/testsuite/tests/polykinds/T9106.stderr b/testsuite/tests/polykinds/T9106.stderr new file mode 100644 index 0000000..0b239f2 --- /dev/null +++ b/testsuite/tests/polykinds/T9106.stderr @@ -0,0 +1,8 @@ + +T9106.hs:13:10: + Illegal instance declaration for ?FunctorN n f a (f fa)? + The liberal coverage condition fails in class ?FunctorN? + for functional dependency: ?n f a -> fa? + Reason: lhs types ?n?, ?f?, ?a? + do not jointly determine rhs type ?f fa? + In the instance declaration for ?FunctorN n f a (f fa)? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 3634d83..96faa67 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -100,3 +100,4 @@ test('T8566a', expect_broken(8566), compile,['']) test('T7481', normal, compile_fail,['']) test('T8705', normal, compile, ['']) test('T8985', normal, compile, ['']) +test('T9106', normal, compile_fail, ['']) From git at git.haskell.org Mon Jun 23 09:03:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 09:03:13 +0000 (UTC) Subject: [commit: ghc] master: arclint: disable Bad Charset lint rule (446b0e1) Message-ID: <20140623090313.DF1D62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/446b0e166c9e46f943318f13f25f0441c88c67ef/ghc >--------------------------------------------------------------- commit 446b0e166c9e46f943318f13f25f0441c88c67ef Author: Austin Seipp Date: Mon Jun 23 04:02:44 2014 -0500 arclint: disable Bad Charset lint rule Signed-off-by: Austin Seipp >--------------------------------------------------------------- 446b0e166c9e46f943318f13f25f0441c88c67ef .arclint | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.arclint b/.arclint index db6299d..caa72ab 100644 --- a/.arclint +++ b/.arclint @@ -13,7 +13,10 @@ "type": "nolint" }, "text": { - "type": "text" + "type": "text", + "severity": { + "5": "disabled" + } } } } From git at git.haskell.org Mon Jun 23 09:07:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 09:07:33 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. (e40bd13) Message-ID: <20140623090733.3997A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/e40bd13b5b509b76d61ae66247ded145d4af93ea/ghc >--------------------------------------------------------------- commit e40bd13b5b509b76d61ae66247ded145d4af93ea Author: Dr. ERDI Gergo Date: Tue May 27 21:16:41 2014 +0800 Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. Also updates haddock submodule to accomodate tweaks in PatSyn representation Conflicts: compiler/typecheck/TcPatSyn.lhs utils/haddock (cherry picked from commit e0fbf1e3bc062b7ce3f1c515a135fd9f3d49e2ee) >--------------------------------------------------------------- e40bd13b5b509b76d61ae66247ded145d4af93ea compiler/basicTypes/PatSyn.lhs | 103 +++++++++++++++++++++++++++++----------- compiler/coreSyn/CorePrep.lhs | 1 + compiler/iface/BuildTyCl.lhs | 81 ++++++++----------------------- compiler/iface/IfaceSyn.lhs | 28 ++++++----- compiler/iface/LoadIface.lhs | 3 +- compiler/iface/MkIface.lhs | 13 ++--- compiler/iface/TcIface.lhs | 35 +++++--------- compiler/main/HscTypes.lhs | 20 ++++---- compiler/main/TidyPgm.lhs | 2 +- compiler/typecheck/TcPat.lhs | 4 +- compiler/typecheck/TcPatSyn.lhs | 34 +++++++------ 11 files changed, 169 insertions(+), 155 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e40bd13b5b509b76d61ae66247ded145d4af93ea From git at git.haskell.org Mon Jun 23 09:07:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 09:07:35 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) (d1c2a27) Message-ID: <20140623090735.AF02F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/d1c2a2784ffc120bdd8f1fccc9cc61933c0cc5d0/ghc >--------------------------------------------------------------- commit d1c2a2784ffc120bdd8f1fccc9cc61933c0cc5d0 Author: Simon Peyton Jones Date: Thu Jun 5 11:03:45 2014 +0100 Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) We simply weren't giving anything like the right instantiating types to patSynInstArgTys in matchOneConLike. To get these instantiating types would have involved matching the result type of the pattern synonym with the pattern type, which is tiresome. So instead I changed ConPatOut so that instead of recording the type of the *whole* pattern (in old field pat_ty), it not records the *instantiating* types (in new field pat_arg_tys). Then we canuse TcHsSyn.conLikeResTy to get the pattern type when needed. There are lots of knock-on incidental effects, but they mostly made the code simpler, so I'm happy. Conflicts: compiler/typecheck/TcPat.lhs (cherry picked from commit 1fc4f6b973a4fb14b2b15143b2774ec597b4da0f) >--------------------------------------------------------------- d1c2a2784ffc120bdd8f1fccc9cc61933c0cc5d0 compiler/basicTypes/PatSyn.lhs | 25 +++++++++++++++++++++++-- compiler/deSugar/Check.lhs | 32 +++++++++++++++----------------- compiler/deSugar/DsExpr.lhs | 2 +- compiler/deSugar/DsUtils.lhs | 3 +-- compiler/deSugar/Match.lhs | 11 +++++------ compiler/deSugar/MatchCon.lhs | 33 +++++++++++++++------------------ compiler/deSugar/MatchLit.lhs | 6 +++--- compiler/hsSyn/Convert.lhs | 4 ++-- compiler/hsSyn/HsPat.lhs | 31 ++++++++++++++++++++----------- compiler/hsSyn/HsUtils.lhs | 2 +- compiler/parser/RdrHsSyn.lhs | 2 +- compiler/rename/RnPat.lhs | 2 +- compiler/typecheck/TcHsSyn.lhs | 24 ++++++++++++++++-------- compiler/typecheck/TcPat.lhs | 19 ++++++++++--------- 14 files changed, 114 insertions(+), 82 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d1c2a2784ffc120bdd8f1fccc9cc61933c0cc5d0 From git at git.haskell.org Mon Jun 23 09:07:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 09:07:38 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Test Trac #9023 (f6e4942) Message-ID: <20140623090738.3374C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f6e494231b2ad00fa073fc6623a876ffe40e900e/ghc >--------------------------------------------------------------- commit f6e494231b2ad00fa073fc6623a876ffe40e900e Author: Simon Peyton Jones Date: Thu Jun 5 12:26:24 2014 +0100 Test Trac #9023 (cherry picked from commit 1b45c6b4959762209dbcabf3290feb8673a60b23) >--------------------------------------------------------------- f6e494231b2ad00fa073fc6623a876ffe40e900e testsuite/tests/patsyn/should_compile/T9023.hs | 6 ++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 2 files changed, 7 insertions(+) diff --git a/testsuite/tests/patsyn/should_compile/T9023.hs b/testsuite/tests/patsyn/should_compile/T9023.hs new file mode 100644 index 0000000..3a86140 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T9023.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T9023 where + +pattern P a b = Just (a, b) +foo P{} = True diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index ecc4701..d851bc3 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -9,3 +9,4 @@ test('num', normal, compile, ['']) test('incomplete', normal, compile, ['']) test('export', normal, compile, ['']) test('T8966', normal, compile, ['']) +test('T9023', normal, compile, ['']) From git at git.haskell.org Mon Jun 23 09:26:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 09:26:22 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Revert "Test Trac #9023" (e86e5cd) Message-ID: <20140623092622.ECF692406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/e86e5cd941c016a9fb8de379fc760b58ec79e93b/ghc >--------------------------------------------------------------- commit e86e5cd941c016a9fb8de379fc760b58ec79e93b Author: Austin Seipp Date: Mon Jun 23 04:25:46 2014 -0500 Revert "Test Trac #9023" This reverts commit f6e494231b2ad00fa073fc6623a876ffe40e900e. Signed-off-by: Austin Seipp >--------------------------------------------------------------- e86e5cd941c016a9fb8de379fc760b58ec79e93b testsuite/tests/patsyn/should_compile/T9023.hs | 6 ------ testsuite/tests/patsyn/should_compile/all.T | 1 - 2 files changed, 7 deletions(-) diff --git a/testsuite/tests/patsyn/should_compile/T9023.hs b/testsuite/tests/patsyn/should_compile/T9023.hs deleted file mode 100644 index 3a86140..0000000 --- a/testsuite/tests/patsyn/should_compile/T9023.hs +++ /dev/null @@ -1,6 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} - -module T9023 where - -pattern P a b = Just (a, b) -foo P{} = True diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index d851bc3..ecc4701 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -9,4 +9,3 @@ test('num', normal, compile, ['']) test('incomplete', normal, compile, ['']) test('export', normal, compile, ['']) test('T8966', normal, compile, ['']) -test('T9023', normal, compile, ['']) From git at git.haskell.org Mon Jun 23 09:26:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 09:26:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Revert "Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023)" (5eb0e9f) Message-ID: <20140623092625.703092406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/5eb0e9fcad134d5199f2c171b98a74ab09021466/ghc >--------------------------------------------------------------- commit 5eb0e9fcad134d5199f2c171b98a74ab09021466 Author: Austin Seipp Date: Mon Jun 23 04:25:55 2014 -0500 Revert "Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023)" This reverts commit d1c2a2784ffc120bdd8f1fccc9cc61933c0cc5d0. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5eb0e9fcad134d5199f2c171b98a74ab09021466 compiler/basicTypes/PatSyn.lhs | 25 ++----------------------- compiler/deSugar/Check.lhs | 32 +++++++++++++++++--------------- compiler/deSugar/DsExpr.lhs | 2 +- compiler/deSugar/DsUtils.lhs | 3 ++- compiler/deSugar/Match.lhs | 11 ++++++----- compiler/deSugar/MatchCon.lhs | 33 ++++++++++++++++++--------------- compiler/deSugar/MatchLit.lhs | 6 +++--- compiler/hsSyn/Convert.lhs | 4 ++-- compiler/hsSyn/HsPat.lhs | 31 +++++++++++-------------------- compiler/hsSyn/HsUtils.lhs | 2 +- compiler/parser/RdrHsSyn.lhs | 2 +- compiler/rename/RnPat.lhs | 2 +- compiler/typecheck/TcHsSyn.lhs | 24 ++++++++---------------- compiler/typecheck/TcPat.lhs | 19 +++++++++---------- 14 files changed, 82 insertions(+), 114 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5eb0e9fcad134d5199f2c171b98a74ab09021466 From git at git.haskell.org Mon Jun 23 09:26:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 09:26:27 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Revert "Store IfExtNames for PatSyn matchers and wrappers in interface file." (9de7cef) Message-ID: <20140623092628.298472406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/9de7cefec507d0d682eab2bf69c4d4547602541d/ghc >--------------------------------------------------------------- commit 9de7cefec507d0d682eab2bf69c4d4547602541d Author: Austin Seipp Date: Mon Jun 23 04:26:01 2014 -0500 Revert "Store IfExtNames for PatSyn matchers and wrappers in interface file." This reverts commit e40bd13b5b509b76d61ae66247ded145d4af93ea. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9de7cefec507d0d682eab2bf69c4d4547602541d compiler/basicTypes/PatSyn.lhs | 103 +++++++++++----------------------------- compiler/coreSyn/CorePrep.lhs | 1 - compiler/iface/BuildTyCl.lhs | 81 +++++++++++++++++++++++-------- compiler/iface/IfaceSyn.lhs | 28 +++++------ compiler/iface/LoadIface.lhs | 3 +- compiler/iface/MkIface.lhs | 13 +++-- compiler/iface/TcIface.lhs | 35 +++++++++----- compiler/main/HscTypes.lhs | 20 ++++---- compiler/main/TidyPgm.lhs | 2 +- compiler/typecheck/TcPat.lhs | 4 +- compiler/typecheck/TcPatSyn.lhs | 34 ++++++------- 11 files changed, 155 insertions(+), 169 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9de7cefec507d0d682eab2bf69c4d4547602541d From git at git.haskell.org Mon Jun 23 13:14:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 13:14:59 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds (7ef8dd5) Message-ID: <20140623131459.A38A02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/7ef8dd532674cc046c4df80c4768756be736172f/ghc >--------------------------------------------------------------- commit 7ef8dd532674cc046c4df80c4768756be736172f Author: Simon Peyton Jones Date: Fri Jun 6 11:39:41 2014 +0100 Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds This was a serious bug, exposed by Trac #9175. The matcher and wrapper must be LocalIds, like record selectors and dictionary functions, for the reasons now documented in Note [Exported LocalIds] in Id.lhs In fixing this I found - PatSyn should have an Id inside it (apart from the wrapper and matcher) It should be a Name. Hence psId --> psName, with knock-on consequences - Tidying of PatSyns in TidyPgm was wrong - The keep-alive set in Desugar.deSugar (now) doesn't need pattern synonyms in it I also cleaned up the interface to PatSyn a little, so there's a tiny knock-on effect in Haddock; hence the haddock submodule update. It's very hard to make a test for this bug, so I haven't. Conflicts: compiler/typecheck/TcRnTypes.lhs utils/haddock >--------------------------------------------------------------- 7ef8dd532674cc046c4df80c4768756be736172f compiler/basicTypes/Id.lhs | 39 +++++++++++++- compiler/basicTypes/MkId.lhs | 31 +++-------- compiler/basicTypes/PatSyn.lhs | 77 +++++++++++++++++----------- compiler/deSugar/Desugar.lhs | 21 +++----- compiler/deSugar/MatchCon.lhs | 2 +- compiler/hsSyn/Convert.lhs | 2 +- compiler/iface/MkIface.lhs | 4 +- compiler/main/HscTypes.lhs | 20 ++------ compiler/main/TidyPgm.lhs | 52 +++++++++++-------- compiler/typecheck/TcEnv.lhs | 3 +- compiler/typecheck/TcPat.lhs | 4 +- compiler/typecheck/TcPatSyn.lhs | 5 +- compiler/typecheck/TcRnDriver.lhs | 5 +- compiler/typecheck/TcRnTypes.lhs | 4 +- compiler/typecheck/TcSplice.lhs | 4 +- compiler/typecheck/TcTyClsDecls.lhs | 7 ++- compiler/vectorise/Vectorise/Monad/Naming.hs | 5 +- 17 files changed, 153 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 7ef8dd532674cc046c4df80c4768756be736172f From git at git.haskell.org Mon Jun 23 13:15:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 13:15:01 +0000 (UTC) Subject: [commit: ghc] wip/T9023's head updated: Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds (7ef8dd5) Message-ID: <20140623131502.290552406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9023' now includes: 52222f9 Fix #9047 fd4169f Fix up b84748121e777d a35a031 Fix over-zealous unused-import warning f98d2c2 Second go at fixing #9061 020350b Fix a serious, but rare, strictness analyser bug (Trac #9128) 1662245 In splitHsFunType, take account of prefix (->) 1aeea20 Make the unifier a fixpoint even for the free kind vars of a tyvar e40bd13 Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. d1c2a27 Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) f6e4942 Test Trac #9023 7ef8dd5 Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds From git at git.haskell.org Mon Jun 23 15:51:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 15:51:49 +0000 (UTC) Subject: [commit: ghc] master: Mark T9208 as broken when debugging is on (518ada5) Message-ID: <20140623155149.E7D1A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/518ada5cda08d3256826ed0383888111f8096de5/ghc >--------------------------------------------------------------- commit 518ada5cda08d3256826ed0383888111f8096de5 Author: Joachim Breitner Date: Mon Jun 23 08:50:47 2014 -0700 Mark T9208 as broken when debugging is on this seems to be expected, as explained by SPJ in comment 7 of #9208. >--------------------------------------------------------------- 518ada5cda08d3256826ed0383888111f8096de5 testsuite/tests/stranal/should_compile/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index b88c49f..3a9a35d 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -19,4 +19,4 @@ test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) -test('T9208', normal, compile, ['']) +test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, ['']) From git at git.haskell.org Mon Jun 23 16:27:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jun 2014 16:27:19 +0000 (UTC) Subject: [commit: ghc] master: More updates to Backpack impl docs. (7a78374) Message-ID: <20140623162719.E350A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a783746972561565eacea634512c3888ded6ec2/ghc >--------------------------------------------------------------- commit 7a783746972561565eacea634512c3888ded6ec2 Author: Edward Z. Yang Date: Mon Jun 23 17:26:10 2014 +0100 More updates to Backpack impl docs. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 7a783746972561565eacea634512c3888ded6ec2 docs/backpack/backpack-impl.tex | 163 +++++++++++++++++++++++++++++++++++----- docs/backpack/pkgdb.png | Bin 96706 -> 61693 bytes 2 files changed, 146 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 7a783746972561565eacea634512c3888ded6ec2 From git at git.haskell.org Tue Jun 24 10:27:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jun 2014 10:27:50 +0000 (UTC) Subject: [commit: ghc] master: Fix regression in Data.Fixed Read instance (re #9231) (c1035d5) Message-ID: <20140624102750.EABC92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1035d51edaac2f388a0630e2ad25391e7e3c1ab/ghc >--------------------------------------------------------------- commit c1035d51edaac2f388a0630e2ad25391e7e3c1ab Author: Herbert Valerio Riedel Date: Tue Jun 24 11:42:06 2014 +0200 Fix regression in Data.Fixed Read instance (re #9231) `convertFixed` operates under the wrong assumption that `Data.Fixed.resolution` returns a base-10 exponent `e`, whereas it actually returns the power-of-10 value `10^e`. So while the code (that was introduced in 5f19f951d8 / #7483) happens to compute a correct result by coincidence, it allocates huge integer values in the process (i.e. `10^(10^e)`) which cause long computations which eventually result in out-of-memory conditions for `e`-values beyond `Data.Fixed.Milli`. A proper long-term fix would probably be to extend the `HasResolution` type-class to have a 2nd method providing the `e` value. Signed-off-by: Herbert Valerio Riedel Differential Revision: https://phabricator.haskell.org/D25 >--------------------------------------------------------------- c1035d51edaac2f388a0630e2ad25391e7e3c1ab libraries/base/Data/Fixed.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs index b946d5e..b3af208 100644 --- a/libraries/base/Data/Fixed.hs +++ b/libraries/base/Data/Fixed.hs @@ -158,9 +158,10 @@ instance (HasResolution a) => Read (Fixed a) where convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a) convertFixed (Number n) - | Just (i, f) <- numberToFixed r n = - return (fromInteger i + (fromInteger f / (10 ^ r))) - where r = resolution (undefined :: Fixed a) + | Just (i, f) <- numberToFixed e n = + return (fromInteger i + (fromInteger f / fromInteger r)) + where r = resolution (undefined :: Fixed a) -- = 10^e + e = round (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail data E0 = E0 From git at git.haskell.org Tue Jun 24 12:25:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jun 2014 12:25:00 +0000 (UTC) Subject: [commit: ghc] master: Minor refactoring of interface to extraTyVarInfo (761c4b1) Message-ID: <20140624122500.3EE052406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/761c4b15ec93d5494d0990f9a7ac58dc5da44b3c/ghc >--------------------------------------------------------------- commit 761c4b15ec93d5494d0990f9a7ac58dc5da44b3c Author: Simon Peyton Jones Date: Mon Jun 23 17:16:48 2014 +0100 Minor refactoring of interface to extraTyVarInfo >--------------------------------------------------------------- 761c4b15ec93d5494d0990f9a7ac58dc5da44b3c compiler/typecheck/TcErrors.lhs | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 6992fa9..8fe9751 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -668,10 +668,11 @@ mkTyVarEqErr :: DynFlags -> ReportErrCtxt -> SDoc -> Ct -- tv1 and ty2 are already tidied mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2 | isUserSkolem ctxt tv1 -- ty2 won't be a meta-tyvar, or else the thing would - -- be oriented the other way round; see TcCanonical.reOrient + -- be oriented the other way round; + -- see TcCanonical.canEqTyVarTyVar || isSigTyVar tv1 && not (isTyVarTy ty2) = mkErrorMsg ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2 - , extraTyVarInfo ctxt ty1 ty2 + , extraTyVarInfo ctxt tv1 ty2 , extra ]) -- So tv is a meta tyvar (or started that way before we @@ -701,7 +702,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2 , Implic { ic_skols = skols } <- implic , tv1 `elem` skols = mkErrorMsg ctxt ct (vcat [ misMatchMsg oriented ty1 ty2 - , extraTyVarInfo ctxt ty1 ty2 + , extraTyVarInfo ctxt tv1 ty2 , extra ]) -- Check for skolem escape @@ -734,7 +735,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2 , nest 2 $ ptext (sLit "inside the constraints") <+> pprEvVarTheta given , nest 2 $ ptext (sLit "bound by") <+> ppr skol_info , nest 2 $ ptext (sLit "at") <+> ppr (tcl_loc env) ] - tv_extra = extraTyVarInfo ctxt ty1 ty2 + tv_extra = extraTyVarInfo ctxt tv1 ty2 add_sig = suggestAddSig ctxt ty1 ty2 ; mkErrorMsg ctxt ct (vcat [msg, untch_extra, tv_extra, add_sig, extra]) } @@ -815,15 +816,18 @@ pp_givens givens 2 (sep [ ptext (sLit "bound by") <+> ppr skol_info , ptext (sLit "at") <+> ppr loc]) -extraTyVarInfo :: ReportErrCtxt -> TcType -> TcType -> SDoc +extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc -- Add on extra info about skolem constants -- NB: The types themselves are already tidied -extraTyVarInfo ctxt ty1 ty2 - = nest 2 (tv_extra ty1 $$ tv_extra ty2) +extraTyVarInfo ctxt tv1 ty2 + = nest 2 (tv_extra tv1 $$ ty_extra ty2) where implics = cec_encl ctxt - tv_extra ty | Just tv <- tcGetTyVar_maybe ty - , isTcTyVar tv, isSkolemTyVar tv + ty_extra ty = case tcGetTyVar_maybe ty of + Just tv -> tv_extra tv + Nothing -> empty + + tv_extra tv | isTcTyVar tv, isSkolemTyVar tv , let pp_tv = quotes (ppr tv) = case tcTyVarDetails tv of SkolemTv {} -> pp_tv <+> pprSkol (getSkolemInfo implics tv) (getSrcLoc tv) From git at git.haskell.org Tue Jun 24 12:25:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jun 2014 12:25:02 +0000 (UTC) Subject: [commit: ghc] master: Add Note [Placeholder PatSyn kinds] in TcBinds (0757831) Message-ID: <20140624122504.37CD92406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0757831eaca96c8ebfd99fc51427560d3568cffa/ghc >--------------------------------------------------------------- commit 0757831eaca96c8ebfd99fc51427560d3568cffa Author: Simon Peyton Jones Date: Tue Jun 24 13:24:36 2014 +0100 Add Note [Placeholder PatSyn kinds] in TcBinds This is just documentation for the fix to Trac #9161 >--------------------------------------------------------------- 0757831eaca96c8ebfd99fc51427560d3568cffa compiler/typecheck/TcBinds.lhs | 44 +++++++++++++++++++++++++++++++----------- compiler/typecheck/TcEnv.lhs | 3 +++ 2 files changed, 36 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 273ef82..887e41c 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -274,6 +274,30 @@ time by defaulting. No no no. However [Oct 10] this is all handled automatically by the untouchable-range idea. +Note [Placeholder PatSyn kinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (Trac #9161) + + {-# LANGUAGE PatternSynonyms, DataKinds #-} + pattern A = () + b :: A + b = undefined + +Here, the type signature for b mentions A. But A is a pattern +synonym, which is typechecked (for very good reasons; a view pattern +in the RHS may mention a value binding) as part of a group of +bindings. It is entirely resonable to reject this, but to do so +we need A to be in the kind environment when kind-checking the signature for B. + +Hence the tcExtendKindEnv2 patsyn_placeholder_kinds, which adds a binding + A -> AGlobal (AConLike (PatSynCon _|_)) +to the environment. Then TcHsType.tcTyVar will find A in the kind environment, +and will give a 'wrongThingErr' as a result. But the lookup of A won't fail. + +The _|_ (= panic "fakePatSynCon") works because the wrongThingErr call, in +tcTyVar, doesn't look inside the TcTyThing. + + \begin{code} tcValBinds :: TopLevelFlag -> [(RecFlag, LHsBinds Name)] -> [LSig Name] @@ -281,12 +305,9 @@ tcValBinds :: TopLevelFlag -> TcM ([(RecFlag, LHsBinds TcId)], thing) tcValBinds top_lvl binds sigs thing_inside - = do { -- Add fake entries for pattern synonyms so that - -- precise error messages can be generated when - -- trying to use a pattern synonym as a kind - traceTc "Fake lifted patsyns:" (vcat (map ppr patsyns)) - -- Typecheck the signature - ; (poly_ids, sig_fn) <- tcExtendKindEnv2 [(patsyn, fakePatSynCon) | patsyn <- patsyns] $ + = do { -- Typecheck the signature + ; (poly_ids, sig_fn) <- tcExtendKindEnv2 patsyn_placeholder_kinds $ + -- See Note [Placeholder PatSyn kinds] tcTySigs sigs ; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds) @@ -298,11 +319,12 @@ tcValBinds top_lvl binds sigs thing_inside tcBindGroups top_lvl sig_fn prag_fn binds thing_inside } where - patsyns = [ name - | (_, lbinds) <- binds - , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds - ] - fakePatSynCon = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" + patsyn_placeholder_kinds -- See Note [Placeholder PatSyn kinds] + = [ (name, placeholder_patsyn_tything) + | (_, lbinds) <- binds + , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds ] + placeholder_patsyn_tything + = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" ------------------------ tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 28cd7a6..be2058f 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -874,6 +874,9 @@ notFound name } wrongThingErr :: String -> TcTyThing -> Name -> TcM a +-- It's important that this only calls pprTcTyThingCategory, which in +-- turn does not look at the details of the TcTyThing. +-- See Note [Placeholder PatSyn kinds] in TcBinds wrongThingErr expected thing name = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> ptext (sLit "used as a") <+> text expected) From git at git.haskell.org Tue Jun 24 12:25:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jun 2014 12:25:04 +0000 (UTC) Subject: [commit: ghc] master: Comment the expect_broken for Trac #9208 (8a0aa19) Message-ID: <20140624122505.148842406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a0aa198f78cac1ca8d0695bd711778e8ad086aa/ghc >--------------------------------------------------------------- commit 8a0aa198f78cac1ca8d0695bd711778e8ad086aa Author: Simon Peyton Jones Date: Mon Jun 23 17:37:56 2014 +0100 Comment the expect_broken for Trac #9208 >--------------------------------------------------------------- 8a0aa198f78cac1ca8d0695bd711778e8ad086aa testsuite/tests/stranal/should_compile/all.T | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 3a9a35d..184ff1e 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -19,4 +19,7 @@ test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) + test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, ['']) +# T9208 fails (and should do so) if you have assertion checking on in the compiler +# Hence the above expect_broken. See comments in the Trac ticket \ No newline at end of file From git at git.haskell.org Tue Jun 24 16:30:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jun 2014 16:30:08 +0000 (UTC) Subject: [commit: ghc] master: Describe signature mini-backpack. (a4a79b5) Message-ID: <20140624163008.D9FEE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4a79b5a04658ac542b1e07a6975b488fd589441/ghc >--------------------------------------------------------------- commit a4a79b5a04658ac542b1e07a6975b488fd589441 Author: Edward Z. Yang Date: Tue Jun 24 17:29:49 2014 +0100 Describe signature mini-backpack. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a4a79b5a04658ac542b1e07a6975b488fd589441 docs/backpack/backpack-impl.tex | 124 +++++++++++++++++++++++++++++++--------- 1 file changed, 96 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a4a79b5a04658ac542b1e07a6975b488fd589441 From git at git.haskell.org Tue Jun 24 17:47:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jun 2014 17:47:09 +0000 (UTC) Subject: [commit: ghc] master: Add more primops for atomic ops on byte arrays (d8abf85) Message-ID: <20140624174709.497982406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d8abf85f8ca176854e9d5d0b12371c4bc402aac3/ghc >--------------------------------------------------------------- commit d8abf85f8ca176854e9d5d0b12371c4bc402aac3 Author: Johan Tibell Date: Mon Jun 9 11:43:21 2014 +0200 Add more primops for atomic ops on byte arrays Summary: Add more primops for atomic ops on byte arrays Adds the following primops: * atomicReadIntArray# * atomicWriteIntArray# * fetchSubIntArray# * fetchOrIntArray# * fetchXorIntArray# * fetchAndIntArray# Makes these pre-existing out-of-line primops inline: * fetchAddIntArray# * casIntArray# >--------------------------------------------------------------- d8abf85f8ca176854e9d5d0b12371c4bc402aac3 compiler/cmm/CmmMachOp.hs | 19 ++ compiler/cmm/CmmSink.hs | 4 + compiler/cmm/PprC.hs | 4 + compiler/codeGen/StgCmmPrim.hs | 94 +++++++ compiler/llvmGen/Llvm/AbsSyn.hs | 7 + compiler/llvmGen/Llvm/PpLlvm.hs | 18 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 71 ++++-- compiler/nativeGen/CPrim.hs | 50 +++- compiler/nativeGen/PPC/CodeGen.hs | 4 + compiler/nativeGen/SPARC/CodeGen.hs | 4 + compiler/nativeGen/X86/CodeGen.hs | 92 +++++++ compiler/nativeGen/X86/Instr.hs | 38 ++- compiler/nativeGen/X86/Ppr.hs | 8 + compiler/prelude/primops.txt.pp | 76 +++++- includes/stg/MiscClosures.h | 1 - libraries/ghc-prim/cbits/atomic.c | 280 +++++++++++++++++++++ libraries/ghc-prim/ghc-prim.cabal | 1 + rts/Linker.c | 1 - rts/PrimOps.cmm | 12 - testsuite/tests/concurrent/should_run/.gitignore | 1 + .../tests/concurrent/should_run/AtomicPrimops.hs | 245 ++++++++++++++++++ .../concurrent/should_run/AtomicPrimops.stdout | 7 + testsuite/tests/concurrent/should_run/all.T | 1 + 23 files changed, 984 insertions(+), 54 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d8abf85f8ca176854e9d5d0b12371c4bc402aac3 From git at git.haskell.org Tue Jun 24 21:31:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jun 2014 21:31:14 +0000 (UTC) Subject: [commit: ghc] master: Fixup c1035d51e to behave more like in GHC 7.6 (ec550e8) Message-ID: <20140624213114.3B2C92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ec550e8f951e50fb91c89389e2e77a3358079c3a/ghc >--------------------------------------------------------------- commit ec550e8f951e50fb91c89389e2e77a3358079c3a Author: Herbert Valerio Riedel Date: Tue Jun 24 22:58:41 2014 +0200 Fixup c1035d51e to behave more like in GHC 7.6 The fix in c1035d51e (addressing #9231) was done under the assumption that `Data.Fixed` is used only with power-of-10 `resolution`. This follow-up fixup changes the behavior to be more consistent with the previous behavior in GHC 7.6 For instance, for the following `B7` resolution > data B7 > instance HasResolution B7 where resolution _ = 128 After this patch, the following behavior is now observable: > 1.070 :: Fixed B7 1.062 > 1.062 :: Fixed B7 1.054 > read "1.070" :: Fixed B7 1.062 > read "1.062" :: Fixed B7 1.054 This doesn't provide the desirable "read . show == id" property yet (which didn't hold in GHC 7.6 either), but at least `fromRational` and `read` are consistent. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- ec550e8f951e50fb91c89389e2e77a3358079c3a libraries/base/Data/Fixed.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs index b3af208..cadbb61 100644 --- a/libraries/base/Data/Fixed.hs +++ b/libraries/base/Data/Fixed.hs @@ -159,9 +159,12 @@ instance (HasResolution a) => Read (Fixed a) where convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a) convertFixed (Number n) | Just (i, f) <- numberToFixed e n = - return (fromInteger i + (fromInteger f / fromInteger r)) - where r = resolution (undefined :: Fixed a) -- = 10^e - e = round (logBase 10 (fromInteger r) :: Double) + return (fromInteger i + (fromInteger f / (10 ^ e))) + where r = resolution (undefined :: Fixed a) + -- round 'e' up to help make the 'read . show == id' property + -- possible also for cases where 'resolution' is not a + -- power-of-10, such as e.g. when 'resolution = 128' + e = ceiling (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail data E0 = E0 From git at git.haskell.org Wed Jun 25 08:32:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jun 2014 08:32:03 +0000 (UTC) Subject: [commit: ghc] master: Convert loose sub-repos into proper submodules (re #8545) (db19c66) Message-ID: <20140625083203.E6D0B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db19c665ec5055c2193b2174519866045aeff09a/ghc >--------------------------------------------------------------- commit db19c665ec5055c2193b2174519866045aeff09a Author: Herbert Valerio Riedel Date: Sat Mar 22 15:26:34 2014 +0100 Convert loose sub-repos into proper submodules (re #8545) Specifically, the following sub-repos/modules are converted: - libffi-tarballs - libraries/array - libraries/deepseq - libraries/directory - libraries/dph - libraries/filepath - libraries/haskell2010 - libraries/haskell98 - libraries/hoopl - libraries/hpc - libraries/old-locale - libraries/old-time - libraries/parallel - libraries/process - libraries/stm - libraries/unix - nofib - utils/hsc2hs N.B. ghc-tarballs is not converted as it will probably be handled differently in the future. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- db19c665ec5055c2193b2174519866045aeff09a .gitignore | 21 -------------------- .gitmodules | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++ libffi-tarballs | 1 + libraries/array | 1 + libraries/deepseq | 1 + libraries/directory | 1 + libraries/dph | 1 + libraries/filepath | 1 + libraries/haskell2010 | 1 + libraries/haskell98 | 1 + libraries/hoopl | 1 + libraries/hpc | 1 + libraries/old-locale | 1 + libraries/old-time | 1 + libraries/parallel | 1 + libraries/process | 1 + libraries/stm | 1 + libraries/unix | 1 + nofib | 1 + packages | 36 +++++++++++++++++----------------- utils/hsc2hs | 1 + 21 files changed, 90 insertions(+), 39 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc db19c665ec5055c2193b2174519866045aeff09a From git at git.haskell.org Wed Jun 25 08:48:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jun 2014 08:48:41 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (97ac32a) Message-ID: <20140625084841.4B8DC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97ac32a06a10ce3719705d064054dc047ab86e48/ghc >--------------------------------------------------------------- commit 97ac32a06a10ce3719705d064054dc047ab86e48 Author: Gabor Greif Date: Fri Jun 6 16:15:21 2014 +0200 Typos in comments >--------------------------------------------------------------- 97ac32a06a10ce3719705d064054dc047ab86e48 compiler/basicTypes/OccName.lhs | 4 ++-- compiler/types/Unify.lhs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 2de1fdd..d942362 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -373,7 +373,7 @@ demoteOccName (OccName space name) = do return $ OccName space' name -- Name spaces are related if there is a chance to mean the one when one writes --- the other, i.e. variables <-> data construtors and type variables <-> type constructors +-- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2 @@ -385,7 +385,7 @@ otherNameSpace TcClsName = TvName -{- | Other names in the compiler add aditional information to an OccName. +{- | Other names in the compiler add additional information to an OccName. This class provides a consistent way to access the underlying OccName. -} class HasOccName name where occName :: name -> OccName diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index b668186..94fdb9c 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -219,7 +219,7 @@ binding variables to types that have an unacceptable shape. This helps us avoid "overlapping instance" errors in the presence of very general instances. The main motivating example for this is the -implementation of `Typeable`, which conatins the instances: +implementation of `Typeable`, which contains the instances: ... => Typeable (f a) where ... ... => Typeable (a :: Nat) where ... From git at git.haskell.org Wed Jun 25 08:54:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jun 2014 08:54:14 +0000 (UTC) Subject: [commit: ghc] master: Fix anchors in Haddock (881be80) Message-ID: <20140625085415.17C482406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/881be80e97629c092784efcbe089d46e94203893/ghc >--------------------------------------------------------------- commit 881be80e97629c092784efcbe089d46e94203893 Author: Mateusz Kowalczyk Date: Wed Jun 25 10:53:56 2014 +0200 Fix anchors in Haddock Updates submodule >--------------------------------------------------------------- 881be80e97629c092784efcbe089d46e94203893 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 5412c26..5260671 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 5412c262f403e52be45d607b34eb3a5806ea2a76 +Subproject commit 526067188c056a5d73e7e44671ca98baf12d666b From git at git.haskell.org Wed Jun 25 13:25:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jun 2014 13:25:54 +0000 (UTC) Subject: [commit: ghc] master: Fix few Haddock parser brainfarts (9833090) Message-ID: <20140625132554.6A7562406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9833090e011cd560fe04c1f034b66beadbce7794/ghc >--------------------------------------------------------------- commit 9833090e011cd560fe04c1f034b66beadbce7794 Author: Mateusz Kowalczyk Date: Wed Jun 25 15:25:37 2014 +0200 Fix few Haddock parser brainfarts Updates submodule >--------------------------------------------------------------- 9833090e011cd560fe04c1f034b66beadbce7794 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 5260671..1a3f8f7 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 526067188c056a5d73e7e44671ca98baf12d666b +Subproject commit 1a3f8f74116d749a17467c79ee30c5efabd694d2 From git at git.haskell.org Wed Jun 25 17:14:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jun 2014 17:14:24 +0000 (UTC) Subject: [commit: ghc] master: The linking restriction, no shaping necessary. (d587ebd) Message-ID: <20140625171424.A9F092406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d587ebdaffe3000f5abb6158e6b93f7e23542c38/ghc >--------------------------------------------------------------- commit d587ebdaffe3000f5abb6158e6b93f7e23542c38 Author: Edward Z. Yang Date: Wed Jun 25 18:14:11 2014 +0100 The linking restriction, no shaping necessary. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- d587ebdaffe3000f5abb6158e6b93f7e23542c38 docs/backpack/backpack-impl.tex | 497 +++++++++++++++++++++++++++------------- 1 file changed, 332 insertions(+), 165 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d587ebdaffe3000f5abb6158e6b93f7e23542c38 From git at git.haskell.org Wed Jun 25 17:52:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jun 2014 17:52:44 +0000 (UTC) Subject: [commit: ghc] master: sync-all: Allow - in submodule URLs (c7dacdb) Message-ID: <20140625175244.263692406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c7dacdb83494737d9a23f9ceb682d34fdd84d631/ghc >--------------------------------------------------------------- commit c7dacdb83494737d9a23f9ceb682d34fdd84d631 Author: Joachim Breitner Date: Wed Jun 25 10:52:36 2014 -0700 sync-all: Allow - in submodule URLs >--------------------------------------------------------------- c7dacdb83494737d9a23f9ceb682d34fdd84d631 sync-all | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sync-all b/sync-all index ffc150e..7012647 100755 --- a/sync-all +++ b/sync-all @@ -588,14 +588,14 @@ sub gitInitSubmodules { my $submodulespaths = &readgit(".", "config", "--get-regexp", "^submodule[.].*[.]url"); # if we came from github, change the urls appropriately - while ($submodulespaths =~ m!^(submodule.(?:libraries|utils)/[a-zA-Z0-9]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9]+).git$!gm) { + while ($submodulespaths =~ m!^(submodule.(?:libraries|utils)/[a-zA-Z0-9-]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9-]+).git$!gm) { &git(".", "config", $1, "$2/ghc/packages-$3"); } # if we came from a local repository, grab our submodules from their # checkouts over there, if they exist. if ($repo_local) { - while ($submodulespaths =~ m!^(submodule.((?:libraries|utils)/[a-zA-Z0-9]+).url) .*$!gm) { + while ($submodulespaths =~ m!^(submodule.((?:libraries|utils)/[a-zA-Z0-9-]+).url) .*$!gm) { if (-e "$repo_base/$2/.git") { &git(".", "config", $1, "$repo_base/$2"); } From git at git.haskell.org Thu Jun 26 02:54:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:29 +0000 (UTC) Subject: [commit: ghc] master: sync-all: cleanup (4612524) Message-ID: <20140626025429.AA7992406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4612524542e26c782e8e1255b6e323c704310b56/ghc >--------------------------------------------------------------- commit 4612524542e26c782e8e1255b6e323c704310b56 Author: Thomas Miedema Date: Wed Jun 11 15:36:45 2014 +0200 sync-all: cleanup + Remove dead code from the DarcsAges + Tweak `git config` flags * remove --local, it is not a valid flag * --get was used in some places, not in others + Simplify reading current branch + Delete duplicated code in help >--------------------------------------------------------------- 4612524542e26c782e8e1255b6e323c704310b56 sync-all | 50 +++++++++----------------------------------------- 1 file changed, 9 insertions(+), 41 deletions(-) diff --git a/sync-all b/sync-all index ffc150e..e0e1f55 100755 --- a/sync-all +++ b/sync-all @@ -16,7 +16,6 @@ my $verbose = 2; my $try_to_resume = 0; my $ignore_failure = 0; my $checked_out_flag = 0; # NOT the opposite of bare_flag (describes remote repo state) -my $get_mode; my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo state) my %tags; @@ -159,11 +158,11 @@ sub readgit { sub configure_repository { my $localpath = shift; - &git($localpath, "config", "--local", "core.ignorecase", "true"); + &git($localpath, "config", "core.ignorecase", "true"); my $autocrlf = &readgitline($localpath, 'config', '--get', 'core.autocrlf'); if ($autocrlf eq "true") { - &git($localpath, "config", "--local", "core.autocrlf", "false"); + &git($localpath, "config", "core.autocrlf", "false"); &git($localpath, "reset", "--hard"); } } @@ -182,14 +181,14 @@ sub getrepo { my $branch = &readgitline($git_dir, "rev-parse", "--abbrev-ref", "HEAD"); die "Bad branch: $branch" unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!; - my $remote = &readgitline($git_dir, "config", "branch.$branch.remote"); + my $remote = &readgitline($git_dir, "config", "--get", "branch.$branch.remote"); if ($remote eq "") { # remotes are not mandatory for branches (e.g. not recorded by default for bare repos) $remote = "origin"; } die "Bad remote: $remote" unless $remote =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!; - $repo = &readgitline($git_dir, "config", "remote.$remote.url"); + $repo = &readgitline($git_dir, "config", "--get", "remote.$remote.url"); } my $repo_base; @@ -204,11 +203,7 @@ sub getrepo { # --checked-out is needed if you want to use a checked-out repo # over SSH or HTTP - if ($checked_out_flag) { - $checked_out_tree = 1; - } else { - $checked_out_tree = 0; - } + $checked_out_tree = $checked_out_flag; # Don't drop the last part of the path if specified with -r, as # it expects repos of the form: @@ -604,9 +599,7 @@ sub gitInitSubmodules { } sub checkCurrentBranchIsMaster { - my $branch = `git symbolic-ref HEAD`; - $branch =~ s/refs\/heads\///; - $branch =~ s/\n//; + my $branch = &readgitline(".", "rev-parse", "--abbrev-ref", "HEAD"); if ($branch !~ /master/) { print "\nWarning: You are trying to 'pull' while on branch '$branch'.\n" @@ -621,8 +614,7 @@ sub help my $tags = join ' ', sort (grep !/^-$/, keys %tags); - # Get the built in help - my $help = < and in the file 'packages'. -Available package-tags are: -END - - # Collect all the tags in the packages file - my %available_tags; - open IN, "< packages.conf" - or open IN, "< packages" # clashes with packages directory when using --bare - or die "Can't open packages file (or packages.conf)"; - while () { - chomp; - if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) { - if (defined($2) && $2 ne "-") { - $available_tags{$2} = 1; - } - } - elsif (! /^(#.*)?$/) { - die "Bad line: $_"; - } - } - close IN; +Available package-tags are: $tags - # Show those tags and the help text - my @available_tags = keys %available_tags; - print "$help at available_tags\n\n"; +END exit $exit; } @@ -846,9 +817,6 @@ sub main { elsif ($arg eq "--ignore-failure") { $ignore_failure = 1; } - elsif ($arg eq "--complete" || $arg eq "--partial") { - $get_mode = $arg; - } # Use --checked-out if the _remote_ repos are a checked-out tree, # rather than the master trees. elsif ($arg eq "--checked-out") { From git at git.haskell.org Thu Jun 26 02:54:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:31 +0000 (UTC) Subject: [commit: ghc] master: sync-all: delete dead code calling gitInitSubmodules (bd07942) Message-ID: <20140626025432.0A6D22406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd07942e4d1cb92d9c1eb8b776f38a95aa8bbe7e/ghc >--------------------------------------------------------------- commit bd07942e4d1cb92d9c1eb8b776f38a95aa8bbe7e Author: Thomas Miedema Date: Wed Jun 11 17:12:35 2014 +0200 sync-all: delete dead code calling gitInitSubmodules When running './sync-all get', 'git submodule init' has to be (and is always) executed, since .gitmodules might contain new submodules (see commit c3db2b). As a result, after cloning the ghc repo and running the initial './sync-all get', .git/config will always contain some submodule sections. Therefore it is not needed to check for this on every subsequent get or pull, and this code can be deleted. >--------------------------------------------------------------- bd07942e4d1cb92d9c1eb8b776f38a95aa8bbe7e sync-all | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/sync-all b/sync-all index e0e1f55..7b9d220 100755 --- a/sync-all +++ b/sync-all @@ -69,16 +69,6 @@ sub parsePackages { } } -sub tryReadFile { - my $filename = shift; - my @lines; - - open (FH, $filename) or return ""; - @lines = ; - close FH; - return join('', @lines); -} - sub message { if ($verbose >= 2) { print "@_\n"; @@ -903,17 +893,7 @@ sub main { &gitInitSubmodules(@submodule_args); } - if ($command eq "pull") { - my $gitConfig = &tryReadFile(".git/config"); - if ($gitConfig !~ /submodule/) { - &gitInitSubmodules(@submodule_args); - } - } if ($command eq "get" or $command eq "pull") { - my $gitConfig = &tryReadFile(".git/config"); - if ($gitConfig !~ /submodule/) { - &gitInitSubmodules(@submodule_args); - } &git(".", "submodule", "update", @submodule_args); } } @@ -1030,4 +1010,3 @@ EOF } main(@ARGV); - From git at git.haskell.org Thu Jun 26 02:54:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:34 +0000 (UTC) Subject: [commit: ghc] master: sync-all: die for real when required repo is missing (101c3f7) Message-ID: <20140626025435.09A642406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/101c3f77706df77f5ef7df68cb08437131ec3aa0/ghc >--------------------------------------------------------------- commit 101c3f77706df77f5ef7df68cb08437131ec3aa0 Author: Thomas Miedema Date: Tue Jun 17 18:25:33 2014 +0200 sync-all: die for real when required repo is missing Since commit 0e17d4, the default "tag" is "-", not "". It is never undefined. >--------------------------------------------------------------- 101c3f77706df77f5ef7df68cb08437131ec3aa0 sync-all | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/sync-all b/sync-all index 7b9d220..d60e5c9 100755 --- a/sync-all +++ b/sync-all @@ -340,10 +340,6 @@ sub gitall { if ($command eq "get") { next if $remotepath eq "-"; # "git submodule init/update" will get this later - # Skip any repositories we have not included the tag for - if (not defined($tags{$tag})) { - $tags{$tag} = 0; - } if ($tags{$tag} == 0) { next; } @@ -366,8 +362,8 @@ sub gitall { my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath"); if (not $git_repo_present) { - if ($tag eq "") { - die "Required repo $localpath is missing"; + if ($tag eq "-") { + die "Required repo $localpath is missing. Please first run './sync-all get'.\n"; } else { message "== $localpath repo not present; skipping"; From git at git.haskell.org Thu Jun 26 02:54:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:37 +0000 (UTC) Subject: [commit: ghc] master: sync-all: make --no-dph work for all subcommands (bdb5809) Message-ID: <20140626025438.63E362406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bdb5809129a926eb56ed1c8bd25da5be20d0ee98/ghc >--------------------------------------------------------------- commit bdb5809129a926eb56ed1c8bd25da5be20d0ee98 Author: Thomas Miedema Date: Tue Jun 17 19:21:37 2014 +0200 sync-all: make --no-dph work for all subcommands >--------------------------------------------------------------- bdb5809129a926eb56ed1c8bd25da5be20d0ee98 sync-all | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/sync-all b/sync-all index d60e5c9..cebb86b 100755 --- a/sync-all +++ b/sync-all @@ -307,6 +307,10 @@ sub gitall { for $line (@packages) { $tag = $$line{"tag"}; + if ($tags{$tag} == 0) { + next; + } + # Use the "remote" structure for bare git repositories $localpath = ($bare_flag) ? $$line{"remotepath"} : $$line{"localpath"}; @@ -340,10 +344,6 @@ sub gitall { if ($command eq "get") { next if $remotepath eq "-"; # "git submodule init/update" will get this later - if ($tags{$tag} == 0) { - next; - } - if (-d $localpath) { warning("$localpath already present; omitting") if $localpath ne "."; From git at git.haskell.org Thu Jun 26 02:54:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:39 +0000 (UTC) Subject: [commit: ghc] master: sync-all: set and check variable $repo_is_submodule (9a131dd) Message-ID: <20140626025439.E3EDC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a131dd091323602cd4ab343031a05ef131fe122/ghc >--------------------------------------------------------------- commit 9a131dd091323602cd4ab343031a05ef131fe122 Author: Thomas Miedema Date: Sun Jun 22 18:12:06 2014 +0200 sync-all: set and check variable $repo_is_submodule Not only does this make the code easier to read, it also fixes a bug. Starting with commits 691c8a and ccce9f, certain subcommands should behave differently for submodules. This was done by checking, for each such subcommand: $remotepath eq "-" This commit corrects that to the check: $$line{"remotepath"} eq "-". Because when we have a clone of a local mirror (checked_out_tree=1), remotepath actually gets set to $$line{"localpath"}. >--------------------------------------------------------------- 9a131dd091323602cd4ab343031a05ef131fe122 sync-all | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/sync-all b/sync-all index cebb86b..88c40da 100755 --- a/sync-all +++ b/sync-all @@ -238,6 +238,7 @@ sub gitall { my $tag; my $remotepath; my $line; + my $repo_is_submodule; my $branch_name; my $subcommand; @@ -332,6 +333,8 @@ sub gitall { close RESUME; rename "resume.tmp", "resume"; + $repo_is_submodule = $$line{"remotepath"} eq "-"; + # We can't create directories on GitHub, so we translate # "packages/foo" into "package-foo". if ($is_github_repo) { @@ -342,7 +345,7 @@ sub gitall { $path = "$repo_base/$remotepath"; if ($command eq "get") { - next if $remotepath eq "-"; # "git submodule init/update" will get this later + next if $repo_is_submodule; # "git submodule init/update" will get this later if (-d $localpath) { warning("$localpath already present; omitting") @@ -382,7 +385,7 @@ sub gitall { } elsif ($command eq "check_submodules") { # If we have a submodule then check whether it is up-to-date - if ($remotepath eq "-") { + if ($repo_is_submodule) { my %remote_heads; message "== Checking sub-module $localpath"; @@ -415,14 +418,14 @@ sub gitall { # to push to them then you need to use a special command, as # described on # http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream - if ($remotepath ne "-") { + if (!$repo_is_submodule) { &git($localpath, "push", @args); } } elsif ($command eq "pull") { my $realcmd; my @realargs; - if ($remotepath eq "-") { + if ($repo_is_submodule) { # Only fetch for the submodules. "git submodule update" # will take care of making us point to the right commit. $realcmd = "fetch"; @@ -456,7 +459,7 @@ sub gitall { my @scm_args; my $rpath; $ignore_failure = 1; - if ($remotepath eq '-') { + if ($repo_is_submodule) { $rpath = "$localpath.git"; # N.B.: $localpath lacks the .git suffix if ($localpath =~ m!^(?:libraries|utils)/!) { # FIXME: This is just a simple heuristic to @@ -521,7 +524,7 @@ sub gitall { elsif ($command eq "compare") { # Don't compare the subrepos; it doesn't work properly as # they aren't on a branch. - next if $remotepath eq "-"; + next if $repo_is_submodule; my $compareto; if ($#args eq -1) { From git at git.haskell.org Thu Jun 26 02:54:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:42 +0000 (UTC) Subject: [commit: ghc] master: sync-all: infer remotepath from .gitmodules file (72fe49d) Message-ID: <20140626025442.8042C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/72fe49d88565fc1dd807a0e185a5aa6fc4989ea0/ghc >--------------------------------------------------------------- commit 72fe49d88565fc1dd807a0e185a5aa6fc4989ea0 Author: Thomas Miedema Date: Tue Jun 17 17:27:04 2014 +0200 sync-all: infer remotepath from .gitmodules file After this commit, running `sync-all remote set-url` works properly for the haddock package: command: ./sync-all -r git://git.haskell.org remote set-url origin before: git://git.haskell.org/packages/haddock.git after: git://git.haskell.org/haddock.git By doing the `remotepath` lookup before the `$is_github_repo` check, running `sync-all remote set-url` now also works properly for submodule repos on github: command: ./sync-all -r git://github.com/ghc remote set-url origin before: git://github.com/ghc/packages/binary after: git://github.com/ghc/packages-binary * Relevant prior commits: 4f4357 "Make `sync-all remote set-url` use normalized `/packages/` urls" 34b072 "Convert haddock into a proper submodule (re #8545)" 974a97 "sync-all: Apply submodule url rewriting also to stuff in util/" >--------------------------------------------------------------- 72fe49d88565fc1dd807a0e185a5aa6fc4989ea0 sync-all | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) diff --git a/sync-all b/sync-all index 88c40da..e68da62 100755 --- a/sync-all +++ b/sync-all @@ -315,8 +315,6 @@ sub gitall { # Use the "remote" structure for bare git repositories $localpath = ($bare_flag) ? $$line{"remotepath"} : $$line{"localpath"}; - $remotepath = ($checked_out_tree) ? - $$line{"localpath"} : $$line{"remotepath"}; if (!$started) { if ($start_repo eq $localpath) { @@ -335,6 +333,17 @@ sub gitall { $repo_is_submodule = $$line{"remotepath"} eq "-"; + if ($checked_out_tree) { + $remotepath = $$line{"localpath"}; + } + elsif ($repo_is_submodule) { + $remotepath = &readgitline(".", 'config', '-f', '.gitmodules', '--get', "submodule.$localpath.url"); + $remotepath =~ s/\.\.\///; + } + else { + $remotepath = $$line{"remotepath"}; + } + # We can't create directories on GitHub, so we translate # "packages/foo" into "package-foo". if ($is_github_repo) { @@ -457,30 +466,15 @@ sub gitall { } elsif ($command eq "remote") { my @scm_args; - my $rpath; $ignore_failure = 1; - if ($repo_is_submodule) { - $rpath = "$localpath.git"; # N.B.: $localpath lacks the .git suffix - if ($localpath =~ m!^(?:libraries|utils)/!) { - # FIXME: This is just a simple heuristic to - # infer the remotepath for Git submodules. A - # proper solution would require to parse the - # .gitmodules file to obtain the actual - # localpath<->remotepath mapping. - $rpath =~ s!^(?:libraries|utils)/!packages/!; - } - $rpath = "$repo_base/$rpath"; - } else { - $rpath = $path; - } if ($subcommand eq 'add') { - @scm_args = ("remote", "add", $branch_name, $rpath); + @scm_args = ("remote", "add", $branch_name, $path); } elsif ($subcommand eq 'rm') { @scm_args = ("remote", "rm", $branch_name); } elsif ($subcommand eq 'set-branches') { @scm_args = ("remote", "set-branches", $branch_name); } elsif ($subcommand eq 'set-url') { - @scm_args = ("remote", "set-url", $branch_name, $rpath); + @scm_args = ("remote", "set-url", $branch_name, $path); } &git($localpath, @scm_args, @args); } From git at git.haskell.org Thu Jun 26 02:54:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:44 +0000 (UTC) Subject: [commit: ghc] master: Merge Thomas Miedema’s syn-all improvments (c61260e) Message-ID: <20140626025445.1660C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c61260e0f716c32334ef32c759616f12f49b579e/ghc >--------------------------------------------------------------- commit c61260e0f716c32334ef32c759616f12f49b579e Merge: c7dacdb 72fe49d Author: Joachim Breitner Date: Wed Jun 25 19:21:28 2014 -0700 Merge Thomas Miedema?s syn-all improvments as submitted on #9212. >--------------------------------------------------------------- c61260e0f716c32334ef32c759616f12f49b579e sync-all | 132 +++++++++++++++++---------------------------------------------- 1 file changed, 36 insertions(+), 96 deletions(-) From git at git.haskell.org Thu Jun 26 02:54:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:47 +0000 (UTC) Subject: [commit: ghc] master: Fix sync-all get from a local working copy (4bf3aa2) Message-ID: <20140626025447.77F592406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4bf3aa23d76c0e9ef88b382e4edfbfa847bd6bb5/ghc >--------------------------------------------------------------- commit 4bf3aa23d76c0e9ef88b382e4edfbfa847bd6bb5 Author: Joachim Breitner Date: Wed Jun 25 19:36:22 2014 -0700 Fix sync-all get from a local working copy >--------------------------------------------------------------- 4bf3aa23d76c0e9ef88b382e4edfbfa847bd6bb5 sync-all | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sync-all b/sync-all index 571586c..517d4ff 100755 --- a/sync-all +++ b/sync-all @@ -566,14 +566,14 @@ sub gitInitSubmodules { my $submodulespaths = &readgit(".", "config", "--get-regexp", "^submodule[.].*[.]url"); # if we came from github, change the urls appropriately - while ($submodulespaths =~ m!^(submodule.(?:libraries|utils)/[a-zA-Z0-9-]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9-]+).git$!gm) { + while ($submodulespaths =~ m!^(submodule.(?:libraries/|utils/)?[a-zA-Z0-9-]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9-]+).git$!gm) { &git(".", "config", $1, "$2/ghc/packages-$3"); } # if we came from a local repository, grab our submodules from their # checkouts over there, if they exist. if ($repo_local) { - while ($submodulespaths =~ m!^(submodule.((?:libraries|utils)/[a-zA-Z0-9-]+).url) .*$!gm) { + while ($submodulespaths =~ m!^(submodule.((?:libraries/|utils/)?[a-zA-Z0-9-]+).url) .*$!gm) { if (-e "$repo_base/$2/.git") { &git(".", "config", $1, "$repo_base/$2"); } From git at git.haskell.org Thu Jun 26 02:54:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 02:54:49 +0000 (UTC) Subject: [commit: ghc] master: Fix “Checking for old .. repo” messages (bcccadd) Message-ID: <20140626025450.01FC52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bcccadd9719d89c1e51619bc01c3d655ddf0e5f1/ghc >--------------------------------------------------------------- commit bcccadd9719d89c1e51619bc01c3d655ddf0e5f1 Author: Joachim Breitner Date: Wed Jun 25 19:44:18 2014 -0700 Fix ?Checking for old .. repo? messages >--------------------------------------------------------------- bcccadd9719d89c1e51619bc01c3d655ddf0e5f1 sync-all | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sync-all b/sync-all index 517d4ff..355e16a 100755 --- a/sync-all +++ b/sync-all @@ -943,8 +943,8 @@ END { ["libraries/Cabal", "c8ebd66a32865f72ae03ee0663c62df3d77f08fe"], ); for (@obsolete_dirs) { - my ($dir, $hash) = $_; - my $name = $dir =~ m!/([^/]+)$!; + my ($dir, $hash) = @$_; + my ($name) = $dir =~ m!/([^/]+)$!; message "== Checking for old $name repo"; if (-d "$dir/.git") { chdir($dir); From git at git.haskell.org Thu Jun 26 06:41:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 06:41:51 +0000 (UTC) Subject: [commit: ghc] master: Work around lack of __sync_fetch_and_nand in clang (04dd7cb) Message-ID: <20140626064151.F3D5A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/04dd7cb3423f1940242fdfe2ea2e3b8abd68a177/ghc >--------------------------------------------------------------- commit 04dd7cb3423f1940242fdfe2ea2e3b8abd68a177 Author: Johan Tibell Date: Thu Jun 26 08:39:53 2014 +0200 Work around lack of __sync_fetch_and_nand in clang clang chose to not implement this function. See http://llvm.org/bugs/show_bug.cgi?id=8842 >--------------------------------------------------------------- 04dd7cb3423f1940242fdfe2ea2e3b8abd68a177 libraries/ghc-prim/cbits/atomic.c | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/libraries/ghc-prim/cbits/atomic.c b/libraries/ghc-prim/cbits/atomic.c index a2e64af..e3d6cc1 100644 --- a/libraries/ghc-prim/cbits/atomic.c +++ b/libraries/ghc-prim/cbits/atomic.c @@ -101,32 +101,58 @@ hs_atomic_and64(volatile StgWord64 *x, StgWord64 val) // FetchNandByteArrayOp_Int +// Workaround for http://llvm.org/bugs/show_bug.cgi?id=8842 +#define CAS_NAND(x, val) \ + { \ + __typeof__ (*(x)) tmp = *(x); \ + while (!__sync_bool_compare_and_swap(x, tmp, ~(tmp & (val)))) { \ + tmp = *(x); \ + } \ + return tmp; \ + } + extern StgWord hs_atomic_nand8(volatile StgWord8 *x, StgWord val); StgWord hs_atomic_nand8(volatile StgWord8 *x, StgWord val) { +#ifdef __clang__ + CAS_NAND(x, (StgWord8) val) +#else return __sync_fetch_and_nand(x, (StgWord8) val); +#endif } extern StgWord hs_atomic_nand16(volatile StgWord16 *x, StgWord val); StgWord hs_atomic_nand16(volatile StgWord16 *x, StgWord val) { +#ifdef __clang__ + CAS_NAND(x, (StgWord16) val); +#else return __sync_fetch_and_nand(x, (StgWord16) val); +#endif } extern StgWord hs_atomic_nand32(volatile StgWord32 *x, StgWord val); StgWord hs_atomic_nand32(volatile StgWord32 *x, StgWord val) { +#ifdef __clang__ + CAS_NAND(x, (StgWord32) val); +#else return __sync_fetch_and_nand(x, (StgWord32) val); +#endif } extern StgWord64 hs_atomic_nand64(volatile StgWord64 *x, StgWord64 val); StgWord64 hs_atomic_nand64(volatile StgWord64 *x, StgWord64 val) { +#ifdef __clang__ + CAS_NAND(x, val); +#else return __sync_fetch_and_nand(x, val); +#endif } // FetchOrByteArrayOp_Int From git at git.haskell.org Thu Jun 26 08:33:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 08:33:34 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Fix regression in Data.Fixed Read instance (re #9231) (99462b6) Message-ID: <20140626083334.7BA1C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/99462b6877308003442942cbddb3296f29cfb9a8/base >--------------------------------------------------------------- commit 99462b6877308003442942cbddb3296f29cfb9a8 Author: Herbert Valerio Riedel Date: Tue Jun 24 11:42:06 2014 +0200 Fix regression in Data.Fixed Read instance (re #9231) `convertFixed` operates under the wrong assumption that `Data.Fixed.resolution` returns a base-10 exponent `e`, whereas it actually returns the power-of-10 value `10^e`. So while the code (that was introduced in 5f19f951d8 / #7483) happens to compute a correct result by coincidence, it allocates huge integer values in the process (i.e. `10^(10^e)`) which cause long computations which eventually result in out-of-memory conditions for `e`-values beyond `Data.Fixed.Milli`. A proper long-term fix would probably be to extend the `HasResolution` type-class to have a 2nd method providing the `e` value. Signed-off-by: Herbert Valerio Riedel (cherry picked from commit [c1035d51edaac2f388a0630e2ad25391e7e3c1ab/ghc]) Differential Revision: https://phabricator.haskell.org/D25 >--------------------------------------------------------------- 99462b6877308003442942cbddb3296f29cfb9a8 Data/Fixed.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Data/Fixed.hs b/Data/Fixed.hs index f5fb896..984e1f3 100644 --- a/Data/Fixed.hs +++ b/Data/Fixed.hs @@ -158,9 +158,10 @@ instance (HasResolution a) => Read (Fixed a) where convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a) convertFixed (Number n) - | Just (i, f) <- numberToFixed r n = - return (fromInteger i + (fromInteger f / (10 ^ r))) - where r = resolution (undefined :: Fixed a) + | Just (i, f) <- numberToFixed e n = + return (fromInteger i + (fromInteger f / fromInteger r)) + where r = resolution (undefined :: Fixed a) -- = 10^e + e = round (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail data E0 = E0 From git at git.haskell.org Thu Jun 26 08:33:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 08:33:36 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Fixup c1035d51e to behave more like in GHC 7.6 (4254e15) Message-ID: <20140626083336.876D02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/4254e158e05ac86b922dea6ba3c3c330732d991b/base >--------------------------------------------------------------- commit 4254e158e05ac86b922dea6ba3c3c330732d991b Author: Herbert Valerio Riedel Date: Tue Jun 24 22:58:41 2014 +0200 Fixup c1035d51e to behave more like in GHC 7.6 The fix in c1035d51e (addressing #9231) was done under the assumption that `Data.Fixed` is used only with power-of-10 `resolution`. This follow-up fixup changes the behavior to be more consistent with the previous behavior in GHC 7.6 For instance, for the following `B7` resolution > data B7 > instance HasResolution B7 where resolution _ = 128 After this patch, the following behavior is now observable: > 1.070 :: Fixed B7 1.062 > 1.062 :: Fixed B7 1.054 > read "1.070" :: Fixed B7 1.062 > read "1.062" :: Fixed B7 1.054 This doesn't provide the desirable "read . show == id" property yet (which didn't hold in GHC 7.6 either), but at least `fromRational` and `read` are consistent. Signed-off-by: Herbert Valerio Riedel (cherry picked from commit [ec550e8f951e50fb91c89389e2e77a3358079c3a/ghc]) >--------------------------------------------------------------- 4254e158e05ac86b922dea6ba3c3c330732d991b Data/Fixed.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Data/Fixed.hs b/Data/Fixed.hs index 984e1f3..29bc171 100644 --- a/Data/Fixed.hs +++ b/Data/Fixed.hs @@ -159,9 +159,12 @@ instance (HasResolution a) => Read (Fixed a) where convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a) convertFixed (Number n) | Just (i, f) <- numberToFixed e n = - return (fromInteger i + (fromInteger f / fromInteger r)) - where r = resolution (undefined :: Fixed a) -- = 10^e - e = round (logBase 10 (fromInteger r) :: Double) + return (fromInteger i + (fromInteger f / (10 ^ e))) + where r = resolution (undefined :: Fixed a) + -- round 'e' up to help make the 'read . show == id' property + -- possible also for cases where 'resolution' is not a + -- power-of-10, such as e.g. when 'resolution = 128' + e = ceiling (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail data E0 = E0 From git at git.haskell.org Thu Jun 26 08:33:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 08:33:38 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Bump to 4.7.0.1 and update changelog.md (cd00135) Message-ID: <20140626083338.93D422406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/cd00135acbdfaae3adab2b5acf14386eddde9fa8/base >--------------------------------------------------------------- commit cd00135acbdfaae3adab2b5acf14386eddde9fa8 Author: Herbert Valerio Riedel Date: Thu Jun 26 10:07:18 2014 +0200 Bump to 4.7.0.1 and update changelog.md Fwiw, the version bump should have been performed together with the first change after 4.7.0.0 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- cd00135acbdfaae3adab2b5acf14386eddde9fa8 base.cabal | 4 ++-- changelog.md | 11 +++++++++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/base.cabal b/base.cabal index f8937dc..8aa8cf7 100644 --- a/base.cabal +++ b/base.cabal @@ -1,6 +1,6 @@ name: base -version: 4.7.0.0 --- GHC 7.6.1 released with 4.6.0.0 +version: 4.7.0.1 +-- GHC 7.6.3 released with 4.7.0.0 license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org diff --git a/changelog.md b/changelog.md index d86f6df..5eef01f 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,16 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.7.0.1 *Jun 2014* + + * Bundled with GHC 7.8.3 + + * Unhide `Foreign.ForeignPtr` in Haddock (#8475) + + * Fix recomputation of `TypeRep` in `Typeable` type-application instance + (#9203) + + * Fix regression in Data.Fixed Read instance (#9231) + ## 4.7.0.0 *Mar 2014* * Bundled with GHC 7.8.1 From git at git.haskell.org Thu Jun 26 12:31:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 12:31:55 +0000 (UTC) Subject: [commit: ghc] master: Lots of rewrites to further move toward new world order (84d7845) Message-ID: <20140626123155.171DE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/84d7845063c974a9437a29f4f0b5094392d04a29/ghc >--------------------------------------------------------------- commit 84d7845063c974a9437a29f4f0b5094392d04a29 Author: Edward Z. Yang Date: Thu Jun 26 13:31:40 2014 +0100 Lots of rewrites to further move toward new world order Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 84d7845063c974a9437a29f4f0b5094392d04a29 docs/backpack/backpack-impl.tex | 770 +++++++++++++++------------------------- 1 file changed, 291 insertions(+), 479 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 84d7845063c974a9437a29f4f0b5094392d04a29 From git at git.haskell.org Thu Jun 26 12:59:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 12:59:35 +0000 (UTC) Subject: [commit: ghc] master: Revert "Add more primops for atomic ops on byte arrays" (950fcae) Message-ID: <20140626125935.5AE3A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/950fcae46a82569e7cd1fba1637a23b419e00ecd/ghc >--------------------------------------------------------------- commit 950fcae46a82569e7cd1fba1637a23b419e00ecd Author: Johan Tibell Date: Thu Jun 26 14:31:37 2014 +0200 Revert "Add more primops for atomic ops on byte arrays" This commit caused the register allocator to fail on i386. This reverts commit d8abf85f8ca176854e9d5d0b12371c4bc402aac3 and 04dd7cb3423f1940242fdfe2ea2e3b8abd68a177 (the second being a fix to the first). >--------------------------------------------------------------- 950fcae46a82569e7cd1fba1637a23b419e00ecd compiler/cmm/CmmMachOp.hs | 19 -- compiler/cmm/CmmSink.hs | 4 - compiler/cmm/PprC.hs | 4 - compiler/codeGen/StgCmmPrim.hs | 94 ------- compiler/llvmGen/Llvm/AbsSyn.hs | 7 - compiler/llvmGen/Llvm/PpLlvm.hs | 18 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 71 ++--- compiler/nativeGen/CPrim.hs | 50 +--- compiler/nativeGen/PPC/CodeGen.hs | 4 - compiler/nativeGen/SPARC/CodeGen.hs | 4 - compiler/nativeGen/X86/CodeGen.hs | 92 ------- compiler/nativeGen/X86/Instr.hs | 38 +-- compiler/nativeGen/X86/Ppr.hs | 8 - compiler/prelude/primops.txt.pp | 76 +---- includes/stg/MiscClosures.h | 1 + libraries/ghc-prim/cbits/atomic.c | 306 --------------------- libraries/ghc-prim/ghc-prim.cabal | 1 - rts/Linker.c | 1 + rts/PrimOps.cmm | 12 + testsuite/tests/concurrent/should_run/.gitignore | 1 - .../tests/concurrent/should_run/AtomicPrimops.hs | 245 ----------------- .../concurrent/should_run/AtomicPrimops.stdout | 7 - testsuite/tests/concurrent/should_run/all.T | 1 - 23 files changed, 54 insertions(+), 1010 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 950fcae46a82569e7cd1fba1637a23b419e00ecd From git at git.haskell.org Thu Jun 26 16:18:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 16:18:01 +0000 (UTC) Subject: [commit: packages/parallel] master: Add a .gitignore file. (ce0d167) Message-ID: <20140626161801.C435B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/ce0d167561eb612640bced85f2b6f849aeb7fc29 >--------------------------------------------------------------- commit ce0d167561eb612640bced85f2b6f849aeb7fc29 Author: Edward Z. Yang Date: Thu Jun 26 09:13:38 2014 -0700 Add a .gitignore file. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- ce0d167561eb612640bced85f2b6f849aeb7fc29 .gitignore | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..242131b --- /dev/null +++ b/.gitignore @@ -0,0 +1,19 @@ +*.o +*.aux +*.hi +*.comp.stderr +*.comp.stdout +*.interp.stderr +*.interp.stdout +*.run.stderr +*.run.stdout +*.eventlog +*.genscript + +# Backup files +*~ + +# Specific generated files +/GNUmakefile +/dist-install/ +/ghc.mk From git at git.haskell.org Thu Jun 26 16:20:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 16:20:11 +0000 (UTC) Subject: [commit: packages/stm] master: Add .gitignore file. (0ba4b10) Message-ID: <20140626162011.0BDC82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/0ba4b104df9f7364efeec22934fb92669824a8ae >--------------------------------------------------------------- commit 0ba4b104df9f7364efeec22934fb92669824a8ae Author: Edward Z. Yang Date: Thu Jun 26 09:19:02 2014 -0700 Add .gitignore file. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 0ba4b104df9f7364efeec22934fb92669824a8ae .gitignore | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..242131b --- /dev/null +++ b/.gitignore @@ -0,0 +1,19 @@ +*.o +*.aux +*.hi +*.comp.stderr +*.comp.stdout +*.interp.stderr +*.interp.stdout +*.run.stderr +*.run.stdout +*.eventlog +*.genscript + +# Backup files +*~ + +# Specific generated files +/GNUmakefile +/dist-install/ +/ghc.mk From git at git.haskell.org Thu Jun 26 16:26:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 16:26:26 +0000 (UTC) Subject: [commit: ghc] master: Update parallel and stm submodules to have .gitignore (22c16eb) Message-ID: <20140626162626.8C57D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22c16eb71c2bf87a555387aca115eae7367df50a/ghc >--------------------------------------------------------------- commit 22c16eb71c2bf87a555387aca115eae7367df50a Author: Edward Z. Yang Date: Thu Jun 26 09:24:37 2014 -0700 Update parallel and stm submodules to have .gitignore Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 22c16eb71c2bf87a555387aca115eae7367df50a libraries/parallel | 2 +- libraries/stm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/parallel b/libraries/parallel index 03da433..ce0d167 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit 03da43303ed05ace65cb24cee1dbc1766c694233 +Subproject commit ce0d167561eb612640bced85f2b6f849aeb7fc29 diff --git a/libraries/stm b/libraries/stm index 52c3028..0ba4b10 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 52c3028aff127fd957cdaf1ec7605fc533a59961 +Subproject commit 0ba4b104df9f7364efeec22934fb92669824a8ae From git at git.haskell.org Thu Jun 26 16:34:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 16:34:08 +0000 (UTC) Subject: [commit: ghc] master: arclint: update rules for xml files (5bbbc7d) Message-ID: <20140626163408.EBEEE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5bbbc7d7e0ef141bff6f4c5991d154413ed86ac3/ghc >--------------------------------------------------------------- commit 5bbbc7d7e0ef141bff6f4c5991d154413ed86ac3 Author: Austin Seipp Date: Thu Jun 26 11:33:29 2014 -0500 arclint: update rules for xml files As pointed out by Edward, it's probably unreasonable to have the xml docs adhere to 80 columns, so we'll separate out the linters for now. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5bbbc7d7e0ef141bff6f4c5991d154413ed86ac3 .arclint | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/.arclint b/.arclint index caa72ab..21ca5f0 100644 --- a/.arclint +++ b/.arclint @@ -14,9 +14,18 @@ }, "text": { "type": "text", + "exclude": [ "(\\.xml$)" ], "severity": { "5": "disabled" } + }, + "text-xml": { + "type": "text", + "include": "(\\.xml$)", + "severity": { + "5": "disabled", + "3": "disabled" + } } } } From git at git.haskell.org Thu Jun 26 21:53:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 21:53:34 +0000 (UTC) Subject: [commit: ghc] master: Add new flag -fwrite-interface for -fno-code. (ab105f8) Message-ID: <20140626215334.510632406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab105f83dcd5f9094a9edb0f0c8266fba6f3c808/ghc >--------------------------------------------------------------- commit ab105f83dcd5f9094a9edb0f0c8266fba6f3c808 Author: Edward Z. Yang Date: Thu Jun 26 16:52:52 2014 +0100 Add new flag -fwrite-interface for -fno-code. Summary: Normally, -fno-code does not generate interface files. However, if you want to use it to type check over multiple runs of GHC, you will need the interface files to check source files further down the dependency chain; -fwrite-interface does this for you. Signed-off-by: Edward Z. Yang Test Plan: clean validate, and a new test-case Reviewers: simonpj Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D27 >--------------------------------------------------------------- ab105f83dcd5f9094a9edb0f0c8266fba6f3c808 compiler/main/DriverPipeline.hs | 4 +++- compiler/main/DynFlags.hs | 2 ++ compiler/main/HscMain.hs | 6 +++++- docs/users_guide/flags.xml | 6 ++++++ docs/users_guide/phases.xml | 18 ++++++++++++++++-- testsuite/tests/driver/Makefile | 12 ++++++++++++ testsuite/tests/driver/all.T | 2 ++ testsuite/tests/driver/write_interface_make.stdout | 1 + 8 files changed, 47 insertions(+), 4 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 0eae3bb..11427e2 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -228,7 +228,9 @@ compileOne' m_tc_result mHscMessage hm_iface = iface, hm_linkable = Just linkable }) HscNothing -> - do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash + do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash + when (gopt Opt_WriteInterface dflags) $ + hscWriteIface dflags iface changed summary let linkable = if isHsBoot src_flavour then maybe_old_linkable else Just (LM (ms_hs_date summary) this_mod []) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index f82c404..3494208 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -333,6 +333,7 @@ data GeneralFlag | Opt_IgnoreInterfacePragmas | Opt_OmitInterfacePragmas | Opt_ExposeAllUnfoldings + | Opt_WriteInterface -- forces .hi files to be written even with -fno-code -- profiling opts | Opt_AutoSccsOnIndividualCafs @@ -2647,6 +2648,7 @@ fFlags = [ ( "pedantic-bottoms", Opt_PedanticBottoms, nop ), ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, nop ), ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, nop ), + ( "write-interface", Opt_WriteInterface, nop ), ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, nop ), ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, nop ), ( "ignore-asserts", Opt_IgnoreAsserts, nop ), diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index ea31ed7..aef6007 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -623,7 +623,11 @@ hscCompileOneShot' hsc_env mod_summary src_changed guts0 <- hscDesugar' (ms_location mod_summary) tc_result dflags <- getDynFlags case hscTarget dflags of - HscNothing -> return HscNotGeneratingCode + HscNothing -> do + when (gopt Opt_WriteInterface dflags) $ liftIO $ do + (iface, changed, _details) <- hscSimpleIface hsc_env tc_result mb_old_hash + hscWriteIface dflags iface changed mod_summary + return HscNotGeneratingCode _ -> case ms_hsc_src mod_summary of HsBootFile -> diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 90804a2..ad9c44c 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -2209,6 +2209,12 @@ - + + Always write interface files + dynamic + - + + Generate byte-code dynamic diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml index db32f38..0326af1 100644 --- a/docs/users_guide/phases.xml +++ b/docs/users_guide/phases.xml @@ -576,8 +576,22 @@ $ cat foo.hspp Omit code generation (and all later phases) - altogether. Might be of some use if you just want to see - dumps of the intermediate compilation phases. + altogether. This is useful if you're only interested in + type checking code. + + + + + + + + + + Always write interface files. GHC will normally write + interface files automatically, but this flag is useful with + diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 37b661c..62aa2f9 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -566,3 +566,15 @@ T703: [ ! -d T703 ] "$(TEST_HC)" $(TEST_HC_OPTS) --make T703.hs -v0 ! readelf -W -l T703 2>/dev/null | grep 'GNU_STACK' | grep -q 'RWE' + +.PHONY: write_interface_oneshot +write_interface_oneshot: + $(RM) -rf write_interface_oneshot/A011.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_oneshot -fno-code -fwrite-interface -c A011.hs + test -f write_interface_oneshot/A011.hi + +.PHONY: write_interface_make +write_interface_make: + $(RM) -rf write_interface_make/A011.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_make -fno-code -fwrite-interface --make A011.hs + test -f write_interface_make/A011.hi diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 45c7662..7236ec1 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -404,3 +404,5 @@ def build_T9050(name, way): return simple_build(name + '.cmm', way, '-outputdir=. ', 0, '', 0, 0, 0) test('T9050', normal, build_T9050, []) +test('write_interface_oneshot', normal, run_command, ['$MAKE -s --no-print-directory write_interface_oneshot']) +test('write_interface_make', normal, run_command, ['$MAKE -s --no-print-directory write_interface_make']) diff --git a/testsuite/tests/driver/write_interface_make.stdout b/testsuite/tests/driver/write_interface_make.stdout new file mode 100644 index 0000000..1594f5e --- /dev/null +++ b/testsuite/tests/driver/write_interface_make.stdout @@ -0,0 +1 @@ +[1 of 1] Compiling A011 ( A011.hs, nothing ) From git at git.haskell.org Thu Jun 26 21:56:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 21:56:53 +0000 (UTC) Subject: [commit: packages/array] master: add testsuite-related gitignore entries (7784c53) Message-ID: <20140626215653.A19712406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/7784c531e2fc8ae7e544ce50293a6108005cedd4 >--------------------------------------------------------------- commit 7784c531e2fc8ae7e544ce50293a6108005cedd4 Author: Herbert Valerio Riedel Date: Thu Jun 26 23:01:42 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- 7784c531e2fc8ae7e544ce50293a6108005cedd4 tests/.gitignore | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..95e6531 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,14 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/T2120 +/array001 +/array001.data +/largeArray From git at git.haskell.org Thu Jun 26 21:57:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 21:57:23 +0000 (UTC) Subject: [commit: packages/directory] master: add testsuite-related gitignore entries (54c677d) Message-ID: <20140626215723.AFBF92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/54c677d227b278de694b10398404981d64ece62f/directory >--------------------------------------------------------------- commit 54c677d227b278de694b10398404981d64ece62f Author: Herbert Valerio Riedel Date: Thu Jun 26 23:19:13 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- 54c677d227b278de694b10398404981d64ece62f tests/.gitignore | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..e675d35 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,24 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/T4113 +/copyFile001 +/copyFile002 +/createDirectory001 +/createDirectoryIfMissing001 +/currentDirectory001 +/directory001 +/doesDirectoryExist001 +/getDirContents001 +/getDirContents002 +/getHomeDirectory001 +/getPermissions001 +/renameFile001 +/renameFile001.tmp1 From git at git.haskell.org Thu Jun 26 21:59:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 21:59:40 +0000 (UTC) Subject: [commit: packages/filepath] master: add testsuite-related gitignore entries (57d9b11) Message-ID: <20140626215941.010562406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/filepath On branch : master Link : http://git.haskell.org/packages/filepath.git/commitdiff/57d9b11e4a551588ae5df4013e192ff6ec7812f3 >--------------------------------------------------------------- commit 57d9b11e4a551588ae5df4013e192ff6ec7812f3 Author: Herbert Valerio Riedel Date: Thu Jun 26 23:26:03 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- 57d9b11e4a551588ae5df4013e192ff6ec7812f3 .gitignore | 4 ---- tests/.gitignore | 13 +++++++++++++ 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/.gitignore b/.gitignore index 1f948c9..d83c989 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,3 @@ GNUmakefile dist-install/ ghc.mk -tests/FilePath_Test.hs -tests/GenTests -tests/GenTests.hi -tests/GenTests.o diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..d12d62c --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,13 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/FilePath_Test +/FilePath_Test.hs +/GenTests From git at git.haskell.org Thu Jun 26 22:00:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:00:11 +0000 (UTC) Subject: [commit: packages/hpc] master: add testsuite-related gitignore entries (5a1ee4e) Message-ID: <20140626220012.BF07E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/5a1ee4e8a2056beff16f0a3cac2c4da61b96f317 >--------------------------------------------------------------- commit 5a1ee4e8a2056beff16f0a3cac2c4da61b96f317 Author: Herbert Valerio Riedel Date: Thu Jun 26 23:13:42 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- 5a1ee4e8a2056beff16f0a3cac2c4da61b96f317 tests/.gitignore | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..9846ea3 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,20 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe +*.hs.html +hpc_index*.html + +# all *.tix except hpc_sample.tix +*.tix +!hpc_sample.tix + +# specific files +/fork/hpc_fork +/function/tough +/function2/tough2 +/simple/hpc001 From git at git.haskell.org Thu Jun 26 22:00:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:00:33 +0000 (UTC) Subject: [commit: packages/old-time] master: add testsuite-related gitignore entries (e816d30) Message-ID: <20140626220033.7E1A12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/old-time On branch : master Link : http://git.haskell.org/packages/old-time.git/commitdiff/e816d30ae8c64ccde2dde3063a7420abc922a0d4 >--------------------------------------------------------------- commit e816d30ae8c64ccde2dde3063a7420abc922a0d4 Author: Herbert Valerio Riedel Date: Thu Jun 26 23:41:35 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- e816d30ae8c64ccde2dde3063a7420abc922a0d4 tests/.gitignore | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..ee04626 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,14 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/T5430 +/time002 +/time003 +/time004 From git at git.haskell.org Thu Jun 26 22:01:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:01:18 +0000 (UTC) Subject: [commit: packages/parallel] master: add testsuite-related gitignore entries (8df9de9) Message-ID: <20140626220118.52CEC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/8df9de914ea3ab7f47874e53b7e9d7c6af4d7f8e >--------------------------------------------------------------- commit 8df9de914ea3ab7f47874e53b7e9d7c6af4d7f8e Author: Herbert Valerio Riedel Date: Thu Jun 26 23:29:31 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- 8df9de914ea3ab7f47874e53b7e9d7c6af4d7f8e tests/.gitignore | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..0f6f0c4 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,14 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/T2185 +/par001 +/par002 +/par003 From git at git.haskell.org Thu Jun 26 22:01:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:01:53 +0000 (UTC) Subject: [commit: packages/process] master: add testsuite-related gitignore entries (35bf51c) Message-ID: <20140626220153.CC4502406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/process On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/35bf51cb72baaaeaad22fb340aa9d8c957d2186c/process >--------------------------------------------------------------- commit 35bf51cb72baaaeaad22fb340aa9d8c957d2186c Author: Herbert Valerio Riedel Date: Thu Jun 26 23:17:26 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- 35bf51cb72baaaeaad22fb340aa9d8c957d2186c tests/.gitignore | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..73f38bb --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,31 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/T1780 +/T3231 +/T3994 +/T4198 +/T4889 +/T8343 +/process001 +/process001.out +/process002 +/process002.out +/process003 +/process004 +/process005 +/process006 +/process007 +/process007.tmp +/process007_fd +/process008 +/process009 +/process010 +/process011 From git at git.haskell.org Thu Jun 26 22:02:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:02:54 +0000 (UTC) Subject: [commit: packages/stm] master: add testsuite-related gitignore entries (e8a901f) Message-ID: <20140626220254.5388B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/e8a901fddc88c6560af34e18a5201deeb8d51557 >--------------------------------------------------------------- commit e8a901fddc88c6560af34e18a5201deeb8d51557 Author: Herbert Valerio Riedel Date: Thu Jun 26 23:28:37 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- e8a901fddc88c6560af34e18a5201deeb8d51557 tests/.gitignore | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..25856d1 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,30 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/T2411 +/T3049 +/T4057 +/cloneTChan001 +/stm046 +/stm047 +/stm048 +/stm049 +/stm050 +/stm052 +/stm053 +/stm054 +/stm055 +/stm056 +/stm060 +/stm061 +/stm062 +/stm063 +/stm064 +/stm065 From git at git.haskell.org Thu Jun 26 22:03:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:03:29 +0000 (UTC) Subject: [commit: packages/unix] master: add testsuite-related gitignore entries (c2a7e0f) Message-ID: <20140626220329.4C20B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c2a7e0f9a5af31c86334ae818be858befe777cb3/unix >--------------------------------------------------------------- commit c2a7e0f9a5af31c86334ae818be858befe777cb3 Author: Herbert Valerio Riedel Date: Thu Jun 26 23:20:54 2014 +0200 add testsuite-related gitignore entries >--------------------------------------------------------------- c2a7e0f9a5af31c86334ae818be858befe777cb3 tests/.gitignore | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 0000000..a6b0472 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,40 @@ +.hpc*/ +*.o +*.hi +*.comp.std* +*.run.std* +*.eventlog +*.genscript +*.exe + +# specific files +/T1185 +/T3816 +/T8108 +/executeFile001 +/fdReadBuf001 +/fileStatus +/fileStatusByteString +/fileexist01 +/forkprocess01 +/getEnvironment01 +/getEnvironment02 +/getGroupEntryForName +/getUserEntryForName +/libposix/po003.out +/libposix/posix002 +/libposix/posix003 +/libposix/posix004 +/libposix/posix005 +/libposix/posix006 +/libposix/posix009 +/libposix/posix010 +/libposix/posix014 +/processGroup001 +/processGroup002 +/queryfdoption01 +/resourceLimit +/signals001 +/signals002 +/signals004 +/user001 From git at git.haskell.org Thu Jun 26 22:06:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:06:29 +0000 (UTC) Subject: [commit: packages/unix] master: Update URLs to point to GitHub (d7fb71b) Message-ID: <20140626220629.7107C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7fb71b2d6b4f6809be28071c5c8107929268687/unix >--------------------------------------------------------------- commit d7fb71b2d6b4f6809be28071c5c8107929268687 Author: Herbert Valerio Riedel Date: Mon Apr 28 10:38:51 2014 +0200 Update URLs to point to GitHub >--------------------------------------------------------------- d7fb71b2d6b4f6809be28071c5c8107929268687 README.md | 2 +- unix.cabal | 14 +++++--------- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index d7ab52b..dae5aaa 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -The `unix` Package [![Build Status](https://travis-ci.org/ghc/packages-unix.png?branch=master)](https://travis-ci.org/ghc/packages-unix) +The `unix` Package [![Build Status](https://travis-ci.org/haskell/unix.svg)](https://travis-ci.org/haskell/unix) ================== See [`unix` on Hackage](http://hackage.haskell.org/package/unix) for diff --git a/unix.cabal b/unix.cabal index 12f463b..8d0b16f 100644 --- a/unix.cabal +++ b/unix.cabal @@ -1,10 +1,11 @@ name: unix -version: 2.7.0.1 --- GHC 7.6.1 released with 2.6.0.0 +version: 2.7.0.2 +-- GHC 7.8.2 released with 2.7.0.1 license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org -bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries/unix +homepage: https://github.com/haskell/unix +bug-reports: https://github.com/haskell/unix/issues synopsis: POSIX functionality category: System build-type: Configure @@ -38,12 +39,7 @@ extra-tmp-files: source-repository head type: git - location: http://git.haskell.org/packages/unix.git - -source-repository this - type: git - location: http://git.haskell.org/packages/unix.git - tag: unix-2.7.0.1-release + location: https://github.com/haskell/unix.git library default-language: Haskell2010 From git at git.haskell.org Thu Jun 26 22:06:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:06:31 +0000 (UTC) Subject: [commit: packages/unix] master: Merge https://github.com/haskell/unix (bc48ca8) Message-ID: <20140626220631.8B6B92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bc48ca82deb23f6985579b7a50d205632cfd5d46/unix >--------------------------------------------------------------- commit bc48ca82deb23f6985579b7a50d205632cfd5d46 Merge: c2a7e0f d7fb71b Author: Herbert Valerio Riedel Date: Fri Jun 27 00:05:14 2014 +0200 Merge https://github.com/haskell/unix >--------------------------------------------------------------- bc48ca82deb23f6985579b7a50d205632cfd5d46 README.md | 2 +- unix.cabal | 14 +++++--------- 2 files changed, 6 insertions(+), 10 deletions(-) From git at git.haskell.org Thu Jun 26 22:07:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:07:01 +0000 (UTC) Subject: [commit: ghc] master: Add testsuite-related .gitignore files (aa4c5e7) Message-ID: <20140626220702.400FA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa4c5e7dd491a5f3a2e25a7368c0aa768255c913/ghc >--------------------------------------------------------------- commit aa4c5e7dd491a5f3a2e25a7368c0aa768255c913 Author: Herbert Valerio Riedel Date: Thu Jun 26 23:51:54 2014 +0200 Add testsuite-related .gitignore files Also set `submodule..ignore=none` explicitly for the recently converted submodules, as those are not supposed to have untracked/unignored files lying around. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- aa4c5e7dd491a5f3a2e25a7368c0aa768255c913 .gitmodules | 19 +++++++++++++++++++ libraries/array | 2 +- libraries/directory | 2 +- libraries/filepath | 2 +- libraries/hpc | 2 +- libraries/old-time | 2 +- libraries/parallel | 2 +- libraries/process | 2 +- libraries/stm | 2 +- libraries/unix | 2 +- 10 files changed, 28 insertions(+), 9 deletions(-) diff --git a/.gitmodules b/.gitmodules index b5e7122..b5e29b9 100644 --- a/.gitmodules +++ b/.gitmodules @@ -57,57 +57,76 @@ [submodule "libraries/array"] path = libraries/array url = ../packages/array.git + ignore = none [submodule "libraries/deepseq"] path = libraries/deepseq url = ../packages/deepseq.git + ignore = none [submodule "libraries/directory"] path = libraries/directory url = ../packages/directory.git + ignore = none [submodule "libraries/filepath"] path = libraries/filepath url = ../packages/filepath.git + ignore = none [submodule "libraries/haskell98"] path = libraries/haskell98 url = ../packages/haskell98.git + ignore = none [submodule "libraries/haskell2010"] path = libraries/haskell2010 url = ../packages/haskell2010.git + ignore = none [submodule "libraries/hoopl"] path = libraries/hoopl url = ../packages/hoopl.git + ignore = none [submodule "libraries/hpc"] path = libraries/hpc url = ../packages/hpc.git + ignore = none [submodule "libraries/old-locale"] path = libraries/old-locale url = ../packages/old-locale.git + ignore = none [submodule "libraries/old-time"] path = libraries/old-time url = ../packages/old-time.git + ignore = none [submodule "libraries/process"] path = libraries/process url = ../packages/process.git + ignore = none [submodule "libraries/unix"] path = libraries/unix url = ../packages/unix.git + ignore = none [submodule "libraries/parallel"] path = libraries/parallel url = ../packages/parallel.git + ignore = none [submodule "libraries/stm"] path = libraries/stm url = ../packages/stm.git + ignore = none [submodule "libraries/dph"] path = libraries/dph url = ../packages/dph.git + ignore = none [submodule "utils/haddock"] path = utils/haddock url = ../haddock.git + ignore = none [submodule "nofib"] path = nofib url = ../nofib.git + ignore = none [submodule "utils/hsc2hs"] path = utils/hsc2hs url = ../hsc2hs.git + ignore = none [submodule "libffi-tarballs"] path = libffi-tarballs url = ../libffi-tarballs.git + ignore = none diff --git a/libraries/array b/libraries/array index 26ff047..7784c53 160000 --- a/libraries/array +++ b/libraries/array @@ -1 +1 @@ -Subproject commit 26ff04744117b0ad8233a1a2b5635fa1277b88d9 +Subproject commit 7784c531e2fc8ae7e544ce50293a6108005cedd4 diff --git a/libraries/directory b/libraries/directory index 0c64d54..54c677d 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 0c64d5420e54bb871f0407a4ec3155c6be600756 +Subproject commit 54c677d227b278de694b10398404981d64ece62f diff --git a/libraries/filepath b/libraries/filepath index 486373c..57d9b11 160000 --- a/libraries/filepath +++ b/libraries/filepath @@ -1 +1 @@ -Subproject commit 486373cb6bc3de8bf7f0b8532558c5fff32df20a +Subproject commit 57d9b11e4a551588ae5df4013e192ff6ec7812f3 diff --git a/libraries/hpc b/libraries/hpc index d6ac0c5..5a1ee4e 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit d6ac0c532f12d30af778eeb285da9031bb06fddb +Subproject commit 5a1ee4e8a2056beff16f0a3cac2c4da61b96f317 diff --git a/libraries/old-time b/libraries/old-time index 8901741..e816d30 160000 --- a/libraries/old-time +++ b/libraries/old-time @@ -1 +1 @@ -Subproject commit 89017411036b24875393e4fd6ca8ef92fc181ad2 +Subproject commit e816d30ae8c64ccde2dde3063a7420abc922a0d4 diff --git a/libraries/parallel b/libraries/parallel index ce0d167..8df9de9 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit ce0d167561eb612640bced85f2b6f849aeb7fc29 +Subproject commit 8df9de914ea3ab7f47874e53b7e9d7c6af4d7f8e diff --git a/libraries/process b/libraries/process index b39e340..35bf51c 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit b39e340bb1fa887842e99db9824906858515cdf7 +Subproject commit 35bf51cb72baaaeaad22fb340aa9d8c957d2186c diff --git a/libraries/stm b/libraries/stm index 0ba4b10..e8a901f 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 0ba4b104df9f7364efeec22934fb92669824a8ae +Subproject commit e8a901fddc88c6560af34e18a5201deeb8d51557 diff --git a/libraries/unix b/libraries/unix index cdc3ae7..bc48ca8 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit cdc3ae7b087ac7451298a5b87fe2548fb74c2fdc +Subproject commit bc48ca82deb23f6985579b7a50d205632cfd5d46 From git at git.haskell.org Thu Jun 26 22:27:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jun 2014 22:27:34 +0000 (UTC) Subject: [commit: ghc] master: s/KnownLit/KnownSymbol/g and a typo fix (af913ad) Message-ID: <20140626222734.8833F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af913ad24afda66762bc05949dc50bcd01da257d/ghc >--------------------------------------------------------------- commit af913ad24afda66762bc05949dc50bcd01da257d Author: Gabor Greif Date: Fri Jun 27 00:11:14 2014 +0200 s/KnownLit/KnownSymbol/g and a typo fix >--------------------------------------------------------------- af913ad24afda66762bc05949dc50bcd01da257d compiler/typecheck/TcEvidence.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs index 45f52d4..7fc6194 100644 --- a/compiler/typecheck/TcEvidence.lhs +++ b/compiler/typecheck/TcEvidence.lhs @@ -596,7 +596,7 @@ data EvTerm -- dictionaries, even though the former have no -- selector Id. We count up from _0_ - | EvLit EvLit -- Dictionary for KnownNat and KnownLit classes. + | EvLit EvLit -- Dictionary for KnownNat and KnownSymbol classes. -- Note [KnownNat & KnownSymbol and EvLit] deriving( Data.Data, Data.Typeable) @@ -653,7 +653,7 @@ Conclusion: a new wanted coercion variable should be made mutable. Note [KnownNat & KnownSymbol and EvLit] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A part of the type-level literals implementation are the classes -"KnownNat" and "KnownLit", which provide a "smart" constructor for +"KnownNat" and "KnownSymbol", which provide a "smart" constructor for defining singleton values. Here is the key stuff from GHC.TypeLits class KnownNat (n :: Nat) where @@ -694,7 +694,7 @@ especialy when the `KnowNat` evidence is packaged up in an existential. The story for kind `Symbol` is analogous: * class KnownSymbol - * newypte SSymbol + * newtype SSymbol * Evidence: EvLit (EvStr n) From git at git.haskell.org Fri Jun 27 08:19:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 08:19:15 +0000 (UTC) Subject: [commit: ghc] master: More allDistinctTyVars from TcDeriv to Type (0451f91) Message-ID: <20140627081915.A1B7D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0451f9137a73777170cd797406a1afb67cfb8916/ghc >--------------------------------------------------------------- commit 0451f9137a73777170cd797406a1afb67cfb8916 Author: Simon Peyton Jones Date: Tue Jun 24 22:19:24 2014 +0100 More allDistinctTyVars from TcDeriv to Type Just a minor refactoring >--------------------------------------------------------------- 0451f9137a73777170cd797406a1afb67cfb8916 compiler/typecheck/TcDeriv.lhs | 10 ---------- compiler/types/Type.lhs | 13 +++++++++++-- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 492a99e..1d7936d 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -1444,16 +1444,6 @@ cond_functorOK allowFunctions (_, rep_tc, _) functions = ptext (sLit "must not contain function types") wrong_arg = ptext (sLit "must use the type variable only as the last argument of a data type") -allDistinctTyVars :: [KindOrType] -> Bool -allDistinctTyVars tkvs = go emptyVarSet tkvs - where - go _ [] = True - go so_far (ty : tys) - = case getTyVar_maybe ty of - Nothing -> False - Just tv | tv `elemVarSet` so_far -> False - | otherwise -> go (so_far `extendVarSet` tv) tys - checkFlag :: ExtensionFlag -> Condition checkFlag flag (dflags, _, _) | xopt flag dflags = Nothing diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 808216f..55df6432 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -36,7 +36,7 @@ module Type ( mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, mkPiKinds, mkPiType, mkPiTypes, - applyTy, applyTys, applyTysD, isForAllTy, dropForAlls, + applyTy, applyTys, applyTysD, dropForAlls, mkNumLitTy, isNumLitTy, mkStrLitTy, isStrLitTy, @@ -63,7 +63,7 @@ module Type ( funTyCon, -- ** Predicates on types - isTypeVar, isKindVar, + isTypeVar, isKindVar, allDistinctTyVars, isForAllTy, isTyVarTy, isFunTy, isDictTy, isPredTy, isVoidTy, -- (Lifting and boxity) @@ -323,6 +323,15 @@ getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty' getTyVar_maybe (TyVarTy tv) = Just tv getTyVar_maybe _ = Nothing +allDistinctTyVars :: [KindOrType] -> Bool +allDistinctTyVars tkvs = go emptyVarSet tkvs + where + go _ [] = True + go so_far (ty : tys) + = case getTyVar_maybe ty of + Nothing -> False + Just tv | tv `elemVarSet` so_far -> False + | otherwise -> go (so_far `extendVarSet` tv) tys \end{code} From git at git.haskell.org Fri Jun 27 08:19:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 08:19:18 +0000 (UTC) Subject: [commit: ghc] master: In TcValidity.checkAmbiguity, skolemise kind vars that appear free in the kinds of type variables (2be99d2) Message-ID: <20140627081918.39C882406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2be99d2309471bc75ddb9cb47acda9ccbcb7ab63/ghc >--------------------------------------------------------------- commit 2be99d2309471bc75ddb9cb47acda9ccbcb7ab63 Author: Simon Peyton Jones Date: Tue Jun 24 22:23:29 2014 +0100 In TcValidity.checkAmbiguity, skolemise kind vars that appear free in the kinds of type variables This was shown up by Trac #9222. >--------------------------------------------------------------- 2be99d2309471bc75ddb9cb47acda9ccbcb7ab63 compiler/typecheck/TcValidity.lhs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index 55498d8..8f6a773 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -74,11 +74,16 @@ checkAmbiguity ctxt ty | otherwise = do { traceTc "Ambiguity check for" (ppr ty) - ; (subst, _tvs) <- tcInstSkolTyVars (varSetElems (tyVarsOfType ty)) + ; let free_tkvs = varSetElemsKvsFirst (closeOverKinds (tyVarsOfType ty)) + ; (subst, _tvs) <- tcInstSkolTyVars free_tkvs ; let ty' = substTy subst ty - -- The type might have free TyVars, - -- so we skolemise them as TcTyVars + -- The type might have free TyVars, esp when the ambiguity check + -- happens during a call to checkValidType, + -- so we skolemise them as TcTyVars. -- Tiresome; but the type inference engine expects TcTyVars + -- NB: The free tyvar might be (a::k), so k is also free + -- and we must skolemise it as well. Hence closeOverKinds. + -- (Trac #9222) -- Solve the constraints eagerly because an ambiguous type -- can cause a cascade of further errors. Since the free From git at git.haskell.org Fri Jun 27 10:40:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 10:40:20 +0000 (UTC) Subject: [commit: ghc] master: Fix docs typo. (fe0cbe4) Message-ID: <20140627104020.9E9472406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe0cbe48f2ec8f2ed8d1029c593220ae85324083/ghc >--------------------------------------------------------------- commit fe0cbe48f2ec8f2ed8d1029c593220ae85324083 Author: Edward Z. Yang Date: Fri Jun 27 11:40:08 2014 +0100 Fix docs typo. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- fe0cbe48f2ec8f2ed8d1029c593220ae85324083 docs/users_guide/phases.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml index 0326af1..8a5589a 100644 --- a/docs/users_guide/phases.xml +++ b/docs/users_guide/phases.xml @@ -589,7 +589,7 @@ $ cat foo.hspp Always write interface files. GHC will normally write interface files automatically, but this flag is useful with - , which normally suppresses generation of interface files. This is useful if you want to type check over multiple runs of GHC without compiling dependencies. From git at git.haskell.org Fri Jun 27 12:33:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 12:33:57 +0000 (UTC) Subject: [commit: ghc] master: Refactor extension-bitmap in Lexer (b80d573) Message-ID: <20140627123357.EB6402406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b80d5739361b5879a25de8497ae08dd0bfdbf627/ghc >--------------------------------------------------------------- commit b80d5739361b5879a25de8497ae08dd0bfdbf627 Author: Herbert Valerio Riedel Date: Sat Jun 21 17:04:32 2014 +0200 Refactor extension-bitmap in Lexer This introduces an Enum type `ExtBits` for the currently used 32 flags and introduces a type-synonym `ExtsBitmap` for representing a set over `ExtBits`. While at it, the current `Int` was replaced by `Word` to have the compiler catch any missed use-sites. This will make it easy to swap the `Word`-representation of `ExtsBitmap` by something different, such as e.g. a `Word64` Test Plan: successful validate Differential Revision: https://phabricator.haskell.org/D23 >--------------------------------------------------------------- b80d5739361b5879a25de8497ae08dd0bfdbf627 compiler/parser/Lexer.x | 369 +++++++++++++++++++++++------------------------- 1 file changed, 173 insertions(+), 196 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b80d5739361b5879a25de8497ae08dd0bfdbf627 From git at git.haskell.org Fri Jun 27 12:53:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 12:53:55 +0000 (UTC) Subject: [commit: ghc] master: Make -fno-write-interface to all modes of GHC, not just -fno-code. (05120ec) Message-ID: <20140627125355.836312406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/05120ecd95b2ebf9b096a95304793cd78be9506e/ghc >--------------------------------------------------------------- commit 05120ecd95b2ebf9b096a95304793cd78be9506e Author: Edward Z. Yang Date: Fri Jun 27 13:48:19 2014 +0100 Make -fno-write-interface to all modes of GHC, not just -fno-code. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 05120ecd95b2ebf9b096a95304793cd78be9506e compiler/main/DriverPipeline.hs | 3 +-- compiler/main/HscMain.hs | 9 +++++---- testsuite/tests/driver/Makefile | 6 ++++++ testsuite/tests/driver/all.T | 1 + 4 files changed, 13 insertions(+), 6 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 11427e2..b7cb412 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -229,8 +229,7 @@ compileOne' m_tc_result mHscMessage hm_linkable = Just linkable }) HscNothing -> do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash - when (gopt Opt_WriteInterface dflags) $ - hscWriteIface dflags iface changed summary + hscWriteIface dflags iface changed summary let linkable = if isHsBoot src_flavour then maybe_old_linkable else Just (LM (ms_hs_date summary) this_mod []) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index aef6007..5d60559 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -624,9 +624,8 @@ hscCompileOneShot' hsc_env mod_summary src_changed dflags <- getDynFlags case hscTarget dflags of HscNothing -> do - when (gopt Opt_WriteInterface dflags) $ liftIO $ do - (iface, changed, _details) <- hscSimpleIface hsc_env tc_result mb_old_hash - hscWriteIface dflags iface changed mod_summary + (iface, changed, _) <- hscSimpleIface' tc_result mb_old_hash + liftIO $ hscWriteIface dflags iface changed mod_summary return HscNotGeneratingCode _ -> case ms_hsc_src mod_summary of @@ -1107,7 +1106,9 @@ hscNormalIface' simpl_result mb_old_iface = do -------------------------------------------------------------- hscWriteIface :: DynFlags -> ModIface -> Bool -> ModSummary -> IO () -hscWriteIface dflags iface no_change mod_summary = do +hscWriteIface dflags iface no_change mod_summary + | not (gopt Opt_WriteInterface dflags) = return () + | otherwise = do let ifaceFile = ml_hi_file (ms_location mod_summary) unless no_change $ {-# SCC "writeIface" #-} diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 62aa2f9..06821d8 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -578,3 +578,9 @@ write_interface_make: $(RM) -rf write_interface_make/A011.hi "$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_make -fno-code -fwrite-interface --make A011.hs test -f write_interface_make/A011.hi + +.PHONY: no_write_interface +no_write_interface: + $(RM) -rf no_write_interface/A011.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -hidir no_write_interface -fno-write-interface -c A011.hs + ! test -f no_write_interface/A011.hi diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 7236ec1..52b6e93 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -406,3 +406,4 @@ test('T9050', normal, build_T9050, []) test('write_interface_oneshot', normal, run_command, ['$MAKE -s --no-print-directory write_interface_oneshot']) test('write_interface_make', normal, run_command, ['$MAKE -s --no-print-directory write_interface_make']) +test('no_write_interface', normal, run_command, ['$MAKE -s --no-print-directory no_write_interface']) From git at git.haskell.org Fri Jun 27 13:06:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 13:06:58 +0000 (UTC) Subject: [commit: ghc] master: Revert "Make -fno-write-interface to all modes of GHC, not just -fno-code." (5031772) Message-ID: <20140627130658.9F5FE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5031772861a64dd2d4f6dc047add31b3231b2a52/ghc >--------------------------------------------------------------- commit 5031772861a64dd2d4f6dc047add31b3231b2a52 Author: Edward Z. Yang Date: Fri Jun 27 14:06:51 2014 +0100 Revert "Make -fno-write-interface to all modes of GHC, not just -fno-code." This reverts commit 05120ecd95b2ebf9b096a95304793cd78be9506e. >--------------------------------------------------------------- 5031772861a64dd2d4f6dc047add31b3231b2a52 compiler/main/DriverPipeline.hs | 3 ++- compiler/main/HscMain.hs | 9 ++++----- testsuite/tests/driver/Makefile | 6 ------ testsuite/tests/driver/all.T | 1 - 4 files changed, 6 insertions(+), 13 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index b7cb412..11427e2 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -229,7 +229,8 @@ compileOne' m_tc_result mHscMessage hm_linkable = Just linkable }) HscNothing -> do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash - hscWriteIface dflags iface changed summary + when (gopt Opt_WriteInterface dflags) $ + hscWriteIface dflags iface changed summary let linkable = if isHsBoot src_flavour then maybe_old_linkable else Just (LM (ms_hs_date summary) this_mod []) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 5d60559..aef6007 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -624,8 +624,9 @@ hscCompileOneShot' hsc_env mod_summary src_changed dflags <- getDynFlags case hscTarget dflags of HscNothing -> do - (iface, changed, _) <- hscSimpleIface' tc_result mb_old_hash - liftIO $ hscWriteIface dflags iface changed mod_summary + when (gopt Opt_WriteInterface dflags) $ liftIO $ do + (iface, changed, _details) <- hscSimpleIface hsc_env tc_result mb_old_hash + hscWriteIface dflags iface changed mod_summary return HscNotGeneratingCode _ -> case ms_hsc_src mod_summary of @@ -1106,9 +1107,7 @@ hscNormalIface' simpl_result mb_old_iface = do -------------------------------------------------------------- hscWriteIface :: DynFlags -> ModIface -> Bool -> ModSummary -> IO () -hscWriteIface dflags iface no_change mod_summary - | not (gopt Opt_WriteInterface dflags) = return () - | otherwise = do +hscWriteIface dflags iface no_change mod_summary = do let ifaceFile = ml_hi_file (ms_location mod_summary) unless no_change $ {-# SCC "writeIface" #-} diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 06821d8..62aa2f9 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -578,9 +578,3 @@ write_interface_make: $(RM) -rf write_interface_make/A011.hi "$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_make -fno-code -fwrite-interface --make A011.hs test -f write_interface_make/A011.hi - -.PHONY: no_write_interface -no_write_interface: - $(RM) -rf no_write_interface/A011.hi - "$(TEST_HC)" $(TEST_HC_OPTS) -hidir no_write_interface -fno-write-interface -c A011.hs - ! test -f no_write_interface/A011.hi diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 52b6e93..7236ec1 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -406,4 +406,3 @@ test('T9050', normal, build_T9050, []) test('write_interface_oneshot', normal, run_command, ['$MAKE -s --no-print-directory write_interface_oneshot']) test('write_interface_make', normal, run_command, ['$MAKE -s --no-print-directory write_interface_make']) -test('no_write_interface', normal, run_command, ['$MAKE -s --no-print-directory no_write_interface']) From git at git.haskell.org Fri Jun 27 16:38:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 16:38:01 +0000 (UTC) Subject: [commit: ghc] master: Comments only (f4766c4) Message-ID: <20140627163802.19DA72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f4766c4b4ad10ef7c58bc6b443ec244a07c68bf5/ghc >--------------------------------------------------------------- commit f4766c4b4ad10ef7c58bc6b443ec244a07c68bf5 Author: Gabor Greif Date: Fri Jun 27 18:35:17 2014 +0200 Comments only >--------------------------------------------------------------- f4766c4b4ad10ef7c58bc6b443ec244a07c68bf5 compiler/typecheck/TcEnv.lhs | 2 +- compiler/types/Type.lhs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index be2058f..6020797 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -867,7 +867,7 @@ notFound name ptext (sLit "is not in scope during type checking, but it passed the renamer"), ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl_env)] -- Take case: printing the whole gbl env can - -- cause an infnite loop, in the case where we + -- cause an infinite loop, in the case where we -- are in the middle of a recursive TyCon/Class group; -- so let's just not print it! Getting a loop here is -- very unhelpful, because it hides one compiler bug with another diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 55df6432..ad9e8b5 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -824,7 +824,7 @@ applyTysD doc orig_fun_ty arg_tys = substTyWith (take n_args tvs) arg_tys (mkForAllTys (drop n_args tvs) rho_ty) | otherwise -- Too many type args - = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty ) -- Zero case gives infnite loop! + = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty ) -- Zero case gives infinite loop! applyTysD doc (substTyWith tvs (take n_tvs arg_tys) rho_ty) (drop n_tvs arg_tys) where From git at git.haskell.org Fri Jun 27 18:58:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jun 2014 18:58:29 +0000 (UTC) Subject: [commit: ghc] master: Add -XBinaryLiterals language extension (re #9224) (1c0b5fd) Message-ID: <20140627185829.295F32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c0b5fdc9f2b6ea8166cc565383d4cd20432343c/ghc >--------------------------------------------------------------- commit 1c0b5fdc9f2b6ea8166cc565383d4cd20432343c Author: Herbert Valerio Riedel Date: Sat Jun 21 11:38:17 2014 +0200 Add -XBinaryLiterals language extension (re #9224) Haskell2010 supports - base-10 (prefix-less), - base-8 (via `0[oO]`-prefix), and - base-16 (via `0[xX]`-prefix) integer literals. This commit adds syntax support for base-2 integer literals via the new `0[bB]` prefix. The use of a `0b` prefix for indicating binary literals is known from popular programming languages such as C++14, Perl, Python, Ruby, and Java. This syntax extension is disabled by default and can be enabled via the new `{-# LANGUAGE BinaryLiterals #-}` pragma and/or the new `-XBinaryLiterals` This new extensions requires to upgrade the `ExtsBitmap` type from `Word` to `Word64` as this adds a 33th flag which is not guaranteed to fit into a `Word`. Signed-off-by: Herbert Valerio Riedel Differential Revision: https://phabricator.haskell.org/D22 >--------------------------------------------------------------- 1c0b5fdc9f2b6ea8166cc565383d4cd20432343c compiler/main/DynFlags.hs | 2 ++ compiler/parser/Ctype.lhs | 5 +++- compiler/parser/Lexer.x | 21 ++++++++++++++-- docs/users_guide/7.10.1-notes.xml | 2 +- docs/users_guide/flags.xml | 6 +++++ docs/users_guide/glasgow_exts.xml | 20 +++++++++++++++ testsuite/.gitignore | 3 +++ testsuite/tests/driver/T4437.hs | 1 + .../parser/should_fail/ParserNoBinaryLiterals1.hs | 5 ++++ .../should_fail/ParserNoBinaryLiterals1.stderr | 5 ++++ .../parser/should_fail/ParserNoBinaryLiterals2.hs | 9 +++++++ .../should_fail/ParserNoBinaryLiterals2.stderr | 5 ++++ .../parser/should_fail/ParserNoBinaryLiterals3.hs | 9 +++++++ .../should_fail/ParserNoBinaryLiterals3.stderr | 5 ++++ testsuite/tests/parser/should_fail/all.T | 3 +++ .../tests/parser/should_run/BinaryLiterals0.hs | 19 ++++++++++++++ .../tests/parser/should_run/BinaryLiterals0.stdout | 1 + .../tests/parser/should_run/BinaryLiterals1.hs | 25 +++++++++++++++++++ .../tests/parser/should_run/BinaryLiterals1.stdout | 3 +++ .../tests/parser/should_run/BinaryLiterals2.hs | 29 ++++++++++++++++++++++ .../tests/parser/should_run/BinaryLiterals2.stdout | 4 +++ testsuite/tests/parser/should_run/all.T | 3 +++ 22 files changed, 181 insertions(+), 4 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1c0b5fdc9f2b6ea8166cc565383d4cd20432343c From git at git.haskell.org Sat Jun 28 10:59:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 10:59:15 +0000 (UTC) Subject: [commit: ghc] master: Minor updates to Backpack docs. (ec38f4a) Message-ID: <20140628105915.318A32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ec38f4abd90ec6008aea8214c04a6af4be6814f8/ghc >--------------------------------------------------------------- commit ec38f4abd90ec6008aea8214c04a6af4be6814f8 Author: Edward Z. Yang Date: Thu Jun 26 14:40:45 2014 +0100 Minor updates to Backpack docs. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- ec38f4abd90ec6008aea8214c04a6af4be6814f8 docs/backpack/backpack-impl.tex | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index cd435c0..e172499 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -576,7 +576,8 @@ than \verb|pkg-b_B_b| (package subqualification is necessary because package C may define its own B module after thinning out the import.) One big problem with this proposal is that it doesn't implement applicative -semantics. If there is another package: +semantics beyond compilation units. While modules within a single +compilation will get reused, if there is another package: \begin{verbatim} package pkg-d where @@ -584,11 +585,11 @@ package pkg-d where include pkg-b \end{verbatim} -this will generate its own instance of B, even though it should be the same -as C. Simon was willing to entertain the idea that, well, as long as the -type-checker is able to figure out they are the same, then it might be OK -if we accidentally generate two copies of the code (provided they actually -are the same). +when it is compiled by itself, it will generate its own instance of B, +even though it should be the same as C. Simon was willing to entertain +the idea that, well, as long as the type-checker is able to figure out +they are the same, then it might be OK if we accidentally generate two +copies of the code (provided they actually are the same). \paragraph{The ``upstream'' proposal} The problem with the ``downstream'' proposal is that it always recompiles @@ -612,7 +613,9 @@ package myapp2 where Here, monte-carlo depends on a ``subpart of the myapp2 package'', and it's not entirely clear how monte-carlo should be represented in the installed package database: should myapp2 be carved up into pieces so that subparts -of its package description can be installed to the database? +of its package description can be installed to the database? One notable +thing to note is that these ``stubs'' will never be used by any other packages, +they are strictly local. Another reason you might not be so keen about this proposal is the fact that we have to hit the package database, despite the fact that these From git at git.haskell.org Sat Jun 28 11:11:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 11:11:34 +0000 (UTC) Subject: [commit: ghc] master: Whitespace only (713b271) Message-ID: <20140628111135.021082406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/713b271fdb3c626848e1ae33703d3088ab7336a7/ghc >--------------------------------------------------------------- commit 713b271fdb3c626848e1ae33703d3088ab7336a7 Author: Gabor Greif Date: Mon Jun 16 15:50:45 2014 +0200 Whitespace only >--------------------------------------------------------------- 713b271fdb3c626848e1ae33703d3088ab7336a7 libraries/template-haskell/Language/Haskell/TH.hs | 122 +++++++++++----------- 1 file changed, 61 insertions(+), 61 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs index 5852145..29e3787 100644 --- a/libraries/template-haskell/Language/Haskell/TH.hs +++ b/libraries/template-haskell/Language/Haskell/TH.hs @@ -5,52 +5,52 @@ For other documentation, refer to: -} module Language.Haskell.TH( - -- * The monad and its operations - Q, - runQ, + -- * The monad and its operations + Q, + runQ, -- ** Administration: errors, locations and IO - reportError, -- :: String -> Q () - reportWarning, -- :: String -> Q () - report, -- :: Bool -> String -> Q () - recover, -- :: Q a -> Q a -> Q a - location, -- :: Q Loc - Loc(..), - runIO, -- :: IO a -> Q a - -- ** Querying the compiler - -- *** Reify - reify, -- :: Name -> Q Info - reifyModule, - thisModule, - Info(..), ModuleInfo(..), - InstanceDec, - ParentName, - Arity, - Unlifted, - -- *** Name lookup - lookupTypeName, -- :: String -> Q (Maybe Name) - lookupValueName, -- :: String -> Q (Maybe Name) - -- *** Instance lookup - reifyInstances, - isInstance, + reportError, -- :: String -> Q () + reportWarning, -- :: String -> Q () + report, -- :: Bool -> String -> Q () + recover, -- :: Q a -> Q a -> Q a + location, -- :: Q Loc + Loc(..), + runIO, -- :: IO a -> Q a + -- ** Querying the compiler + -- *** Reify + reify, -- :: Name -> Q Info + reifyModule, + thisModule, + Info(..), ModuleInfo(..), + InstanceDec, + ParentName, + Arity, + Unlifted, + -- *** Name lookup + lookupTypeName, -- :: String -> Q (Maybe Name) + lookupValueName, -- :: String -> Q (Maybe Name) + -- *** Instance lookup + reifyInstances, + isInstance, -- *** Roles lookup reifyRoles, -- *** Annotation lookup reifyAnnotations, AnnLookup(..), - -- * Typed expressions - TExp, unType, - - -- * Names - Name, NameSpace, -- Abstract - -- ** Constructing names - mkName, -- :: String -> Name - newName, -- :: String -> Q Name - -- ** Deconstructing names - nameBase, -- :: Name -> String - nameModule, -- :: Name -> Maybe String - -- ** Built-in names - tupleTypeName, tupleDataName, -- Int -> Name - unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name + -- * Typed expressions + TExp, unType, + + -- * Names + Name, NameSpace, -- Abstract + -- ** Constructing names + mkName, -- :: String -> Name + newName, -- :: String -> Q Name + -- ** Deconstructing names + nameBase, -- :: Name -> String + nameModule, -- :: Name -> Maybe String + -- ** Built-in names + tupleTypeName, tupleDataName, -- Int -> Name + unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name -- * The algebraic data types -- | The lowercase versions (/syntax operators/) of these constructors are @@ -58,11 +58,11 @@ module Language.Haskell.TH( -- quotations (@[| |]@) and splices (@$( ... )@) -- ** Declarations - Dec(..), Con(..), Clause(..), - Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..), - Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..), - FunDep(..), FamFlavour(..), TySynEqn(..), - Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, + Dec(..), Con(..), Clause(..), + Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..), + Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..), + FunDep(..), FamFlavour(..), TySynEqn(..), + Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, -- ** Expressions Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..), -- ** Patterns @@ -78,22 +78,22 @@ module Language.Haskell.TH( -- ** Constructors lifted to 'Q' -- *** Literals - intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL, - charL, stringL, stringPrimL, + intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL, + charL, stringL, stringPrimL, -- *** Patterns - litP, varP, tupP, conP, uInfixP, parensP, infixP, - tildeP, bangP, asP, wildP, recP, - listP, sigP, viewP, - fieldPat, + litP, varP, tupP, conP, uInfixP, parensP, infixP, + tildeP, bangP, asP, wildP, recP, + listP, sigP, viewP, + fieldPat, -- *** Pattern Guards - normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, + normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, -- *** Expressions - dyn, global, varE, conE, litE, appE, uInfixE, parensE, - infixE, infixApp, sectionL, sectionR, - lamE, lam1E, lamCaseE, tupE, condE, multiIfE, letE, caseE, appsE, - listE, sigE, recConE, recUpdE, stringE, fieldExp, + dyn, global, varE, conE, litE, appE, uInfixE, parensE, + infixE, infixApp, sectionL, sectionR, + lamE, lam1E, lamCaseE, tupE, condE, multiIfE, letE, caseE, appsE, + listE, sigE, recConE, recUpdE, stringE, fieldExp, -- **** Ranges fromE, fromThenE, fromToE, fromThenToE, @@ -105,24 +105,24 @@ module Language.Haskell.TH( bindS, letS, noBindS, parS, -- *** Types - forallT, varT, conT, appT, arrowT, equalityT, listT, tupleT, sigT, litT, + forallT, varT, conT, appT, arrowT, equalityT, listT, tupleT, sigT, litT, promotedT, promotedTupleT, promotedNilT, promotedConsT, -- **** Type literals numTyLit, strTyLit, -- **** Strictness - isStrict, notStrict, strictType, varStrictType, + isStrict, notStrict, strictType, varStrictType, -- **** Class Contexts cxt, classP, equalP, normalC, recC, infixC, forallC, -- *** Kinds - varK, conK, tupleK, arrowK, listK, appK, starK, constraintK, + varK, conK, tupleK, arrowK, listK, appK, starK, constraintK, -- *** Roles nominalR, representationalR, phantomR, inferR, -- *** Top Level Declarations -- **** Data - valD, funD, tySynD, dataD, newtypeD, + valD, funD, tySynD, dataD, newtypeD, -- **** Class classD, instanceD, sigD, -- **** Role annotations @@ -138,7 +138,7 @@ module Language.Haskell.TH( ruleVar, typedRuleVar, pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD, - -- * Pretty-printer + -- * Pretty-printer Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType ) where From git at git.haskell.org Sat Jun 28 11:12:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 11:12:59 +0000 (UTC) Subject: [commit: ghc] master: Untabify and M-x whitespace cleanup (4144996) Message-ID: <20140628111259.847012406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/414499655aa07af095ecb243f6edd11e337b1300/ghc >--------------------------------------------------------------- commit 414499655aa07af095ecb243f6edd11e337b1300 Author: Gabor Greif Date: Wed Jun 25 11:52:11 2014 +0200 Untabify and M-x whitespace cleanup >--------------------------------------------------------------- 414499655aa07af095ecb243f6edd11e337b1300 compiler/typecheck/TcGenGenerics.lhs | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 648979b..ea87520 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -7,12 +7,6 @@ The deriving code for the Generic class \begin{code} {-# LANGUAGE CPP, ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details module TcGenGenerics (canDoGenerics, canDoGenerics1, @@ -286,8 +280,8 @@ canDoGenerics tc tc_args then (Just (ppr dc <+> text "must be a vanilla data constructor")) else Nothing) - -- Nor can we do the job if it's an existential data constructor, - -- Nor if the args are polymorphic types (I don't think) + -- Nor can we do the job if it's an existential data constructor, + -- Nor if the args are polymorphic types (I don't think) bad_arg_type ty = isUnLiftedType ty || not (isTauTy ty) mergeErrors :: [Maybe SDoc] -> Maybe SDoc @@ -401,13 +395,13 @@ canDoGenerics1 rep_tc tc_args = \end{code} %************************************************************************ -%* * +%* * \subsection{Generating the RHS of a generic default method} -%* * +%* * %************************************************************************ \begin{code} -type US = Int -- Local unique supply, just a plain Int +type US = Int -- Local unique supply, just a plain Int type Alt = (LPat RdrName, LHsExpr RdrName) -- GenericKind serves to mark if a datatype derives Generic (Gen0) or @@ -821,9 +815,9 @@ genLR_E i n e -- Build a product expression mkProd_E :: GenericKind_DC -- Generic or Generic1? - -> US -- Base for unique names + -> US -- Base for unique names -> [(RdrName, Type)] -- List of variables matched on the lhs and their types - -> LHsExpr RdrName -- Resulting product expression + -> LHsExpr RdrName -- Resulting product expression mkProd_E _ _ [] = mkM1_E (nlHsVar u1DataCon_RDR) mkProd_E gk_ _ varTys = mkM1_E (foldBal prod appVars) -- These M1s are meta-information for the constructor @@ -847,9 +841,9 @@ wrapArg_E (Gen1_DC argVar) (var, ty) = mkM1_E $ converter ty `nlHsApp` nlHsVar v -- Build a product pattern mkProd_P :: GenericKind -- Gen0 or Gen1 - -> US -- Base for unique names - -> [RdrName] -- List of variables to match - -> LPat RdrName -- Resulting product pattern + -> US -- Base for unique names + -> [RdrName] -- List of variables to match + -> LPat RdrName -- Resulting product pattern mkProd_P _ _ [] = mkM1_P (nlNullaryConPat u1DataCon_RDR) mkProd_P gk _ vars = mkM1_P (foldBal prod appVars) -- These M1s are meta-information for the constructor From git at git.haskell.org Sat Jun 28 11:51:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 11:51:12 +0000 (UTC) Subject: [commit: ghc] branch 'wip/generics-propeq' created Message-ID: <20140628115112.B60982406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/generics-propeq Referencing: 69d2a1a29e2c09d86c421dd2c7f3e3471c53eb62 From git at git.haskell.org Sat Jun 28 11:51:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 11:51:15 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: Equip D_Int with a Symbol at the type level (79cf130) Message-ID: <20140628115115.31E442406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/79cf13006b7f50d1bcf5077e97b1e329619b5e3a/ghc >--------------------------------------------------------------- commit 79cf13006b7f50d1bcf5077e97b1e329619b5e3a Author: Gabor Greif Date: Wed Jun 25 12:59:25 2014 +0200 Equip D_Int with a Symbol at the type level >--------------------------------------------------------------- 79cf13006b7f50d1bcf5077e97b1e329619b5e3a libraries/base/GHC/Generics.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 1c81858..683c168 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -7,6 +7,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -562,6 +564,7 @@ module GHC.Generics ( -- We use some base types import GHC.Types +import GHC.TypeLits import Data.Maybe ( Maybe(..) ) import Data.Either ( Either(..) ) @@ -750,10 +753,10 @@ deriving instance Generic1 ((,,,,,,) a b c d e f) -------------------------------------------------------------------------------- -- Int -data D_Int +data D_Int (name :: Symbol) data C_Int -instance Datatype D_Int where +instance Datatype (D_Int "Int") where datatypeName _ = "Int" moduleName _ = "GHC.Int" @@ -761,7 +764,7 @@ instance Constructor C_Int where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Int where - type Rep Int = D1 D_Int (C1 C_Int (S1 NoSelector (Rec0 Int))) + type Rep Int = D1 (D_Int "Int") (C1 C_Int (S1 NoSelector (Rec0 Int))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x From git at git.haskell.org Sat Jun 28 11:51:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 11:51:17 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: start making Generics amenable for propositional equality by parametrizing with Symbol (69d2a1a) Message-ID: <20140628115118.0F5FC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/69d2a1a29e2c09d86c421dd2c7f3e3471c53eb62/ghc >--------------------------------------------------------------- commit 69d2a1a29e2c09d86c421dd2c7f3e3471c53eb62 Author: Gabor Greif Date: Sat Jun 28 13:09:21 2014 +0200 start making Generics amenable for propositional equality by parametrizing with Symbol >--------------------------------------------------------------- 69d2a1a29e2c09d86c421dd2c7f3e3471c53eb62 compiler/prelude/PrelNames.lhs | 9 ++++--- compiler/typecheck/TcGenGenerics.lhs | 49 +++++++++++++++++++++++------------- compiler/types/Kind.lhs | 10 ++++---- libraries/base/GHC/Generics.hs | 11 +++++--- 4 files changed, 51 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 69d2a1a29e2c09d86c421dd2c7f3e3471c53eb62 From git at git.haskell.org Sat Jun 28 12:15:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 12:15:14 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: clean up (9dc1547) Message-ID: <20140628121514.9A0352406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/9dc15479c8ba185218d989ff4715252930c607fb/ghc >--------------------------------------------------------------- commit 9dc15479c8ba185218d989ff4715252930c607fb Author: Gabor Greif Date: Sat Jun 28 14:10:06 2014 +0200 clean up >--------------------------------------------------------------- 9dc15479c8ba185218d989ff4715252930c607fb compiler/typecheck/TcGenGenerics.lhs | 29 +++++++++-------------------- 1 file changed, 9 insertions(+), 20 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index d242218..59bbcad 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -79,7 +79,6 @@ genGenericMetaTyCons tc mod = tc_arits = map dataConSourceArity tc_cons tc_occ = nameOccName tc_name - --d_occ = mkGenD tc_occ c_occ m = mkGenC tc_occ m s_occ m n = mkGenS tc_occ m n @@ -90,20 +89,17 @@ genGenericMetaTyCons tc mod = False -- Not GADT syntax NoParentTyCon - --d_name <- newGlobalBinder mod d_occ loc - --d_tycon <- tcLookupTyCon datTyConName -- "Dat" - --let d_type = mkTyConApp d_tycon [LitTy . StrTyLit . fsLit $ "HEY!"] -- HEYtcLookupTyCon datTyConName -- "Dat" - let d_type d_tycon = mkTyConApp d_tycon [LitTy . StrTyLit $ occNameFS (nameOccName tc_name)] -- HEYtcLookupTyCon datTyConName -- "Dat" + d_tycon <- tcLookupTyCon datTyConName + let d_type = mkTyConApp d_tycon [LitTy . StrTyLit $ occNameFS (nameOccName tc_name)] c_names <- forM (zip [0..] tc_cons) $ \(m,_) -> newGlobalBinder mod (c_occ m) loc s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> newGlobalBinder mod (s_occ m n) loc - let --metaDTyCon = d_tycon -- mkTyCon [] d_name - metaCTyCons = map (mkTyCon []) c_names + let metaCTyCons = map (mkTyCon []) c_names metaSTyCons = map (map (mkTyCon [])) s_names - metaDts = MetaTyCons {-metaDTyCon-}d_type metaCTyCons metaSTyCons + metaDts = MetaTyCons d_type metaCTyCons metaSTyCons -- pprTrace "rep0" (ppr rep0_tycon) $ (,) metaDts `fmap` metaTyConsToDerivStuff tc metaDts @@ -113,7 +109,6 @@ metaTyConsToDerivStuff :: TyCon -> MetaTyCons -> TcM BagDerivStuff metaTyConsToDerivStuff tc metaDts = do loc <- getSrcSpanM dflags <- getDynFlags - dat <- tcLookupTyCon datTyConName -- HERE not good, wrong context! dClas <- tcLookupClass datatypeClassName let new_dfun_name clas tycon = newDFunName clas [mkTyConApp tycon []] loc d_dfun_name <- new_dfun_name dClas tc @@ -142,9 +137,7 @@ metaTyConsToDerivStuff tc metaDts = tys = [ty] -- Datatype - --d_metaTycon = undefined --metaD metaDts - --d_inst = mk_inst dClas d_metaTycon d_dfun_name - d_inst = mk_inst_ty dClas (metaD metaDts dat) d_dfun_name + d_inst = mk_inst_ty dClas (metaD metaDts) d_dfun_name d_binds = InstBindings { ib_binds = dBinds , ib_pragmas = [] , ib_extensions = [] @@ -607,7 +600,6 @@ tc_mkRepTy gk_ tycon metaDts = plus <- tcLookupTyCon sumTyConName times <- tcLookupTyCon prodTyConName comp <- tcLookupTyCon compTyConName - dat <- tcLookupTyCon datTyConName let mkSum' a b = mkTyConApp plus [a,b] mkProd a b = mkTyConApp times [a,b] @@ -615,7 +607,7 @@ tc_mkRepTy gk_ tycon metaDts = mkRec0 a = mkTyConApp rec0 [a] mkRec1 a = mkTyConApp rec1 [a] mkPar1 = mkTyConTy par1 - mkD a = mkTyConApp d1 [metaDTyCon dat, sumP (tyConDataCons a)] + mkD a = mkTyConApp d1 [metaDTy, sumP (tyConDataCons a)] mkC i d a = mkTyConApp c1 [d, prod i (dataConInstOrigArgTys a $ mkTyVarTys $ tyConTyVars tycon) (null (dataConFieldLabels a))] -- This field has no label @@ -653,10 +645,7 @@ tc_mkRepTy gk_ tycon metaDts = {ata_rec0 = mkRec0, ata_par1 = mkPar1, ata_rec1 = mkRec1, ata_comp = mkComp} - - --metaDTyCon = mkTyConTy (metaD metaDts) - --metaDTyCon = TyConApp (metaD metaDts) [LitTy . StrTyLit . fsLit $ "HEY!"] - metaDTyCon = metaD metaDts --mkTyConApp (metaD metaDts) [LitTy . StrTyLit . fsLit $ "HEY!"] + metaDTy = metaD metaDts metaCTyCons = map mkTyConTy (metaC metaDts) metaSTyCons = map (map mkTyConTy) (metaS metaDts) @@ -667,14 +656,14 @@ tc_mkRepTy gk_ tycon metaDts = -------------------------------------------------------------------------------- data MetaTyCons = MetaTyCons { -- One meta datatype per dataype - metaD :: TyCon -> Type --TyCon + metaD :: Type -- One meta datatype per constructor , metaC :: [TyCon] -- One meta datatype per selector per constructor , metaS :: [[TyCon]] } instance Outputable MetaTyCons where - ppr (MetaTyCons d c s) = {-ppr d $$-} vcat (map ppr c) $$ vcat (map ppr (concat s)) + ppr (MetaTyCons d c s) = ppr d $$ vcat (map ppr c) $$ vcat (map ppr (concat s)) metaTyCons2TyCons :: MetaTyCons -> Bag TyCon metaTyCons2TyCons (MetaTyCons d c s) = listToBag ({-d :-} c ++ concat s) From git at git.haskell.org Sat Jun 28 12:15:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 12:15:17 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: conversion for the other primitive data types too (f07536a) Message-ID: <20140628121519.A51F92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/f07536a9489ab3e78c337df63ca1c38247d0ad9c/ghc >--------------------------------------------------------------- commit f07536a9489ab3e78c337df63ca1c38247d0ad9c Author: Gabor Greif Date: Sat Jun 28 14:10:37 2014 +0200 conversion for the other primitive data types too >--------------------------------------------------------------- f07536a9489ab3e78c337df63ca1c38247d0ad9c libraries/base/GHC/Generics.hs | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 12b5bf4..3979964 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -758,7 +758,6 @@ deriving instance Generic1 ((,,,,,,) a b c d e f) -------------------------------------------------------------------------------- -- Int ---data D_Int (name :: Symbol) data C_Int instance Datatype (Dat "Int") where @@ -775,10 +774,9 @@ instance Generic Int where -- Float -data D_Float data C_Float -instance Datatype D_Float where +instance Datatype (Dat "Float") where datatypeName _ = "Float" moduleName _ = "GHC.Float" @@ -786,16 +784,15 @@ instance Constructor C_Float where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Float where - type Rep Float = D1 D_Float (C1 C_Float (S1 NoSelector (Rec0 Float))) + type Rep Float = D1 (Dat "Float") (C1 C_Float (S1 NoSelector (Rec0 Float))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x -- Double -data D_Double data C_Double -instance Datatype D_Double where +instance Datatype (Dat "Double") where datatypeName _ = "Double" moduleName _ = "GHC.Float" @@ -803,16 +800,15 @@ instance Constructor C_Double where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Double where - type Rep Double = D1 D_Double (C1 C_Double (S1 NoSelector (Rec0 Double))) + type Rep Double = D1 (Dat "Double") (C1 C_Double (S1 NoSelector (Rec0 Double))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x -- Char -data D_Char data C_Char -instance Datatype D_Char where +instance Datatype (Dat "Char") where datatypeName _ = "Char" moduleName _ = "GHC.Base" @@ -820,7 +816,7 @@ instance Constructor C_Char where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Char where - type Rep Char = D1 D_Char (C1 C_Char (S1 NoSelector (Rec0 Char))) + type Rep Char = D1 (Dat "Char") (C1 C_Char (S1 NoSelector (Rec0 Char))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x From git at git.haskell.org Sat Jun 28 15:46:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 15:46:38 +0000 (UTC) Subject: [commit: ghc] master: Fix #9245 by always checking hi-boot for consistency if we find one. (0763a2f) Message-ID: <20140628154638.4B3BF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0763a2f2eec4f6d9933fe17ee0d4a3a57823e6bf/ghc >--------------------------------------------------------------- commit 0763a2f2eec4f6d9933fe17ee0d4a3a57823e6bf Author: Edward Z. Yang Date: Sat Jun 28 11:56:08 2014 +0100 Fix #9245 by always checking hi-boot for consistency if we find one. Summary: What this fix does is reorder how we look for hi-boot files: we unconditionally check for an hi-boot file, and if we don't find one, we check the import graph to see if there was circularity. This is as opposed to the previous scheme (check for circularity, then load hi-boot file). This costs us an extra file system access every typecheck, which is not the best. Signed-off-by: Edward Z. Yang Test Plan: Validate and check for compiler regressions in nofib Reviewers: simonpj, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D30 >--------------------------------------------------------------- 0763a2f2eec4f6d9933fe17ee0d4a3a57823e6bf compiler/iface/TcIface.lhs | 40 ++++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 867674b..14eb723 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -344,26 +344,34 @@ tcHiBootIface hsc_src mod else do -- OK, so we're in one-shot mode. - -- In that case, we're read all the direct imports by now, - -- so eps_is_boot will record if any of our imports mention us by - -- way of hi-boot file - { eps <- getEps - ; case lookupUFM (eps_is_boot eps) (moduleName mod) of { - Nothing -> return emptyModDetails ; -- The typical case + -- Re #9245, we always check if there is an hi-boot interface + -- to check consistency against, rather than just when we notice + -- that an hi-boot is necessary due to a circular import. + { read_result <- findAndReadIface + need mod + True -- Hi-boot file - Just (_, False) -> failWithTc moduleLoop ; + ; case read_result of { + Succeeded (iface, _path) -> typecheckIface iface ; + Failed err -> + + -- There was no hi-boot file. But if there is circularity in + -- the module graph, there really should have been one. + -- Since we've read all the direct imports by now, + -- eps_is_boot will record if any of our imports mention the + -- current module, which either means a module loop (not + -- a SOURCE import) or that our hi-boot file has mysteriously + -- disappeared. + do { eps <- getEps + ; case lookupUFM (eps_is_boot eps) (moduleName mod) of + Nothing -> return emptyModDetails -- The typical case + + Just (_, False) -> failWithTc moduleLoop -- Someone below us imported us! -- This is a loop with no hi-boot in the way - Just (_mod, True) -> -- There's a hi-boot interface below us - - do { read_result <- findAndReadIface - need mod - True -- Hi-boot file - - ; case read_result of - Failed err -> failWithTc (elaborate err) - Succeeded (iface, _path) -> typecheckIface iface + Just (_mod, True) -> failWithTc (elaborate err) + -- The hi-boot file has mysteriously disappeared. }}}} where need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod From git at git.haskell.org Sat Jun 28 16:57:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jun 2014 16:57:56 +0000 (UTC) Subject: [commit: ghc] master: Simplify .gitignore files (767b9dd) Message-ID: <20140628165756.2EEAC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/767b9ddf7d2ea2bb99d49372c79be129fc2058ce/ghc >--------------------------------------------------------------- commit 767b9ddf7d2ea2bb99d49372c79be129fc2058ce Author: Herbert Valerio Riedel Date: Sat Jun 28 18:48:20 2014 +0200 Simplify .gitignore files It's a bit confusing to have .gitignore files spread all over the filesystem. This commit tries to consolidate those into one .gitignore file per component. Moreover, we try to describe files to be ignored which happen to have a common identifying pattern by glob patterns. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 767b9ddf7d2ea2bb99d49372c79be129fc2058ce libraries/base/.gitignore | 247 -- libraries/base/tests/.gitignore | 364 ++- libraries/base/tests/Concurrent/.gitignore | 5 - libraries/base/tests/IO/.gitignore | 75 - libraries/base/tests/Numeric/.gitignore | 10 - libraries/base/tests/System/.gitignore | 8 - libraries/base/tests/Text.Printf/.gitignore | 2 - libraries/template-haskell/tests/.gitignore | 18 +- testsuite/.gitignore | 2753 ++++++++++---------- .../tests/annotations/should_compile/th/.gitignore | 1 - testsuite/tests/callarity/perf/.gitignore | 1 - testsuite/tests/callarity/should_run/.gitignore | 1 - testsuite/tests/callarity/unittest/.gitignore | 1 - testsuite/tests/codeGen/should_run/.gitignore | 11 - testsuite/tests/concurrent/should_run/.gitignore | 6 - testsuite/tests/cpranal/should_run/.gitignore | 1 - testsuite/tests/deSugar/should_run/.gitignore | 1 - testsuite/tests/deriving/should_run/.gitignore | 1 - testsuite/tests/driver/.gitignore | 1 - testsuite/tests/driver/T7835/.gitignore | 1 - testsuite/tests/driver/T8526/.gitignore | 1 - testsuite/tests/driver/T8602/.gitignore | 1 - testsuite/tests/ffi/should_run/.gitignore | 1 - testsuite/tests/ghc-api/.gitignore | 3 - testsuite/tests/ghci/scripts/.gitignore | 2 - testsuite/tests/numeric/should_run/.gitignore | 2 - testsuite/tests/patsyn/should_compile/.gitignore | 9 - testsuite/tests/patsyn/should_run/.gitignore | 7 - testsuite/tests/perf/should_run/.gitignore | 8 - testsuite/tests/primops/should_run/.gitignore | 2 - testsuite/tests/quasiquotation/.gitignore | 1 - testsuite/tests/rts/.gitignore | 13 - testsuite/tests/simplCore/should_run/.gitignore | 4 - .../tests/stranal/should_run/T8425/.gitignore | 1 - testsuite/tests/th/.gitignore | 2 - .../tests/typecheck/should_compile/.gitignore | 1 - testsuite/tests/typecheck/should_run/.gitignore | 3 - 37 files changed, 1704 insertions(+), 1865 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 767b9ddf7d2ea2bb99d49372c79be129fc2058ce From git at git.haskell.org Sun Jun 29 06:59:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 06:59:50 +0000 (UTC) Subject: [commit: ghc] master: Add BUILD_DPH variable to GHC build-system (88d85aa) Message-ID: <20140629065950.9FDCD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/88d85aa65ea15d984bf207f82d99928eda0b6c26/ghc >--------------------------------------------------------------- commit 88d85aa65ea15d984bf207f82d99928eda0b6c26 Author: Herbert Valerio Riedel Date: Sat Jun 28 20:23:48 2014 +0200 Add BUILD_DPH variable to GHC build-system Now that the `libraries/dph` submodule is checked out always we need a different way to disable building DPH to save compile-time while developing GHC. This commit adds a new YES/NO Make variable `BUILD_DPH` that can be used inside mk/build.mk to control whether to build libraries/dph or not. The default setting is `BUILD_DPH=YES` (via `mk/config.mk.in`). This also changes `validate`'s flag `--no-dph` to explicitly disable DPH for the current validation run. Signed-off-by: Herbert Valerio Riedel Test Plan: successful validates with `--fast --no-dph` Differential Revision: https://phabricator.haskell.org/D31 >--------------------------------------------------------------- 88d85aa65ea15d984bf207f82d99928eda0b6c26 ghc.mk | 16 +++++++++++++--- mk/build.mk.sample | 3 +++ mk/config.mk.in | 3 +++ validate | 13 ++++++++++--- 4 files changed, 29 insertions(+), 6 deletions(-) diff --git a/ghc.mk b/ghc.mk index 3beab67..e9d7e83 100644 --- a/ghc.mk +++ b/ghc.mk @@ -452,9 +452,17 @@ ifneq "$(CrossCompiling)" "YES" define addExtraPackage ifeq "$2" "-" # Do nothing; this package is already handled above -else ifeq "$2 $$(GhcProfiled)" "dph YES" -# Ignore the package: These packages need TH, which is incompatible -# with a profiled GHC +else ifeq "$2" "dph" +## DPH-specific clause +ifeq "$$(GhcProfiled)" "YES" +# Ignore package: The DPH packages need TH, which is incompatible with +# a profiled GHC +else ifneq "$$(BUILD_DPH)" "YES" +# Ignore package: DPH was disabled +else +PACKAGES_STAGE2 += $1 +endif +## end of DPH-specific clause else PACKAGES_STAGE2 += $1 endif @@ -635,8 +643,10 @@ ifneq "$(CLEANING)" "YES" BUILD_DIRS += $(patsubst %, libraries/%, $(PACKAGES_STAGE2)) BUILD_DIRS += $(patsubst %, libraries/%, $(PACKAGES_STAGE1)) BUILD_DIRS += $(patsubst %, libraries/%, $(filter-out $(PACKAGES_STAGE1),$(PACKAGES_STAGE0))) +ifeq "$(BUILD_DPH)" "YES" BUILD_DIRS += $(wildcard libraries/dph) endif +endif ifeq "$(INTEGER_LIBRARY)" "integer-gmp" diff --git a/mk/build.mk.sample b/mk/build.mk.sample index 3d47bbe..a323884 100644 --- a/mk/build.mk.sample +++ b/mk/build.mk.sample @@ -66,6 +66,9 @@ V = 1 # working on stage 2 and want to freeze stage 1 and the libraries for # a while. +# Uncomment the following line to disable building DPH +#BUILD_DPH=NO + GhcLibWays = $(if $(filter $(DYNAMIC_GHC_PROGRAMS),YES),v dyn,v) # ----------- A Performance/Distribution build -------------------------------- diff --git a/mk/config.mk.in b/mk/config.mk.in index afe48ab..7a73d46 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -790,6 +790,9 @@ else HSCOLOUR_SRCS = YES endif +# Build DPH? +BUILD_DPH = YES + ################################################################################ # # Library configure arguments diff --git a/validate b/validate index 889c0e8..cabb86c 100755 --- a/validate +++ b/validate @@ -22,9 +22,10 @@ Flags: --fast Omit dyn way, omit binary distribution --slow Build stage2 with -DDEBUG. 2008-07-01: 14% slower than the default. - --no-dph: Skip requiring libraries/dph. In --slow mode, these tests - can take a substantial amount of time, and on some platforms - with broken linkers, we don't want to try compiling it. + --no-dph: Skip building libraries/dph and running associated tests. + In --slow mode, these tests can take a substantial amount + of time, and on some platforms with broken linkers, we + don't want to try compiling it. --help shows this usage help. Set environment variable 'CPUS' to number of cores, to exploit @@ -135,6 +136,12 @@ echo "Validating=YES" > mk/are-validating.mk echo "ValidateSpeed=$speed" >> mk/are-validating.mk echo "ValidateHpc=$hpc" >> mk/are-validating.mk +if [ $skip_dph -eq 1 ]; then + echo "BUILD_DPH=NO" >> mk/are-validating.mk +else + echo "BUILD_DPH=YES" >> mk/are-validating.mk +fi + $make -j$threads # For a "debug make", add "--debug=b --debug=m" From git at git.haskell.org Sun Jun 29 08:12:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 08:12:46 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: equip Dat with a module index (a Symbol) (28588ad) Message-ID: <20140629081246.595692406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/28588ad753a9eb0cf4f7e52bea422dacaac08d96/ghc >--------------------------------------------------------------- commit 28588ad753a9eb0cf4f7e52bea422dacaac08d96 Author: Gabor Greif Date: Sun Jun 29 10:11:23 2014 +0200 equip Dat with a module index (a Symbol) >--------------------------------------------------------------- 28588ad753a9eb0cf4f7e52bea422dacaac08d96 compiler/typecheck/TcGenGenerics.lhs | 4 ++-- libraries/base/GHC/Generics.hs | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 59bbcad..6f9f912 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -25,7 +25,7 @@ import TyCon import TypeRep import FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom ) import FamInst -import Module ( Module, moduleName, moduleNameString ) +import Module ( Module, moduleName, moduleNameString, moduleNameFS ) import IfaceEnv ( newGlobalBinder ) import Name hiding ( varName ) import RdrName @@ -90,7 +90,7 @@ genGenericMetaTyCons tc mod = NoParentTyCon d_tycon <- tcLookupTyCon datTyConName - let d_type = mkTyConApp d_tycon [LitTy . StrTyLit $ occNameFS (nameOccName tc_name)] + let d_type = mkTyConApp d_tycon [LitTy . StrTyLit . moduleNameFS . moduleName $ mod, LitTy . StrTyLit $ occNameFS (nameOccName tc_name)] c_names <- forM (zip [0..] tc_cons) $ \(m,_) -> newGlobalBinder mod (c_occ m) loc s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 3979964..fd97ad8 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -581,7 +581,7 @@ import Data.Proxy -- Representation types -------------------------------------------------------------------------------- -data Dat (name :: Symbol) +data Dat (mod :: Symbol) (name :: Symbol) -- | Void: used for datatypes without constructors data V1 p @@ -760,7 +760,7 @@ deriving instance Generic1 ((,,,,,,) a b c d e f) -- Int data C_Int -instance Datatype (Dat "Int") where +instance Datatype (Dat "GHC.Int" "Int") where datatypeName _ = "Int" moduleName _ = "GHC.Int" @@ -768,7 +768,7 @@ instance Constructor C_Int where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Int where - type Rep Int = D1 (Dat "Int") (C1 C_Int (S1 NoSelector (Rec0 Int))) + type Rep Int = D1 (Dat "GHC.Int" "Int") (C1 C_Int (S1 NoSelector (Rec0 Int))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x @@ -776,7 +776,7 @@ instance Generic Int where -- Float data C_Float -instance Datatype (Dat "Float") where +instance Datatype (Dat "GHC.Float" "Float") where datatypeName _ = "Float" moduleName _ = "GHC.Float" @@ -784,7 +784,7 @@ instance Constructor C_Float where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Float where - type Rep Float = D1 (Dat "Float") (C1 C_Float (S1 NoSelector (Rec0 Float))) + type Rep Float = D1 (Dat "GHC.Float" "Float") (C1 C_Float (S1 NoSelector (Rec0 Float))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x @@ -792,7 +792,7 @@ instance Generic Float where -- Double data C_Double -instance Datatype (Dat "Double") where +instance Datatype (Dat "GHC.Float" "Double") where datatypeName _ = "Double" moduleName _ = "GHC.Float" @@ -800,7 +800,7 @@ instance Constructor C_Double where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Double where - type Rep Double = D1 (Dat "Double") (C1 C_Double (S1 NoSelector (Rec0 Double))) + type Rep Double = D1 (Dat "GHC.Float" "Double") (C1 C_Double (S1 NoSelector (Rec0 Double))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x @@ -808,7 +808,7 @@ instance Generic Double where -- Char data C_Char -instance Datatype (Dat "Char") where +instance Datatype (Dat "GHC.Base" "Char") where datatypeName _ = "Char" moduleName _ = "GHC.Base" @@ -816,7 +816,7 @@ instance Constructor C_Char where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Char where - type Rep Char = D1 (Dat "Char") (C1 C_Char (S1 NoSelector (Rec0 Char))) + type Rep Char = D1 (Dat "GHC.Base" "Char") (C1 C_Char (S1 NoSelector (Rec0 Char))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x From git at git.haskell.org Sun Jun 29 09:16:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 09:16:34 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: simplify and eliminate warning (060f7c7) Message-ID: <20140629091634.4BCAE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/060f7c7612d910c415f71b2f8a555f1d3500b0a9/ghc >--------------------------------------------------------------- commit 060f7c7612d910c415f71b2f8a555f1d3500b0a9 Author: Gabor Greif Date: Sun Jun 29 10:27:31 2014 +0200 simplify and eliminate warning >--------------------------------------------------------------- 060f7c7612d910c415f71b2f8a555f1d3500b0a9 compiler/typecheck/TcGenGenerics.lhs | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 6f9f912..809434d 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -90,7 +90,8 @@ genGenericMetaTyCons tc mod = NoParentTyCon d_tycon <- tcLookupTyCon datTyConName - let d_type = mkTyConApp d_tycon [LitTy . StrTyLit . moduleNameFS . moduleName $ mod, LitTy . StrTyLit $ occNameFS (nameOccName tc_name)] + let d_type = mkTyConApp d_tycon $ map (LitTy . StrTyLit) + [moduleNameFS . moduleName $ mod, occNameFS . nameOccName $ tc_name] c_names <- forM (zip [0..] tc_cons) $ \(m,_) -> newGlobalBinder mod (c_occ m) loc s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> @@ -123,13 +124,7 @@ metaTyConsToDerivStuff tc metaDts = let safeOverlap = safeLanguageOn dflags (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc - mk_inst clas tc dfun_name - = mkLocalInstance (mkDictFunId dfun_name [] [] clas tys) - (NoOverlap safeOverlap) - [] clas tys - where - tys = [mkTyConTy tc] -- FIXME: simplify - mk_inst_ty clas ty dfun_name + mk_inst clas ty dfun_name = mkLocalInstance (mkDictFunId dfun_name [] [] clas tys) (NoOverlap safeOverlap) [] clas tys @@ -137,7 +132,7 @@ metaTyConsToDerivStuff tc metaDts = tys = [ty] -- Datatype - d_inst = mk_inst_ty dClas (metaD metaDts) d_dfun_name + d_inst = mk_inst dClas (metaD metaDts) d_dfun_name d_binds = InstBindings { ib_binds = dBinds , ib_pragmas = [] , ib_extensions = [] @@ -146,7 +141,7 @@ metaTyConsToDerivStuff tc metaDts = -- Constructor c_metaTycons = metaC metaDts - c_insts = [ mk_inst cClas c ds + c_insts = [ mk_inst cClas (mkTyConTy c) ds | (c, ds) <- myZip1 c_metaTycons c_dfun_names ] c_binds = [ InstBindings { ib_binds = c , ib_pragmas = [] @@ -158,7 +153,7 @@ metaTyConsToDerivStuff tc metaDts = -- Selector s_metaTycons = metaS metaDts - s_insts = map (map (\(s,ds) -> mk_inst sClas s ds)) + s_insts = map (map (\(s,ds) -> mk_inst sClas (mkTyConTy s) ds)) (myZip2 s_metaTycons s_dfun_names) s_binds = [ [ InstBindings { ib_binds = s , ib_pragmas = [] @@ -666,7 +661,7 @@ instance Outputable MetaTyCons where ppr (MetaTyCons d c s) = ppr d $$ vcat (map ppr c) $$ vcat (map ppr (concat s)) metaTyCons2TyCons :: MetaTyCons -> Bag TyCon -metaTyCons2TyCons (MetaTyCons d c s) = listToBag ({-d :-} c ++ concat s) +metaTyCons2TyCons (MetaTyCons _ c s) = listToBag (c ++ concat s) -- Bindings for Datatype, Constructor, and Selector instances From git at git.haskell.org Sun Jun 29 09:22:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 09:22:38 +0000 (UTC) Subject: [commit: ghc] master: Tyop in comment (9b93ac6) Message-ID: <20140629092239.2FF3B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9b93ac66582b2b6dfa9e957f0743180d97a29dc4/ghc >--------------------------------------------------------------- commit 9b93ac66582b2b6dfa9e957f0743180d97a29dc4 Author: Gabor Greif Date: Sun Jun 29 11:20:34 2014 +0200 Tyop in comment >--------------------------------------------------------------- 9b93ac66582b2b6dfa9e957f0743180d97a29dc4 compiler/typecheck/TcGenGenerics.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index ea87520..044d058 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -651,7 +651,7 @@ tc_mkRepTy gk_ tycon metaDts = -- Meta-information -------------------------------------------------------------------------------- -data MetaTyCons = MetaTyCons { -- One meta datatype per dataype +data MetaTyCons = MetaTyCons { -- One meta datatype per datatype metaD :: TyCon -- One meta datatype per constructor , metaC :: [TyCon] From git at git.haskell.org Sun Jun 29 11:29:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 11:29:44 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: testing waters with indexed constructors (a665402) Message-ID: <20140629112944.D62F92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/a66540240a3c2dfe86c2ef5a0d335efe150aaf8f/ghc >--------------------------------------------------------------- commit a66540240a3c2dfe86c2ef5a0d335efe150aaf8f Author: Gabor Greif Date: Sun Jun 29 12:23:34 2014 +0200 testing waters with indexed constructors * first index is the datatype context * second is the name of the constructor (Note: for these datatypes we cannot (easily) enumerate all the distinct constructors, so we specify the empty symbol, meaning an abstract constuctor (in 'gdiff' parlance)) >--------------------------------------------------------------- a66540240a3c2dfe86c2ef5a0d335efe150aaf8f libraries/base/GHC/Generics.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index fd97ad8..7bb1ed0 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -546,7 +546,7 @@ module GHC.Generics ( ----------------------------------------------------------------------------- -- * Datatype representation types - Dat, + Dat, Constr, -- * Generic representation types V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..) @@ -583,6 +583,8 @@ import Data.Proxy data Dat (mod :: Symbol) (name :: Symbol) +data Constr ctx (name :: Symbol) + -- | Void: used for datatypes without constructors data V1 p @@ -758,7 +760,7 @@ deriving instance Generic1 ((,,,,,,) a b c d e f) -------------------------------------------------------------------------------- -- Int -data C_Int +type C_Int = Constr (Dat "GHC.Int" "Int") "" instance Datatype (Dat "GHC.Int" "Int") where datatypeName _ = "Int" @@ -774,7 +776,7 @@ instance Generic Int where -- Float -data C_Float +type C_Float = Constr (Dat "GHC.Float" "Float") "" instance Datatype (Dat "GHC.Float" "Float") where datatypeName _ = "Float" @@ -790,7 +792,7 @@ instance Generic Float where -- Double -data C_Double +type C_Double = Constr (Dat "GHC.Float" "Double") "" instance Datatype (Dat "GHC.Float" "Double") where datatypeName _ = "Double" @@ -806,7 +808,7 @@ instance Generic Double where -- Char -data C_Char +type C_Char = Constr (Dat "GHC.Base" "Char") "" instance Datatype (Dat "GHC.Base" "Char") where datatypeName _ = "Char" From git at git.haskell.org Sun Jun 29 11:29:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 11:29:47 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: actually create the indexed Constr descriptions (711503c) Message-ID: <20140629112947.658322406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/711503c6dada380db2ce549281785267a632345d/ghc >--------------------------------------------------------------- commit 711503c6dada380db2ce549281785267a632345d Author: Gabor Greif Date: Sun Jun 29 13:29:15 2014 +0200 actually create the indexed Constr descriptions >--------------------------------------------------------------- 711503c6dada380db2ce549281785267a632345d compiler/prelude/PrelNames.lhs | 10 +++++++--- compiler/typecheck/TcGenGenerics.lhs | 17 +++++++++-------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 81cba3c..e7408a1 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -353,7 +353,7 @@ genericTyConNames = [ compTyConName, rTyConName, pTyConName, dTyConName, cTyConName, sTyConName, rec0TyConName, par0TyConName, d1TyConName, c1TyConName, s1TyConName, noSelTyConName, - repTyConName, rep1TyConName, datTyConName + repTyConName, rep1TyConName, datTyConName, constrTyConName ] \end{code} @@ -775,7 +775,8 @@ v1TyConName, u1TyConName, par1TyConName, rec1TyConName, compTyConName, rTyConName, pTyConName, dTyConName, cTyConName, sTyConName, rec0TyConName, par0TyConName, d1TyConName, c1TyConName, s1TyConName, noSelTyConName, - repTyConName, rep1TyConName, datTyConName :: Name + repTyConName, rep1TyConName, datTyConName, + constrTyConName :: Name v1TyConName = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey u1TyConName = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey @@ -795,6 +796,7 @@ cTyConName = tcQual gHC_GENERICS (fsLit "C") cTyConKey sTyConName = tcQual gHC_GENERICS (fsLit "S") sTyConKey datTyConName = tcQual gHC_GENERICS (fsLit "Dat") datTyConKey +constrTyConName = tcQual gHC_GENERICS (fsLit "Constr") constrTyConKey rec0TyConName = tcQual gHC_GENERICS (fsLit "Rec0") rec0TyConKey par0TyConName = tcQual gHC_GENERICS (fsLit "Par0") par0TyConKey @@ -1458,7 +1460,8 @@ v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey, compTyConKey, rTyConKey, pTyConKey, dTyConKey, cTyConKey, sTyConKey, rec0TyConKey, par0TyConKey, d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey, - repTyConKey, rep1TyConKey, datTyConKey :: Unique + repTyConKey, rep1TyConKey, datTyConKey, + constrTyConKey :: Unique v1TyConKey = mkPreludeTyConUnique 135 u1TyConKey = mkPreludeTyConUnique 136 @@ -1487,6 +1490,7 @@ noSelTyConKey = mkPreludeTyConUnique 154 repTyConKey = mkPreludeTyConUnique 155 rep1TyConKey = mkPreludeTyConUnique 156 datTyConKey = mkPreludeTyConUnique 157 +constrTyConKey = mkPreludeTyConUnique 158 -- Type-level naturals typeNatKindConNameKey, typeSymbolKindConNameKey, diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 809434d..1e4d42b 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -97,10 +97,11 @@ genGenericMetaTyCons tc mod = s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> newGlobalBinder mod (s_occ m n) loc - let metaCTyCons = map (mkTyCon []) c_names + c_tycon <- tcLookupTyCon constrTyConName + let metaCTys = map (\name -> mkTyConApp c_tycon [d_type, LitTy . StrTyLit . occNameFS . nameOccName $ name]) c_names metaSTyCons = map (map (mkTyCon [])) s_names - metaDts = MetaTyCons d_type metaCTyCons metaSTyCons + metaDts = MetaTyCons d_type metaCTys metaSTyCons -- pprTrace "rep0" (ppr rep0_tycon) $ (,) metaDts `fmap` metaTyConsToDerivStuff tc metaDts @@ -141,7 +142,7 @@ metaTyConsToDerivStuff tc metaDts = -- Constructor c_metaTycons = metaC metaDts - c_insts = [ mk_inst cClas (mkTyConTy c) ds + c_insts = [ mk_inst cClas c ds | (c, ds) <- myZip1 c_metaTycons c_dfun_names ] c_binds = [ InstBindings { ib_binds = c , ib_pragmas = [] @@ -612,9 +613,9 @@ tc_mkRepTy gk_ tycon metaDts = -- Sums and products are done in the same way for both Rep and Rep1 sumP [] = mkTyConTy v1 - sumP l = ASSERT(length metaCTyCons == length l) + sumP l = ASSERT(length metaCTys == length l) foldBal mkSum' [ mkC i d a - | (d,(a,i)) <- zip metaCTyCons (zip l [0..])] + | (d,(a,i)) <- zip metaCTys (zip l [0..])] -- The Bool is True if this constructor has labelled fields prod :: Int -> [Type] -> Bool -> Type prod i [] _ = ASSERT(length metaSTyCons > i) @@ -641,7 +642,7 @@ tc_mkRepTy gk_ tycon metaDts = ata_rec1 = mkRec1, ata_comp = mkComp} metaDTy = metaD metaDts - metaCTyCons = map mkTyConTy (metaC metaDts) + metaCTys = metaC metaDts metaSTyCons = map (map mkTyConTy) (metaS metaDts) return (mkD tycon) @@ -653,7 +654,7 @@ tc_mkRepTy gk_ tycon metaDts = data MetaTyCons = MetaTyCons { -- One meta datatype per dataype metaD :: Type -- One meta datatype per constructor - , metaC :: [TyCon] + , metaC :: [Type] -- One meta datatype per selector per constructor , metaS :: [[TyCon]] } @@ -661,7 +662,7 @@ instance Outputable MetaTyCons where ppr (MetaTyCons d c s) = ppr d $$ vcat (map ppr c) $$ vcat (map ppr (concat s)) metaTyCons2TyCons :: MetaTyCons -> Bag TyCon -metaTyCons2TyCons (MetaTyCons _ c s) = listToBag (c ++ concat s) +metaTyCons2TyCons (MetaTyCons _ _ s) = listToBag (concat s) -- Bindings for Datatype, Constructor, and Selector instances From git at git.haskell.org Sun Jun 29 11:58:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 11:58:31 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal to BinaryLiterals-aware 1.20 version (dab0fa0) Message-ID: <20140629115831.77ED52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dab0fa06fa33eeb45cef16c06c41d6c45b102451/ghc >--------------------------------------------------------------- commit dab0fa06fa33eeb45cef16c06c41d6c45b102451 Author: Herbert Valerio Riedel Date: Sun Jun 29 10:03:35 2014 +0200 Update Cabal to BinaryLiterals-aware 1.20 version In 1c0b5fdc9f2b6ea8166cc565383d4cd20432343c (re #9224) `BinaryLiterals` was temporarily added to T4437's `expectedGhcOnlyExtensions` list. This can now reverted as Cabal has been made aware of `BinaryLiterals` (see haskell/cabal#1970 and haskell/cabal#1972). updates Cabal submodule Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- dab0fa06fa33eeb45cef16c06c41d6c45b102451 libraries/Cabal | 2 +- testsuite/tests/driver/T4437.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 597ed8f..c125342 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 597ed8f613db327cfab958aa64da6c0f9e1ee291 +Subproject commit c125342d4147ffb59c88d43024ae9abfc3a9c96d diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index c6332ea..40ddb4b 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -32,7 +32,6 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", - "BinaryLiterals", "AlternativeLayoutRuleTransitional", "JavaScriptFFI", "PatternSynonyms"] From git at git.haskell.org Sun Jun 29 12:40:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 12:40:39 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: fix the creation of constructor names (43c3228) Message-ID: <20140629124040.7733B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/43c3228ab5fbaa5c5a7f1fc14ca532c4a7a9f0ee/ghc >--------------------------------------------------------------- commit 43c3228ab5fbaa5c5a7f1fc14ca532c4a7a9f0ee Author: Gabor Greif Date: Sun Jun 29 14:38:16 2014 +0200 fix the creation of constructor names >--------------------------------------------------------------- 43c3228ab5fbaa5c5a7f1fc14ca532c4a7a9f0ee compiler/typecheck/TcGenGenerics.lhs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 1e4d42b..c601a85 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -79,7 +79,7 @@ genGenericMetaTyCons tc mod = tc_arits = map dataConSourceArity tc_cons tc_occ = nameOccName tc_name - c_occ m = mkGenC tc_occ m + --c_occ m = mkGenC tc_occ m s_occ m n = mkGenS tc_occ m n mkTyCon tyvars name = ASSERT( isExternalName name ) @@ -92,8 +92,10 @@ genGenericMetaTyCons tc mod = d_tycon <- tcLookupTyCon datTyConName let d_type = mkTyConApp d_tycon $ map (LitTy . StrTyLit) [moduleNameFS . moduleName $ mod, occNameFS . nameOccName $ tc_name] - c_names <- forM (zip [0..] tc_cons) $ \(m,_) -> - newGlobalBinder mod (c_occ m) loc + --c_names <- forM (zip [0..] tc_cons) $ \(m,_) -> + -- newGlobalBinder mod (c_occ m) loc + --let c_names = flip map (zip [0..] tc_cons) $ \(m,con) -> getName con + let c_names = map getName tc_cons s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> newGlobalBinder mod (s_occ m n) loc From git at git.haskell.org Sun Jun 29 12:40:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 12:40:41 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: clean up (a9c9ef6) Message-ID: <20140629124042.0A5572406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/a9c9ef66a68dbd2d659db42a7968f64ff14f3643/ghc >--------------------------------------------------------------- commit a9c9ef66a68dbd2d659db42a7968f64ff14f3643 Author: Gabor Greif Date: Sun Jun 29 14:40:07 2014 +0200 clean up >--------------------------------------------------------------- a9c9ef66a68dbd2d659db42a7968f64ff14f3643 compiler/typecheck/TcGenGenerics.lhs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index c601a85..a711eb5 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -79,7 +79,6 @@ genGenericMetaTyCons tc mod = tc_arits = map dataConSourceArity tc_cons tc_occ = nameOccName tc_name - --c_occ m = mkGenC tc_occ m s_occ m n = mkGenS tc_occ m n mkTyCon tyvars name = ASSERT( isExternalName name ) @@ -92,9 +91,6 @@ genGenericMetaTyCons tc mod = d_tycon <- tcLookupTyCon datTyConName let d_type = mkTyConApp d_tycon $ map (LitTy . StrTyLit) [moduleNameFS . moduleName $ mod, occNameFS . nameOccName $ tc_name] - --c_names <- forM (zip [0..] tc_cons) $ \(m,_) -> - -- newGlobalBinder mod (c_occ m) loc - --let c_names = flip map (zip [0..] tc_cons) $ \(m,con) -> getName con let c_names = map getName tc_cons s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> newGlobalBinder mod (s_occ m n) loc From git at git.haskell.org Sun Jun 29 13:02:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 13:02:56 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: shorten lines (ff9c557) Message-ID: <20140629130256.BA96E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/ff9c5570395bcacf8963149b3a8475f5644ce694/ghc >--------------------------------------------------------------- commit ff9c5570395bcacf8963149b3a8475f5644ce694 Author: Gabor Greif Date: Sun Jun 29 14:44:10 2014 +0200 shorten lines >--------------------------------------------------------------- ff9c5570395bcacf8963149b3a8475f5644ce694 compiler/typecheck/TcGenGenerics.lhs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index a711eb5..8b72430 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -90,13 +90,17 @@ genGenericMetaTyCons tc mod = d_tycon <- tcLookupTyCon datTyConName let d_type = mkTyConApp d_tycon $ map (LitTy . StrTyLit) - [moduleNameFS . moduleName $ mod, occNameFS . nameOccName $ tc_name] + [moduleNameFS . moduleName $ mod, + occNameFS . nameOccName $ tc_name] let c_names = map getName tc_cons s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> newGlobalBinder mod (s_occ m n) loc c_tycon <- tcLookupTyCon constrTyConName - let metaCTys = map (\name -> mkTyConApp c_tycon [d_type, LitTy . StrTyLit . occNameFS . nameOccName $ name]) c_names + let metaCTys = map (\name -> mkTyConApp c_tycon + [d_type, LitTy . StrTyLit . occNameFS + . nameOccName $ name]) + c_names metaSTyCons = map (map (mkTyCon [])) s_names metaDts = MetaTyCons d_type metaCTys metaSTyCons From git at git.haskell.org Sun Jun 29 14:03:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 14:03:26 +0000 (UTC) Subject: [commit: ghc] master: Expect test failure for T8832 on 32bit (re #8832) (40ba3da) Message-ID: <20140629140326.B7EE92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/40ba3daa8ce68eea92f7a42b0c1f6c716636b494/ghc >--------------------------------------------------------------- commit 40ba3daa8ce68eea92f7a42b0c1f6c716636b494 Author: Herbert Valerio Riedel Date: Sun Jun 29 15:49:27 2014 +0200 Expect test failure for T8832 on 32bit (re #8832) Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 40ba3daa8ce68eea92f7a42b0c1f6c716636b494 testsuite/tests/simplCore/should_compile/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 616b6cc..1ebc742 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -198,7 +198,7 @@ test('T5996', ['$MAKE -s --no-print-directory T5996']) test('T8537', normal, compile, ['']) test('T8832', - extra_clean(['T8832.hi', 'T8832a.o']), + [when(wordsize(32), expect_fail), extra_clean(['T8832.hi', 'T8832a.o'])], run_command, ['$MAKE -s --no-print-directory T8832']) test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings']) From git at git.haskell.org Sun Jun 29 14:03:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 14:03:29 +0000 (UTC) Subject: [commit: ghc] master: Update 32bit & 64bit performance numbers (f12075d) Message-ID: <20140629140329.563D62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f12075d3e334ad86c38f383f1e863a91725c8c5c/ghc >--------------------------------------------------------------- commit f12075d3e334ad86c38f383f1e863a91725c8c5c Author: Herbert Valerio Riedel Date: Sun Jun 29 15:53:39 2014 +0200 Update 32bit & 64bit performance numbers Some numbers have decreased but the haddock numbers have generally increased noticeable again (see also last update in 970e5d99fb658b73) This updates all numbers I noticed in the "fast" test-mode, *except* for the T9203 test-case on 32bit, which needs more investigation before bumping due to its significant increase: bytes allocated value is too high: Expected bytes allocated: 50000000 +/-5% Lower bound bytes allocated: 47500000 Upper bound bytes allocated: 52500000 Actual bytes allocated: 85093548 *** unexpected failure for T9203(normal) >--------------------------------------------------------------- f12075d3e334ad86c38f383f1e863a91725c8c5c testsuite/tests/perf/compiler/all.T | 6 ++++-- testsuite/tests/perf/haddock/all.T | 30 ++++++++++++++++++++---------- testsuite/tests/perf/should_run/all.T | 3 ++- 3 files changed, 26 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f12075d3e334ad86c38f383f1e863a91725c8c5c From git at git.haskell.org Sun Jun 29 15:07:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jun 2014 15:07:02 +0000 (UTC) Subject: [commit: ghc] master: Promote TcNullaryTC and TcCoercible to fast tests (26f4192) Message-ID: <20140629150706.737642406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/26f41922e8923185bc77ceb8ef44d23564d29bed/ghc >--------------------------------------------------------------- commit 26f41922e8923185bc77ceb8ef44d23564d29bed Author: Herbert Valerio Riedel Date: Sun Jun 29 16:06:45 2014 +0200 Promote TcNullaryTC and TcCoercible to fast tests I'm wondering whether it's sensible to omit so many typecheck testcases from the default validate test target. As for instance, TcNullaryTC has been failing since its introduction in c63a465011b99eeafbb957074e54c2e6bbf751d9 (re #8993) and it seems to have gone unnoticed so far. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 26f41922e8923185bc77ceb8ef44d23564d29bed testsuite/tests/typecheck/should_run/all.T | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index de37d13..760d5e1 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -12,6 +12,8 @@ test('tcrun003', normal, compile_and_run, ['']) test('tcrun004', normal, compile_and_run, ['']) test('tcrun005', normal, compile_and_run, ['']) test('Defer01', normal, compile_and_run, ['']) +test('TcNullaryTC', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) +test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) # ----------------------------------------------------------------------------- # Skip everything else if fast is on @@ -105,10 +107,8 @@ test('T6117', normal, compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) test('T5913', normal, compile_and_run, ['']) test('T7748', normal, compile_and_run, ['']) -test('TcNullaryTC', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) test('T7861', exit_code(1), compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) -test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) test('T8492', normal, compile_and_run, ['']) test('T8739', normal, compile_and_run, ['']) From git at git.haskell.org Mon Jun 30 00:37:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 00:37:49 +0000 (UTC) Subject: [commit: ghc] master: Factor-out the `OverlapMode` from `OverlapFlag`. (9982715) Message-ID: <20140630003749.2EF9A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9982715002edfd789926fd4ccd42bea284a67939/ghc >--------------------------------------------------------------- commit 9982715002edfd789926fd4ccd42bea284a67939 Author: Iavor S. Diatchki Date: Sun Jun 29 16:34:30 2014 -0700 Factor-out the `OverlapMode` from `OverlapFlag`. This seems a bit cleaner conceptually because the overlap mode and running in safety mode are quite orthogonal. More pragmatically, it also makes it possible to use `OverlapMode` to let programmers pick the overlap mode for individual instances. >--------------------------------------------------------------- 9982715002edfd789926fd4ccd42bea284a67939 compiler/basicTypes/BasicTypes.lhs | 29 +++++++++++++++++++++-------- compiler/typecheck/Inst.lhs | 13 +++++++------ compiler/typecheck/TcGenGenerics.lhs | 4 ++-- compiler/types/InstEnv.lhs | 15 ++++++++------- compiler/utils/Binary.hs | 26 +++++++++++++++++--------- 5 files changed, 55 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9982715002edfd789926fd4ccd42bea284a67939 From git at git.haskell.org Mon Jun 30 00:37:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 00:37:52 +0000 (UTC) Subject: [commit: ghc] master: Overlapable pragmas for individual instances (#9242) (6290eea) Message-ID: <20140630003752.20ED72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6290eeadf61a40f2eb08d0fd7ef1f3b7f9804178/ghc >--------------------------------------------------------------- commit 6290eeadf61a40f2eb08d0fd7ef1f3b7f9804178 Author: Iavor S. Diatchki Date: Sun Jun 29 17:22:16 2014 -0700 Overlapable pragmas for individual instances (#9242) Programmers may provide a pragma immediately after the `instance` keyword to control the overlap/incoherence behavior for individual instances. For example: instance {-# OVERLAP #-} C a where ... I chose this notation, rather than the other two outlined in the ticket for these reasons: 1. Having the pragma after the type looks odd, I think. 2. Having the pragma after there `where` does not work for stand-alone derived instances I have implemented 3 pragams: 1. NO_OVERLAP 2. OVERLAP 3. INCOHERENT These correspond directly to the internal modes currently supported by GHC. If a pragma is specified, it will be used no matter what flags are turned on. For example, putting `NO_OVERLAP` on an instance will mark it as non-overlapping, even if `OVERLAPPIN_INSTANCES` is turned on for the module. >--------------------------------------------------------------- 6290eeadf61a40f2eb08d0fd7ef1f3b7f9804178 compiler/hsSyn/Convert.lhs | 2 +- compiler/hsSyn/HsDecls.lhs | 24 ++++++++++++++++---- compiler/parser/Lexer.x | 6 +++++ compiler/parser/Parser.y.pp | 21 +++++++++++++----- compiler/rename/RnSource.lhs | 7 ++++-- compiler/typecheck/TcDeriv.lhs | 46 +++++++++++++++++++++++++-------------- compiler/typecheck/TcInstDcls.lhs | 5 ++++- 7 files changed, 82 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 6290eeadf61a40f2eb08d0fd7ef1f3b7f9804178 From git at git.haskell.org Mon Jun 30 00:37:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 00:37:54 +0000 (UTC) Subject: [commit: ghc] master: Eliminate `Unify.validKindShape` (#9242) (b7f9b6a) Message-ID: <20140630003754.826102406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7f9b6a7c800da98d5ba17c45df2a589cc999975/ghc >--------------------------------------------------------------- commit b7f9b6a7c800da98d5ba17c45df2a589cc999975 Author: Iavor S. Diatchki Date: Sun Jun 29 17:37:34 2014 -0700 Eliminate `Unify.validKindShape` (#9242) >--------------------------------------------------------------- b7f9b6a7c800da98d5ba17c45df2a589cc999975 compiler/types/Unify.lhs | 38 +------------------------------- libraries/base/Data/Typeable/Internal.hs | 6 +---- 2 files changed, 2 insertions(+), 42 deletions(-) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index 94fdb9c..f44e260 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -39,10 +39,8 @@ import Type import TyCon import TypeRep import Util -import PrelNames(typeNatKindConNameKey, typeSymbolKindConNameKey) -import Unique(hasKey) -import Control.Monad (liftM, ap, unless, guard) +import Control.Monad (liftM, ap) import Control.Applicative (Applicative(..)) \end{code} @@ -175,8 +173,6 @@ match menv subst (TyVarTy tv1) ty2 then Nothing -- Occurs check else do { subst1 <- match_kind menv subst (tyVarKind tv1) (typeKind ty2) -- Note [Matching kinds] - ; guard (validKindShape (tyVarKind tv1) ty2) - -- Note [Kinds Containing Only Literals] ; return (extendVarEnv subst1 tv1' ty2) } | otherwise -- tv1 is not a template tyvar @@ -210,35 +206,6 @@ match _ _ _ _ = Nothing -{- Note [Kinds Containing Only Literals] - -The kinds `Nat` and `Symbol` contain only literal types (e.g., 17, "Hi", etc.). -As such, they can only ever match and unify with a type variable or a literal -type. We check for this during matching and unification, and reject -binding variables to types that have an unacceptable shape. - -This helps us avoid "overlapping instance" errors in the presence of -very general instances. The main motivating example for this is the -implementation of `Typeable`, which contains the instances: - -... => Typeable (f a) where ... -... => Typeable (a :: Nat) where ... - -Without the explicit check these look like they overlap, and are rejected. -The two do not overlap, however, because nothing of kind `Nat` can be -of the form `f a`. --} - -validKindShape :: Kind -> Type -> Bool -validKindShape k ty - | Just (tc,[]) <- splitTyConApp_maybe k - , tc `hasKey` typeNatKindConNameKey || - tc `hasKey` typeSymbolKindConNameKey = case ty of - TyVarTy _ -> True - LitTy _ -> True - _ -> False -validKindShape _ _ = True - -------------- match_kind :: MatchEnv -> TvSubstEnv -> Kind -> Kind -> Maybe TvSubstEnv @@ -689,9 +656,6 @@ uUnrefined subst tv1 ty2 ty2' -- ty2 is not a type variable | otherwise = do { subst' <- unify subst k1 k2 -- Note [Kinds Containing Only Literals] - ; let ki = substTy (mkOpenTvSubst subst') k1 - ; unless (validKindShape ki ty2') - surelyApart ; bindTv subst' tv1 ty2 } -- Bind tyvar to the synonym if poss where k1 = tyVarKind tv1 diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index e962752..93b64ef 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -263,7 +263,7 @@ type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a {-# DEPRECATED Typeable7 "renamed to 'Typeable'" #-} -- deprecated in 7.8 -- | Kind-polymorphic Typeable instance for type application -instance (Typeable s, Typeable a) => Typeable (s a) where +instance {-# INCOHERENT #-} (Typeable s, Typeable a) => Typeable (s a) where typeRep# = \_ -> rep -- Note [Memoising typeOf] where !ty1 = typeRep# (proxy# :: Proxy# s) !ty2 = typeRep# (proxy# :: Proxy# a) @@ -446,8 +446,6 @@ lifted types with infinitely many inhabitants. Indeed, `Nat` is isomorphic to (lifted) `[()]` and `Symbol` is isomorphic to `[Char]`. -} --- See `Note [Kinds Containing Only Literals]` in `types/Unify.hs` for --- an explanation of how we avoid overlap with `Typeable (f a)`. instance KnownNat n => Typeable (n :: Nat) where -- See #9203 for an explanation of why this is written as `\_ -> rep`. typeRep# = \_ -> rep @@ -465,8 +463,6 @@ instance KnownNat n => Typeable (n :: Nat) where mk a b c = a ++ " " ++ b ++ " " ++ c --- See `Note [Kinds Containing Only Literals]` in `types/Unify.hs` for --- an explanation of how we avoid overlap with `Typeable (f a)`. instance KnownSymbol s => Typeable (s :: Symbol) where -- See #9203 for an explanation of why this is written as `\_ -> rep`. typeRep# = \_ -> rep From git at git.haskell.org Mon Jun 30 07:59:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 07:59:56 +0000 (UTC) Subject: [commit: ghc] master: Document #8883 in the release notes (d5c6fd6) Message-ID: <20140630075956.A6B052406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5c6fd6c8525477f869d62d5c71945672b46ee56/ghc >--------------------------------------------------------------- commit d5c6fd6c8525477f869d62d5c71945672b46ee56 Author: Jan Stolarek Date: Mon Jun 30 09:52:16 2014 +0200 Document #8883 in the release notes >--------------------------------------------------------------- d5c6fd6c8525477f869d62d5c71945672b46ee56 docs/users_guide/7.10.1-notes.xml | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index b45721c..6d9b937 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -42,7 +42,20 @@ - TODO FIXME + GHC now checks that all the language extensions required for + the inferred type signatures are explicitly enabled. This + means that if any of the type signatures inferred in your + program requires some language extension you will need to + enable it. The motivation is that adding a missing type + signature inferred by GHC should yield a program that + typechecks. Previously this was not the case. + + + This is a breaking change. Code that used to compile in the + past might fail with an error message requiring some + particular language extension (most likely + , or + ). From git at git.haskell.org Mon Jun 30 08:35:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 08:35:14 +0000 (UTC) Subject: [commit: ghc] master: Remove dead code. Fix comment typo. (abeb2bb) Message-ID: <20140630083514.D229A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/abeb2bbc5f2237783476d53f44e5b7e6490c4e7e/ghc >--------------------------------------------------------------- commit abeb2bbc5f2237783476d53f44e5b7e6490c4e7e Author: Jan Stolarek Date: Mon Jun 30 10:34:36 2014 +0200 Remove dead code. Fix comment typo. >--------------------------------------------------------------- abeb2bbc5f2237783476d53f44e5b7e6490c4e7e compiler/hsSyn/HsExpr.lhs | 4 +--- compiler/hsSyn/HsUtils.lhs | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index aa7923f..69b6df6 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -79,8 +79,6 @@ noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr")) type CmdSyntaxTable id = [(Name, SyntaxExpr id)] -- See Note [CmdSyntaxTable] -noSyntaxTable :: CmdSyntaxTable id -noSyntaxTable = [] \end{code} Note [CmdSyntaxtable] @@ -88,7 +86,7 @@ Note [CmdSyntaxtable] Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps track of the methods needed for a Cmd. -* Before the renamer, this list is 'noSyntaxTable' +* Before the renamer, this list is an empty list * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@ For example, for the 'arr' method diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index ae7866c..42838ef 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -4,7 +4,7 @@ Here we collect a variety of helper functions that construct or analyse HsSyn. All these functions deal with generic HsSyn; functions -which deal with the intantiated versions are located elsewhere: +which deal with the instantiated versions are located elsewhere: Parameterised by Module ---------------- ------------- From git at git.haskell.org Mon Jun 30 12:44:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 12:44:54 +0000 (UTC) Subject: [commit: ghc] master: Revert "Fix obscure problem with using the system linker (#8935)" (aed1723) Message-ID: <20140630124454.6CEE72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aed1723f97e0539d5ab35222b180c1552a5f4cfc/ghc >--------------------------------------------------------------- commit aed1723f97e0539d5ab35222b180c1552a5f4cfc Author: Austin Seipp Date: Mon Jun 30 07:44:31 2014 -0500 Revert "Fix obscure problem with using the system linker (#8935)" This reverts commit 2f8b4c9330b455d4cb31c186c747a7db12a69251. Signed-off-by: Austin Seipp >--------------------------------------------------------------- aed1723f97e0539d5ab35222b180c1552a5f4cfc compiler/ghci/Linker.lhs | 72 ++++++++++++++++-------------------------------- rts/Linker.c | 43 ++++++----------------------- 2 files changed, 32 insertions(+), 83 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc aed1723f97e0539d5ab35222b180c1552a5f4cfc From git at git.haskell.org Mon Jun 30 13:50:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 13:50:10 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Make splitStrProdDmd (and similarly Use) more robust (dfbe251) Message-ID: <20140630135010.9F9DD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/dfbe251a55137d7e3d29438fa2e85d0176e6c9b4/ghc >--------------------------------------------------------------- commit dfbe251a55137d7e3d29438fa2e85d0176e6c9b4 Author: Simon Peyton Jones Date: Mon Jun 30 07:55:59 2014 -0500 Make splitStrProdDmd (and similarly Use) more robust Signed-off-by: Austin Seipp >--------------------------------------------------------------- dfbe251a55137d7e3d29438fa2e85d0176e6c9b4 compiler/basicTypes/Demand.lhs | 49 ++++++------- testsuite/tests/stranal/should_compile/T9208.hs | 98 +++++++++++++++++++++++++ testsuite/tests/stranal/should_compile/all.T | 2 +- 3 files changed, 121 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dfbe251a55137d7e3d29438fa2e85d0176e6c9b4 From git at git.haskell.org Mon Jun 30 13:50:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 13:50:13 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix Trac #9071, an egregious bug in TcDeriv.inferConstraints (f79b5ab) Message-ID: <20140630135013.2D72E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f79b5ab8ba93531009b81d2165378172ec07a8f1/ghc >--------------------------------------------------------------- commit f79b5ab8ba93531009b81d2165378172ec07a8f1 Author: Simon Peyton Jones Date: Tue May 6 08:22:37 2014 +0100 Fix Trac #9071, an egregious bug in TcDeriv.inferConstraints The constraints for Functor don't line up 1-1 with the arguments (they are fetched out from sub-terms of the type), but the surrounding code was mistakenly assuming they were in 1-1 association. (cherry picked from commit 13a330e87cf459311a7f164e1e57baf877741da6) Conflicts: compiler/typecheck/TcDeriv.lhs >--------------------------------------------------------------- f79b5ab8ba93531009b81d2165378172ec07a8f1 compiler/typecheck/TcDeriv.lhs | 34 ++++++++++++++++-------------- compiler/typecheck/TcGenGenerics.lhs | 11 +++++----- compiler/typecheck/TcRnTypes.lhs | 3 ++- testsuite/tests/deriving/should_fail/all.T | 3 +++ 4 files changed, 28 insertions(+), 23 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 8d5a3a1..09218db 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -1094,21 +1094,23 @@ inferConstraints cls inst_tys rep_tc rep_tc_args | otherwise -- The others are a bit more complicated = ASSERT2( equalLength rep_tc_tvs all_rep_tc_args, ppr cls <+> ppr rep_tc ) - return (stupid_constraints ++ extra_constraints - ++ sc_constraints - ++ con_arg_constraints cls get_std_constrained_tys) - + do { traceTc "inferConstraints" (vcat [ppr cls <+> ppr inst_tys, ppr arg_constraints]) + ; return (stupid_constraints ++ extra_constraints + ++ sc_constraints + ++ arg_constraints) } where + arg_constraints = con_arg_constraints cls get_std_constrained_tys + -- Constraints arising from the arguments of each constructor con_arg_constraints cls' get_constrained_tys - = [ mkPredOrigin (DerivOriginDC data_con arg_n) (mkClassPred cls' [arg_ty]) - | data_con <- tyConDataCons rep_tc, - (arg_n, arg_ty) <- - ASSERT( isVanillaDataCon data_con ) - zip [1..] $ - get_constrained_tys $ - dataConInstOrigArgTys data_con all_rep_tc_args, - not (isUnLiftedType arg_ty) ] + = [ mkPredOrigin (DerivOriginDC data_con arg_n) (mkClassPred cls' [inner_ty]) + | data_con <- tyConDataCons rep_tc + , (arg_n, arg_ty) <- ASSERT( isVanillaDataCon data_con ) + zip [1..] $ -- ASSERT is precondition of dataConInstOrigArgTys + dataConInstOrigArgTys data_con all_rep_tc_args + , not (isUnLiftedType arg_ty) + , inner_ty <- get_constrained_tys arg_ty ] + -- No constraints for unlifted types -- See Note [Deriving and unboxed types] @@ -1118,10 +1120,10 @@ inferConstraints cls inst_tys rep_tc rep_tc_args -- (b) The rep_tc_args will be one short is_functor_like = getUnique cls `elem` functorLikeClassKeys - get_std_constrained_tys :: [Type] -> [Type] - get_std_constrained_tys tys - | is_functor_like = concatMap (deepSubtypesContaining last_tv) tys - | otherwise = tys + get_std_constrained_tys :: Type -> [Type] + get_std_constrained_tys ty + | is_functor_like = deepSubtypesContaining last_tv ty + | otherwise = [ty] rep_tc_tvs = tyConTyVars rep_tc last_tv = last rep_tc_tvs diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index d9d92ba..35bf424 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -189,14 +189,13 @@ metaTyConsToDerivStuff tc metaDts = %************************************************************************ \begin{code} -get_gen1_constrained_tys :: TyVar -> [Type] -> [Type] +get_gen1_constrained_tys :: TyVar -> Type -> [Type] -- called by TcDeriv.inferConstraints; generates a list of types, each of which -- must be a Functor in order for the Generic1 instance to work. -get_gen1_constrained_tys argVar = - concatMap $ argTyFold argVar $ ArgTyAlg { - ata_rec0 = const [], - ata_par1 = [], ata_rec1 = const [], - ata_comp = (:)} +get_gen1_constrained_tys argVar + = argTyFold argVar $ ArgTyAlg { ata_rec0 = const [] + , ata_par1 = [], ata_rec1 = const [] + , ata_comp = (:) } {- diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 44dc3fa..bacaba6 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1845,7 +1845,8 @@ pprO TupleOrigin = ptext (sLit "a tuple") pprO NegateOrigin = ptext (sLit "a use of syntactic negation") pprO ScOrigin = ptext (sLit "the superclasses of an instance declaration") pprO DerivOrigin = ptext (sLit "the 'deriving' clause of a data type declaration") -pprO (DerivOriginDC dc n) = hsep [ ptext (sLit "the"), speakNth n, +pprO (DerivOriginDC dc n) = pprTrace "dco" (ppr dc <+> ppr n) $ + hsep [ ptext (sLit "the"), speakNth n, ptext (sLit "field of"), quotes (ppr dc), parens (ptext (sLit "type") <+> quotes (ppr ty)) ] where ty = dataConOrigArgTys dc !! (n-1) diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index d503b6e..99da88a 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -50,3 +50,6 @@ test('T7800', normal, multimod_compile_fail, ['T7800','']) test('T5498', normal, compile_fail, ['']) test('T6147', normal, compile_fail, ['']) test('T8851', normal, compile_fail, ['']) +test('T9071', normal, multimod_compile_fail, ['T9071','']) +test('T9071_2', normal, compile_fail, ['']) + From git at git.haskell.org Mon Jun 30 13:50:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 13:50:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Adding missing test files for #9071 (f68d7b3) Message-ID: <20140630135015.F3F6F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f68d7b33e90c3582428ec4d6f30be4d40687b464/ghc >--------------------------------------------------------------- commit f68d7b33e90c3582428ec4d6f30be4d40687b464 Author: Simon Peyton Jones Date: Tue May 6 09:46:14 2014 +0100 Adding missing test files for #9071 (cherry picked from commit 59b4e6d0ba504b33cc7064d489b8ec485a7703f4) >--------------------------------------------------------------- f68d7b33e90c3582428ec4d6f30be4d40687b464 testsuite/tests/deriving/should_fail/T9071-2.hs | 7 +++++++ testsuite/tests/deriving/should_fail/T9071.hs | 8 ++++++++ testsuite/tests/deriving/should_fail/T9071.stderr | 10 ++++++++++ testsuite/tests/deriving/should_fail/T9071_2.hs | 7 +++++++ testsuite/tests/deriving/should_fail/T9071_2.stderr | 8 ++++++++ testsuite/tests/deriving/should_fail/T9071a.hs | 4 ++++ 6 files changed, 44 insertions(+) diff --git a/testsuite/tests/deriving/should_fail/T9071-2.hs b/testsuite/tests/deriving/should_fail/T9071-2.hs new file mode 100644 index 0000000..7a2f474 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071-2.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DeriveFunctor #-} +module T9071_2 where + +newtype Mu f = Mu (f (Mu f)) + +newtype K1 a b = K1 a +newtype F1 a = F1 (Mu (K1 a)) deriving Functor diff --git a/testsuite/tests/deriving/should_fail/T9071.hs b/testsuite/tests/deriving/should_fail/T9071.hs new file mode 100644 index 0000000..dc64f42 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DeriveFunctor #-} +module T9071 where + +import T9071a + +newtype K a b = K a +newtype F a = F (Mu (K a)) deriving Functor + diff --git a/testsuite/tests/deriving/should_fail/T9071.stderr b/testsuite/tests/deriving/should_fail/T9071.stderr new file mode 100644 index 0000000..259adba --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071.stderr @@ -0,0 +1,10 @@ +[1 of 2] Compiling T9071a ( T9071a.hs, T9071a.o ) +[2 of 2] Compiling T9071 ( T9071.hs, T9071.o ) + +T9071.hs:7:37: + No instance for (Functor K) + arising from the first field of ?F? (type ?Mu (K a)?) + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Functor F) diff --git a/testsuite/tests/deriving/should_fail/T9071_2.hs b/testsuite/tests/deriving/should_fail/T9071_2.hs new file mode 100644 index 0000000..7a2f474 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071_2.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DeriveFunctor #-} +module T9071_2 where + +newtype Mu f = Mu (f (Mu f)) + +newtype K1 a b = K1 a +newtype F1 a = F1 (Mu (K1 a)) deriving Functor diff --git a/testsuite/tests/deriving/should_fail/T9071_2.stderr b/testsuite/tests/deriving/should_fail/T9071_2.stderr new file mode 100644 index 0000000..ae0fcdb --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071_2.stderr @@ -0,0 +1,8 @@ + +T9071_2.hs:7:40: + No instance for (Functor Mu) + arising from the first field of ?F1? (type ?Mu (K1 a)?) + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Functor F1) diff --git a/testsuite/tests/deriving/should_fail/T9071a.hs b/testsuite/tests/deriving/should_fail/T9071a.hs new file mode 100644 index 0000000..bf3a126 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071a.hs @@ -0,0 +1,4 @@ +module T9071a where + +newtype Mu f = Mu (f (Mu f)) + From git at git.haskell.org Mon Jun 30 13:50:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 13:50:18 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Better debug printing (37182fa) Message-ID: <20140630135018.985E02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/37182fa8e6a752b42b8acff5499a5f4cc3346c20/ghc >--------------------------------------------------------------- commit 37182fa8e6a752b42b8acff5499a5f4cc3346c20 Author: Simon Peyton Jones Date: Thu Jun 12 16:35:37 2014 +0100 Better debug printing (cherry picked from commit b60df0fa017eac8800a3848650dbad09acb6f1b8) >--------------------------------------------------------------- 37182fa8e6a752b42b8acff5499a5f4cc3346c20 compiler/basicTypes/OccName.lhs | 7 +++++-- compiler/rename/RnTypes.lhs | 13 +++++++++---- compiler/utils/UniqFM.lhs | 11 +++++++++-- 3 files changed, 23 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index e870c46..370e9ee 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -86,7 +86,7 @@ module OccName ( lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C, extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv, - alterOccEnv, + alterOccEnv, pprOccEnv, -- * The 'OccSet' type OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, @@ -416,7 +416,10 @@ filterOccEnv x (A y) = A $ filterUFM x y alterOccEnv fn (A y) k = A $ alterUFM fn y k instance Outputable a => Outputable (OccEnv a) where - ppr (A x) = ppr x + ppr x = pprOccEnv ppr x + +pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc +pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env type OccSet = UniqSet OccName diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index 23c54c3..bcb6231 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -360,8 +360,9 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside kvs_from_tv_bndrs = [ kv | L _ (KindedTyVar _ kind) <- tvs , let (_, kvs) = extractHsTyRdrTyVars kind , kv <- kvs ] - all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) $ - nub (kv_bndrs ++ kvs_from_tv_bndrs) + all_kvs' = nub (kv_bndrs ++ kvs_from_tv_bndrs) + all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) all_kvs' + overlap_kvs = [ kv | kv <- all_kvs, any ((==) kv . hsLTyVarName) tvs ] -- These variables appear both as kind and type variables -- in the same declaration; eg type family T (x :: *) (y :: x) @@ -395,8 +396,12 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside ; (tv_bndrs', fvs1) <- mapFvRn rn_tv_bndr tvs ; (res, fvs2) <- bindLocalNamesFV (map hsLTyVarName tv_bndrs') $ - do { env <- getLocalRdrEnv - ; traceRn (text "bhtv" <+> (ppr tvs $$ ppr all_kvs $$ ppr env)) + do { inner_rdr_env <- getLocalRdrEnv + ; traceRn (text "bhtv" <+> vcat + [ ppr tvs, ppr kv_bndrs, ppr kvs_from_tv_bndrs + , ppr $ map (`elemLocalRdrEnv` rdr_env) all_kvs' + , ppr $ map (getUnique . rdrNameOcc) all_kvs' + , ppr all_kvs, ppr rdr_env, ppr inner_rdr_env ]) ; thing_inside (HsQTvs { hsq_tvs = tv_bndrs', hsq_kvs = kv_names }) } ; return (res, fvs1 `plusFV` fvs2) } } diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs index 52cd3dd..dd17a49 100644 --- a/compiler/utils/UniqFM.lhs +++ b/compiler/utils/UniqFM.lhs @@ -59,9 +59,10 @@ module UniqFM ( lookupWithDefaultUFM, lookupWithDefaultUFM_Directly, eltsUFM, keysUFM, splitUFM, ufmToList, - joinUFM + joinUFM, pprUniqFM ) where +import FastString import Unique ( Uniquable(..), Unique, getKey ) import Outputable @@ -315,5 +316,11 @@ joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, \begin{code} instance Outputable a => Outputable (UniqFM a) where - ppr ufm = ppr (ufmToList ufm) + ppr ufm = pprUniqFM ppr ufm + +pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc +pprUniqFM ppr_elt ufm + = brackets $ fsep $ punctuate comma $ + [ ppr uq <+> ptext (sLit ":->") <+> ppr_elt elt + | (uq, elt) <- ufmToList ufm ] \end{code} From git at git.haskell.org Mon Jun 30 13:50:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 13:50:20 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix merge fallout, killing validate (2ac7a33) Message-ID: <20140630135020.CD49C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/2ac7a33f0a74b1ac8ffd1d8ffaa38b5a70bec85d/ghc >--------------------------------------------------------------- commit 2ac7a33f0a74b1ac8ffd1d8ffaa38b5a70bec85d Author: Austin Seipp Date: Mon Jun 30 08:42:15 2014 -0500 Fix merge fallout, killing validate Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2ac7a33f0a74b1ac8ffd1d8ffaa38b5a70bec85d compiler/deSugar/DsMeta.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index a0245dd..ad40fc0 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -61,7 +61,6 @@ import DynFlags import FastString import ForeignCall import Util -import TcRnMonad( traceOptIf ) import Data.Maybe import Control.Monad From git at git.haskell.org Mon Jun 30 13:50:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 13:50:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Line up kind and type variables correctly when desugaring TH brackets (1eaaeb7) Message-ID: <20140630135023.6E6442406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/1eaaeb7a01843ee9aacc86354cf886a5a9952123/ghc >--------------------------------------------------------------- commit 1eaaeb7a01843ee9aacc86354cf886a5a9952123 Author: Simon Peyton Jones Date: Thu Jun 12 16:36:59 2014 +0100 Line up kind and type variables correctly when desugaring TH brackets This bug was causing Trac #9199 (cherry picked from commit 571f0adccda687098d59f63524357f4ac98e72fb) Conflicts: testsuite/tests/th/all.T >--------------------------------------------------------------- 1eaaeb7a01843ee9aacc86354cf886a5a9952123 compiler/deSugar/DsMeta.hs | 13 ++++++++----- testsuite/tests/th/T9199.hs | 9 +++++++++ testsuite/tests/th/all.T | 1 + 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 9ee5bc1..a0245dd 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -61,6 +61,7 @@ import DynFlags import FastString import ForeignCall import Util +import TcRnMonad( traceOptIf ) import Data.Maybe import Control.Monad @@ -705,12 +706,14 @@ addTyVarBinds :: LHsTyVarBndrs Name -- the binders to -- the computations passed as the second argument is executed in that extended -- meta environment and gets the *new* names on Core-level as an argument -addTyVarBinds tvs m - = do { freshNames <- mkGenSyms (hsLKiTyVarNames tvs) - ; term <- addBinds freshNames $ - do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs `zip` freshNames) +addTyVarBinds (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs }) m + = do { fresh_kv_names <- mkGenSyms kvs + ; fresh_tv_names <- mkGenSyms (map hsLTyVarName tvs) + ; let fresh_names = fresh_kv_names ++ fresh_tv_names + ; term <- addBinds fresh_names $ + do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (tvs `zip` fresh_tv_names) ; m kbs } - ; wrapGenSyms freshNames term } + ; wrapGenSyms fresh_names term } where mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v) diff --git a/testsuite/tests/th/T9199.hs b/testsuite/tests/th/T9199.hs new file mode 100644 index 0000000..aa41198 --- /dev/null +++ b/testsuite/tests/th/T9199.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell, PolyKinds, TypeFamilies #-} + +module T9160 where + +$( [d| class C (a :: k) where + type F (a :: k) :: * + |] + ) + diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 841b41b..0b1679d 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -323,3 +323,4 @@ test('T8884', normal, compile, ['-v0']) test('T8932', normal, compile_fail, ['-v0']) test('T8954', normal, compile, ['-v0']) test('T7241', normal, compile_fail, ['-v0']) +test('T9199', normal, compile, ['-v0']) From git at git.haskell.org Mon Jun 30 13:50:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 13:50:26 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix elemLocalRdrEnv (Trac #9160) (ff25866) Message-ID: <20140630135026.1E3472406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/ff25866fd3ae9b39ca6559f373ab3b92b75f1780/ghc >--------------------------------------------------------------- commit ff25866fd3ae9b39ca6559f373ab3b92b75f1780 Author: Simon Peyton Jones Date: Thu Jun 12 16:42:37 2014 +0100 Fix elemLocalRdrEnv (Trac #9160) This was pretty obscure. elemLocalRdrEnv was utterly wrong (replied False when it should reply True) when given an Exact Name. That doesn't happen often, but it does happen in the result of a TH splice. The result was that an associated type didn't get a type variable that lined up with its parent class (elemLocalRdrEnv is used in RnTypes.bindHsTyVars), and that messed up the singletons package. I've made a completely different test case to show up the bug: indexed_types/should_fail/T9160 I also refactored RdrName.LocalRdrEnv to be a record with named fields, which makes the code more robust and easy to understand. (cherry picked from commit b637585dcbfc1ba53aa49bcb9b730cd08fea4b59) Conflicts: testsuite/tests/indexed-types/should_fail/all.T >--------------------------------------------------------------- ff25866fd3ae9b39ca6559f373ab3b92b75f1780 compiler/basicTypes/RdrName.lhs | 60 +++++++++++++++------- testsuite/tests/indexed-types/should_fail/T9160.hs | 19 +++++++ .../tests/indexed-types/should_fail/T9160.stderr | 11 ++++ testsuite/tests/indexed-types/should_fail/all.T | 2 +- 4 files changed, 72 insertions(+), 20 deletions(-) diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 4ffeae0..31be827 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -331,49 +331,71 @@ instance Ord RdrName where -- It is keyed by OccName, because we never use it for qualified names -- We keep the current mapping, *and* the set of all Names in scope -- Reason: see Note [Splicing Exact Names] in RnEnv -type LocalRdrEnv = (OccEnv Name, NameSet) +data LocalRdrEnv = LRE { lre_env :: OccEnv Name + , lre_in_scope :: NameSet } + +instance Outputable LocalRdrEnv where + ppr (LRE {lre_env = env, lre_in_scope = ns}) + = hang (ptext (sLit "LocalRdrEnv {")) + 2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env + , ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetToList ns)) + ] <+> char '}') + where + ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name + -- So we can see if the keys line up correctly emptyLocalRdrEnv :: LocalRdrEnv -emptyLocalRdrEnv = (emptyOccEnv, emptyNameSet) +emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv, lre_in_scope = emptyNameSet } extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv -- The Name should be a non-top-level thing -extendLocalRdrEnv (env, ns) name +extendLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) name = WARN( isExternalName name, ppr name ) - ( extendOccEnv env (nameOccName name) name - , addOneToNameSet ns name - ) + LRE { lre_env = extendOccEnv env (nameOccName name) name + , lre_in_scope = addOneToNameSet ns name } extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv -extendLocalRdrEnvList (env, ns) names +extendLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) names = WARN( any isExternalName names, ppr names ) - ( extendOccEnvList env [(nameOccName n, n) | n <- names] - , addListToNameSet ns names - ) + LRE { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names] + , lre_in_scope = addListToNameSet ns names } lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name -lookupLocalRdrEnv (env, _) (Unqual occ) = lookupOccEnv env occ -lookupLocalRdrEnv _ _ = Nothing +lookupLocalRdrEnv (LRE { lre_env = env }) (Unqual occ) = lookupOccEnv env occ +lookupLocalRdrEnv _ _ = Nothing lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name -lookupLocalRdrOcc (env, _) occ = lookupOccEnv env occ +lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool -elemLocalRdrEnv rdr_name (env, _) - | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env - | otherwise = False +elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns }) + = case rdr_name of + Unqual occ -> occ `elemOccEnv` env + Exact name -> name `elemNameSet` ns -- See Note [Local bindings with Exact Names] + Qual {} -> False + Orig {} -> False localRdrEnvElts :: LocalRdrEnv -> [Name] -localRdrEnvElts (env, _) = occEnvElts env +localRdrEnvElts (LRE { lre_env = env }) = occEnvElts env inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool -- This is the point of the NameSet -inLocalRdrEnvScope name (_, ns) = name `elemNameSet` ns +inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv -delLocalRdrEnvList (env, ns) occs = (delListFromOccEnv env occs, ns) +delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs + = LRE { lre_env = delListFromOccEnv env occs + , lre_in_scope = ns } \end{code} +Note [Local bindings with Exact Names] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With Template Haskell we can make local bindings that have Exact Names. +Computing shadowing etc may use elemLocalRdrEnv (at least it certainly +does so in RnTpes.bindHsTyVars), so for an Exact Name we must consult +the in-scope-name-set. + + %************************************************************************ %* * GlobalRdrEnv diff --git a/testsuite/tests/indexed-types/should_fail/T9160.hs b/testsuite/tests/indexed-types/should_fail/T9160.hs new file mode 100644 index 0000000..64ae3b9 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9160.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances, TemplateHaskell, PolyKinds, TypeFamilies #-} + +module T9160 where +import Language.Haskell.TH + +$( do { cls_nm <- newName "C" + ; a_nm <- newName "a" + ; k_nm <- newName "k" + ; f_nm <- newName "F" + ; return [ClassD [] cls_nm [KindedTV a_nm (VarT k_nm)] [] + [FamilyD TypeFam f_nm [] (Just (VarT k_nm))]] } ) + +-- Splices in: +-- class C (a :: k) where +-- type F :: k + +instance C (a :: *) where + type F = Maybe -- Should be illegal + diff --git a/testsuite/tests/indexed-types/should_fail/T9160.stderr b/testsuite/tests/indexed-types/should_fail/T9160.stderr new file mode 100644 index 0000000..7a476d4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9160.stderr @@ -0,0 +1,11 @@ +Loading package ghc-prim ... linking ... done. +Loading package integer-gmp ... linking ... done. +Loading package base ... linking ... done. +Loading package pretty-1.1.1.1 ... linking ... done. +Loading package template-haskell ... linking ... done. + +T9160.hs:18:8: + Type indexes must match class instance head + Found ?* -> *? but expected ?*? + In the type instance declaration for ?F? + In the instance declaration for ?C (a :: *)? diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 54a33cd..5340574 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -119,4 +119,4 @@ test('T8129', test('T8368', normal, compile_fail, ['']) test('T8368a', normal, compile_fail, ['']) test('T8518', normal, compile_fail, ['']) - +test('T9160', normal, compile_fail, ['']) From git at git.haskell.org Mon Jun 30 20:13:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 20:13:38 +0000 (UTC) Subject: [commit: ghc] master: Re-add more primops for atomic ops on byte arrays (4ee4ab0) Message-ID: <20140630201339.3307A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4ee4ab01c1d97845aecb7707ad2f9a80933e7a49/ghc >--------------------------------------------------------------- commit 4ee4ab01c1d97845aecb7707ad2f9a80933e7a49 Author: Johan Tibell Date: Fri Jun 27 13:48:24 2014 +0200 Re-add more primops for atomic ops on byte arrays This is the second attempt to add this functionality. The first attempt was reverted in 950fcae46a82569e7cd1fba1637a23b419e00ecd, due to register allocator failure on x86. Given how the register allocator currently works, we don't have enough registers on x86 to support cmpxchg using complicated addressing modes. Instead we fall back to a simpler addressing mode on x86. Adds the following primops: * atomicReadIntArray# * atomicWriteIntArray# * fetchSubIntArray# * fetchOrIntArray# * fetchXorIntArray# * fetchAndIntArray# Makes these pre-existing out-of-line primops inline: * fetchAddIntArray# * casIntArray# >--------------------------------------------------------------- 4ee4ab01c1d97845aecb7707ad2f9a80933e7a49 compiler/cmm/CmmMachOp.hs | 19 ++ compiler/cmm/CmmSink.hs | 4 + compiler/cmm/PprC.hs | 4 + compiler/codeGen/StgCmmPrim.hs | 94 +++++++ compiler/llvmGen/Llvm/AbsSyn.hs | 7 + compiler/llvmGen/Llvm/PpLlvm.hs | 18 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 71 +++-- compiler/nativeGen/CPrim.hs | 50 +++- compiler/nativeGen/PPC/CodeGen.hs | 4 + compiler/nativeGen/SPARC/CodeGen.hs | 4 + compiler/nativeGen/X86/CodeGen.hs | 110 ++++++++ compiler/nativeGen/X86/Instr.hs | 38 ++- compiler/nativeGen/X86/Ppr.hs | 8 + compiler/prelude/primops.txt.pp | 76 ++++- includes/stg/MiscClosures.h | 1 - libraries/ghc-prim/cbits/atomic.c | 306 +++++++++++++++++++++ libraries/ghc-prim/ghc-prim.cabal | 1 + rts/Linker.c | 1 - rts/PrimOps.cmm | 12 - .../tests/concurrent/should_run/AtomicPrimops.hs | 245 +++++++++++++++++ .../concurrent/should_run/AtomicPrimops.stdout | 7 + testsuite/tests/concurrent/should_run/all.T | 1 + 22 files changed, 1027 insertions(+), 54 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4ee4ab01c1d97845aecb7707ad2f9a80933e7a49 From git at git.haskell.org Mon Jun 30 21:29:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jun 2014 21:29:11 +0000 (UTC) Subject: [commit: ghc] master: Remove extraneous debugging output (#9071) (c44da48) Message-ID: <20140630212911.AC6302406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c44da48c6d19b3d8cc0ba34328576683410f8ec2/ghc >--------------------------------------------------------------- commit c44da48c6d19b3d8cc0ba34328576683410f8ec2 Author: Reid Barton Date: Mon Jun 30 17:27:14 2014 -0400 Remove extraneous debugging output (#9071) >--------------------------------------------------------------- c44da48c6d19b3d8cc0ba34328576683410f8ec2 compiler/typecheck/TcRnTypes.lhs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index d054bc2..bc536c1 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1852,8 +1852,7 @@ pprO TupleOrigin = ptext (sLit "a tuple") pprO NegateOrigin = ptext (sLit "a use of syntactic negation") pprO ScOrigin = ptext (sLit "the superclasses of an instance declaration") pprO DerivOrigin = ptext (sLit "the 'deriving' clause of a data type declaration") -pprO (DerivOriginDC dc n) = pprTrace "dco" (ppr dc <+> ppr n) $ - hsep [ ptext (sLit "the"), speakNth n, +pprO (DerivOriginDC dc n) = hsep [ ptext (sLit "the"), speakNth n, ptext (sLit "field of"), quotes (ppr dc), parens (ptext (sLit "type") <+> quotes (ppr ty)) ] where ty = dataConOrigArgTys dc !! (n-1)