From git at git.haskell.org Mon Feb 2 04:35:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Feb 2015 04:35:23 +0000 (UTC) Subject: [commit: ghc] branch 'typeable-with-kinds' created Message-ID: <20150202043523.498AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : typeable-with-kinds Referencing: 246d2c925d7ffe6a5b61fbdce7372178bf02c217 From git at git.haskell.org Mon Feb 2 04:35:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Feb 2015 04:35:25 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Checkpoint: generate explicit representations for all type constructors. (246d2c9) Message-ID: <20150202043525.EF6F53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/246d2c925d7ffe6a5b61fbdce7372178bf02c217/ghc >--------------------------------------------------------------- commit 246d2c925d7ffe6a5b61fbdce7372178bf02c217 Author: Iavor S. Diatchki Date: Sun Feb 1 20:33:41 2015 -0800 Checkpoint: generate explicit representations for all type constructors. This is probably not quite right yet for the following reasons: - The call to generate tycons is called from withing the code that derives instances. This is incorrect, as nothing is generated when there is nothing to derive. - Currently, the representation of the tycon `Test`, its promoted version (i.e., kind) `Test`, and a promoted *data* constructor, also `Test`, end up having the same representation. Technically, this might not matter as these all have different kinds/sorts, however it is odd, and it seems safer to distinguish them. >--------------------------------------------------------------- 246d2c925d7ffe6a5b61fbdce7372178bf02c217 compiler/basicTypes/OccName.hs | 6 ++++ compiler/prelude/PrelNames.hs | 3 +- compiler/typecheck/TcDeriv.hs | 74 ++++++++++++++++++++++++++++++++++++++-- compiler/typecheck/TcGenDeriv.hs | 38 +++++++++++++++++++++ 4 files changed, 118 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index efa871d..03f11e6 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -72,6 +72,8 @@ module OccName ( mkPReprTyConOcc, mkPADFunOcc, + mkTyConRepOcc, + -- ** Deconstruction occNameFS, occNameString, occNameSpace, @@ -607,6 +609,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc, mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc, mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc + :: OccName -> OccName -- These derived variables have a prefix that no Haskell value could have @@ -658,6 +661,9 @@ mkGenRCo = mk_simple_deriv tcName "CoRep_" mkDataTOcc = mk_simple_deriv varName "$t" mkDataCOcc = mk_simple_deriv varName "$c" +mkTyConRepOcc :: Maybe String -> OccName -> OccName +mkTyConRepOcc = mk_simple_deriv_with varName "$tcr" + -- Vectorisation mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, mkPADFunOcc, mkPReprTyConOcc, diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 3b40385..5e43b56 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -676,10 +676,11 @@ showString_RDR = varQual_RDR gHC_SHOW (fsLit "showString") showSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showSpace") showParen_RDR = varQual_RDR gHC_SHOW (fsLit "showParen") -typeRep_RDR, mkTyCon_RDR, mkTyConApp_RDR :: RdrName +typeRep_RDR, mkTyCon_RDR, mkTyConApp_RDR, typeable_TyCon_RDR :: RdrName typeRep_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "typeRep#") mkTyCon_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyCon") mkTyConApp_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyConApp") +typeable_TyCon_RDR = tcQual_RDR tYPEABLE_INTERNAL (fsLit "TyCon") undefined_RDR :: RdrName undefined_RDR = varQual_RDR gHC_ERR (fsLit "undefined") diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 3d980e2..91104f8 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -382,10 +382,14 @@ tcDeriving tycl_decls inst_decls deriv_decls ; let (binds, newTyCons, famInsts, extraInstances) = genAuxBinds loc (unionManyBags (auxDerivStuff : deriv_stuff)) + ; dflags <- getDynFlags + ; tcRepBinds <- genTypeableTyConReps dflags + tycl_decls inst_decls + ; (inst_info, rn_binds, rn_dus) <- - renameDeriv is_boot (inst_infos ++ (bagToList extraInstances)) binds + renameDeriv is_boot (inst_infos ++ (bagToList extraInstances)) + (unionBags tcRepBinds binds) - ; dflags <- getDynFlags ; unless (isEmptyBag inst_info) $ liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" (ddump_deriving inst_info rn_binds newTyCons famInsts)) @@ -414,6 +418,72 @@ tcDeriving tycl_decls inst_decls deriv_decls hangP s x = text "" $$ hang (ptext (sLit s)) 2 x +genTypeableTyConReps :: DynFlags -> + [LTyClDecl Name] -> + [LInstDecl Name] -> + TcM (Bag (LHsBind RdrName, LSig RdrName)) +genTypeableTyConReps dflags decls insts = + do tcs1 <- mapM tyConsFromDecl decls + tcs2 <- mapM tyConsFromInst insts + return $ listToBag [ genTypeableTyConRep dflags loc tc + | (loc,tc) <- concat (tcs1 ++ tcs2) ] + where + + tyConFromDataCon (L l n) = do dc <- tcLookupDataCon n + return (do tc <- promoteDataCon_maybe dc + return (l,tc)) + + -- Promoted data constructors from a data declaration, or + -- a data-family instance. + tyConsFromDataRHS = fmap catMaybes + . mapM tyConFromDataCon + . concatMap (con_names . unLoc) + . dd_cons + + -- Tycons from a data-family declaration; not promotable. + tyConFromDataFamDecl FamilyDecl { fdLName = L loc name } = + do tc <- tcLookupTyCon name + return (loc,tc) + + + -- tycons from a type-level declaration + tyConsFromDecl (L _ d) + + -- data or newtype declaration: promoted tycon, tycon, promoted ctrs. + | isDataDecl d = + do let L loc name = tcdLName d + tc <- tcLookupTyCon name + promotedCtrs <- tyConsFromDataRHS (tcdDataDefn d) + let tyCons = (loc,tc) : promotedCtrs + + return (case promotableTyCon_maybe tc of + Nothing -> tyCons + Just kc -> (loc,kc) : tyCons) + + -- data family: just the type constructor; these are not promotable. + | isDataFamilyDecl d = + do res <- tyConFromDataFamDecl (tcdFam d) + return [res] + + -- class: the type constructors of associated data families + | isClassDecl d = + let isData FamilyDecl { fdInfo = DataFamily } = True + isData _ = False + + in mapM tyConFromDataFamDecl (filter isData (map unLoc (tcdATs d))) + + | otherwise = return [] + + + tyConsFromInst (L _ d) = + case d of + ClsInstD ci -> fmap concat + $ mapM (tyConsFromDataRHS . dfid_defn . unLoc) + $ cid_datafam_insts ci + DataFamInstD dfi -> tyConsFromDataRHS (dfid_defn dfi) + TyFamInstD {} -> return [] + + -- Prints the representable type family instance pprRepTy :: FamInst -> SDoc pprRepTy fi@(FamInst { fi_tys = lhs }) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index c928108..d8a6d8e 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -20,6 +20,7 @@ module TcGenDeriv ( canDeriveAnyClass, genDerivedBinds, + genTypeableTyConRep, FFoldType(..), functorLikeTraverse, deepSubtypesContaining, foldDataConArgs, mkCoerceClassMethEqn, @@ -1277,6 +1278,43 @@ gen_Typeable_binds dflags loc tycon | wORD_SIZE dflags == 4 = HsWord64Prim "" . fromIntegral | otherwise = HsWordPrim "" . fromIntegral +genTypeableTyConRep :: DynFlags -> SrcSpan -> TyCon -> + (LHsBind RdrName, LSig RdrName) +genTypeableTyConRep dflags loc tycon = + ( mk_easy_FunBind loc rep_name [] tycon_rep + , L loc (TypeSig [L loc rep_name] sig_ty PlaceHolder) + ) + where + rep_name = mk_tc_deriv_name tycon (mkTyConRepOcc suf) + suf = if isPromotedTyCon tycon then Just "k" else + if isPromotedDataCon tycon then Just "c" else Nothing + + sig_ty = nlHsTyVar typeable_TyCon_RDR + + tycon_name = tyConName tycon + modl = nameModule tycon_name + pkg = modulePackageKey modl + + modl_fs = moduleNameFS (moduleName modl) + pkg_fs = packageKeyFS pkg + name_fs = occNameFS (nameOccName tycon_name) + + tycon_rep = nlHsApps mkTyCon_RDR + (map nlHsLit [int64 high, + int64 low, + HsString "" pkg_fs, + HsString "" modl_fs, + HsString "" name_fs]) + + hashThis = unwords $ map unpackFS [pkg_fs, modl_fs, name_fs] + Fingerprint high low = fingerprintString hashThis + + int64 + | wORD_SIZE dflags == 4 = HsWord64Prim "" . fromIntegral + | otherwise = HsWordPrim "" . fromIntegral + + + {- ************************************************************************ * * From git at git.haskell.org Mon Feb 2 16:05:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Feb 2015 16:05:13 +0000 (UTC) Subject: [commit: ghc] master: Fix #10017 (92c9354) Message-ID: <20150202160513.2D0283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92c93544939199f6ef758e1658149a971d4437c9/ghc >--------------------------------------------------------------- commit 92c93544939199f6ef758e1658149a971d4437c9 Author: Andreas Voellmy Date: Mon Feb 2 10:50:52 2015 -0500 Fix #10017 Summary: In the threaded RTS, a signal is delivered from the RTS to Haskell user code by writing to file that one of the IO managers watches (via an instance of GHC.Event.Control.Control). When the IO manager receives the signal, it calls GHC.Conc.Signal.runHandlers to invoke Haskell signal handler. In the move from a single IO manager to one IO manager per capability, the behavior was (wrongly) extended so that a signal is delivered to every event manager (see #9423), each of which invoke Haskell signal handlers, leading to multiple invocations of Haskell signal handlers for a single signal. This change fixes this problem by having the RTS (in generic_handler()) notify only the Control instance used by the TimerManager, rather than all the per-capability IO managers. Reviewers: austin, hvr, simonmar, Mikolaj Reviewed By: simonmar, Mikolaj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D641 >--------------------------------------------------------------- 92c93544939199f6ef758e1658149a971d4437c9 libraries/base/GHC/Event/Manager.hs | 3 +-- rts/posix/Signals.c | 12 ------------ testsuite/tests/rts/T10017.hs | 11 +++++++++++ testsuite/tests/rts/T10017.stdout | 1 + testsuite/tests/rts/all.T | 2 ++ 5 files changed, 15 insertions(+), 14 deletions(-) diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs index eeda1c8..11b01ad 100644 --- a/libraries/base/GHC/Event/Manager.hs +++ b/libraries/base/GHC/Event/Manager.hs @@ -72,7 +72,6 @@ import Data.Maybe (maybe) import Data.OldList (partition) import GHC.Arr (Array, (!), listArray) import GHC.Base -import GHC.Conc.Signal (runHandlers) import GHC.Conc.Sync (yield) import GHC.List (filter, replicate) import GHC.Num (Num(..)) @@ -163,7 +162,7 @@ handleControlEvent mgr fd _evt = do case msg of CMsgWakeup -> return () CMsgDie -> writeIORef (emState mgr) Finished - CMsgSignal fp s -> runHandlers fp s + _ -> return () newDefaultBackend :: IO Backend #if defined(HAVE_KQUEUE) diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c index 44bd0b6..5fbb917 100644 --- a/rts/posix/Signals.c +++ b/rts/posix/Signals.c @@ -251,18 +251,6 @@ generic_handler(int sig USED_IF_THREADS, } } - nat i; - int fd; - for (i=0; i < n_capabilities; i++) { - fd = capabilities[i]->io_manager_control_wr_fd; - if (0 <= fd) { - r = write(fd, buf, sizeof(siginfo_t)+1); - if (r == -1 && errno == EAGAIN) { - errorBelch("lost signal due to full pipe: %d\n", sig); - } - } - } - // If the IO manager hasn't told us what the FD of the write end // of its pipe is, there's not much we can do here, so just ignore // the signal.. diff --git a/testsuite/tests/rts/T10017.hs b/testsuite/tests/rts/T10017.hs new file mode 100644 index 0000000..ed34841 --- /dev/null +++ b/testsuite/tests/rts/T10017.hs @@ -0,0 +1,11 @@ +import Control.Concurrent +import System.Posix.Signals + +main :: IO () +main = do + _ <- flip (installHandler sig) Nothing $ Catch $ + putStrLn $ "Received my signal" + raiseSignal sig + threadDelay 100000 + where + sig = sigUSR2 diff --git a/testsuite/tests/rts/T10017.stdout b/testsuite/tests/rts/T10017.stdout new file mode 100644 index 0000000..f138924 --- /dev/null +++ b/testsuite/tests/rts/T10017.stdout @@ -0,0 +1 @@ +Received my signal diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 89f1da8..88c354f 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -238,6 +238,8 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) +test('T10017', [ only_ways(threaded_ways), extra_run_opts('+RTS -N2 -RTS') ], compile_and_run, ['']) + test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) # this needs runtime infrastructure to do in ghci: # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. From git at git.haskell.org Mon Feb 2 17:57:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Feb 2015 17:57:31 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix #10017 (ddd95c0) Message-ID: <20150202175731.7E8E43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/ddd95c0b575da33447c078a8791d3c4f2edec9b7/ghc >--------------------------------------------------------------- commit ddd95c0b575da33447c078a8791d3c4f2edec9b7 Author: Andreas Voellmy Date: Mon Feb 2 10:50:52 2015 -0500 Fix #10017 Summary: In the threaded RTS, a signal is delivered from the RTS to Haskell user code by writing to file that one of the IO managers watches (via an instance of GHC.Event.Control.Control). When the IO manager receives the signal, it calls GHC.Conc.Signal.runHandlers to invoke Haskell signal handler. In the move from a single IO manager to one IO manager per capability, the behavior was (wrongly) extended so that a signal is delivered to every event manager (see #9423), each of which invoke Haskell signal handlers, leading to multiple invocations of Haskell signal handlers for a single signal. This change fixes this problem by having the RTS (in generic_handler()) notify only the Control instance used by the TimerManager, rather than all the per-capability IO managers. Reviewers: austin, hvr, simonmar, Mikolaj Reviewed By: simonmar, Mikolaj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D641 (cherry picked from commit 92c93544939199f6ef758e1658149a971d4437c9) >--------------------------------------------------------------- ddd95c0b575da33447c078a8791d3c4f2edec9b7 libraries/base/GHC/Event/Manager.hs | 3 +-- rts/posix/Signals.c | 12 ------------ testsuite/tests/rts/T10017.hs | 11 +++++++++++ testsuite/tests/rts/T10017.stdout | 1 + testsuite/tests/rts/all.T | 2 ++ 5 files changed, 15 insertions(+), 14 deletions(-) diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs index eeda1c8..11b01ad 100644 --- a/libraries/base/GHC/Event/Manager.hs +++ b/libraries/base/GHC/Event/Manager.hs @@ -72,7 +72,6 @@ import Data.Maybe (maybe) import Data.OldList (partition) import GHC.Arr (Array, (!), listArray) import GHC.Base -import GHC.Conc.Signal (runHandlers) import GHC.Conc.Sync (yield) import GHC.List (filter, replicate) import GHC.Num (Num(..)) @@ -163,7 +162,7 @@ handleControlEvent mgr fd _evt = do case msg of CMsgWakeup -> return () CMsgDie -> writeIORef (emState mgr) Finished - CMsgSignal fp s -> runHandlers fp s + _ -> return () newDefaultBackend :: IO Backend #if defined(HAVE_KQUEUE) diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c index 44bd0b6..5fbb917 100644 --- a/rts/posix/Signals.c +++ b/rts/posix/Signals.c @@ -251,18 +251,6 @@ generic_handler(int sig USED_IF_THREADS, } } - nat i; - int fd; - for (i=0; i < n_capabilities; i++) { - fd = capabilities[i]->io_manager_control_wr_fd; - if (0 <= fd) { - r = write(fd, buf, sizeof(siginfo_t)+1); - if (r == -1 && errno == EAGAIN) { - errorBelch("lost signal due to full pipe: %d\n", sig); - } - } - } - // If the IO manager hasn't told us what the FD of the write end // of its pipe is, there's not much we can do here, so just ignore // the signal.. diff --git a/testsuite/tests/rts/T10017.hs b/testsuite/tests/rts/T10017.hs new file mode 100644 index 0000000..ed34841 --- /dev/null +++ b/testsuite/tests/rts/T10017.hs @@ -0,0 +1,11 @@ +import Control.Concurrent +import System.Posix.Signals + +main :: IO () +main = do + _ <- flip (installHandler sig) Nothing $ Catch $ + putStrLn $ "Received my signal" + raiseSignal sig + threadDelay 100000 + where + sig = sigUSR2 diff --git a/testsuite/tests/rts/T10017.stdout b/testsuite/tests/rts/T10017.stdout new file mode 100644 index 0000000..f138924 --- /dev/null +++ b/testsuite/tests/rts/T10017.stdout @@ -0,0 +1 @@ +Received my signal diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 89f1da8..88c354f 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -238,6 +238,8 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) +test('T10017', [ only_ways(threaded_ways), extra_run_opts('+RTS -N2 -RTS') ], compile_and_run, ['']) + test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) # this needs runtime infrastructure to do in ghci: # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. From git at git.haskell.org Mon Feb 2 21:45:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Feb 2015 21:45:08 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: Add mention of prefetch API changes (#9937) (aafc415) Message-ID: <20150202214508.7AA053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/aafc41589a38e71d8f9f84c603f19d3e22553268/ghc >--------------------------------------------------------------- commit aafc41589a38e71d8f9f84c603f19d3e22553268 Author: Austin Seipp Date: Mon Feb 2 14:16:10 2015 -0600 docs: Add mention of prefetch API changes (#9937) Signed-off-by: Austin Seipp >--------------------------------------------------------------- aafc41589a38e71d8f9f84c603f19d3e22553268 docs/users_guide/7.10.1-notes.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 16f113f..4a84db9 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -676,6 +676,18 @@ echo "[]" > package.conf Version number 0.3.1.0 (was 0.3.1.0) + + + The low-level prefetch API exported by + GHC.Prim (added in GHC 7.8) has + been overhauled to use State# + parameters to serialize and thread state around. + + + This API is still considered experimental, and + will be prone to change. + + From git at git.haskell.org Mon Feb 2 21:45:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Feb 2015 21:45:11 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: Add missing libraries to release notes (#10038) (cd0bbc5) Message-ID: <20150202214511.3CF343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/cd0bbc5421f16a599a40468cd45161c7ed798696/ghc >--------------------------------------------------------------- commit cd0bbc5421f16a599a40468cd45161c7ed798696 Author: Austin Seipp Date: Mon Feb 2 14:44:27 2015 -0600 docs: Add missing libraries to release notes (#10038) Signed-off-by: Austin Seipp >--------------------------------------------------------------- cd0bbc5421f16a599a40468cd45161c7ed798696 docs/users_guide/7.10.1-notes.xml | 55 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 4a84db9..40f9e45 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -692,6 +692,17 @@ echo "[]" > package.conf + haskeline + + + + Version number 0.7.2.0 (was 0.7.1.2) + + + + + + hoopl @@ -739,6 +750,17 @@ echo "[]" > package.conf + pretty + + + + Version number 1.1.2.0 (was 1.1.1.1) + + + + + + process @@ -761,6 +783,17 @@ echo "[]" > package.conf + terminfo + + + + Version number 0.4.0.1 (was 0.4.0.0) + + + + + + time @@ -772,6 +805,17 @@ echo "[]" > package.conf + transformers + + + + Version number 0.4.2.0 (was 0.3.0.0) + + + + + + unix @@ -792,6 +836,17 @@ echo "[]" > package.conf + + + xhtml + + + + Version number remained at 3000.2.1 + + + + From git at git.haskell.org Wed Feb 4 09:04:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Feb 2015 09:04:22 +0000 (UTC) Subject: [commit: ghc] master: Fix a profiling bug (daed18c) Message-ID: <20150204090422.1BB4D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/daed18c35cda114d8a5303bcb645195e1fd397e3/ghc >--------------------------------------------------------------- commit daed18c35cda114d8a5303bcb645195e1fd397e3 Author: Simon Marlow Date: Wed Jan 28 11:25:52 2015 +0000 Fix a profiling bug Summary: We were erroneously discarding SCCs on function-typed variables. These can affect the call stack, so we have to retain them. The bug was introduced during the recent SourceNote refactoring. This is an alternative to the fix proposed in D616. I also added the scc005 test from that diff, which works with this change. While I was here, I also fixed up the other profiling tests, marking a few as expect_broken_for(10037) where the opt/unopt output differs in non-fatal ways. Test Plan: profiling tests Reviewers: scpmw, ezyang, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D636 GHC Trac Issues: #10007 >--------------------------------------------------------------- daed18c35cda114d8a5303bcb645195e1fd397e3 compiler/coreSyn/CoreUtils.hs | 12 ++++- .../tests/profiling/should_run/T2552.prof.sample | 56 ++++++++++------------ testsuite/tests/profiling/should_run/all.T | 19 ++++++-- .../tests/profiling/should_run/ioprof.prof.sample | 41 ++++++++-------- .../profiling/should_run/prof-doc-fib.prof.sample | 31 ++++++------ testsuite/tests/profiling/should_run/scc005.hs | 10 ++++ .../tests/profiling/should_run/scc005.prof.sample | 27 +++++++++++ 7 files changed, 125 insertions(+), 71 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc daed18c35cda114d8a5303bcb645195e1fd397e3 From git at git.haskell.org Thu Feb 5 08:10:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 08:10:43 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Several important fixes (We get a stack overflow though) (cc7e390) Message-ID: <20150205081043.7C4DA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/cc7e3902c536e68ad9aebaff75ca650dbeb35b7b/ghc >--------------------------------------------------------------- commit cc7e3902c536e68ad9aebaff75ca650dbeb35b7b Author: George Karachalias Date: Thu Feb 5 08:59:24 2015 +0100 Several important fixes (We get a stack overflow though) Fixed `tcTyVarDetails' failure (impossible happened): 1. Extended `toTcType' to transform kinds as well 2. Added `instTypePmM' and `instTypesPmM' for correct fresh tvs Improved performance: 3. Made PmM a type synonym of DsM 4. Removed redundant term substitutions 5. Stopped calling isSatisfiable on covered vectors, as soon as the first well-typed is found Misc. 6. Made toTcType pure (no actual need to be monadic) Important note: I have temporarily deactivated the propagation of EvVars in scope while traversing the AST, until the space leak problem is resolved. >--------------------------------------------------------------- cc7e3902c536e68ad9aebaff75ca650dbeb35b7b compiler/deSugar/Check.hs | 265 ++++++++++++++++------------------------ compiler/deSugar/Match.hs | 7 +- compiler/typecheck/TcMType.hs | 17 +-- compiler/typecheck/TcRnTypes.hs | 11 +- compiler/typecheck/TcSMonad.hs | 4 + 5 files changed, 133 insertions(+), 171 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cc7e3902c536e68ad9aebaff75ca650dbeb35b7b From git at git.haskell.org Thu Feb 5 14:23:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 14:23:29 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Represent sets as Bags and not as lists (still stack overflow) (837688d) Message-ID: <20150205142329.89B793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/837688de8e090f74f93bba0db562a22d7a9c90e1/ghc >--------------------------------------------------------------- commit 837688de8e090f74f93bba0db562a22d7a9c90e1 Author: George Karachalias Date: Thu Feb 5 15:25:05 2015 +0100 Represent sets as Bags and not as lists (still stack overflow) >--------------------------------------------------------------- 837688de8e090f74f93bba0db562a22d7a9c90e1 compiler/deSugar/Check.hs | 63 ++++++++++++++++++++++++++++------------------- compiler/utils/Bag.hs | 26 ++++++++++++++++++- 2 files changed, 62 insertions(+), 27 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 837688de8e090f74f93bba0db562a22d7a9c90e1 From git at git.haskell.org Thu Feb 5 23:42:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:42:36 +0000 (UTC) Subject: [commit: ghc] master: fix _FILE_OFFSET_BITS redefined warning on Solaris/i386 platform (78216e2) Message-ID: <20150205234236.A7AD33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78216e227dfb069d3eda804799f1f96716320a1b/ghc >--------------------------------------------------------------- commit 78216e227dfb069d3eda804799f1f96716320a1b Author: Karel Gardas Date: Thu Feb 5 17:35:45 2015 -0600 fix _FILE_OFFSET_BITS redefined warning on Solaris/i386 platform Summary: The problem with Solaris is that system header files include /usr/include/sys/feature_tests.h header file and it tests if _FILE_OFFSET_BITS define is defined. If not, it defines it to 32 which is in conflict with 64 which we need for large file support. The solution is easy, always include own header files before system header files. Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D644 >--------------------------------------------------------------- 78216e227dfb069d3eda804799f1f96716320a1b libraries/base/include/WCsubst.h | 2 +- libraries/integer-gmp2/cbits/wrappers.c | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/libraries/base/include/WCsubst.h b/libraries/base/include/WCsubst.h index 4ad373a..11bedb6 100644 --- a/libraries/base/include/WCsubst.h +++ b/libraries/base/include/WCsubst.h @@ -2,8 +2,8 @@ #define WCSUBST_INCL -#include #include "HsFFI.h" +#include HsInt u_iswupper(HsInt wc); HsInt u_iswdigit(HsInt wc); diff --git a/libraries/integer-gmp2/cbits/wrappers.c b/libraries/integer-gmp2/cbits/wrappers.c index cf28e29..4b710dc 100644 --- a/libraries/integer-gmp2/cbits/wrappers.c +++ b/libraries/integer-gmp2/cbits/wrappers.c @@ -9,6 +9,9 @@ #define _ISOC99_SOURCE +#include "HsFFI.h" +#include "MachDeps.h" + #include #include #include @@ -20,8 +23,6 @@ #include -#include "HsFFI.h" -#include "MachDeps.h" // GMP 4.x compatibility #if !defined(__GNU_MP_VERSION) From git at git.haskell.org Thu Feb 5 23:42:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:42:39 +0000 (UTC) Subject: [commit: ghc] master: Bring Match m_fun_id_infix through the renamer. (c88e112) Message-ID: <20150205234239.5E7B23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c88e11219c1e914b71d8c630a1f1d4f6f0fb6b9b/ghc >--------------------------------------------------------------- commit c88e11219c1e914b71d8c630a1f1d4f6f0fb6b9b Author: Alan Zimmerman Date: Thu Feb 5 17:36:57 2015 -0600 Bring Match m_fun_id_infix through the renamer. Summary: This is a first step for #9988 It turns out that bringing m_fun_id_infix through the renamer is actually very simple, affecting the internals of rnMatch' only. Is this simple enough to hit 7.10.1? Test Plan: ./validate Reviewers: hvr, simonpj, austin Reviewed By: simonpj, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D639 GHC Trac Issues: #9988 >--------------------------------------------------------------- c88e11219c1e914b71d8c630a1f1d4f6f0fb6b9b compiler/rename/RnBinds.hs | 11 ++++++++--- testsuite/tests/ghc-api/landmines/landmines.stdout | 6 +++--- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 97eb457..3e3b3d1 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -978,7 +978,8 @@ rnMatch' :: Outputable (body RdrName) => HsMatchContext Name -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars)) -> Match RdrName (Located (body RdrName)) -> RnM (Match Name (Located (body Name)), FreeVars) -rnMatch' ctxt rnBody match@(Match _mf pats maybe_rhs_sig grhss) +rnMatch' ctxt rnBody match@(Match { m_fun_id_infix = mf, m_pats = pats + , m_type = maybe_rhs_sig, m_grhss = grhss }) = do { -- Result type signatures are no longer supported case maybe_rhs_sig of Nothing -> return () @@ -988,8 +989,12 @@ rnMatch' ctxt rnBody match@(Match _mf pats maybe_rhs_sig grhss) -- note that there are no local ficity decls for matches ; rnPats ctxt pats $ \ pats' -> do { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss - - ; return (Match Nothing pats' Nothing grhss', grhss_fvs) }} + ; let mf' = case (ctxt,mf) of + (FunRhs funid isinfix,Just (L lf _,_)) + -> Just (L lf funid,isinfix) + _ -> Nothing + ; return (Match { m_fun_id_infix = mf', m_pats = pats' + , m_type = Nothing, m_grhss = grhss'}, grhss_fvs ) }} emptyCaseErr :: HsMatchContext Name -> SDoc emptyCaseErr ctxt = hang (ptext (sLit "Empty list of alternatives in") <+> pp_ctxt) diff --git a/testsuite/tests/ghc-api/landmines/landmines.stdout b/testsuite/tests/ghc-api/landmines/landmines.stdout index fc53814..7d667ed 100644 --- a/testsuite/tests/ghc-api/landmines/landmines.stdout +++ b/testsuite/tests/ghc-api/landmines/landmines.stdout @@ -1,4 +1,4 @@ -(10,9,6) +(10,10,6) (49,45,0) -(12,10,6) -(8,7,6) +(12,11,6) +(8,8,6) From git at git.haskell.org Thu Feb 5 23:42:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:42:42 +0000 (UTC) Subject: [commit: ghc] master: GRHS with empty wherebinds gets wrong SrcSpan (d4f25cb) Message-ID: <20150205234242.12AC73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4f25cb151db1a539aab66b26ccca4d166562b22/ghc >--------------------------------------------------------------- commit d4f25cb151db1a539aab66b26ccca4d166562b22 Author: Alan Zimmerman Date: Thu Feb 5 17:37:42 2015 -0600 GRHS with empty wherebinds gets wrong SrcSpan Summary: When parsing a rhs, the GRHS is constructed via unguardedRHS which is given a SrcSpan which only takes account of the '=' and wherebinds, so does not include the exp when wherebinds are empty. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D643 >--------------------------------------------------------------- d4f25cb151db1a539aab66b26ccca4d166562b22 compiler/parser/Parser.y | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index e376090..1bffbee 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1875,7 +1875,7 @@ decl :: { Located (OrdList (LHsDecl RdrName)) } rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) } : '=' exp wherebinds { sL (comb3 $1 $2 $3) ((mj AnnEqual $1 : (fst $ unLoc $3)) - ,GRHSs (unguardedRHS (comb2 $1 $3) $2) + ,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2) (snd $ unLoc $3)) } | gdrhs wherebinds { sLL $1 $> (fst $ unLoc $2 ,GRHSs (reverse (unLoc $1)) From git at git.haskell.org Thu Feb 5 23:42:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:42:45 +0000 (UTC) Subject: [commit: ghc] master: Add packageName to GHC.Generics.Datatype (ae39c5c) Message-ID: <20150205234245.6FE933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ae39c5c040f121947e14877c3ceb47bbe80c0ccb/ghc >--------------------------------------------------------------- commit ae39c5c040f121947e14877c3ceb47bbe80c0ccb Author: Oleg Grenrus Date: Thu Feb 5 17:42:36 2015 -0600 Add packageName to GHC.Generics.Datatype Summary: Added packageName to GHC.Generics.Datatype class definition Reviewers: hvr, dreixel, austin Reviewed By: dreixel, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D631 GHC Trac Issues: #10030 >--------------------------------------------------------------- ae39c5c040f121947e14877c3ceb47bbe80c0ccb compiler/prelude/PrelNames.hs | 3 ++- compiler/typecheck/TcGenGenerics.hs | 8 ++++++-- docs/users_guide/glasgow_exts.xml | 1 + libraries/base/GHC/Generics.hs | 6 ++++++ testsuite/tests/generics/GenDerivOutput.stderr | 2 ++ testsuite/tests/generics/GenDerivOutput1_0.stderr | 1 + testsuite/tests/generics/GenDerivOutput1_1.stderr | 4 ++++ testsuite/tests/generics/T10030.hs | 7 +++++++ testsuite/tests/generics/T10030.stdout | 2 ++ testsuite/tests/generics/all.T | 1 + testsuite/tests/perf/compiler/T5642.hs | 1 + 11 files changed, 33 insertions(+), 3 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ae39c5c040f121947e14877c3ceb47bbe80c0ccb From git at git.haskell.org Thu Feb 5 23:42:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:42:48 +0000 (UTC) Subject: [commit: ghc] master: Eta-expand argument to foldr in mapM_ for [] (7cf87fc) Message-ID: <20150205234248.2CD7E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7cf87fc6928f0252d9f61719e2344e6c69237079/ghc >--------------------------------------------------------------- commit 7cf87fc6928f0252d9f61719e2344e6c69237079 Author: David Feuer Date: Thu Feb 5 17:42:50 2015 -0600 Eta-expand argument to foldr in mapM_ for [] Summary: This improves performance, at least sometimes--the previous implementation can be worse than the version in base 4.7. I have not had the time to run benchmarks and such, but `mapM` already does this. Also, inline `mapM_`, like `mapM`. Reviewers: hvr, nomeata, ekmett, austin Reviewed By: ekmett, austin Subscribers: thomie Projects: #ghc Differential Revision: https://phabricator.haskell.org/D632 GHC Trac Issues: #10034 >--------------------------------------------------------------- 7cf87fc6928f0252d9f61719e2344e6c69237079 libraries/base/Data/Foldable.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index a745f66..b8b0973 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -349,7 +349,8 @@ for_ = flip traverse_ -- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to -- 'Monad'. mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m () -mapM_ f= foldr ((>>) . f) (return ()) +{-# INLINE mapM_ #-} +mapM_ f = foldr (\m n -> f m >> n) (return ()) -- | 'forM_' is 'mapM_' with its arguments flipped. For a version that -- doesn't ignore the results see 'Data.Traversable.forM'. From git at git.haskell.org Thu Feb 5 23:42:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:42:50 +0000 (UTC) Subject: [commit: ghc] master: Make -ddump-splices output to stdout (fixes #8796) (73f976c) Message-ID: <20150205234250.CEAD43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/73f976c47f00060baaeead9e0331ab265a84251c/ghc >--------------------------------------------------------------- commit 73f976c47f00060baaeead9e0331ab265a84251c Author: Alexander Vershilov Date: Thu Feb 5 17:43:32 2015 -0600 Make -ddump-splices output to stdout (fixes #8796) Summary: Fixes debug output so all info messages will use stdout. Fixes #8796. Make -ddump-splices output to stdout (fixes #8796) Make -dverbose-core2core use stdout (fixes #8796) Reviewers: simonpj, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D627 GHC Trac Issues: #8796 >--------------------------------------------------------------- 73f976c47f00060baaeead9e0331ab265a84251c compiler/simplCore/SimplMonad.hs | 2 +- compiler/simplCore/Simplify.hs | 4 ++-- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/vectorise/Vectorise/Monad.hs | 2 +- compiler/vectorise/Vectorise/Monad/Base.hs | 4 ++-- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/simplCore/SimplMonad.hs b/compiler/simplCore/SimplMonad.hs index 451bf34..0069106 100644 --- a/compiler/simplCore/SimplMonad.hs +++ b/compiler/simplCore/SimplMonad.hs @@ -135,7 +135,7 @@ traceSmpl :: String -> SDoc -> SimplM () traceSmpl herald doc = do { dflags <- getDynFlags ; when (dopt Opt_D_dump_simpl_trace dflags) $ liftIO $ - printInfoForUser dflags alwaysQualify $ + printOutputForUser dflags alwaysQualify $ hang (text herald) 2 doc } {- diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index db7f5a6..3614bb3 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1440,10 +1440,10 @@ completeCall env var cont | not (dopt Opt_D_dump_inlinings dflags) = return () | not (dopt Opt_D_verbose_core2core dflags) = when (isExternalName (idName var)) $ - liftIO $ printInfoForUser dflags alwaysQualify $ + liftIO $ printOutputForUser dflags alwaysQualify $ sep [text "Inlining done:", nest 4 (ppr var)] | otherwise - = liftIO $ printInfoForUser dflags alwaysQualify $ + = liftIO $ printOutputForUser dflags alwaysQualify $ sep [text "Inlining done: " <> ppr var, nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), text "Cont: " <+> ppr cont])] diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 374a859..84ae0b9 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -551,7 +551,7 @@ printForUserTcRn :: SDoc -> TcRn () printForUserTcRn doc = do { dflags <- getDynFlags ; printer <- getPrintUnqualified dflags - ; liftIO (printInfoForUser dflags printer doc) } + ; liftIO (printOutputForUser dflags printer doc) } -- | Typechecker debug debugDumpTcRn :: SDoc -> TcRn () diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs index 3e6c33a..4e9726a 100644 --- a/compiler/vectorise/Vectorise/Monad.hs +++ b/compiler/vectorise/Vectorise/Monad.hs @@ -105,7 +105,7 @@ initV hsc_env guts info thing_inside Yes genv _ x -> return $ Just (new_info genv, x) No reason -> do { unqual <- mkPrintUnqualifiedDs ; liftIO $ - printInfoForUser dflags unqual $ + printOutputForUser dflags unqual $ mkDumpDoc "Warning: vectorisation failure:" reason ; return Nothing } diff --git a/compiler/vectorise/Vectorise/Monad/Base.hs b/compiler/vectorise/Vectorise/Monad/Base.hs index 3cb6adb..a3089e3 100644 --- a/compiler/vectorise/Vectorise/Monad/Base.hs +++ b/compiler/vectorise/Vectorise/Monad/Base.hs @@ -117,7 +117,7 @@ emitVt :: String -> SDoc -> VM () emitVt herald doc = liftDs $ do dflags <- getDynFlags - liftIO . printInfoForUser dflags alwaysQualify $ + liftIO . printOutputForUser dflags alwaysQualify $ hang (text herald) 2 doc -- |Output a trace message if -ddump-vt-trace is active. @@ -144,7 +144,7 @@ dumpVt :: String -> SDoc -> VM () dumpVt header doc = do { unqual <- liftDs mkPrintUnqualifiedDs ; dflags <- liftDs getDynFlags - ; liftIO $ printInfoForUser dflags unqual (mkDumpDoc header doc) + ; liftIO $ printOutputForUser dflags unqual (mkDumpDoc header doc) } From git at git.haskell.org Thu Feb 5 23:46:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:46:35 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: fix _FILE_OFFSET_BITS redefined warning on Solaris/i386 platform (9ed5689) Message-ID: <20150205234635.7A34D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/9ed5689097aaa5276f61cda9e1c7da7233c69048/ghc >--------------------------------------------------------------- commit 9ed5689097aaa5276f61cda9e1c7da7233c69048 Author: Karel Gardas Date: Thu Feb 5 17:35:45 2015 -0600 fix _FILE_OFFSET_BITS redefined warning on Solaris/i386 platform Summary: The problem with Solaris is that system header files include /usr/include/sys/feature_tests.h header file and it tests if _FILE_OFFSET_BITS define is defined. If not, it defines it to 32 which is in conflict with 64 which we need for large file support. The solution is easy, always include own header files before system header files. Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D644 (cherry picked from commit 78216e227dfb069d3eda804799f1f96716320a1b) >--------------------------------------------------------------- 9ed5689097aaa5276f61cda9e1c7da7233c69048 libraries/base/include/WCsubst.h | 2 +- libraries/integer-gmp2/cbits/wrappers.c | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/libraries/base/include/WCsubst.h b/libraries/base/include/WCsubst.h index 4ad373a..11bedb6 100644 --- a/libraries/base/include/WCsubst.h +++ b/libraries/base/include/WCsubst.h @@ -2,8 +2,8 @@ #define WCSUBST_INCL -#include #include "HsFFI.h" +#include HsInt u_iswupper(HsInt wc); HsInt u_iswdigit(HsInt wc); diff --git a/libraries/integer-gmp2/cbits/wrappers.c b/libraries/integer-gmp2/cbits/wrappers.c index cf28e29..4b710dc 100644 --- a/libraries/integer-gmp2/cbits/wrappers.c +++ b/libraries/integer-gmp2/cbits/wrappers.c @@ -9,6 +9,9 @@ #define _ISOC99_SOURCE +#include "HsFFI.h" +#include "MachDeps.h" + #include #include #include @@ -20,8 +23,6 @@ #include -#include "HsFFI.h" -#include "MachDeps.h" // GMP 4.x compatibility #if !defined(__GNU_MP_VERSION) From git at git.haskell.org Thu Feb 5 23:46:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:46:38 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Bring Match m_fun_id_infix through the renamer. (29bb156) Message-ID: <20150205234638.3A6AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/29bb15667755d9d71fd92e63e63305068f6fdafb/ghc >--------------------------------------------------------------- commit 29bb15667755d9d71fd92e63e63305068f6fdafb Author: Alan Zimmerman Date: Thu Feb 5 17:36:57 2015 -0600 Bring Match m_fun_id_infix through the renamer. Summary: This is a first step for #9988 It turns out that bringing m_fun_id_infix through the renamer is actually very simple, affecting the internals of rnMatch' only. Is this simple enough to hit 7.10.1? Test Plan: ./validate Reviewers: hvr, simonpj, austin Reviewed By: simonpj, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D639 GHC Trac Issues: #9988 (cherry picked from commit c88e11219c1e914b71d8c630a1f1d4f6f0fb6b9b) >--------------------------------------------------------------- 29bb15667755d9d71fd92e63e63305068f6fdafb compiler/rename/RnBinds.hs | 11 ++++++++--- testsuite/tests/ghc-api/landmines/landmines.stdout | 6 +++--- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 7a9dcae..397780c 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -978,7 +978,8 @@ rnMatch' :: Outputable (body RdrName) => HsMatchContext Name -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars)) -> Match RdrName (Located (body RdrName)) -> RnM (Match Name (Located (body Name)), FreeVars) -rnMatch' ctxt rnBody match@(Match _mf pats maybe_rhs_sig grhss) +rnMatch' ctxt rnBody match@(Match { m_fun_id_infix = mf, m_pats = pats + , m_type = maybe_rhs_sig, m_grhss = grhss }) = do { -- Result type signatures are no longer supported case maybe_rhs_sig of Nothing -> return () @@ -988,8 +989,12 @@ rnMatch' ctxt rnBody match@(Match _mf pats maybe_rhs_sig grhss) -- note that there are no local ficity decls for matches ; rnPats ctxt pats $ \ pats' -> do { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss - - ; return (Match Nothing pats' Nothing grhss', grhss_fvs) }} + ; let mf' = case (ctxt,mf) of + (FunRhs funid isinfix,Just (L lf _,_)) + -> Just (L lf funid,isinfix) + _ -> Nothing + ; return (Match { m_fun_id_infix = mf', m_pats = pats' + , m_type = Nothing, m_grhss = grhss'}, grhss_fvs ) }} emptyCaseErr :: HsMatchContext Name -> SDoc emptyCaseErr ctxt = hang (ptext (sLit "Empty list of alternatives in") <+> pp_ctxt) diff --git a/testsuite/tests/ghc-api/landmines/landmines.stdout b/testsuite/tests/ghc-api/landmines/landmines.stdout index fc53814..7d667ed 100644 --- a/testsuite/tests/ghc-api/landmines/landmines.stdout +++ b/testsuite/tests/ghc-api/landmines/landmines.stdout @@ -1,4 +1,4 @@ -(10,9,6) +(10,10,6) (49,45,0) -(12,10,6) -(8,7,6) +(12,11,6) +(8,8,6) From git at git.haskell.org Thu Feb 5 23:46:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Feb 2015 23:46:40 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: GRHS with empty wherebinds gets wrong SrcSpan (9956c18) Message-ID: <20150205234640.C7E693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/9956c18bff581b56411db81c8cc1447732659c50/ghc >--------------------------------------------------------------- commit 9956c18bff581b56411db81c8cc1447732659c50 Author: Alan Zimmerman Date: Thu Feb 5 17:37:42 2015 -0600 GRHS with empty wherebinds gets wrong SrcSpan Summary: When parsing a rhs, the GRHS is constructed via unguardedRHS which is given a SrcSpan which only takes account of the '=' and wherebinds, so does not include the exp when wherebinds are empty. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D643 (cherry picked from commit d4f25cb151db1a539aab66b26ccca4d166562b22) >--------------------------------------------------------------- 9956c18bff581b56411db81c8cc1447732659c50 compiler/parser/Parser.y | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index e376090..1bffbee 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1875,7 +1875,7 @@ decl :: { Located (OrdList (LHsDecl RdrName)) } rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) } : '=' exp wherebinds { sL (comb3 $1 $2 $3) ((mj AnnEqual $1 : (fst $ unLoc $3)) - ,GRHSs (unguardedRHS (comb2 $1 $3) $2) + ,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2) (snd $ unLoc $3)) } | gdrhs wherebinds { sLL $1 $> (fst $ unLoc $2 ,GRHSs (reverse (unLoc $1)) From git at git.haskell.org Fri Feb 6 15:03:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Feb 2015 15:03:28 +0000 (UTC) Subject: [commit: ghc] master: Comments only (2f13cd8) Message-ID: <20150206150328.3E6913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f13cd88de8ab045737d8447d8d5e0f7ac7ae9f9/ghc >--------------------------------------------------------------- commit 2f13cd88de8ab045737d8447d8d5e0f7ac7ae9f9 Author: Simon Peyton Jones Date: Tue Feb 3 15:40:42 2015 +0000 Comments only >--------------------------------------------------------------- 2f13cd88de8ab045737d8447d8d5e0f7ac7ae9f9 compiler/rename/RnBinds.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 3e3b3d1..89f8a14 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -986,7 +986,7 @@ rnMatch' ctxt rnBody match@(Match { m_fun_id_infix = mf, m_pats = pats Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty) -- Now the main event - -- note that there are no local ficity decls for matches + -- Note that there are no local fixity decls for matches ; rnPats ctxt pats $ \ pats' -> do { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss ; let mf' = case (ctxt,mf) of From git at git.haskell.org Fri Feb 6 15:03:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Feb 2015 15:03:30 +0000 (UTC) Subject: [commit: ghc] master: Comments only (da78af3) Message-ID: <20150206150330.CEAB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da78af367dfa5050c2c19b758ab046218ee4dd91/ghc >--------------------------------------------------------------- commit da78af367dfa5050c2c19b758ab046218ee4dd91 Author: Simon Peyton Jones Date: Fri Feb 6 12:32:01 2015 +0000 Comments only >--------------------------------------------------------------- da78af367dfa5050c2c19b758ab046218ee4dd91 libraries/base/GHC/Arr.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/libraries/base/GHC/Arr.hs b/libraries/base/GHC/Arr.hs index 8b7a2af..ee666eb 100644 --- a/libraries/base/GHC/Arr.hs +++ b/libraries/base/GHC/Arr.hs @@ -706,7 +706,7 @@ unsafeAccum f arr ies = runST (do STArray l u n marr# <- thawSTArray arr ST (foldr (adjust f marr#) (done l u n marr#) ies)) -{-# INLINE [1] amap #-} +{-# INLINE [1] amap #-} -- See Note [amap] amap :: (a -> b) -> Array i a -> Array i b amap f arr@(Array l u n@(I# n#) _) = runST (ST $ \s1# -> case newArray# n# arrEleBottom s1# of @@ -716,7 +716,8 @@ amap f arr@(Array l u n@(I# n#) _) = runST (ST $ \s1# -> | otherwise = fill marr# (i, f (unsafeAt arr i)) (go (i+1)) s# in go 0 s2# ) -{- +{- Note [amap] +~~~~~~~~~~~~~~ amap was originally defined like this: amap f arr@(Array l u n _) = @@ -725,11 +726,12 @@ amap was originally defined like this: There are two problems: 1. The enumFromTo implementation produces (spurious) code for the impossible -case of n<0 that ends up duplicating the array freezing code. + case of n<0 that ends up duplicating the array freezing code. -2. This implementation relies on list fusion for efficiency. In order to -implement the amap/coerce rule, we need to delay inlining amap until simplifier -phase 1, which is when the eftIntList rule kicks in and makes that impossible. +2. This implementation relies on list fusion for efficiency. In order + to implement the "amap/coerce" rule, we need to delay inlining amap + until simplifier phase 1, which is when the eftIntList rule kicks + in and makes that impossible. (c.f. Trac #8767) -} @@ -737,7 +739,7 @@ phase 1, which is when the eftIntList rule kicks in and makes that impossible. -- Coercions for Haskell", section 6.5: -- http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf {-# RULES -"amap/coerce" amap coerce = coerce +"amap/coerce" amap coerce = coerce -- See Note [amap] #-} -- Second functor law: From git at git.haskell.org Fri Feb 6 15:03:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Feb 2015 15:03:33 +0000 (UTC) Subject: [commit: ghc] master: Put parens around (ty :: kind) when pretty-printing TH syntax (111e587) Message-ID: <20150206150333.7BA113A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/111e5870803bcccd1c0736fdba432f8f9410454f/ghc >--------------------------------------------------------------- commit 111e5870803bcccd1c0736fdba432f8f9410454f Author: Simon Peyton Jones Date: Fri Feb 6 14:48:33 2015 +0000 Put parens around (ty :: kind) when pretty-printing TH syntax See Note [Pretty-printing kind signatures] in Language.Haskell.TH.Ppr.hs, and Trac #10050. >--------------------------------------------------------------- 111e5870803bcccd1c0736fdba432f8f9410454f libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 15 +++++++++++++-- testsuite/tests/th/T8953.stderr | 12 ++++++------ testsuite/tests/th/TH_RichKinds.stderr | 14 +++++++------- 3 files changed, 26 insertions(+), 15 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index 4ba43f3..e5cab65 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -498,14 +498,25 @@ pprParendType PromotedNilT = text "'[]" pprParendType PromotedConsT = text "(':)" pprParendType StarT = char '*' pprParendType ConstraintT = text "Constraint" +pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) pprParendType other = parens (ppr other) instance Ppr Type where ppr (ForallT tvars ctxt ty) = text "forall" <+> hsep (map ppr tvars) <+> text "." <+> sep [pprCxt ctxt, ppr ty] - ppr (SigT ty k) = ppr ty <+> text "::" <+> ppr k - ppr ty = pprTyApp (split ty) + ppr ty = pprTyApp (split ty) + -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind) + -- See Note [Pretty-printing kind signatures] + +{- Note [Pretty-printing kind signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC's parser only recognises a kind signature in a type when there are +parens around it. E.g. the parens are required here: + f :: (Int :: *) + type instance F Int = (Bool :: *) +So we always print a SigT with parens (see Trac #10050). -} + pprTyApp :: (Type, [Type]) -> Doc pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2] diff --git a/testsuite/tests/th/T8953.stderr b/testsuite/tests/th/T8953.stderr index 14db2b7..94312ef 100644 --- a/testsuite/tests/th/T8953.stderr +++ b/testsuite/tests/th/T8953.stderr @@ -2,8 +2,8 @@ type family T8953.Poly (a_0 :: k_1) :: * type instance T8953.Poly (x_2 :: GHC.Types.Bool) = GHC.Types.Int type instance T8953.Poly (x_3 :: GHC.Base.Maybe k_4) = GHC.Types.Double type family T8953.Silly :: k_0 -> * -type instance T8953.Silly = Data.Proxy.Proxy :: * -> * -type instance T8953.Silly = Data.Proxy.Proxy :: (* -> *) -> * +type instance T8953.Silly = (Data.Proxy.Proxy :: * -> *) +type instance T8953.Silly = (Data.Proxy.Proxy :: (* -> *) -> *) T8953.a :: Data.Proxy.Proxy (Data.Proxy.Proxy :: * -> *) T8953.b :: Data.Proxy.Proxy (Data.Proxy.Proxy :: (* -> *) -> *) type T8953.StarProxy (a_0 :: *) = Data.Proxy.Proxy a_0 @@ -11,9 +11,9 @@ class T8953.PC (a_0 :: k_1) instance T8953.PC (a_2 :: *) instance T8953.PC (Data.Proxy.Proxy :: (k_3 -> *) -> *) type family T8953.F (a_0 :: *) :: k_1 -type instance T8953.F GHC.Types.Char = T8953.G (T8953.T1 :: * -> - (* -> *) -> *) - GHC.Types.Bool :: (* -> *) -> * +type instance T8953.F GHC.Types.Char = (T8953.G (T8953.T1 :: * -> + (* -> *) -> *) + GHC.Types.Bool :: (* -> *) -> *) type family T8953.G (a_0 :: k_1) :: k_1 type instance T8953.G (T8953.T1 :: k_2 -> - k1_3 -> *) = T8953.T2 :: k_2 -> k1_3 -> * + k1_3 -> *) = (T8953.T2 :: k_2 -> k1_3 -> *) diff --git a/testsuite/tests/th/TH_RichKinds.stderr b/testsuite/tests/th/TH_RichKinds.stderr index c52667e..09a8e40 100644 --- a/testsuite/tests/th/TH_RichKinds.stderr +++ b/testsuite/tests/th/TH_RichKinds.stderr @@ -1,9 +1,9 @@ TH_RichKinds.hs:12:3: Warning: - forall a_0 . a_0 :: GHC.Types.Bool -forall a_1 . a_1 :: Constraint -forall a_2 . a_2 :: [*] -forall a_3 . a_3 :: (*, GHC.Types.Bool) -forall a_4 . a_4 :: GHC.Tuple.() -forall a_5 . a_5 :: (* -> GHC.Types.Bool) -> - (*, * -> *) -> GHC.Types.Bool + forall a_0 . (a_0 :: GHC.Types.Bool) +forall a_1 . (a_1 :: Constraint) +forall a_2 . (a_2 :: [*]) +forall a_3 . (a_3 :: (*, GHC.Types.Bool)) +forall a_4 . (a_4 :: GHC.Tuple.()) +forall a_5 . (a_5 :: (* -> GHC.Types.Bool) -> + (*, * -> *) -> GHC.Types.Bool) From git at git.haskell.org Fri Feb 6 15:03:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Feb 2015 15:03:36 +0000 (UTC) Subject: [commit: ghc] master: Fix the nullary-type-class case for associated types (dda6528) Message-ID: <20150206150336.7D6003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dda652826326022e4604d7b0fdc82c1993e32a67/ghc >--------------------------------------------------------------- commit dda652826326022e4604d7b0fdc82c1993e32a67 Author: Simon Peyton Jones Date: Fri Feb 6 15:04:50 2015 +0000 Fix the nullary-type-class case for associated types It was already ok for methods. Fixes Trac #10020 >--------------------------------------------------------------- dda652826326022e4604d7b0fdc82c1993e32a67 compiler/typecheck/TcTyClsDecls.hs | 37 +++++++++++++--------- .../tests/indexed-types/should_compile/T10020.hs | 5 +++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 28 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index b765129..8f278fc 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -1645,9 +1645,9 @@ checkValidClass cls -- Check that the class is unary, unless multiparameter type classes -- are enabled; also recognize deprecated nullary type classes -- extension (subsumed by multiparameter type classes, Trac #8993) - ; checkTc (multi_param_type_classes || arity == 1 || - (nullary_type_classes && arity == 0)) - (classArityErr arity cls) + ; checkTc (multi_param_type_classes || cls_arity == 1 || + (nullary_type_classes && cls_arity == 0)) + (classArityErr cls_arity cls) ; checkTc (fundep_classes || null fundeps) (classFunDepsErr cls) -- Check the super-classes @@ -1667,7 +1667,8 @@ checkValidClass cls ; mapM_ check_at_defs at_stuff } where (tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls - arity = count isTypeVar tyvars -- Ignore kind variables + cls_arity = count isTypeVar tyvars -- Ignore kind variables + cls_tv_set = mkVarSet tyvars check_op constrained_class_methods (sel_id, dm) = addErrCtxt (classOpCtxt sel_id tau) $ do @@ -1678,17 +1679,15 @@ checkValidClass cls ; traceTc "class op type" (ppr op_ty <+> ppr tau) ; checkValidType ctxt tau - -- Check that the type mentions at least one of - -- the class type variables...or at least one reachable - -- from one of the class variables. Example: tc223 + -- Check that the method type mentions a class variable + -- But actually check that the variables *reachable from* + -- the method type include a class variable. + -- Example: tc223 -- class Error e => Game b mv e | b -> mv e where -- newBoard :: MonadState b m => m () -- Here, MonadState has a fundep m->b, so newBoard is fine - -- The check is disabled for nullary type classes, - -- since there is no possible ambiguity - ; let grown_tyvars = growThetaTyVars theta (mkVarSet tyvars) - ; checkTc (arity == 0 || tyVarsOfType tau `intersectsVarSet` grown_tyvars) - (noClassTyVarErr cls (ptext (sLit "class method") <+> quotes (ppr sel_id))) + ; check_mentions (growThetaTyVars theta (tyVarsOfType tau)) + (ptext (sLit "class method") <+> quotes (ppr sel_id)) ; case dm of GenDefMeth dm_name -> do { dm_id <- tcLookupId dm_name @@ -1711,9 +1710,17 @@ checkValidClass cls -- type variable. What a mess! check_at_defs (ATI fam_tc _) - = 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))) } + = check_mentions (mkVarSet (tyConTyVars fam_tc)) + (ptext (sLit "associated type") <+> quotes (ppr fam_tc)) + + check_mentions :: TyVarSet -> SDoc -> TcM () + -- Check that the thing (method or associated type) mentions at least + -- one of the class type variables + -- The check is disabled for nullary type classes, + -- since there is no possible ambiguity (Trac #10020) + check_mentions thing_tvs thing_doc + = checkTc (cls_arity == 0 || thing_tvs `intersectsVarSet` cls_tv_set) + (noClassTyVarErr cls thing_doc) checkFamFlag :: Name -> TcM () -- Check that we don't use families without -XTypeFamilies diff --git a/testsuite/tests/indexed-types/should_compile/T10020.hs b/testsuite/tests/indexed-types/should_compile/T10020.hs new file mode 100644 index 0000000..0cdb38e --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10020.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-} +module T10020 where + +class NullaryClass where + data NullaryData diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 928a70d..9f76c7d 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -250,3 +250,4 @@ test('T9211', normal, compile, ['']) test('T9747', normal, compile, ['']) test('T9582', normal, compile, ['']) test('T9090', normal, compile, ['']) +test('T10020', normal, compile, ['']) From git at git.haskell.org Fri Feb 6 15:15:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Feb 2015 15:15:29 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10041 (0f75a3f) Message-ID: <20150206151529.767443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f75a3f0a15ac26e52dc3477fd6e5bc3cd5c6eca/ghc >--------------------------------------------------------------- commit 0f75a3f0a15ac26e52dc3477fd6e5bc3cd5c6eca Author: Simon Peyton Jones Date: Fri Feb 6 15:16:51 2015 +0000 Test Trac #10041 >--------------------------------------------------------------- 0f75a3f0a15ac26e52dc3477fd6e5bc3cd5c6eca testsuite/tests/polykinds/T10041.hs | 10 ++++++++++ testsuite/tests/polykinds/all.T | 2 ++ 2 files changed, 12 insertions(+) diff --git a/testsuite/tests/polykinds/T10041.hs b/testsuite/tests/polykinds/T10041.hs new file mode 100644 index 0000000..920252f --- /dev/null +++ b/testsuite/tests/polykinds/T10041.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds, TypeFamilies, DataKinds #-} +{-# LANGUAGE TypeOperators, GADTs, InstanceSigs #-} + +module T10041 where + +data family Sing (a :: k) +data instance Sing (xs :: [k]) where + SNil :: Sing '[] + +class SingI (a :: ?) where \ No newline at end of file diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index c86e317..7321387 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -114,3 +114,5 @@ test('T9838', normal, multimod_compile, ['T9838.hs','-v0']) test('T9574', normal, compile_fail, ['']) test('T9833', normal, compile, ['']) test('T7908', normal, compile, ['']) +test('T10041', normal, compile, ['']) + From git at git.haskell.org Fri Feb 6 16:55:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Feb 2015 16:55:13 +0000 (UTC) Subject: [commit: ghc] master: Fix Trac #10004: head [] exception when using recursive mdo (43636e1) Message-ID: <20150206165513.65A0C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43636e1b8cf4a6d4752a22b098a9edd0759a7600/ghc >--------------------------------------------------------------- commit 43636e1b8cf4a6d4752a22b098a9edd0759a7600 Author: Simon Peyton Jones Date: Fri Feb 6 16:38:52 2015 +0000 Fix Trac #10004: head [] exception when using recursive mdo >--------------------------------------------------------------- 43636e1b8cf4a6d4752a22b098a9edd0759a7600 compiler/rename/RnExpr.hs | 53 +++++++++++++++------------- testsuite/tests/mdo/should_compile/T10004.hs | 6 ++++ testsuite/tests/mdo/should_compile/all.T | 2 ++ 3 files changed, 37 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 43636e1b8cf4a6d4752a22b098a9edd0759a7600 From git at git.haskell.org Fri Feb 6 16:55:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Feb 2015 16:55:16 +0000 (UTC) Subject: [commit: ghc] master: Remove the *o pattern in testsuite/.gitignore (9bc13c0) Message-ID: <20150206165516.3E1813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9bc13c0705fbc08989eb9f51dd8691dadc855747/ghc >--------------------------------------------------------------- commit 9bc13c0705fbc08989eb9f51dd8691dadc855747 Author: Simon Peyton Jones Date: Fri Feb 6 16:40:28 2015 +0000 Remove the *o pattern in testsuite/.gitignore It cause the entire testsuite/test/mdo directory to be ignored. We already ignore *.o files. Maybe there are some other suffixes we need to add, but ignoring *o isn't good! >--------------------------------------------------------------- 9bc13c0705fbc08989eb9f51dd8691dadc855747 testsuite/.gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index bbb2174..ef3c861 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -50,7 +50,6 @@ tmp.d *.dyn_o *.dyn_hi *.dyn_hi-boot -*o *.dll *.dylib *.so From git at git.haskell.org Sun Feb 8 15:08:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Feb 2015 15:08:02 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Working still on `Out of memory` issue (f5fc656) Message-ID: <20150208150802.BB11F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/f5fc656a2001d11411a645366d62f5794e3d5ded/ghc >--------------------------------------------------------------- commit f5fc656a2001d11411a645366d62f5794e3d5ded Author: George Karachalias Date: Sun Feb 8 14:28:46 2015 +0100 Working still on `Out of memory` issue * Splitted function `alg' in `alg_covers', `alg_forces' and `alg_uncovered' for more precise control of evaluation. * Covered vectors are no longer computed, we keep track only of the corresponding `Delta's to check for satisfiability. Misc. * Moved `toTcType' appropriately (in typecheck/TcType.hs). * Changed `isSatisfiable's interface to accept only Delta. * Slightly changed terminology to follow the paper. Notes: 1. Propagation of EvVars that are in scope while traversing the AST is still deactivated. 2. The exhaustiveness checker alone does not run out of memory so I am inclined to think that the coverage checker is the one responsible for this unexpected memomy consumption. >--------------------------------------------------------------- f5fc656a2001d11411a645366d62f5794e3d5ded compiler/deSugar/Check.hs | 297 ++++++++++++++++++++----------------------- compiler/typecheck/TcType.hs | 42 ++++++ 2 files changed, 179 insertions(+), 160 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f5fc656a2001d11411a645366d62f5794e3d5ded From git at git.haskell.org Mon Feb 9 09:04:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Feb 2015 09:04:41 +0000 (UTC) Subject: [commit: ghc] master: Provide default implementation of `Monad(return)` (a741e69) Message-ID: <20150209090441.CD5033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a741e69a230eb6d6e3373ad1fbe53c73b5f95077/ghc >--------------------------------------------------------------- commit a741e69a230eb6d6e3373ad1fbe53c73b5f95077 Author: Herbert Valerio Riedel Date: Sun Feb 8 20:56:58 2015 +0100 Provide default implementation of `Monad(return)` This was dropped last-minute from d94de87252d0fe2ae97341d186b03a2fbe136b04 (re #4834) together with the default implementation for `(>>)` (see 65f887e1a0d864526f6a2609a3afc2c151c25e38 for explanation). However, the risk of accidental mutually recursive definitions of `return`/`pure` is rather low as unlike with the `(>>) = (*>)` default, any cyclic definitions would necessarily wind up being new ones, rather than changing the semantics for old operations and introducing bottoms. On the other hand, not having the default method implementation in place in GHC 7.10 would complicate/delay any future attempt to clean-up the `Monad`-class. This finally allows (for `base >= 4.8`) to define a F/A/M instance-chain with the following minimal definitions (while ignoring that `return` is still a class-method in `Monad`) instance Functor M where fmap = ... instance Applicative M where pure = ... (<*>) = ... instance Monad M where (>>=) = ... Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D647 >--------------------------------------------------------------- a741e69a230eb6d6e3373ad1fbe53c73b5f95077 libraries/base/GHC/Base.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 44085a2..7e04ab4 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -468,6 +468,7 @@ class Applicative m => Monad m where -- | Inject a value into the monadic type. return :: a -> m a + return = pure -- | Fail with a message. This operation is not part of the -- mathematical definition of a monad, but is invoked on pattern-match From git at git.haskell.org Mon Feb 9 09:07:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Feb 2015 09:07:16 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Provide default implementation of `Monad(return)` (262f7a8) Message-ID: <20150209090716.81D103A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/262f7a85bb1d40770245b990527eb0bee7c20195/ghc >--------------------------------------------------------------- commit 262f7a85bb1d40770245b990527eb0bee7c20195 Author: Herbert Valerio Riedel Date: Sun Feb 8 20:56:58 2015 +0100 Provide default implementation of `Monad(return)` This was dropped last-minute from d94de87252d0fe2ae97341d186b03a2fbe136b04 (re #4834) together with the default implementation for `(>>)` (see 65f887e1a0d864526f6a2609a3afc2c151c25e38 for explanation). However, the risk of accidental mutually recursive definitions of `return`/`pure` is rather low as unlike with the `(>>) = (*>)` default, any cyclic definitions would necessarily wind up being new ones, rather than changing the semantics for old operations and introducing bottoms. On the other hand, not having the default method implementation in place in GHC 7.10 would complicate/delay any future attempt to clean-up the `Monad`-class. This finally allows (for `base >= 4.8`) to define a F/A/M instance-chain with the following minimal definitions (while ignoring that `return` is still a class-method in `Monad`) instance Functor M where fmap = ... instance Applicative M where pure = ... (<*>) = ... instance Monad M where (>>=) = ... (cherry picked from commit a741e69a230eb6d6e3373ad1fbe53c73b5f95077) >--------------------------------------------------------------- 262f7a85bb1d40770245b990527eb0bee7c20195 libraries/base/GHC/Base.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 44085a2..7e04ab4 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -468,6 +468,7 @@ class Applicative m => Monad m where -- | Inject a value into the monadic type. return :: a -> m a + return = pure -- | Fail with a message. This operation is not part of the -- mathematical definition of a monad, but is invoked on pattern-match From git at git.haskell.org Mon Feb 9 09:48:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Feb 2015 09:48:02 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: cabal: update submodule (re: #10036) (dd1561f) Message-ID: <20150209094802.518E93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/dd1561f7db43f8ee58af82670da463c562126379/ghc >--------------------------------------------------------------- commit dd1561f7db43f8ee58af82670da463c562126379 Author: Austin Seipp Date: Mon Feb 9 02:57:00 2015 -0600 cabal: update submodule (re: #10036) Signed-off-by: Austin Seipp >--------------------------------------------------------------- dd1561f7db43f8ee58af82670da463c562126379 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 66dade3..3c0e648 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 66dade371e720efd57b06424cfdf68454e6aba77 +Subproject commit 3c0e6480d5057dd616457a0ac0458e60946c9849 From git at git.haskell.org Mon Feb 9 09:48:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Feb 2015 09:48:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix Trac #10004: head [] exception when using recursive mdo (3748c73) Message-ID: <20150209094805.5FA823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/3748c7311f3b657a9b3c01a48b39874103f46cb9/ghc >--------------------------------------------------------------- commit 3748c7311f3b657a9b3c01a48b39874103f46cb9 Author: Simon Peyton Jones Date: Fri Feb 6 16:38:52 2015 +0000 Fix Trac #10004: head [] exception when using recursive mdo (cherry picked from commit 43636e1b8cf4a6d4752a22b098a9edd0759a7600) >--------------------------------------------------------------- 3748c7311f3b657a9b3c01a48b39874103f46cb9 compiler/rename/RnExpr.hs | 53 +++++++++++++++------------- testsuite/tests/mdo/should_compile/T10004.hs | 6 ++++ testsuite/tests/mdo/should_compile/all.T | 2 ++ 3 files changed, 37 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3748c7311f3b657a9b3c01a48b39874103f46cb9 From git at git.haskell.org Mon Feb 9 09:48:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Feb 2015 09:48:07 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Put parens around (ty :: kind) when pretty-printing TH syntax (b5f465e) Message-ID: <20150209094807.F2EB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/b5f465e247c37e905b25057aa9072c8861058381/ghc >--------------------------------------------------------------- commit b5f465e247c37e905b25057aa9072c8861058381 Author: Simon Peyton Jones Date: Fri Feb 6 14:48:33 2015 +0000 Put parens around (ty :: kind) when pretty-printing TH syntax See Note [Pretty-printing kind signatures] in Language.Haskell.TH.Ppr.hs, and Trac #10050. (cherry picked from commit 111e5870803bcccd1c0736fdba432f8f9410454f) >--------------------------------------------------------------- b5f465e247c37e905b25057aa9072c8861058381 libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 15 +++++++++++++-- testsuite/tests/th/T8953.stderr | 12 ++++++------ testsuite/tests/th/TH_RichKinds.stderr | 14 +++++++------- 3 files changed, 26 insertions(+), 15 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index 4ba43f3..e5cab65 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -498,14 +498,25 @@ pprParendType PromotedNilT = text "'[]" pprParendType PromotedConsT = text "(':)" pprParendType StarT = char '*' pprParendType ConstraintT = text "Constraint" +pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) pprParendType other = parens (ppr other) instance Ppr Type where ppr (ForallT tvars ctxt ty) = text "forall" <+> hsep (map ppr tvars) <+> text "." <+> sep [pprCxt ctxt, ppr ty] - ppr (SigT ty k) = ppr ty <+> text "::" <+> ppr k - ppr ty = pprTyApp (split ty) + ppr ty = pprTyApp (split ty) + -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind) + -- See Note [Pretty-printing kind signatures] + +{- Note [Pretty-printing kind signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC's parser only recognises a kind signature in a type when there are +parens around it. E.g. the parens are required here: + f :: (Int :: *) + type instance F Int = (Bool :: *) +So we always print a SigT with parens (see Trac #10050). -} + pprTyApp :: (Type, [Type]) -> Doc pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2] diff --git a/testsuite/tests/th/T8953.stderr b/testsuite/tests/th/T8953.stderr index 14db2b7..94312ef 100644 --- a/testsuite/tests/th/T8953.stderr +++ b/testsuite/tests/th/T8953.stderr @@ -2,8 +2,8 @@ type family T8953.Poly (a_0 :: k_1) :: * type instance T8953.Poly (x_2 :: GHC.Types.Bool) = GHC.Types.Int type instance T8953.Poly (x_3 :: GHC.Base.Maybe k_4) = GHC.Types.Double type family T8953.Silly :: k_0 -> * -type instance T8953.Silly = Data.Proxy.Proxy :: * -> * -type instance T8953.Silly = Data.Proxy.Proxy :: (* -> *) -> * +type instance T8953.Silly = (Data.Proxy.Proxy :: * -> *) +type instance T8953.Silly = (Data.Proxy.Proxy :: (* -> *) -> *) T8953.a :: Data.Proxy.Proxy (Data.Proxy.Proxy :: * -> *) T8953.b :: Data.Proxy.Proxy (Data.Proxy.Proxy :: (* -> *) -> *) type T8953.StarProxy (a_0 :: *) = Data.Proxy.Proxy a_0 @@ -11,9 +11,9 @@ class T8953.PC (a_0 :: k_1) instance T8953.PC (a_2 :: *) instance T8953.PC (Data.Proxy.Proxy :: (k_3 -> *) -> *) type family T8953.F (a_0 :: *) :: k_1 -type instance T8953.F GHC.Types.Char = T8953.G (T8953.T1 :: * -> - (* -> *) -> *) - GHC.Types.Bool :: (* -> *) -> * +type instance T8953.F GHC.Types.Char = (T8953.G (T8953.T1 :: * -> + (* -> *) -> *) + GHC.Types.Bool :: (* -> *) -> *) type family T8953.G (a_0 :: k_1) :: k_1 type instance T8953.G (T8953.T1 :: k_2 -> - k1_3 -> *) = T8953.T2 :: k_2 -> k1_3 -> * + k1_3 -> *) = (T8953.T2 :: k_2 -> k1_3 -> *) diff --git a/testsuite/tests/th/TH_RichKinds.stderr b/testsuite/tests/th/TH_RichKinds.stderr index c52667e..09a8e40 100644 --- a/testsuite/tests/th/TH_RichKinds.stderr +++ b/testsuite/tests/th/TH_RichKinds.stderr @@ -1,9 +1,9 @@ TH_RichKinds.hs:12:3: Warning: - forall a_0 . a_0 :: GHC.Types.Bool -forall a_1 . a_1 :: Constraint -forall a_2 . a_2 :: [*] -forall a_3 . a_3 :: (*, GHC.Types.Bool) -forall a_4 . a_4 :: GHC.Tuple.() -forall a_5 . a_5 :: (* -> GHC.Types.Bool) -> - (*, * -> *) -> GHC.Types.Bool + forall a_0 . (a_0 :: GHC.Types.Bool) +forall a_1 . (a_1 :: Constraint) +forall a_2 . (a_2 :: [*]) +forall a_3 . (a_3 :: (*, GHC.Types.Bool)) +forall a_4 . (a_4 :: GHC.Tuple.()) +forall a_5 . (a_5 :: (* -> GHC.Types.Bool) -> + (*, * -> *) -> GHC.Types.Bool) From git at git.haskell.org Mon Feb 9 09:48:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Feb 2015 09:48:10 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix the nullary-type-class case for associated types (4c8b652) Message-ID: <20150209094810.E99CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/4c8b65218c3ad4d040691453b60091b38a41a0b0/ghc >--------------------------------------------------------------- commit 4c8b65218c3ad4d040691453b60091b38a41a0b0 Author: Simon Peyton Jones Date: Fri Feb 6 15:04:50 2015 +0000 Fix the nullary-type-class case for associated types It was already ok for methods. Fixes Trac #10020 (cherry picked from commit dda652826326022e4604d7b0fdc82c1993e32a67) >--------------------------------------------------------------- 4c8b65218c3ad4d040691453b60091b38a41a0b0 compiler/typecheck/TcTyClsDecls.hs | 37 +++++++++++++--------- .../tests/indexed-types/should_compile/T10020.hs | 5 +++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 28 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 63fca47..89f6da3 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -1645,9 +1645,9 @@ checkValidClass cls -- Check that the class is unary, unless multiparameter type classes -- are enabled; also recognize deprecated nullary type classes -- extension (subsumed by multiparameter type classes, Trac #8993) - ; checkTc (multi_param_type_classes || arity == 1 || - (nullary_type_classes && arity == 0)) - (classArityErr arity cls) + ; checkTc (multi_param_type_classes || cls_arity == 1 || + (nullary_type_classes && cls_arity == 0)) + (classArityErr cls_arity cls) ; checkTc (fundep_classes || null fundeps) (classFunDepsErr cls) -- Check the super-classes @@ -1667,7 +1667,8 @@ checkValidClass cls ; mapM_ check_at_defs at_stuff } where (tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls - arity = count isTypeVar tyvars -- Ignore kind variables + cls_arity = count isTypeVar tyvars -- Ignore kind variables + cls_tv_set = mkVarSet tyvars check_op constrained_class_methods (sel_id, dm) = addErrCtxt (classOpCtxt sel_id tau) $ do @@ -1678,17 +1679,15 @@ checkValidClass cls ; traceTc "class op type" (ppr op_ty <+> ppr tau) ; checkValidType ctxt tau - -- Check that the type mentions at least one of - -- the class type variables...or at least one reachable - -- from one of the class variables. Example: tc223 + -- Check that the method type mentions a class variable + -- But actually check that the variables *reachable from* + -- the method type include a class variable. + -- Example: tc223 -- class Error e => Game b mv e | b -> mv e where -- newBoard :: MonadState b m => m () -- Here, MonadState has a fundep m->b, so newBoard is fine - -- The check is disabled for nullary type classes, - -- since there is no possible ambiguity - ; let grown_tyvars = growThetaTyVars theta (mkVarSet tyvars) - ; checkTc (arity == 0 || tyVarsOfType tau `intersectsVarSet` grown_tyvars) - (noClassTyVarErr cls (ptext (sLit "class method") <+> quotes (ppr sel_id))) + ; check_mentions (growThetaTyVars theta (tyVarsOfType tau)) + (ptext (sLit "class method") <+> quotes (ppr sel_id)) ; case dm of GenDefMeth dm_name -> do { dm_id <- tcLookupId dm_name @@ -1711,9 +1710,17 @@ checkValidClass cls -- type variable. What a mess! check_at_defs (ATI fam_tc _) - = 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))) } + = check_mentions (mkVarSet (tyConTyVars fam_tc)) + (ptext (sLit "associated type") <+> quotes (ppr fam_tc)) + + check_mentions :: TyVarSet -> SDoc -> TcM () + -- Check that the thing (method or associated type) mentions at least + -- one of the class type variables + -- The check is disabled for nullary type classes, + -- since there is no possible ambiguity (Trac #10020) + check_mentions thing_tvs thing_doc + = checkTc (cls_arity == 0 || thing_tvs `intersectsVarSet` cls_tv_set) + (noClassTyVarErr cls thing_doc) checkFamFlag :: Name -> TcM () -- Check that we don't use families without -XTypeFamilies diff --git a/testsuite/tests/indexed-types/should_compile/T10020.hs b/testsuite/tests/indexed-types/should_compile/T10020.hs new file mode 100644 index 0000000..0cdb38e --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10020.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-} +module T10020 where + +class NullaryClass where + data NullaryData diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 928a70d..9f76c7d 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -250,3 +250,4 @@ test('T9211', normal, compile, ['']) test('T9747', normal, compile, ['']) test('T9582', normal, compile, ['']) test('T9090', normal, compile, ['']) +test('T10020', normal, compile, ['']) From git at git.haskell.org Tue Feb 10 11:41:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 11:41:51 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Turning point: Several fixes. The solver needs revision (d3dfae3) Message-ID: <20150210114151.A63CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/d3dfae30babc09bb97184740e046f122d731a4ad/ghc >--------------------------------------------------------------- commit d3dfae30babc09bb97184740e046f122d731a4ad Author: George Karachalias Date: Tue Feb 10 12:42:32 2015 +0100 Turning point: Several fixes. The solver needs revision Fixes: * Fixed a problem in `mViewPat' when translating literal patterns' type * Improved `alg_forces' judgement (better approximation) * Removed generation of duplicate constraints in cases "con-con" Things that should change when isSatisfiable works as expected: * We print `Var's with their unique * `alg_covers' does not perform `isSatisfiable' check (only syntax for now) * `matchWrapper' does not propagate environment constraints We also need to investigate the behaviour of `matchSeparator' when called with `RecUpd'. I temporarily changed it to print a `was-a-panic-before' message but it has to be solved properly. >--------------------------------------------------------------- d3dfae30babc09bb97184740e046f122d731a4ad compiler/basicTypes/Var.hs | 2 +- compiler/deSugar/Check.hs | 32 ++++++++++++++++++-------------- compiler/hsSyn/HsExpr.hs | 2 +- 3 files changed, 20 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs index 4cac5d5..167aa96 100644 --- a/compiler/basicTypes/Var.hs +++ b/compiler/basicTypes/Var.hs @@ -205,7 +205,7 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds -} instance Outputable Var where - ppr var = ppr (varName var) <> getPprStyle (ppr_debug var) + ppr var = ppr (varName var) <> ptext (sLit "-") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) ppr_debug :: Var -> PprStyle -> SDoc ppr_debug (TyVar {}) sty diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index ad5a5a2..5c12cbb 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -193,17 +193,17 @@ mViewPat pat@(ConPatOut { pat_con = L _ (RealDataCon con), pat_args = ps }) = do mViewPat pat@(NPat lit mb_neg eq) = case pmTidyNPat lit mb_neg eq of -- Note [Tidying literals for pattern matching] in MatchLit.lhs + LitPat lit -> do -- Explain why this is important + return [PmLitPat (patTypeExpanded pat) (PmLit lit)] -- transformed into simple literal NPat lit mb_neg eq -> - return [PmLitPat (patTypeExpanded pat) (PmOLit lit mb_neg eq)] - pat -> mViewPat pat -- it was translated to sth else (simple literal or constructor) - -- Make sure we get back the right type + return [PmLitPat (patTypeExpanded pat) (PmOLit lit mb_neg eq)] -- remained as is (not enough information) + pat -> mViewPat pat -- it was translated to sth else (constructor) -- only with a string this happens mViewPat pat@(LitPat lit) = case pmTidyLitPat lit of -- Note [Tidying literals for pattern matching] in MatchLit.lhs LitPat lit -> do return [PmLitPat (patTypeExpanded pat) (PmLit lit)] pat -> mViewPat pat -- it was translated to sth else (constructor) - -- Make sure we get back the right type mViewPat pat@(ListPat ps _ Nothing) = do tidy_ps <- mapM (mViewPat . unLoc) ps @@ -313,6 +313,11 @@ impliesGuard :: Delta -> PmGuard -> Bool impliesGuard _ CanFail = False impliesGuard _ CantFail = True +-- Approximation +forcesGuard :: PmGuard -> Bool +forcesGuard CantFail = False -- it is a True/otherwise +forcesGuard CanFail = True -- here we have the approximation + -- Get the type of a pattern with all type synonyms unfolded patTypeExpanded :: Pat Id -> Type patTypeExpanded = expandTypeSynonyms . hsPatType @@ -395,7 +400,9 @@ alg_forces (delta, (PmConPat _ con1 ps1) : us) ((PmConPat _ con2 ps2) : ps) | con1 == con2 = alg_forces (delta, ps1 ++ us) (ps2 ++ ps) | otherwise = return False alg_forces (_, (PmVarPat _ _):_) ((PmConPat _ _ _) : _) = return True -alg_forces (_, _) ((PmGuardPat _) : _) = return True -- Not sure though (any-guard) +alg_forces (delta, us) ((PmGuardPat g) : ps) -- return True (too conservative) + | forcesGuard g = return True -- if it is not a True/otherwise, we consider it forcing sth + | otherwise = alg_forces (delta, us) ps alg_forces (delta, ((PmLitPat _ lit) : us)) ((PmLitPat _ lit') : ps) | lit /= lit' = return False | otherwise = alg_forces (delta, us) ps @@ -408,7 +415,7 @@ alg_forces _ _ = give_up --Covering part of function `alg' alg_covers :: UncoveredVec -> InVec -> PmM Covers -- empty -alg_covers (delta,[]) [] = isSatisfiable delta +alg_covers (delta,[]) [] = return True -- isSatisfiable delta -- let's leave this aside for now -- any-var alg_covers (delta, u : us) ((PmVarPat ty _var) : ps) = do @@ -417,10 +424,8 @@ alg_covers (delta, u : us) ((PmVarPat ty _var) : ps) = do -- con-con alg_covers (delta, (PmConPat ty1 con1 ps1) : us) ((PmConPat ty2 con2 ps2) : ps) - | con1 == con2 = do - evvar <- newEqPmM ty1 ty2 - alg_covers (unitBag evvar `addEvVarsDelta` delta, ps1 ++ us) (ps2 ++ ps) - | otherwise = return False + | con1 == con2 = alg_covers (delta, ps1 ++ us) (ps2 ++ ps) + | otherwise = return False -- var-con alg_covers uvec@(delta, (PmVarPat ty _var):us) vec@((PmConPat _ con _) : _) = do @@ -463,8 +468,7 @@ alg_uncovered (delta, u : us) ((PmVarPat ty _var) : ps) = do -- con-con alg_uncovered (delta, uvec@((PmConPat ty1 con1 ps1) : us)) ((PmConPat ty2 con2 ps2) : ps) | con1 == con2 = do - evvar <- newEqPmM ty1 ty2 - uncovered <- alg_uncovered (unitBag evvar `addEvVarsDelta` delta, ps1 ++ us) (ps2 ++ ps) + uncovered <- alg_uncovered (delta, ps1 ++ us) (ps2 ++ ps) return $ mapUncovered (zip_con ty1 con1) uncovered | otherwise = return $ unitBag (delta,uvec) @@ -530,8 +534,8 @@ returning a @Nothing at . process_vector :: Bag UncoveredVec -> InVec -> PmM (Covers, Bag UncoveredVec, Forces) -- Covers , Uncovered, Forces process_vector uncovered clause = do - forces <- anyBagM (\uvec -> alg_forces uvec clause) uncovered - covers <- anyBagM (\uvec -> alg_covers uvec clause) uncovered + forces <- anyBagM (\uvec -> alg_forces uvec clause) uncovered + covers <- anyBagM (\uvec -> alg_covers uvec clause) uncovered uncovered' <- mapBagM (\uvec -> alg_uncovered uvec clause) uncovered return (covers, concatBag uncovered', forces) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index a5a1aaf..2e69311 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -1689,7 +1689,7 @@ matchSeparator LambdaExpr = ptext (sLit "->") matchSeparator ProcExpr = ptext (sLit "->") matchSeparator PatBindRhs = ptext (sLit "=") matchSeparator (StmtCtxt _) = ptext (sLit "<-") -matchSeparator RecUpd = panic "unused" +matchSeparator RecUpd = ptext (sLit "was-a-panic-before") -- panic "unused" matchSeparator ThPatSplice = panic "unused" matchSeparator ThPatQuote = panic "unused" matchSeparator PatSyn = panic "unused" From git at git.haskell.org Tue Feb 10 12:17:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 12:17:26 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Print varUnique with an underscore (dash causes problems later) (db1b098) Message-ID: <20150210121726.DEFBD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/db1b098e4b100b5f64186547d8811adb260bacc6/ghc >--------------------------------------------------------------- commit db1b098e4b100b5f64186547d8811adb260bacc6 Author: George Karachalias Date: Tue Feb 10 13:17:44 2015 +0100 Print varUnique with an underscore (dash causes problems later) >--------------------------------------------------------------- db1b098e4b100b5f64186547d8811adb260bacc6 compiler/basicTypes/Var.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs index 167aa96..cd26f48 100644 --- a/compiler/basicTypes/Var.hs +++ b/compiler/basicTypes/Var.hs @@ -205,7 +205,7 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds -} instance Outputable Var where - ppr var = ppr (varName var) <> ptext (sLit "-") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) + ppr var = ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) ppr_debug :: Var -> PprStyle -> SDoc ppr_debug (TyVar {}) sty From git at git.haskell.org Tue Feb 10 13:13:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 13:13:17 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Replace check to isSatisfiable (156c56e) Message-ID: <20150210131317.6415A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/156c56e7338245eed14b04bc7d58f2129d12a3aa/ghc >--------------------------------------------------------------- commit 156c56e7338245eed14b04bc7d58f2129d12a3aa Author: Simon Peyton Jones Date: Tue Feb 10 13:13:51 2015 +0000 Replace check to isSatisfiable >--------------------------------------------------------------- 156c56e7338245eed14b04bc7d58f2129d12a3aa compiler/deSugar/Check.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 5c12cbb..a64ba89 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -415,7 +415,7 @@ alg_forces _ _ = give_up --Covering part of function `alg' alg_covers :: UncoveredVec -> InVec -> PmM Covers -- empty -alg_covers (delta,[]) [] = return True -- isSatisfiable delta -- let's leave this aside for now +alg_covers (delta,[]) [] = isSatisfiable delta -- let's leave this aside for now -- any-var alg_covers (delta, u : us) ((PmVarPat ty _var) : ps) = do From git at git.haskell.org Tue Feb 10 13:13:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 13:13:19 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Trace tcCheckSatisfiability (6deae05) Message-ID: <20150210131319.F1F003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/6deae058ebe498a2cd5d147a7779ab191ead40df/ghc >--------------------------------------------------------------- commit 6deae058ebe498a2cd5d147a7779ab191ead40df Author: Simon Peyton Jones Date: Tue Feb 10 13:14:34 2015 +0000 Trace tcCheckSatisfiability >--------------------------------------------------------------- 6deae058ebe498a2cd5d147a7779ab191ead40df compiler/typecheck/TcSimplify.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 76fc3d9..7f32ac4 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -237,9 +237,11 @@ tcCheckSatisfiability :: Bag EvVar -> TcM Bool tcCheckSatisfiability givens = do { lcl_env <- getLclEnv ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env + ; traceTc "checkSatisfiabilty {" (ppr givens) ; (res, _ev_binds) <- runTcS $ do { solveSimpleGivens given_loc (bagToList givens) ; checkInsoluble } + ; traceTc "checkSatisfiabilty }" (ppr res) ; return (not res) } {- From git at git.haskell.org Tue Feb 10 13:22:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 13:22:31 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Add a further check to isSatisfiable in process_vector (bf44187) Message-ID: <20150210132231.55F1C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/bf44187c8ef982e876d8408f9df028f0130f7016/ghc >--------------------------------------------------------------- commit bf44187c8ef982e876d8408f9df028f0130f7016 Author: Simon Peyton Jones Date: Tue Feb 10 13:24:17 2015 +0000 Add a further check to isSatisfiable in process_vector >--------------------------------------------------------------- bf44187c8ef982e876d8408f9df028f0130f7016 compiler/deSugar/Check.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index a64ba89..324deb2 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -537,7 +537,8 @@ process_vector uncovered clause = do forces <- anyBagM (\uvec -> alg_forces uvec clause) uncovered covers <- anyBagM (\uvec -> alg_covers uvec clause) uncovered uncovered' <- mapBagM (\uvec -> alg_uncovered uvec clause) uncovered - return (covers, concatBag uncovered', forces) + uncovered'' <- filterBagM (\(delta,_) -> isSatisfiable delta) (concatBag uncovered') + return (covers, uncovered'', forces) -- | External interface. Takes: -- * The types of the arguments From git at git.haskell.org Tue Feb 10 14:01:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:01:40 +0000 (UTC) Subject: [commit: ghc] master: Replace .lhs with .hs in compiler comments (83efb98) Message-ID: <20150210140140.02D563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/83efb985d632d3a351f69cb6ce9dc5232127d545/ghc >--------------------------------------------------------------- commit 83efb985d632d3a351f69cb6ce9dc5232127d545 Author: Yuri de Wit Date: Mon Feb 9 13:41:02 2015 -0600 Replace .lhs with .hs in compiler comments Summary: It looks like during .lhs -> .hs switch the comments were not updated. So doing exactly that. Reviewers: austin, jstolarek, hvr, goldfire Reviewed By: austin, jstolarek Subscribers: thomie, goldfire Differential Revision: https://phabricator.haskell.org/D621 GHC Trac Issues: #9986 >--------------------------------------------------------------- 83efb985d632d3a351f69cb6ce9dc5232127d545 compiler/basicTypes/BasicTypes.hs | 4 ++-- compiler/basicTypes/DataCon.hs | 2 +- compiler/basicTypes/Id.hs | 4 ++-- compiler/basicTypes/IdInfo.hs | 2 +- compiler/basicTypes/MkId.hs | 2 +- compiler/basicTypes/OccName.hs | 2 +- compiler/basicTypes/Var.hs | 2 +- compiler/cmm/CmmBuildInfoTables.hs | 2 +- compiler/codeGen/StgCmmBind.hs | 2 +- compiler/codeGen/StgCmmExpr.hs | 2 +- compiler/coreSyn/CoreArity.hs | 2 +- compiler/coreSyn/CoreFVs.hs | 4 ++-- compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 20 ++++++++++---------- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/deSugar/Check.hs | 4 ++-- compiler/deSugar/DsExpr.hs | 8 ++++---- compiler/deSugar/DsForeign.hs | 2 +- compiler/ghci/ByteCodeGen.hs | 2 +- compiler/ghci/Linker.hs | 2 +- compiler/hsSyn/Convert.hs | 2 +- compiler/hsSyn/HsDecls.hs | 2 +- compiler/iface/IfaceType.hs | 2 +- compiler/iface/LoadIface.hs | 2 +- compiler/main/DriverPipeline.hs | 4 ++-- compiler/main/Finder.hs | 2 +- compiler/main/GHC.hs | 2 +- compiler/main/HscTypes.hs | 4 ++-- compiler/main/TidyPgm.hs | 2 +- compiler/nativeGen/PIC.hs | 2 +- compiler/nativeGen/PPC/CodeGen.hs | 2 +- compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 4 ++-- compiler/prelude/PrelRules.hs | 4 ++-- compiler/prelude/PrimOp.hs | 4 ++-- compiler/prelude/TysPrim.hs | 4 ++-- compiler/rename/RnEnv.hs | 2 +- compiler/rename/RnPat.hs | 2 +- compiler/rename/RnSplice.hs | 4 ++-- compiler/simplCore/FloatIn.hs | 2 +- compiler/simplCore/OccurAnal.hs | 2 +- compiler/simplCore/SetLevels.hs | 4 ++-- compiler/simplCore/SimplCore.hs | 4 ++-- compiler/simplCore/SimplUtils.hs | 4 ++-- compiler/simplCore/Simplify.hs | 6 +++--- compiler/simplStg/UnariseStg.hs | 2 +- compiler/specialise/SpecConstr.hs | 4 ++-- compiler/stgSyn/CoreToStg.hs | 4 ++-- compiler/stranal/DmdAnal.hs | 2 +- compiler/typecheck/FamInst.hs | 2 +- compiler/typecheck/TcEvidence.hs | 2 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcForeign.hs | 2 +- compiler/typecheck/TcInteract.hs | 2 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcSplice.hs | 4 ++-- compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/typecheck/TcType.hs | 4 ++-- compiler/types/CoAxiom.hs | 2 +- compiler/types/Coercion.hs | 6 +++--- compiler/types/Kind.hs | 4 ++-- compiler/types/OptCoercion.hs | 2 +- compiler/types/TyCon.hs | 4 ++-- compiler/types/Type.hs | 6 +++--- compiler/types/TypeRep.hs | 2 +- compiler/types/Unify.hs | 2 +- compiler/utils/Binary.hs | 2 +- compiler/utils/ExtsCompat46.hs | 0 67 files changed, 104 insertions(+), 104 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 83efb985d632d3a351f69cb6ce9dc5232127d545 From git at git.haskell.org Tue Feb 10 14:01:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:01:42 +0000 (UTC) Subject: [commit: ghc] master: Remove deprecated libraries/base/include/Typeable.h (e22282e) Message-ID: <20150210140142.D27593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e22282e5d2a370395535df4051bdeb8213106d1c/ghc >--------------------------------------------------------------- commit e22282e5d2a370395535df4051bdeb8213106d1c Author: Thomas Miedema Date: Mon Feb 9 13:42:53 2015 -0600 Remove deprecated libraries/base/include/Typeable.h Test Plan: I grepped for other references, there were none. Reviewers: ekmett, hvr, austin Reviewed By: austin Subscribers: ekmett, thomie, carter Differential Revision: https://phabricator.haskell.org/D483 >--------------------------------------------------------------- e22282e5d2a370395535df4051bdeb8213106d1c libraries/base/base.cabal | 1 - libraries/base/include/Typeable.h | 31 ------------------------------- 2 files changed, 32 deletions(-) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 70d719f..f133fbe 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -322,7 +322,6 @@ Library HsBase.h WCsubst.h consUtils.h - Typeable.h -- OS Specific if os(windows) diff --git a/libraries/base/include/Typeable.h b/libraries/base/include/Typeable.h deleted file mode 100644 index 1a31498..0000000 --- a/libraries/base/include/Typeable.h +++ /dev/null @@ -1,31 +0,0 @@ -{- -------------------------------------------------------------------------- -// Macros to help make Typeable instances. -// -// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines -// -// instance Typeable/n/ tc -// instance Typeable a => Typeable/n-1/ (tc a) -// instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b) -// ... -// instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an) -// -------------------------------------------------------------------------- --} - -#ifndef TYPEABLE_H -#define TYPEABLE_H - -#warning is obsolete and will be removed in GHC 7.10 - --- // For GHC, we can use DeriveDataTypeable + StandaloneDeriving to --- // generate the instances. - -#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE4(tycon,tcname,str) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE5(tycon,tcname,str) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE6(tycon,tcname,str) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE7(tycon,tcname,str) deriving instance Typeable tycon - -#endif From git at git.haskell.org Tue Feb 10 14:01:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:01:45 +0000 (UTC) Subject: [commit: ghc] master: Add a workaround to allow older cabal-install to use ghc-7.10 (a1db53c) Message-ID: <20150210140145.816AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1db53cc6ea03d80f097c550bae277141b03ac30/ghc >--------------------------------------------------------------- commit a1db53cc6ea03d80f097c550bae277141b03ac30 Author: Duncan Coutts Date: Mon Feb 9 13:46:06 2015 -0600 Add a workaround to allow older cabal-install to use ghc-7.10 Summary: This should smooth the upgrade process for people and help with testing the 7.10 RCs. Otherwise people need to first install cabal-install-1.22 before they can use 7.10. The problem is that older cabal still used file-style package dbs for the inplace package db when building packages. The workaround is that both ghc and ghc-pkg will notice when cabal tells them to use a file style db e.g. "dist/package.conf.inplace" and, so long as that db is empty (ie content is []) then they'll instead us a dir style db with the same name but ".d" appended, so in this example that would be "dist/package.conf.inplace.d". We have to use a separate dir rather than transparently upgrading because old Cabal really assumes the path is a file, and if it encounters a dir it will fail. This seems to be enough for older Cabal to work, and may well be enough for other scripts that create dbs using "echo [] > package.conf". Test Plan: validate and check new and old cabal can sucessfully install things, including packages that have internal deps (ie using the inplace db) Reviewers: hvr, tibbe, austin Reviewed By: tibbe, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D628 >--------------------------------------------------------------- a1db53cc6ea03d80f097c550bae277141b03ac30 compiler/main/Packages.hs | 35 +++++++++++++++++--- utils/ghc-pkg/Main.hs | 82 +++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 107 insertions(+), 10 deletions(-) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 28f2f2d..db48d99 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -367,13 +367,15 @@ readPackageConfig dflags conf_file = do proto_pkg_configs <- if isdir - then do let filename = conf_file "package.cache" - debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename) - readPackageDbForGhc filename + then readDirStylePackageConfig conf_file else do isfile <- doesFileExist conf_file if isfile - then throwGhcExceptionIO $ InstallationError $ + then do + mpkgs <- tryReadOldFileStylePackageConfig + case mpkgs of + Just pkgs -> return pkgs + Nothing -> throwGhcExceptionIO $ InstallationError $ "ghc no longer supports single-file style package " ++ "databases (" ++ conf_file ++ ") use 'ghc-pkg init' to create the database with " ++ @@ -388,6 +390,31 @@ readPackageConfig dflags conf_file = do pkg_configs2 = setBatchPackageFlags dflags pkg_configs1 -- return pkg_configs2 + where + readDirStylePackageConfig conf_dir = do + let filename = conf_dir "package.cache" + debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename) + readPackageDbForGhc filename + + -- Single-file style package dbs have been deprecated for some time, but + -- it turns out that Cabal was using them in one place. So this is a + -- workaround to allow older Cabal versions to use this newer ghc. + -- We check if the file db contains just "[]" and if so, we look for a new + -- dir-style db in conf_file.d/, ie in a dir next to the given file. + -- We cannot just replace the file with a new dir style since Cabal still + -- assumes it's a file and tries to overwrite with 'writeFile'. + -- ghc-pkg also cooperates with this workaround. + tryReadOldFileStylePackageConfig = do + content <- readFile conf_file `catchIO` \_ -> return "" + if take 2 content == "[]" + then do + let conf_dir = conf_file <.> "d" + direxists <- doesDirectoryExist conf_dir + if direxists + then do debugTraceMsg dflags 2 (text "Ignoring old file-style db and trying:" <+> text conf_dir) + liftM Just (readDirStylePackageConfig conf_dir) + else return (Just []) -- ghc-pkg will create it when it's updated + else return Nothing setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig] setBatchPackageFlags dflags pkgs = maybeDistrustAll pkgs diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 0493866..b2815b8 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -680,10 +680,18 @@ readParseDatabase verbosity mb_user_conf modify use_cache path = do e <- tryIO $ getDirectoryContents path case e of Left err - | ioeGetErrorType err == InappropriateType -> - die ("ghc no longer supports single-file style package databases " - ++ "(" ++ path ++ ") use 'ghc-pkg init' to create the database " - ++ "with the correct format.") + | ioeGetErrorType err == InappropriateType -> do + -- We provide a limited degree of backwards compatibility for + -- old single-file style db: + mdb <- tryReadParseOldFileStyleDatabase verbosity + mb_user_conf modify use_cache path + case mdb of + Just db -> return db + Nothing -> + die $ "ghc no longer supports single-file style package " + ++ "databases (" ++ path ++ ") use 'ghc-pkg init'" + ++ "to create the database with the correct format." + | otherwise -> ioError err Right fs | not use_cache -> ignore_cache (const $ return ()) @@ -823,6 +831,67 @@ mungePackagePaths top_dir pkgroot pkg = -- ----------------------------------------------------------------------------- +-- Workaround for old single-file style package dbs + +-- Single-file style package dbs have been deprecated for some time, but +-- it turns out that Cabal was using them in one place. So this code is for a +-- workaround to allow older Cabal versions to use this newer ghc. + +-- We check if the file db contains just "[]" and if so, we look for a new +-- dir-style db in path.d/, ie in a dir next to the given file. +-- We cannot just replace the file with a new dir style since Cabal still +-- assumes it's a file and tries to overwrite with 'writeFile'. + +-- ghc itself also cooperates in this workaround + +tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (FilePath, Bool) + -> Bool -> Bool -> FilePath + -> IO (Maybe PackageDB) +tryReadParseOldFileStyleDatabase verbosity mb_user_conf modify use_cache path = do + -- assumes we've already established that path exists and is not a dir + content <- readFile path `catchIO` \_ -> return "" + if take 2 content == "[]" + then do + path_abs <- absolutePath path + let path_dir = path <.> "d" + warn $ "Warning: ignoring old file-style db and trying " ++ path_dir + direxists <- doesDirectoryExist path_dir + if direxists + then do db <- readParseDatabase verbosity mb_user_conf + modify use_cache path_dir + -- but pretend it was at the original location + return $ Just db { + location = path, + locationAbsolute = path_abs + } + else return $ Just PackageDB { + location = path, + locationAbsolute = path_abs, + packages = [] + } + + -- if the path is not a file, or is not an empty db then we fail + else return Nothing + +adjustOldFileStylePackageDB :: PackageDB -> IO PackageDB +adjustOldFileStylePackageDB db = do + -- assumes we have not yet established if it's an old style or not + mcontent <- liftM Just (readFile (location db)) `catchIO` \_ -> return Nothing + case fmap (take 2) mcontent of + -- it is an old style and empty db, so look for a dir kind in location.d/ + Just "[]" -> return db { + location = location db <.> "d", + locationAbsolute = locationAbsolute db <.> "d" + } + -- it is old style but not empty, we have to bail + Just _ -> die $ "ghc no longer supports single-file style package " + ++ "databases (" ++ location db ++ ") use 'ghc-pkg init'" + ++ "to create the database with the correct format." + -- probably not old style, carry on as normal + Nothing -> return db + + +-- ----------------------------------------------------------------------------- -- Creating a new package DB initPackageDB :: FilePath -> Verbosity -> [Flag] -> IO () @@ -941,8 +1010,9 @@ data DBOp = RemovePackage InstalledPackageInfo changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO () changeDB verbosity cmds db = do let db' = updateInternalDB db cmds - createDirectoryIfMissing True (location db) - changeDBDir verbosity cmds db' + db'' <- adjustOldFileStylePackageDB db' + createDirectoryIfMissing True (location db'') + changeDBDir verbosity cmds db'' updateInternalDB :: PackageDB -> [DBOp] -> PackageDB updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds } From git at git.haskell.org Tue Feb 10 14:01:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:01:48 +0000 (UTC) Subject: [commit: ghc] master: Add Uniquable instances for InstalledPackageId/SourcePackageId/PackageName (d5a80db) Message-ID: <20150210140148.1C2473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5a80dbe2ea03099c085020142528fcd39059a27/ghc >--------------------------------------------------------------- commit d5a80dbe2ea03099c085020142528fcd39059a27 Author: Edward Z. Yang Date: Mon Feb 9 13:46:29 2015 -0600 Add Uniquable instances for InstalledPackageId/SourcePackageId/PackageName Summary: Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D633 >--------------------------------------------------------------- d5a80dbe2ea03099c085020142528fcd39059a27 compiler/main/PackageConfig.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index b94ea65..3c41151 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -34,6 +34,7 @@ import Data.Version import FastString import Outputable import Module +import Unique -- ----------------------------------------------------------------------------- -- Our PackageConfig type is the InstalledPackageInfo from bin-package-db, @@ -66,6 +67,15 @@ instance BinaryStringRep PackageName where fromStringRep = PackageName . mkFastStringByteString toStringRep (PackageName s) = fastStringToByteString s +instance Uniquable InstalledPackageId where + getUnique (InstalledPackageId n) = getUnique n + +instance Uniquable SourcePackageId where + getUnique (SourcePackageId n) = getUnique n + +instance Uniquable PackageName where + getUnique (PackageName n) = getUnique n + instance Outputable InstalledPackageId where ppr (InstalledPackageId str) = ftext str From git at git.haskell.org Tue Feb 10 14:01:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:01:50 +0000 (UTC) Subject: [commit: ghc] master: Clarify the documentation for 'evaluate' (de9a836) Message-ID: <20150210140150.C7B223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de9a836cd920722a4c28dcb464ff2c8d5905acb9/ghc >--------------------------------------------------------------- commit de9a836cd920722a4c28dcb464ff2c8d5905acb9 Author: Roman Cheplyaka Date: Mon Feb 9 13:44:03 2015 -0600 Clarify the documentation for 'evaluate' Summary: See: https://www.haskell.org/pipermail/ghc-devs/2015-January/007900.html https://ghc.haskell.org/trac/ghc/ticket/5129#comment:17 Reviewers: hvr, Mikolaj, austin Reviewed By: Mikolaj, austin Subscribers: ezyang, nomeata, thomie Differential Revision: https://phabricator.haskell.org/D615 >--------------------------------------------------------------- de9a836cd920722a4c28dcb464ff2c8d5905acb9 libraries/base/GHC/IO.hs | 41 ++++++++++++++++++++++++++++++----------- 1 file changed, 30 insertions(+), 11 deletions(-) diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs index e9ac941..7dbd338 100644 --- a/libraries/base/GHC/IO.hs +++ b/libraries/base/GHC/IO.hs @@ -470,20 +470,39 @@ a `finally` sequel = _ <- sequel return r --- | Forces its argument to be evaluated to weak head normal form when --- the resultant 'IO' action is executed. It can be used to order --- evaluation with respect to other 'IO' operations; its semantics are --- given by +-- | Evaluate the argument to weak head normal form. -- --- > evaluate x `seq` y ==> y --- > evaluate x `catch` f ==> (return $! x) `catch` f --- > evaluate x >>= f ==> (return $! x) >>= f +-- 'evaluate' is typically used to uncover any exceptions that a lazy value +-- may contain, and possibly handle them. -- --- /Note:/ the first equation implies that @(evaluate x)@ is /not/ the --- same as @(return $! x)@. A correct definition is +-- 'evaluate' only evaluates to /weak head normal form/. If deeper +-- evaluation is needed, the @force@ function from @Control.DeepSeq@ +-- may be handy: -- --- > evaluate x = (return $! x) >>= return +-- > evaluate $ force x -- +-- There is a subtle difference between @'evaluate' x@ and @'return' '$!' x@, +-- analogous to the difference between 'throwIO' and 'throw'. If the lazy +-- value @x@ throws an exception, @'return' '$!' x@ will fail to return an +-- 'IO' action and will throw an exception instead. @'evaluate' x@, on the +-- other hand, always produces an 'IO' action; that action will throw an +-- exception upon /execution/ iff @x@ throws an exception upon /evaluation/. +-- +-- The practical implication of this difference is that due to the +-- /imprecise exceptions/ semantics, +-- +-- > (return $! error "foo") >> error "bar" +-- +-- may throw either @"foo"@ or @"bar"@, depending on the optimizations +-- performed by the compiler. On the other hand, +-- +-- > evaluate (error "foo") >> error "bar" +-- +-- is guaranteed to throw @"foo"@. +-- +-- The rule of thumb is to use 'evaluate' to force or handle exceptions in +-- lazy values. If, on the other hand, you are forcing a lazy value for +-- efficiency reasons only and do not care about exceptions, you may +-- use @'return' '$!' x at . evaluate :: a -> IO a evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129 - From git at git.haskell.org Tue Feb 10 14:01:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:01:53 +0000 (UTC) Subject: [commit: ghc] master: llvmGen: move to LLVM 3.6 exclusively (5d5abdc) Message-ID: <20150210140153.7B6313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d5abdca31cdb4db5303999778fa25c4a1371084/ghc >--------------------------------------------------------------- commit 5d5abdca31cdb4db5303999778fa25c4a1371084 Author: Ben Gamari Date: Mon Feb 9 15:21:28 2015 -0600 llvmGen: move to LLVM 3.6 exclusively Summary: Rework llvmGen to use LLVM 3.6 exclusively. The plans for the 7.12 release are to ship LLVM alongside GHC in the interests of user (and developer) sanity. Along the way, refactor TNTC support to take advantage of the new `prefix` data support in LLVM 3.6. This allows us to drop the section-reordering component of the LLVM mangler. Test Plan: Validate, look at emitted code Reviewers: dterei, austin, scpmw Reviewed By: austin Subscribers: erikd, awson, spacekitteh, thomie, carter Differential Revision: https://phabricator.haskell.org/D530 GHC Trac Issues: #10074 >--------------------------------------------------------------- 5d5abdca31cdb4db5303999778fa25c4a1371084 compiler/llvmGen/Llvm/AbsSyn.hs | 13 ++++-- compiler/llvmGen/Llvm/MetaData.hs | 14 +++--- compiler/llvmGen/Llvm/PpLlvm.hs | 37 +++++++++------ compiler/llvmGen/LlvmCodeGen.hs | 7 +-- compiler/llvmGen/LlvmCodeGen/Base.hs | 26 ++--------- compiler/llvmGen/LlvmCodeGen/Data.hs | 2 +- compiler/llvmGen/LlvmCodeGen/Ppr.hs | 90 ++++++++++-------------------------- compiler/llvmGen/LlvmMangler.hs | 49 ++------------------ 8 files changed, 72 insertions(+), 166 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5d5abdca31cdb4db5303999778fa25c4a1371084 From git at git.haskell.org Tue Feb 10 14:01:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:01:56 +0000 (UTC) Subject: [commit: ghc] master: Don't overwrite input file by default (78833ca) Message-ID: <20150210140156.403913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78833ca6305f0875add94351592e141c032cd088/ghc >--------------------------------------------------------------- commit 78833ca6305f0875add94351592e141c032cd088 Author: Phil Ruffwind Date: Mon Feb 9 13:39:12 2015 -0600 Don't overwrite input file by default Summary: If the default filename of the output executable coincides with that of main source file, throw an error instead of silently clobbering the input file. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D642 GHC Trac Issues: #9930 >--------------------------------------------------------------- 78833ca6305f0875add94351592e141c032cd088 compiler/main/GhcMake.hs | 18 +++++++++++++----- testsuite/tests/ghc-e/should_fail/Makefile | 3 +++ testsuite/tests/ghc-e/should_fail/T9930 | 1 + testsuite/tests/ghc-e/should_fail/all.T | 3 +++ 4 files changed, 20 insertions(+), 5 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index a698f50..f9e61a5 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -427,14 +427,22 @@ guessOutputFile = modifySession $ \env -> ml_hs_file (ms_location ms) name = fmap dropExtension mainModuleSrcPath + name_exe = do #if defined(mingw32_HOST_OS) - -- we must add the .exe extention unconditionally here, otherwise - -- when name has an extension of its own, the .exe extension will - -- not be added by DriverPipeline.exeFileName. See #2248 - name_exe = fmap (<.> "exe") name + -- we must add the .exe extention unconditionally here, otherwise + -- when name has an extension of its own, the .exe extension will + -- not be added by DriverPipeline.exeFileName. See #2248 + name' <- fmap (<.> "exe") name #else - name_exe = name + name' <- name #endif + mainModuleSrcPath' <- mainModuleSrcPath + -- #9930: don't clobber input files (unless they ask for it) + if name' == mainModuleSrcPath' + then throwGhcException . UsageError $ + "default output name would overwrite the input file; " ++ + "must specify -o explicitly" + else Just name' in case outputFile dflags of Just _ -> env diff --git a/testsuite/tests/ghc-e/should_fail/Makefile b/testsuite/tests/ghc-e/should_fail/Makefile index c0cebcd..9aa7c07 100644 --- a/testsuite/tests/ghc-e/should_fail/Makefile +++ b/testsuite/tests/ghc-e/should_fail/Makefile @@ -19,3 +19,6 @@ ghc-e-fail1: ghc-e-fail2: '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "type A = A" + +T9930fail: + '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -x hs T9930 diff --git a/testsuite/tests/ghc-e/should_fail/T9930 b/testsuite/tests/ghc-e/should_fail/T9930 new file mode 100644 index 0000000..45846a9 --- /dev/null +++ b/testsuite/tests/ghc-e/should_fail/T9930 @@ -0,0 +1 @@ +main = undefined diff --git a/testsuite/tests/ghc-e/should_fail/all.T b/testsuite/tests/ghc-e/should_fail/all.T index bfd4a8a..8e080e9 100644 --- a/testsuite/tests/ghc-e/should_fail/all.T +++ b/testsuite/tests/ghc-e/should_fail/all.T @@ -17,3 +17,6 @@ test('ghc-e-fail1', [exit_code(2), req_interp, ignore_output], run_command, test('ghc-e-fail2', [exit_code(2), req_interp, ignore_output], run_command, ['$MAKE --no-print-directory -s ghc-e-fail2']) + +test('T9930fail', [exit_code(2), ignore_output], run_command, + ['$MAKE --no-print-directory -s T9930fail']) From git at git.haskell.org Tue Feb 10 14:50:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 14:50:47 +0000 (UTC) Subject: [commit: ghc] master: Refactor the handling of quasi-quotes (f46360e) Message-ID: <20150210145047.923A83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f46360ed7139ff25741b381647b0a0b6d1000d84/ghc >--------------------------------------------------------------- commit f46360ed7139ff25741b381647b0a0b6d1000d84 Author: Simon Peyton Jones Date: Tue Feb 10 14:09:12 2015 +0000 Refactor the handling of quasi-quotes As Trac #10047 points out, a quasi-quotation [n|...blah...|] is supposed to behave exactly like $(n "...blah..."). But it doesn't! This was outright wrong: quasiquotes were being run even inside brackets. Now that TH supports both typed and untyped splices, a quasi-quote is properly regarded as a particular syntax for an untyped splice. But apart from that they should be treated the same. So this patch refactors the handling of quasiquotes to do just that. The changes touch quite a lot of files, but mostly in a routine way. The biggest changes by far are in RnSplice, and more minor changes in TcSplice. These are the places where there was real work to be done. Everything else is routine knock-on changes. * No more QuasiQuote forms in declarations, expressions, types, etc. So we get rid of these data constructors * HsBinds.QuasiQuoteD * HsExpr.HsSpliceE * HsPat.QuasiQuotePat * HsType.HsQuasiQuoteTy * We get rid of the HsQuasiQuote type altogether * Instead, we augment the HsExpr.HsSplice type to have three consructors, for the three types of splice: * HsTypedSplice * HsUntypedSplice * HsQuasiQuote There are some related changes in the data types in HsExpr near HsSplice. Specifically: PendingRnSplice, PendingTcSplice, UntypedSpliceFlavour. * In Hooks, we combine rnQuasiQuoteHook and rnRnSpliceHook into one. A smaller, clearer interface. * We have to update the Haddock submodule, to accommodate the hsSyn changes >--------------------------------------------------------------- f46360ed7139ff25741b381647b0a0b6d1000d84 compiler/deSugar/Check.hs | 2 - compiler/deSugar/DsArrows.hs | 1 - compiler/deSugar/DsExpr.hs | 3 +- compiler/deSugar/DsMeta.hs | 15 +- compiler/hsSyn/HsDecls.hs | 8 +- compiler/hsSyn/HsExpr.hs | 122 ++++--- compiler/hsSyn/HsExpr.hs-boot | 3 +- compiler/hsSyn/HsPat.hs | 13 +- compiler/hsSyn/HsTypes.hs | 35 +- compiler/hsSyn/HsUtils.hs | 19 +- compiler/main/Hooks.hs | 7 +- compiler/parser/Parser.y | 6 +- compiler/parser/RdrHsSyn.hs | 15 +- compiler/rename/RnExpr.hs | 11 +- compiler/rename/RnPat.hs | 9 +- compiler/rename/RnSource.hs | 5 - compiler/rename/RnSplice.hs | 400 +++++++++++++-------- compiler/rename/RnTypes.hs | 9 - compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcExpr.hs | 7 +- compiler/typecheck/TcHsSyn.hs | 8 +- compiler/typecheck/TcHsType.hs | 1 - compiler/typecheck/TcPat.hs | 3 - compiler/typecheck/TcPatSyn.hs | 2 - compiler/typecheck/TcRnDriver.hs | 13 +- compiler/typecheck/TcSplice.hs | 252 ++----------- compiler/typecheck/TcSplice.hs-boot | 33 +- .../tests/annotations/should_fail/annfail03.stderr | 2 +- .../tests/annotations/should_fail/annfail04.stderr | 2 +- .../tests/annotations/should_fail/annfail06.stderr | 2 +- .../tests/annotations/should_fail/annfail09.stderr | 2 +- testsuite/tests/quasiquotation/T3953.stderr | 4 +- testsuite/tests/quasiquotation/qq001/qq001.stderr | 6 +- testsuite/tests/quasiquotation/qq002/qq002.stderr | 6 +- testsuite/tests/quasiquotation/qq003/qq003.stderr | 6 +- testsuite/tests/quasiquotation/qq004/qq004.stderr | 6 +- testsuite/tests/th/T10047.hs | 6 + testsuite/tests/th/T10047.script | 4 + testsuite/tests/th/T10047.stdout | 2 + testsuite/tests/th/T2597b.stderr | 2 +- testsuite/tests/th/T3177a.stderr | 2 +- testsuite/tests/th/T3395.stderr | 2 +- testsuite/tests/th/T5358.stderr | 4 +- testsuite/tests/th/T5795.stderr | 4 +- testsuite/tests/th/T5971.stderr | 2 +- testsuite/tests/th/T7276.stderr | 4 +- testsuite/tests/th/T7276a.stdout | 2 +- testsuite/tests/th/T7667a.stderr | 2 +- testsuite/tests/th/T8412.stderr | 2 +- testsuite/tests/th/TH_1tuple.stderr | 2 +- testsuite/tests/th/TH_StaticPointers02.stderr | 6 +- testsuite/tests/th/TH_runIO.stderr | 4 +- testsuite/tests/th/TH_unresolvedInfix2.stderr | 6 +- testsuite/tests/th/all.T | 1 + utils/haddock | 2 +- 55 files changed, 472 insertions(+), 627 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f46360ed7139ff25741b381647b0a0b6d1000d84 From git at git.haskell.org Tue Feb 10 19:58:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 19:58:39 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Most of the custom solver for typeable. What's missing: (73da504) Message-ID: <20150210195839.222363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/73da504eb55c791eb6f2fff555641dfca6b548d3/ghc >--------------------------------------------------------------- commit 73da504eb55c791eb6f2fff555641dfca6b548d3 Author: Iavor S. Diatchki Date: Mon Feb 9 17:09:39 2015 -0800 Most of the custom solver for typeable. What's missing: * All the scaffolding is there, but solver is not connected in TcInteract * The final step of the dsugaring---where we actually make the expressions for the TypeReps---is not written yet. This changes the deepseq submodule because the representation of TypeReps now has an extra field. >--------------------------------------------------------------- 73da504eb55c791eb6f2fff555641dfca6b548d3 compiler/basicTypes/MkId.hs | 1 + compiler/deSugar/DsBinds.hs | 58 +++++++++++++++++++++++++ compiler/typecheck/TcDeriv.hs | 5 ++- compiler/typecheck/TcEvidence.hs | 46 ++++++++++++++++++++ compiler/typecheck/TcHsSyn.hs | 14 ++++++ compiler/typecheck/TcInteract.hs | 60 +++++++++++++++++++++++++- libraries/base/Data/Typeable/Internal.hs | 74 ++++++++++++++++++++++++-------- libraries/deepseq | 2 +- 8 files changed, 237 insertions(+), 23 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 73da504eb55c791eb6f2fff555641dfca6b548d3 From git at git.haskell.org Tue Feb 10 19:58:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 19:58:41 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Use the kind itself in the evidence for `Typeable` (e50df19) Message-ID: <20150210195841.B8D1A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/e50df19e91daf7d4f73f516b1aa8ab7060222458/ghc >--------------------------------------------------------------- commit e50df19e91daf7d4f73f516b1aa8ab7060222458 Author: Iavor S. Diatchki Date: Tue Feb 10 10:10:59 2015 -0800 Use the kind itself in the evidence for `Typeable` >--------------------------------------------------------------- e50df19e91daf7d4f73f516b1aa8ab7060222458 compiler/deSugar/DsBinds.hs | 4 +--- compiler/typecheck/TcEvidence.hs | 15 ++------------- compiler/typecheck/TcInteract.hs | 8 +++++--- 3 files changed, 8 insertions(+), 19 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 3c50d1e..3fb42bf 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -889,7 +889,7 @@ dsEvTypeable ev = (rep,ty) <- case ev of EvTypeableTyCon tc ks ts -> - do let ty = mkTyConApp tc (map toKind ks ++ map snd ts) + do let ty = mkTyConApp tc (ks ++ map snd ts) kReps <- mapM kindRep ks tReps <- mapM (getRep tyCl) ts return (tyConRep tc kReps tReps, ty) @@ -928,8 +928,6 @@ dsEvTypeable ev = (getTypeableCo tc ty) where proxyT = mkProxyPrimTy (typeKind ty) ty - toKind (EvTypeableKind kc ks) = mkTyConApp kc (map toKind ks) - kindRep k = undefined tyConRep tc kReps tReps = undefined tyAppRep t1 t2 = undefined diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index b55037c..5bc5c94 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -17,7 +17,7 @@ module TcEvidence ( EvTerm(..), mkEvCast, evVarsOfTerm, EvLit(..), evTermCoercion, EvCallStack(..), - EvTypeable(..), EvTypeableKind(..), + EvTypeable(..), -- TcCoercion TcCoercion(..), LeftOrRight(..), pickLR, @@ -735,7 +735,7 @@ data EvTerm -- | Instructions on how to make a 'Typeable' dictionary. data EvTypeable - = EvTypeableTyCon TyCon [EvTypeableKind] [(EvTerm, Type)] + = EvTypeableTyCon TyCon [Kind] [(EvTerm, Type)] -- ^ Dicitionary for concrete type constructors. | EvTypeableTyApp (EvTerm,Type) (EvTerm,Type) @@ -747,11 +747,6 @@ data EvTypeable deriving ( Data.Data, Data.Typeable ) --- | Instructions on how to make evidence for the typeable representation --- of a kind. -data EvTypeableKind = EvTypeableKind TyCon [EvTypeableKind] - deriving ( Data.Data, Data.Typeable ) - data EvLit = EvNum Integer | EvStr FastString @@ -1112,12 +1107,6 @@ instance Outputable EvTypeable where EvTypeableTyApp t1 t2 -> parens (ppr (fst t1) <+> ppr (fst t2)) EvTypeableTyLit x -> ppr x -instance Outputable EvTypeableKind where - ppr (EvTypeableKind kc ks) = - case ks of - [] -> ppr kc - _ -> parens (ppr kc <+> sep (map ppr ks)) - ---------------------------------------------------------------------- -- Helper functions for dealing with IP newtype-dictionaries diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index f1990ca..7293f57 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1823,10 +1823,12 @@ matchTypeableClass clas k t loc mkEv [ct1,ct2] (EvTypeableTyApp (ctEvTerm ct1,f) (ctEvTerm ct2,tk)) - -- Representation for concrete kinds. + -- Representation for concrete kinds. We just use the kind itself, + -- but first check to make sure that it is "simple" (i.e., made entirely + -- out of kind constructors). kindRep ki = do (kc,ks) <- splitTyConApp_maybe ki - kReps <- mapM kindRep ks - return (EvTypeableKind kc kReps) + mapM_ kindRep ks + return ki -- Emit a `Typeable` constraint for the given type. From git at git.haskell.org Tue Feb 10 19:58:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 19:58:44 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Put it all together. (6b4240b) Message-ID: <20150210195844.5F99A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/6b4240b8cda4e8a463141a61d0664896ab1c6b4b/ghc >--------------------------------------------------------------- commit 6b4240b8cda4e8a463141a61d0664896ab1c6b4b Author: Iavor S. Diatchki Date: Tue Feb 10 11:50:22 2015 -0800 Put it all together. >--------------------------------------------------------------- 6b4240b8cda4e8a463141a61d0664896ab1c6b4b compiler/deSugar/DsBinds.hs | 40 +++++++++++++++++++++++++++++++++++++--- compiler/typecheck/TcInteract.hs | 5 +++++ 2 files changed, 42 insertions(+), 3 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 11bd4b8..707a963 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -40,7 +40,8 @@ import Digraph import PrelNames import TysPrim ( mkProxyPrimTy ) -import TyCon ( isTupleTyCon, tyConDataCons_maybe ) +import TyCon ( isTupleTyCon, tyConDataCons_maybe + , tyConName, isPromotedTyCon, isPromotedDataCon ) import TcEvidence import TcType import Type @@ -73,6 +74,7 @@ import Util import Control.Monad( when ) import MonadUtils import Control.Monad(liftM) +import Fingerprint(Fingerprint(..), fingerprintString) {- ************************************************************************ @@ -888,9 +890,12 @@ dsEvTypeable ev = do tyCl <- dsLookupTyCon typeableClassName (ty, rep) <- case ev of + EvTypeableTyCon tc ks ts -> do ctr <- dsLookupGlobalId mkPolyTyConAppName + mkTyCon <- dsLookupGlobalId mkTyConName typeRepTc <- dsLookupTyCon typeRepTyConName + dflags <- getDynFlags let tyRepType = mkTyConApp typeRepTc [] mkRep cRep kReps tReps = mkApps (Var ctr) [ cRep @@ -903,11 +908,11 @@ dsEvTypeable ev = case splitTyConApp_maybe k of Nothing -> panic "dsEvTypeable: not a kind constructor" Just (kc,ks) -> - do kcRep <- undefined kc + do kcRep <- tyConRep dflags mkTyCon kc reps <- mapM kindRep ks return (mkRep kcRep [] reps) - tcRep <- undefined tc + tcRep <- tyConRep dflags mkTyCon tc kReps <- mapM kindRep ks tReps <- mapM (getRep tyCl) ts @@ -957,6 +962,35 @@ dsEvTypeable ev = (getTypeableCo tc ty) where proxyT = mkProxyPrimTy (typeKind ty) ty + -- This part could be cached + tyConRep dflags mkTyCon tc = + do pkgStr <- mkStringExprFS pkg_fs + modStr <- mkStringExprFS modl_fs + nameStr <- mkStringExprFS name_fs + return (mkApps (Var mkTyCon) [ int64 high, int64 low + , pkgStr, modStr, nameStr + ]) + where + tycon_name = tyConName tc + modl = nameModule tycon_name + pkg = modulePackageKey modl + + modl_fs = moduleNameFS (moduleName modl) + pkg_fs = packageKeyFS pkg + name_fs = occNameFS (nameOccName tycon_name) + hash_name_fs + | isPromotedTyCon tc = appendFS (mkFastString "$k") name_fs + | isPromotedDataCon tc = appendFS (mkFastString "$c") name_fs + | otherwise = name_fs + + hashThis = unwords $ map unpackFS [pkg_fs, modl_fs, hash_name_fs] + Fingerprint high low = fingerprintString hashThis + + int64 + | wORD_SIZE dflags == 4 = mkWord64LitWord64 + | otherwise = mkWordLit dflags . fromIntegral + + diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 7293f57..1a01441 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1639,6 +1639,11 @@ matchClassInst _ clas [ ty ] _ = panicTcS (text "Unexpected evidence for" <+> ppr (className clas) $$ vcat (map (ppr . idType) (classMethods clas))) + + +matchClassInst inerts clas [k,t] loc + | className clas == typeableClassName = matchTypeableClass clas k t loc + matchClassInst inerts clas tys loc = do { dflags <- getDynFlags ; tclvl <- getTcLevel From git at git.haskell.org Tue Feb 10 19:58:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 19:58:47 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: All reps, except the ones for type/kind constructors. (abfc297) Message-ID: <20150210195847.0CA1A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/abfc297fd29c76a41f0d3ae6938bc4a4315ac7c7/ghc >--------------------------------------------------------------- commit abfc297fd29c76a41f0d3ae6938bc4a4315ac7c7 Author: Iavor S. Diatchki Date: Tue Feb 10 11:13:47 2015 -0800 All reps, except the ones for type/kind constructors. >--------------------------------------------------------------- abfc297fd29c76a41f0d3ae6938bc4a4315ac7c7 compiler/deSugar/DsBinds.hs | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 92d2e7f..11bd4b8 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -889,25 +889,41 @@ dsEvTypeable ev = (ty, rep) <- case ev of EvTypeableTyCon tc ks ts -> - do let ty = mkTyConApp tc (ks ++ map snd ts) - tcRep <- undefined - kReps <- mapM kindRep ks - tReps <- mapM (getRep tyCl) ts - ctr <- dsLookupGlobalId mkPolyTyConAppName + do ctr <- dsLookupGlobalId mkPolyTyConAppName typeRepTc <- dsLookupTyCon typeRepTyConName let tyRepType = mkTyConApp typeRepTc [] - return (ty, mkApps (Var ctr) - [ tcRep - , mkListExpr tyRepType kReps - , mkListExpr tyRepType tReps - ]) + mkRep cRep kReps tReps = mkApps (Var ctr) + [ cRep + , mkListExpr tyRepType kReps + , mkListExpr tyRepType tReps + ] + + + let kindRep k = + case splitTyConApp_maybe k of + Nothing -> panic "dsEvTypeable: not a kind constructor" + Just (kc,ks) -> + do kcRep <- undefined kc + reps <- mapM kindRep ks + return (mkRep kcRep [] reps) + + tcRep <- undefined tc + + kReps <- mapM kindRep ks + tReps <- mapM (getRep tyCl) ts + + return ( mkTyConApp tc (ks ++ map snd ts) + , mkRep tcRep kReps tReps + ) EvTypeableTyApp t1 t2 -> - do let ty = mkAppTy (snd t1) (snd t2) - e1 <- getRep tyCl t1 + do e1 <- getRep tyCl t1 e2 <- getRep tyCl t2 ctr <- dsLookupGlobalId mkAppTyName - return (ty, mkApps (Var ctr) [ e1, e2 ]) + + return ( mkAppTy (snd t1) (snd t2) + , mkApps (Var ctr) [ e1, e2 ] + ) EvTypeableTyLit ty -> do str <- case (isNumLitTy ty, isStrLitTy ty) of @@ -941,7 +957,6 @@ dsEvTypeable ev = (getTypeableCo tc ty) where proxyT = mkProxyPrimTy (typeKind ty) ty - kindRep k = undefined From git at git.haskell.org Tue Feb 10 19:58:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 19:58:49 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Add wire-in names for the `Typeable` dictionary constructors. (8495351) Message-ID: <20150210195849.A0FDC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/84953516cab9047f44c0761019b61e71090b8808/ghc >--------------------------------------------------------------- commit 84953516cab9047f44c0761019b61e71090b8808 Author: Iavor S. Diatchki Date: Tue Feb 10 10:37:23 2015 -0800 Add wire-in names for the `Typeable` dictionary constructors. >--------------------------------------------------------------- 84953516cab9047f44c0761019b61e71090b8808 compiler/prelude/PrelNames.hs | 37 +++++++++++++++++++++++++++++++++---- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 5e43b56..34a696b 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -213,7 +213,14 @@ basicKnownKeyNames alternativeClassName, foldableClassName, traversableClassName, - typeableClassName, -- derivable + + -- Typeable + typeableClassName, + mkTyConName, + mkPolyTyConAppName, + mkAppTyName, + typeLitTypeRepName, + -- Numeric stuff negateName, minusName, geName, eqName, @@ -1031,9 +1038,19 @@ rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDo ixClassName :: Name ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey --- Class Typeable -typeableClassName :: Name -typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey +-- Class Typeable, and functions for constructing `Typeable` dictionaries +typeableClassName + , mkTyConName + , mkPolyTyConAppName + , mkAppTyName + , typeLitTypeRepName + :: Name +typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey +mkTyConName = varQual tYPEABLE_INTERNAL (fsLit "mkTyCon") mkTyConKey +mkPolyTyConAppName = varQual tYPEABLE_INTERNAL (fsLit "mkPolyTyConApp") mkPolyTyConAppKey +mkAppTyName = varQual tYPEABLE_INTERNAL (fsLit "mkAppTy") mkAppTyKey +typeLitTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeLitTypeRep") typeLitTypeRepKey + -- Class Data @@ -1871,6 +1888,18 @@ proxyHashKey = mkPreludeMiscIdUnique 502 -- USES IdUniques 200-499 ----------------------------------------------------- +-- Used to make `Typeable` dictionaries +mkTyConKey + , mkPolyTyConAppKey + , mkAppTyKey + , typeLitTypeRepKey + :: Unique +mkTyConKey = mkPreludeMiscIdUnique 503 +mkPolyTyConAppKey = mkPreludeMiscIdUnique 504 +mkAppTyKey = mkPreludeMiscIdUnique 505 +typeLitTypeRepKey = mkPreludeMiscIdUnique 506 + + {- ************************************************************************ * * From git at git.haskell.org Tue Feb 10 19:58:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 19:58:52 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Construct basic dictionary shapes. (7fa6e0e) Message-ID: <20150210195852.4FF843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/7fa6e0e2ee07b6e899ab5597c7a306cbff3140dc/ghc >--------------------------------------------------------------- commit 7fa6e0e2ee07b6e899ab5597c7a306cbff3140dc Author: Iavor S. Diatchki Date: Tue Feb 10 11:05:25 2015 -0800 Construct basic dictionary shapes. >--------------------------------------------------------------- 7fa6e0e2ee07b6e899ab5597c7a306cbff3140dc compiler/deSugar/DsBinds.hs | 40 +++++++++++++++++++++++++--------------- compiler/prelude/PrelNames.hs | 7 +++++++ 2 files changed, 32 insertions(+), 15 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 3fb42bf..92d2e7f 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -885,26 +885,39 @@ dsEvTerm (EvTypeable ev) = dsEvTypeable ev dsEvTypeable :: EvTypeable -> DsM CoreExpr dsEvTypeable ev = - do tyCl <- dsLookupTyCon typeableClassName - (rep,ty) <- + do tyCl <- dsLookupTyCon typeableClassName + (ty, rep) <- case ev of EvTypeableTyCon tc ks ts -> do let ty = mkTyConApp tc (ks ++ map snd ts) - kReps <- mapM kindRep ks - tReps <- mapM (getRep tyCl) ts - return (tyConRep tc kReps tReps, ty) + tcRep <- undefined + kReps <- mapM kindRep ks + tReps <- mapM (getRep tyCl) ts + ctr <- dsLookupGlobalId mkPolyTyConAppName + typeRepTc <- dsLookupTyCon typeRepTyConName + let tyRepType = mkTyConApp typeRepTc [] + return (ty, mkApps (Var ctr) + [ tcRep + , mkListExpr tyRepType kReps + , mkListExpr tyRepType tReps + ]) EvTypeableTyApp t1 t2 -> do let ty = mkAppTy (snd t1) (snd t2) - e1 <- getRep tyCl t1 - e2 <- getRep tyCl t2 - return (tyAppRep e1 e2, ty) + e1 <- getRep tyCl t1 + e2 <- getRep tyCl t2 + ctr <- dsLookupGlobalId mkAppTyName + return (ty, mkApps (Var ctr) [ e1, e2 ]) EvTypeableTyLit ty -> - case (isNumLitTy ty, isStrLitTy ty) of - (Just n, _) -> return (litRep (show n), ty) - (_, Just n) -> return (litRep (show n), ty) - _ -> panic "dsEvTypeable: malformed TyLit evidence" + do str <- case (isNumLitTy ty, isStrLitTy ty) of + (Just n, _) -> return (show n) + (_, Just n) -> return (show n) + _ -> panic "dsEvTypeable: malformed TyLit evidence" + ctr <- dsLookupGlobalId typeLitTypeRepName + tag <- mkStringExpr str + return (ty, mkApps (Var ctr) [ tag ]) + return (mkDict tyCl ty rep) @@ -929,9 +942,6 @@ dsEvTypeable ev = where proxyT = mkProxyPrimTy (typeKind ty) ty kindRep k = undefined - tyConRep tc kReps tReps = undefined - tyAppRep t1 t2 = undefined - litRep str = undefined diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 34a696b..d440b43 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -216,6 +216,7 @@ basicKnownKeyNames -- Typeable typeableClassName, + typeRepTyConName, mkTyConName, mkPolyTyConAppName, mkAppTyName, @@ -1040,12 +1041,14 @@ ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey -- Class Typeable, and functions for constructing `Typeable` dictionaries typeableClassName + , typeRepTyConName , mkTyConName , mkPolyTyConAppName , mkAppTyName , typeLitTypeRepName :: Name typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey +typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey mkTyConName = varQual tYPEABLE_INTERNAL (fsLit "mkTyCon") mkTyConKey mkPolyTyConAppName = varQual tYPEABLE_INTERNAL (fsLit "mkPolyTyConApp") mkPolyTyConAppKey mkAppTyName = varQual tYPEABLE_INTERNAL (fsLit "mkAppTy") mkAppTyKey @@ -1557,6 +1560,10 @@ staticPtrInfoTyConKey = mkPreludeTyConUnique 181 callStackTyConKey :: Unique callStackTyConKey = mkPreludeTyConUnique 182 +-- Typeables +typeRepTyConKey :: Unique +typeRepTyConKey = mkPreludeTyConUnique 183 + ---------------- Template Haskell ------------------- -- USES TyConUniques 200-299 ----------------------------------------------------- From git at git.haskell.org Tue Feb 10 21:01:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 21:01:50 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' created Message-ID: <20150210210150.149FA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/travis Referencing: 6b4cbf9ffca1463ef66b900cef096983bc7b7e53 From git at git.haskell.org Tue Feb 10 21:01:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 21:01:52 +0000 (UTC) Subject: [commit: ghc] wip/travis: [ci skip] comment typo (d5cfdd1) Message-ID: <20150210210152.E5E223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/d5cfdd1442a462f9a267856921ca2f6583e03593/ghc >--------------------------------------------------------------- commit d5cfdd1442a462f9a267856921ca2f6583e03593 Author: Joachim Breitner Date: Mon Feb 2 14:10:31 2015 +0100 [ci skip] comment typo >--------------------------------------------------------------- d5cfdd1442a462f9a267856921ca2f6583e03593 compiler/simplCore/CallArity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 5ee5fe2..7bfd2f5 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -347,7 +347,7 @@ t1) in the follwing code: t2 = if ... then go 1 else ... in go 0 -Detecting this would reqiure finding out what variables are only ever called +Detecting this would require finding out what variables are only ever called from thunks. While this is certainly possible, we yet have to see this to be relevant in the wild. From git at git.haskell.org Tue Feb 10 21:01:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 21:01:55 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Try to install llvm-3.6 (6b4cbf9) Message-ID: <20150210210155.B07B23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/6b4cbf9ffca1463ef66b900cef096983bc7b7e53/ghc >--------------------------------------------------------------- commit 6b4cbf9ffca1463ef66b900cef096983bc7b7e53 Author: Joachim Breitner Date: Tue Feb 10 22:03:30 2015 +0100 travis: Try to install llvm-3.6 >--------------------------------------------------------------- 6b4cbf9ffca1463ef66b900cef096983bc7b7e53 .travis.yml | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd4606f..87bcdea 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,11 +12,14 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" + - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 llvm-3.5 - - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.5/bin:$PATH + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - travis_retry sudo apt-get install llvm-3.6 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.6/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ From git at git.haskell.org Tue Feb 10 21:02:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 21:02:49 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Try to install llvm-3.6 (f4ac72a) Message-ID: <20150210210249.549793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/f4ac72a8c8edee30d94a5a77197183da399f5b26/ghc >--------------------------------------------------------------- commit f4ac72a8c8edee30d94a5a77197183da399f5b26 Author: Joachim Breitner Date: Tue Feb 10 22:03:30 2015 +0100 travis: Try to install llvm-3.6 >--------------------------------------------------------------- f4ac72a8c8edee30d94a5a77197183da399f5b26 .travis.yml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd4606f..6a3340d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,11 +12,15 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + - travis_retry sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test + - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" + - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 llvm-3.5 - - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.5/bin:$PATH + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - travis_retry sudo apt-get install llvm-3.6 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.6/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ From git at git.haskell.org Tue Feb 10 21:06:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 21:06:45 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Try to install llvm-3.7 (054c135) Message-ID: <20150210210645.46E163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/054c135ea1b4f38128e7cd8eebffd035fc394c9d/ghc >--------------------------------------------------------------- commit 054c135ea1b4f38128e7cd8eebffd035fc394c9d Author: Joachim Breitner Date: Tue Feb 10 22:03:30 2015 +0100 travis: Try to install llvm-3.7 >--------------------------------------------------------------- 054c135ea1b4f38128e7cd8eebffd035fc394c9d .travis.yml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd4606f..8c53fe4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,11 +12,15 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + - travis_retry sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test + - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" + - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 llvm-3.5 - - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.5/bin:$PATH + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - travis_retry sudo apt-get install llvm-3.7 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.6/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ From git at git.haskell.org Tue Feb 10 21:57:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 21:57:51 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Try to install llvm-3.7 (2e39cb0) Message-ID: <20150210215751.1FCDF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/2e39cb01834f821e04aaadbd5db04c8553ea4387/ghc >--------------------------------------------------------------- commit 2e39cb01834f821e04aaadbd5db04c8553ea4387 Author: Joachim Breitner Date: Tue Feb 10 22:03:30 2015 +0100 travis: Try to install llvm-3.7 >--------------------------------------------------------------- 2e39cb01834f821e04aaadbd5db04c8553ea4387 .travis.yml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd4606f..12e6442 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,11 +12,15 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + - travis_retry sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test + - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" + - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 llvm-3.5 - - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.5/bin:$PATH + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - travis_retry sudo apt-get install llvm-3.7 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ From git at git.haskell.org Tue Feb 10 22:48:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 22:48:16 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Cache representation outside lambda, the way it was in manual instances. (6f93aa8) Message-ID: <20150210224816.CDD903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/6f93aa8d2a8ea420526ef264ff2b0fc4cedee6d2/ghc >--------------------------------------------------------------- commit 6f93aa8d2a8ea420526ef264ff2b0fc4cedee6d2 Author: Iavor S. Diatchki Date: Tue Feb 10 14:28:19 2015 -0800 Cache representation outside lambda, the way it was in manual instances. >--------------------------------------------------------------- 6f93aa8d2a8ea420526ef264ff2b0fc4cedee6d2 compiler/deSugar/DsBinds.hs | 39 +++++++++++++++++++++++++-------------- 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 707a963..6db3cae 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -888,21 +888,19 @@ dsEvTerm (EvTypeable ev) = dsEvTypeable ev dsEvTypeable :: EvTypeable -> DsM CoreExpr dsEvTypeable ev = do tyCl <- dsLookupTyCon typeableClassName + typeRepTc <- dsLookupTyCon typeRepTyConName + let tyRepType = mkTyConApp typeRepTc [] + (ty, rep) <- case ev of EvTypeableTyCon tc ks ts -> do ctr <- dsLookupGlobalId mkPolyTyConAppName mkTyCon <- dsLookupGlobalId mkTyConName - typeRepTc <- dsLookupTyCon typeRepTyConName dflags <- getDynFlags - let tyRepType = mkTyConApp typeRepTc [] - mkRep cRep kReps tReps = mkApps (Var ctr) - [ cRep - , mkListExpr tyRepType kReps - , mkListExpr tyRepType tReps - ] - + let mkRep cRep kReps tReps = + mkApps (Var ctr) [ cRep, mkListExpr tyRepType kReps + , mkListExpr tyRepType tReps ] let kindRep k = case splitTyConApp_maybe k of @@ -939,8 +937,15 @@ dsEvTypeable ev = tag <- mkStringExpr str return (ty, mkApps (Var ctr) [ tag ]) + -- TyRep -> Typeable t + -- see also: Note [Memoising typeOf] + repName <- newSysLocalDs tyRepType + let proxyT = mkProxyPrimTy (typeKind ty) ty + method = bindNonRec repName rep + $ mkLams [mkWildValBinder proxyT] (Var repName) - return (mkDict tyCl ty rep) + -- package up the method as `Typeable` dictionary + return (mkCast method (getTypeableCo tyCl ty)) where -- co: method -> Typeable k t @@ -957,11 +962,6 @@ dsEvTypeable ev = proxy = mkTyApps (Var proxyHashId) [t] return (mkApps method [proxy]) - -- TyRep -> Typeable t - mkDict tc ty rep = mkCast (mkLams [mkWildValBinder proxyT] rep) - (getTypeableCo tc ty) - where proxyT = mkProxyPrimTy (typeKind ty) ty - -- This part could be cached tyConRep dflags mkTyCon tc = do pkgStr <- mkStringExprFS pkg_fs @@ -992,6 +992,17 @@ dsEvTypeable ev = +{- 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. +-} + + + dsEvCallStack :: EvCallStack -> DsM CoreExpr From git at git.haskell.org Tue Feb 10 22:48:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 22:48:19 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Bug-fix: the coercion was the wrong way around. (cc0f70b) Message-ID: <20150210224819.A43773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/cc0f70b95264875ba40a1bb7d90a1c9c0009da1a/ghc >--------------------------------------------------------------- commit cc0f70b95264875ba40a1bb7d90a1c9c0009da1a Author: Iavor S. Diatchki Date: Tue Feb 10 14:37:47 2015 -0800 Bug-fix: the coercion was the wrong way around. >--------------------------------------------------------------- cc0f70b95264875ba40a1bb7d90a1c9c0009da1a compiler/deSugar/DsBinds.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 6db3cae..eebf298 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -945,7 +945,7 @@ dsEvTypeable ev = $ mkLams [mkWildValBinder proxyT] (Var repName) -- package up the method as `Typeable` dictionary - return (mkCast method (getTypeableCo tyCl ty)) + return $ mkCast method $ mkSymCo $ getTypeableCo tyCl ty where -- co: method -> Typeable k t @@ -958,7 +958,7 @@ dsEvTypeable ev = getRep tc (ev,t) = do typeableExpr <- dsEvTerm ev let co = getTypeableCo tc t - method = mkCast typeableExpr (mkSymCo co) + method = mkCast typeableExpr co proxy = mkTyApps (Var proxyHashId) [t] return (mkApps method [proxy]) From git at git.haskell.org Tue Feb 10 23:24:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 23:24:58 +0000 (UTC) Subject: [commit: ghc] master: More comments and white space (12698ff) Message-ID: <20150210232458.C387A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12698ff4eb88146f45e2e1e1fe7b2da608365957/ghc >--------------------------------------------------------------- commit 12698ff4eb88146f45e2e1e1fe7b2da608365957 Author: Simon Peyton Jones Date: Tue Feb 10 21:07:18 2015 +0000 More comments and white space >--------------------------------------------------------------- 12698ff4eb88146f45e2e1e1fe7b2da608365957 compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcSplice.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 564b1f3..e66eaea 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -413,7 +413,7 @@ Note especially that That's important because some are not closed (ie have free tyvars) and the compiler assumes that the global type env (tcg_type_env) has no free tyvars. Actually, only ones with Internal names can be non-closed - so we jsut add those + so we just add those * The tct_closed flag depends on whether the thing has free (RuntimeUnk) type variables diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 1611a99..3928a98 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -941,9 +941,9 @@ getThing th_name -- ToDo: this tcLookup could fail, which would give a -- rather unhelpful error message where - ppr_ns (TH.Name _ (TH.NameG TH.DataName _pkg _mod)) = text "data" + ppr_ns (TH.Name _ (TH.NameG TH.DataName _pkg _mod)) = text "data" ppr_ns (TH.Name _ (TH.NameG TH.TcClsName _pkg _mod)) = text "tc" - ppr_ns (TH.Name _ (TH.NameG TH.VarName _pkg _mod)) = text "var" + ppr_ns (TH.Name _ (TH.NameG TH.VarName _pkg _mod)) = text "var" ppr_ns _ = panic "reify/ppr_ns" reify :: TH.Name -> TcM TH.Info From git at git.haskell.org Tue Feb 10 23:25:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 23:25:01 +0000 (UTC) Subject: [commit: ghc] master: Comments only (1e651b9) Message-ID: <20150210232501.7A3113A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1e651b9092f882a392333c39be2aefd84b53a288/ghc >--------------------------------------------------------------- commit 1e651b9092f882a392333c39be2aefd84b53a288 Author: Simon Peyton Jones Date: Mon Feb 9 15:33:40 2015 +0000 Comments only >--------------------------------------------------------------- 1e651b9092f882a392333c39be2aefd84b53a288 compiler/hsSyn/HsBinds.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index 73c54ce..1d31639 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -627,7 +627,10 @@ data Sig name -- 'ApiAnnotation.AnnComma' -- For details on above see note [Api annotations] in ApiAnnotation - TypeSig [Located name] (LHsType name) (PostRn name [Name]) + TypeSig + [Located name] -- LHS of the signature; e.g. f,g,h :: blah + (LHsType name) -- RHS of the signature + (PostRn name [Name]) -- Wildcards (both named and anonymous) of the RHS -- | A pattern synonym type signature -- From git at git.haskell.org Tue Feb 10 23:25:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 23:25:04 +0000 (UTC) Subject: [commit: ghc] master: Add a couple of tcTraces around reify (1e58ed8) Message-ID: <20150210232504.658BE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1e58ed87a161d1cbc84a1c073f30c09756fbcc78/ghc >--------------------------------------------------------------- commit 1e58ed87a161d1cbc84a1c073f30c09756fbcc78 Author: Simon Peyton Jones Date: Tue Feb 10 21:07:43 2015 +0000 Add a couple of tcTraces around reify >--------------------------------------------------------------- 1e58ed87a161d1cbc84a1c073f30c09756fbcc78 compiler/typecheck/TcSplice.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 3928a98..f2efc93 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -948,7 +948,9 @@ getThing th_name reify :: TH.Name -> TcM TH.Info reify th_name - = do { thing <- getThing th_name + = do { traceTc "reify 1" (text (TH.showName th_name)) + ; thing <- getThing th_name + ; traceTc "reify 2" (ppr thing) ; reifyThing thing } lookupThName :: TH.Name -> TcM Name From git at git.haskell.org Tue Feb 10 23:25:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Feb 2015 23:25:07 +0000 (UTC) Subject: [commit: ghc] master: Do not complain about missing fields in Trac #10047 (1d982ba) Message-ID: <20150210232507.1E7EC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1d982ba10f590828b78eba992e73315dee33f78a/ghc >--------------------------------------------------------------- commit 1d982ba10f590828b78eba992e73315dee33f78a Author: Simon Peyton Jones Date: Tue Feb 10 23:22:34 2015 +0000 Do not complain about missing fields in Trac #10047 >--------------------------------------------------------------- 1d982ba10f590828b78eba992e73315dee33f78a testsuite/tests/th/T10047.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/th/T10047.hs b/testsuite/tests/th/T10047.hs index 7916abb..9e146d3 100644 --- a/testsuite/tests/th/T10047.hs +++ b/testsuite/tests/th/T10047.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-missing-fields #-} module T10047 where import Language.Haskell.TH From git at git.haskell.org Wed Feb 11 02:14:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 02:14:15 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Remove warnings (b909149) Message-ID: <20150211021415.DCDA63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/b909149233bc0298ddbcb789f8d0597cad3e9c3c/ghc >--------------------------------------------------------------- commit b909149233bc0298ddbcb789f8d0597cad3e9c3c Author: Iavor S. Diatchki Date: Tue Feb 10 17:33:06 2015 -0800 Remove warnings >--------------------------------------------------------------- b909149233bc0298ddbcb789f8d0597cad3e9c3c compiler/typecheck/TcInteract.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 1a01441..53ef0e6 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1639,9 +1639,7 @@ matchClassInst _ clas [ ty ] _ = panicTcS (text "Unexpected evidence for" <+> ppr (className clas) $$ vcat (map (ppr . idType) (classMethods clas))) - - -matchClassInst inerts clas [k,t] loc +matchClassInst _ clas [k,t] loc | className clas == typeableClassName = matchTypeableClass clas k t loc matchClassInst inerts clas tys loc @@ -1796,8 +1794,8 @@ matchTypeableClass clas k t loc | isForAllTy k = return NoInstance | Just (tc, ks_tys) <- splitTyConApp_maybe t = doTyConApp tc ks_tys | Just (f,kt) <- splitAppTy_maybe t = doTyApp f kt - | Just n <- isNumLitTy t = mkEv [] (EvTypeableTyLit t) - | Just s <- isStrLitTy t = mkEv [] (EvTypeableTyLit t) + | Just _ <- isNumLitTy t = mkEv [] (EvTypeableTyLit t) + | Just _ <- isStrLitTy t = mkEv [] (EvTypeableTyLit t) | otherwise = return NoInstance where @@ -1831,7 +1829,7 @@ matchTypeableClass clas k t loc -- Representation for concrete kinds. We just use the kind itself, -- but first check to make sure that it is "simple" (i.e., made entirely -- out of kind constructors). - kindRep ki = do (kc,ks) <- splitTyConApp_maybe ki + kindRep ki = do (_,ks) <- splitTyConApp_maybe ki mapM_ kindRep ks return ki From git at git.haskell.org Wed Feb 11 02:14:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 02:14:18 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Custom treatment of `Typeable` in super-classes. (4b4005e) Message-ID: <20150211021418.76ABD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/4b4005ed31a39d9d28daaf5a966af36a0b1f3a61/ghc >--------------------------------------------------------------- commit 4b4005ed31a39d9d28daaf5a966af36a0b1f3a61 Author: Iavor S. Diatchki Date: Tue Feb 10 17:35:01 2015 -0800 Custom treatment of `Typeable` in super-classes. It would appear that GHC "short-cuts" the solver when it encounters super-class constraints that look like classes. This means that the custom solvers in TcInteract do not work! This does not seem quite right, but until we fix it, we have an explicit check to pass on `Typeable` to the constraint solver. >--------------------------------------------------------------- 4b4005ed31a39d9d28daaf5a966af36a0b1f3a61 compiler/typecheck/TcInstDcls.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 4444101..7f980c2 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -1068,6 +1068,7 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds fam_envs sc_th | (sc_co, norm_sc_pred) <- normaliseType fam_envs Nominal sc_pred -- sc_co :: sc_pred ~ norm_sc_pred , ClassPred cls tys <- classifyPredType norm_sc_pred + , className cls /= typeableClassName = do { sc_ev_tm <- emit_sc_cls_pred norm_sc_pred cls tys ; sc_ev_id <- newEvVar sc_pred ; let tc_co = TcCoercion (mkSubCo (mkSymCo sc_co)) From git at git.haskell.org Wed Feb 11 02:14:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 02:14:21 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Mostly disable the old-style Deriving. (ce43ab1) Message-ID: <20150211021421.23F343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/ce43ab11c41771b815aa4165db7c37599c2a2bb2/ghc >--------------------------------------------------------------- commit ce43ab11c41771b815aa4165db7c37599c2a2bb2 Author: Iavor S. Diatchki Date: Tue Feb 10 18:16:10 2015 -0800 Mostly disable the old-style Deriving. For some reason, "deriving" declarations are being processed twice?? >--------------------------------------------------------------- ce43ab11c41771b815aa4165db7c37599c2a2bb2 compiler/typecheck/TcDeriv.hs | 161 +++----------------------- compiler/typecheck/TcGenDeriv.hs | 7 +- libraries/base/Data/Typeable/Internal.hs | 188 ------------------------------- 3 files changed, 19 insertions(+), 337 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ce43ab11c41771b815aa4165db7c37599c2a2bb2 From git at git.haskell.org Wed Feb 11 08:12:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 08:12:06 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Try to install llvm-3.6 (23f5e0d) Message-ID: <20150211081206.EEF4B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/23f5e0da76ef37bd20e1b91a8bf1b7d58c8a6cde/ghc >--------------------------------------------------------------- commit 23f5e0da76ef37bd20e1b91a8bf1b7d58c8a6cde Author: Joachim Breitner Date: Tue Feb 10 22:03:30 2015 +0100 travis: Try to install llvm-3.6 >--------------------------------------------------------------- 23f5e0da76ef37bd20e1b91a8bf1b7d58c8a6cde .travis.yml | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd4606f..d3de022 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,11 +12,16 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test + #- travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" + #- wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - + - travis_retry sudo add-apt-repository -y ppa:xorg-edgers/ppa # seems to be a source for llvm-3.6 - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 llvm-3.5 - - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.5/bin:$PATH + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - travis_retry sudo apt-get install llvm-3.6 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.6/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ From git at git.haskell.org Wed Feb 11 11:16:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 11:16:35 +0000 (UTC) Subject: [commit: ghc] master: Do not share T9878.hs between test T9878 and T9878b (3568bf3) Message-ID: <20150211111635.C3DFB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3568bf3fe76b95208f650f356a0668113838d842/ghc >--------------------------------------------------------------- commit 3568bf3fe76b95208f650f356a0668113838d842 Author: Simon Peyton Jones Date: Wed Feb 11 10:30:05 2015 +0000 Do not share T9878.hs between test T9878 and T9878b I think the sharing was giving a race condition in the test suite; I got a failure from validate which went away when I ran the tests individually. >--------------------------------------------------------------- 3568bf3fe76b95208f650f356a0668113838d842 testsuite/tests/ghci/scripts/{T9878.hs => T9878b.hs} | 2 +- testsuite/tests/ghci/scripts/T9878b.script | 2 +- testsuite/tests/ghci/scripts/all.T | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/ghci/scripts/T9878.hs b/testsuite/tests/ghci/scripts/T9878b.hs similarity index 81% copy from testsuite/tests/ghci/scripts/T9878.hs copy to testsuite/tests/ghci/scripts/T9878b.hs index fceceda..baa0da0 100644 --- a/testsuite/tests/ghci/scripts/T9878.hs +++ b/testsuite/tests/ghci/scripts/T9878b.hs @@ -1,5 +1,5 @@ {-# LANGUAGE StaticPointers #-} -module T9878 where +module T9878b where import GHC.StaticPtr diff --git a/testsuite/tests/ghci/scripts/T9878b.script b/testsuite/tests/ghci/scripts/T9878b.script index a855858..63765af 100644 --- a/testsuite/tests/ghci/scripts/T9878b.script +++ b/testsuite/tests/ghci/scripts/T9878b.script @@ -1,2 +1,2 @@ -:l T9878.hs +:l T9878b.hs f diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index fbcdb25..1decf78 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -204,5 +204,5 @@ test('T9878', ghci_script, ['T9878.script']) test('T9878b', [ extra_run_opts('-fobject-code'), - extra_clean(['T9878.hi','T9878.o'])], + extra_clean(['T9878b.hi','T9878b.o'])], ghci_script, ['T9878b.script']) From git at git.haskell.org Wed Feb 11 11:16:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 11:16:39 +0000 (UTC) Subject: [commit: ghc] master: nameIsLocalOrFrom should include interactive modules (6ff3db9) Message-ID: <20150211111639.492E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ff3db92140e3ac8cbda50d1a4aab976350ac8c4/ghc >--------------------------------------------------------------- commit 6ff3db92140e3ac8cbda50d1a4aab976350ac8c4 Author: Simon Peyton Jones Date: Wed Feb 11 10:55:10 2015 +0000 nameIsLocalOrFrom should include interactive modules The provoking cause was Trac #10019, but it revealed that nameIsLocalOrFrom should really include all interactive modules (ones from the 'interactive' package). Previously we had some ad-hoc 'isInteractiveModule' tests with some (but not all) the calls to nameIsLocalOrFrom. See the new comments with Name.nameIsLocalOrFrom. >--------------------------------------------------------------- 6ff3db92140e3ac8cbda50d1a4aab976350ac8c4 compiler/basicTypes/Name.hs | 31 +++++++++++++++++++++++++++---- compiler/iface/LoadIface.hs | 16 +++++++--------- compiler/rename/RnEnv.hs | 6 +++--- compiler/typecheck/TcDeriv.hs | 4 ++-- compiler/typecheck/TcRnDriver.hs | 18 ++++++++++++------ testsuite/tests/th/T10019.script | 4 ++++ testsuite/tests/th/T10019.stdout | 1 + testsuite/tests/th/all.T | 1 + 8 files changed, 57 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6ff3db92140e3ac8cbda50d1a4aab976350ac8c4 From git at git.haskell.org Wed Feb 11 18:57:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 18:57:43 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Remove some more code for deriving `Typeable` (4b08cd5) Message-ID: <20150211185743.56DF63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/4b08cd5fe239140c584611ae2d94af10410ab19b/ghc >--------------------------------------------------------------- commit 4b08cd5fe239140c584611ae2d94af10410ab19b Author: Iavor S. Diatchki Date: Wed Feb 11 09:53:11 2015 -0800 Remove some more code for deriving `Typeable` >--------------------------------------------------------------- 4b08cd5fe239140c584611ae2d94af10410ab19b compiler/typecheck/TcDeriv.hs | 4 +-- compiler/typecheck/TcGenDeriv.hs | 57 +--------------------------------------- compiler/typecheck/TcInstDcls.hs | 33 +++++++---------------- 3 files changed, 12 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 4b08cd5fe239140c584611ae2d94af10410ab19b From git at git.haskell.org Wed Feb 11 18:57:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 18:57:45 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Allow `Typeable` instances in interfaces, but warn, and ignore them. (fcfebd6) Message-ID: <20150211185745.EF8B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/fcfebd6b69ba67f4017af665ea982d98713bf77b/ghc >--------------------------------------------------------------- commit fcfebd6b69ba67f4017af665ea982d98713bf77b Author: Iavor S. Diatchki Date: Wed Feb 11 10:21:42 2015 -0800 Allow `Typeable` instances in interfaces, but warn, and ignore them. >--------------------------------------------------------------- fcfebd6b69ba67f4017af665ea982d98713bf77b compiler/typecheck/TcInstDcls.hs | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 2b64c41..dfa272f 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -49,6 +49,7 @@ import BasicTypes import DynFlags import ErrUtils import FastString +import HscTypes ( isHsBootOrSig ) import Id import MkId import Name @@ -424,6 +425,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls bad_typeable_instance i = typeableClassName == is_cls_nm (iSpec i) + overlapCheck ty = case overlapMode (is_flag $ iSpec ty) of NoOverlap _ -> False _ -> True @@ -433,10 +435,19 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls ptext (sLit "Replace the following instance:")) 2 (pprInstanceHdr (iSpec i)) - typeable_err i - = setSrcSpan (getSrcSpan (iSpec i)) $ - addErrTc $ ptext - (sLit "Class `Typeable` does not support user-specified instances.") + -- Report an error or a warning for a `Typeable` instances. + -- If we are workikng on an .hs-boot file, we just report a warning, + -- and ignore the instance. We do this, to give users a chance to fix + -- their code. + typeable_err i = + setSrcSpan (getSrcSpan (iSpec i)) $ + do env <- getGblEnv + if isHsBootOrSig (tcg_src env) + then addWarnTc $ vcat + [ ptext (sLit "`Typeable` instances in .hs-boot files are ignored.") + , ptext (sLit "This warning will become an error in future versions of the compiler.") + ] + else addErrTc $ ptext (sLit "Class `Typeable` does not support user-specified instances.") addClsInsts :: [InstInfo Name] -> TcM a -> TcM a addClsInsts infos thing_inside From git at git.haskell.org Wed Feb 11 20:30:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 20:30:31 +0000 (UTC) Subject: [commit: ghc] master: Fix #10079 by recurring after flattening exposes a TyConApp. (befe2d7) Message-ID: <20150211203031.454BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/befe2d7c8902096dd184ebca3f7f135ee5f479e8/ghc >--------------------------------------------------------------- commit befe2d7c8902096dd184ebca3f7f135ee5f479e8 Author: Richard Eisenberg Date: Wed Feb 11 13:06:15 2015 -0500 Fix #10079 by recurring after flattening exposes a TyConApp. Previously, try_decompose_nom_app was smart enough to recur if flattening exposed a TyConApp, but try_decompose_repr_app was not. Now, if neither type in try_decompose_repr_app is an AppTy, recur. Seems all straightforward enough to avoid a Note. >--------------------------------------------------------------- befe2d7c8902096dd184ebca3f7f135ee5f479e8 compiler/typecheck/TcCanonical.hs | 13 +++++++++++-- .../tests/indexed-types/should_compile/T10079.hs | 20 ++++++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 32 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index cdf5f09..b4ec62a 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -680,9 +680,18 @@ try_decompose_repr_app ev ty1 ty2 | ty1 `eqType` ty2 -- See Note [AppTy reflexivity check] = canEqReflexive ev ReprEq ty1 - | otherwise + | AppTy {} <- ty1 + = canEqFailure ev ReprEq ty1 ty2 + + | AppTy {} <- ty2 = canEqFailure ev ReprEq ty1 ty2 + | otherwise -- flattening in can_eq_wanted_app exposed some TyConApps! + = ASSERT2( isJust (tcSplitTyConApp_maybe ty1) || isJust (tcSplitTyConApp_maybe ty2) + , ppr ty1 $$ ppr ty2 ) -- If this assertion fails, we may fall + -- into an infinite loop + canEqNC ev ReprEq ty1 ty2 + --------- try_decompose_nom_app :: CtEvidence -> TcType -> TcType -> TcS (StopOrContinue Ct) @@ -705,7 +714,7 @@ try_decompose_nom_app ev ty1 ty2 -- is good: See Note [Canonicalising type applications] = ASSERT2( isJust (tcSplitTyConApp_maybe ty1) || isJust (tcSplitTyConApp_maybe ty2) , ppr ty1 $$ ppr ty2 ) -- If this assertion fails, we may fall - -- into an inifinite loop (Trac #9971) + -- into an infinite loop (Trac #9971) canEqNC ev NomEq ty1 ty2 where -- Recurses to try_decompose_nom_app to decompose a chain of AppTys diff --git a/testsuite/tests/indexed-types/should_compile/T10079.hs b/testsuite/tests/indexed-types/should_compile/T10079.hs new file mode 100644 index 0000000..6651a74 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10079.hs @@ -0,0 +1,20 @@ + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleContexts #-} +module T10079 where + +import Control.Applicative +import Data.Coerce + +broken :: Bizarre (->) w => w a b t -> () +broken = getConst #. bazaar (Const #. const ()) + +class Profunctor p where + (#.) :: Coercible c b => (b -> c) -> p a b -> p a c + +instance Profunctor (->) where + (#.) = (.) + +class Bizarre p w | w -> p where + bazaar :: Applicative f => p a (f b) -> w a b t -> f t diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 9f76c7d..f4df933 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -251,3 +251,4 @@ test('T9747', normal, compile, ['']) test('T9582', normal, compile, ['']) test('T9090', normal, compile, ['']) test('T10020', normal, compile, ['']) +test('T10079', normal, compile, ['']) From git at git.haskell.org Wed Feb 11 20:30:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 20:30:33 +0000 (UTC) Subject: [commit: ghc] master: Fix egregious typo in checkTauTvUpdate. (d5cd94d) Message-ID: <20150211203033.E75563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5cd94d7b57dc233ff40bb3e494b7baf1be4d285/ghc >--------------------------------------------------------------- commit d5cd94d7b57dc233ff40bb3e494b7baf1be4d285 Author: Richard Eisenberg Date: Wed Feb 11 13:13:53 2015 -0500 Fix egregious typo in checkTauTvUpdate. The old code used an unzonked type in an occurs-check, which would sometimes lead to an infinite loop. Please merge to ghc-7.10. >--------------------------------------------------------------- d5cd94d7b57dc233ff40bb3e494b7baf1be4d285 compiler/typecheck/TcUnify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 93f3f11..024d443 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -979,7 +979,7 @@ checkTauTvUpdate dflags tv ty ; case sub_k of Nothing -> return Nothing Just LT -> return Nothing - _ | is_return_tv -> if tv `elemVarSet` tyVarsOfType ty + _ | is_return_tv -> if tv `elemVarSet` tyVarsOfType ty1 then return Nothing else return (Just ty1) _ | defer_me ty1 -- Quick test From git at git.haskell.org Wed Feb 11 20:30:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 20:30:36 +0000 (UTC) Subject: [commit: ghc] master: Propagate ReturnTvs in matchExpectedFunTys (849e25c) Message-ID: <20150211203036.A631A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/849e25ca4bb5aac2d49d0e27a5dfba61b6f72640/ghc >--------------------------------------------------------------- commit 849e25ca4bb5aac2d49d0e27a5dfba61b6f72640 Author: Richard Eisenberg Date: Wed Feb 11 13:40:21 2015 -0500 Propagate ReturnTvs in matchExpectedFunTys This really should have done a while ago, with the ReturnTv factoring. It's surprising that I can't tickle the bug! Please merge to ghc-7.10. >--------------------------------------------------------------- 849e25ca4bb5aac2d49d0e27a5dfba61b6f72640 compiler/typecheck/TcMType.hs | 5 ++++- compiler/typecheck/TcType.hs | 10 ++++++++-- compiler/typecheck/TcUnify.hs | 18 ++++++++++++------ testsuite/tests/gadt/gadt7.stderr | 18 +++++++++--------- 4 files changed, 33 insertions(+), 18 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 71fc8ff..eb30227 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -19,7 +19,7 @@ module TcMType ( newFlexiTyVar, newFlexiTyVarTy, -- Kind -> TcM TcType newFlexiTyVarTys, -- Int -> Kind -> TcM [TcType] - newReturnTyVar, + newReturnTyVar, newReturnTyVarTy, newMetaKindVar, newMetaKindVars, mkTcTyVarName, cloneMetaTyVar, @@ -434,6 +434,9 @@ newFlexiTyVarTys n kind = mapM newFlexiTyVarTy (nOfThem n kind) newReturnTyVar :: Kind -> TcM TcTyVar newReturnTyVar kind = newMetaTyVar ReturnTv kind +newReturnTyVarTy :: Kind -> TcM TcType +newReturnTyVarTy kind = TyVarTy <$> newReturnTyVar kind + tcInstTyVars :: [TKVar] -> TcM (TvSubst, [TcTyVar]) -- Instantiate with META type variables -- Note that this works for a sequence of kind and type diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 3212065..d6fadc7 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -34,7 +34,7 @@ module TcType ( MetaDetails(Flexi, Indirect), MetaInfo(..), isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isTyVarTy, isSigTyVar, isOverlappableTyVar, isTyConableTyVar, - isFskTyVar, isFmvTyVar, isFlattenTyVar, + isFskTyVar, isFmvTyVar, isFlattenTyVar, isReturnTyVar, isAmbiguousTyVar, metaTvRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, isTypeVar, isKindVar, @@ -686,7 +686,7 @@ isImmutableTyVar tv isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar, isMetaTyVar, isAmbiguousTyVar, - isFmvTyVar, isFskTyVar, isFlattenTyVar :: TcTyVar -> Bool + isFmvTyVar, isFskTyVar, isFlattenTyVar, isReturnTyVar :: TcTyVar -> Bool isTyConableTyVar tv -- True of a meta-type variable that can be filled in @@ -736,6 +736,12 @@ isMetaTyVar tv MetaTv {} -> True _ -> False +isReturnTyVar tv + = ASSERT2( isTcTyVar tv, ppr tv ) + case tcTyVarDetails tv of + MetaTv { mtv_info = ReturnTv } -> True + _ -> False + -- isAmbiguousTyVar is used only when reporting type errors -- It picks out variables that are unbound, namely meta -- type variables and the RuntimUnk variables created by diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 024d443..689e6f4 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -141,7 +141,7 @@ matchExpectedFunTys herald arity orig_ty = do { cts <- readMetaTyVar tv ; case cts of Indirect ty' -> go n_req ty' - Flexi -> defer n_req ty } + Flexi -> defer n_req ty (isReturnTyVar tv) } -- In all other cases we bale out into ordinary unification -- However unlike the meta-tyvar case, we are sure that the @@ -159,15 +159,21 @@ matchExpectedFunTys herald arity orig_ty -- But in that case we add specialized type into error context -- anyway, because it may be useful. See also Trac #9605. go n_req ty = addErrCtxtM mk_ctxt $ - defer n_req ty + defer n_req ty False ------------ - defer n_req fun_ty - = do { arg_tys <- newFlexiTyVarTys n_req openTypeKind + -- If we decide that a ReturnTv (see Note [ReturnTv] in TcType) should + -- really be a function type, then we need to allow the argument and + -- result types also to be ReturnTvs. + defer n_req fun_ty is_return + = do { arg_tys <- mapM new_ty_var_ty (nOfThem n_req openTypeKind) -- See Note [Foralls to left of arrow] - ; res_ty <- newFlexiTyVarTy openTypeKind + ; res_ty <- new_ty_var_ty openTypeKind ; co <- unifyType fun_ty (mkFunTys arg_tys res_ty) ; return (co, arg_tys, res_ty) } + where + new_ty_var_ty | is_return = newReturnTyVarTy + | otherwise = newFlexiTyVarTy ------------ mk_ctxt :: TidyEnv -> TcM (TidyEnv, MsgDoc) @@ -992,7 +998,7 @@ checkTauTvUpdate dflags tv ty where details = ASSERT2( isMetaTyVar tv, ppr tv ) tcTyVarDetails tv info = mtv_info details - is_return_tv = case info of { ReturnTv -> True; _ -> False } + is_return_tv = isReturnTyVar tv impredicative = canUnifyWithPolyType dflags details (tyVarKind tv) defer_me :: TcType -> Bool diff --git a/testsuite/tests/gadt/gadt7.stderr b/testsuite/tests/gadt/gadt7.stderr index 603cf5b..89c05c5 100644 --- a/testsuite/tests/gadt/gadt7.stderr +++ b/testsuite/tests/gadt/gadt7.stderr @@ -1,19 +1,19 @@ gadt7.hs:16:38: - Couldn't match expected type ?t? with actual type ?t1? - ?t1? is untouchable - inside the constraints: t2 ~ Int + Couldn't match expected type ?t? with actual type ?r? + ?r? is untouchable + inside the constraints: t1 ~ Int bound by a pattern with constructor: K :: T Int, in a case alternative at gadt7.hs:16:33 - ?t1? is a rigid type variable bound by - the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1 + ?r? is a rigid type variable bound by + the inferred type of i1b :: T t1 -> r -> t at gadt7.hs:16:1 ?t? is a rigid type variable bound by - the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1 + the inferred type of i1b :: T t1 -> r -> t at gadt7.hs:16:1 Possible fix: add a type signature for ?i1b? Relevant bindings include - y1 :: t1 (bound at gadt7.hs:16:16) - y :: t1 (bound at gadt7.hs:16:7) - i1b :: T t2 -> t1 -> t (bound at gadt7.hs:16:1) + y1 :: r (bound at gadt7.hs:16:16) + y :: r (bound at gadt7.hs:16:7) + i1b :: T t1 -> r -> t (bound at gadt7.hs:16:1) In the expression: y1 In a case alternative: K -> y1 From git at git.haskell.org Wed Feb 11 21:56:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 21:56:18 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: We still need `DataTypeable` when deriving `Data` (was removed accidentally) (53cb59d) Message-ID: <20150211215618.B52243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/53cb59d5002c6ca3e0dde8a1aaf5c3e9f7b7966d/ghc >--------------------------------------------------------------- commit 53cb59d5002c6ca3e0dde8a1aaf5c3e9f7b7966d Author: Iavor S. Diatchki Date: Wed Feb 11 13:58:16 2015 -0800 We still need `DataTypeable` when deriving `Data` (was removed accidentally) >--------------------------------------------------------------- 53cb59d5002c6ca3e0dde8a1aaf5c3e9f7b7966d compiler/typecheck/TcDeriv.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index b96014f..72fba3c 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -1190,7 +1190,8 @@ sideConditions mtheta cls | cls_key == enumClassKey = Just (cond_std `andCond` cond_isEnumeration) | cls_key == ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) | cls_key == boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) - | cls_key == dataClassKey = Just (cond_std `andCond` + | cls_key == dataClassKey = Just (checkFlag Opt_DeriveDataTypeable `andCond` + cond_std `andCond` cond_args cls) | cls_key == functorClassKey = Just (checkFlag Opt_DeriveFunctor `andCond` cond_vanilla `andCond` From git at git.haskell.org Wed Feb 11 22:59:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 22:59:33 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Delete commented out code. (34c8975) Message-ID: <20150211225933.5BDAD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/34c89753951fc17d0d92dcde8d7536d96b727768/ghc >--------------------------------------------------------------- commit 34c89753951fc17d0d92dcde8d7536d96b727768 Author: Iavor S. Diatchki Date: Wed Feb 11 14:54:39 2015 -0800 Delete commented out code. >--------------------------------------------------------------- 34c89753951fc17d0d92dcde8d7536d96b727768 compiler/typecheck/TcGenDeriv.hs | 38 -------------------------------------- 1 file changed, 38 deletions(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index d6261f5..ba6639e 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1225,44 +1225,6 @@ getPrecedence get_fixity nm -- into account for either Read or Show; hence we -- ignore associativity here -{- XXX -genTypeableTyConRep :: DynFlags -> SrcSpan -> TyCon -> - (LHsBind RdrName, LSig RdrName) -genTypeableTyConRep dflags loc tycon = - ( mk_easy_FunBind loc rep_name [] tycon_rep - , L loc (TypeSig [L loc rep_name] sig_ty PlaceHolder) - ) - where - rep_name = mk_tc_deriv_name tycon (mkTyConRepOcc suf) - suf = if isPromotedTyCon tycon then Just "k" else - if isPromotedDataCon tycon then Just "c" else Nothing - - sig_ty = nlHsTyVar typeable_TyCon_RDR - - tycon_name = tyConName tycon - modl = nameModule tycon_name - pkg = modulePackageKey modl - - modl_fs = moduleNameFS (moduleName modl) - pkg_fs = packageKeyFS pkg - name_fs = occNameFS (nameOccName tycon_name) - - tycon_rep = nlHsApps mkTyCon_RDR - (map nlHsLit [int64 high, - int64 low, - HsString "" pkg_fs, - HsString "" modl_fs, - HsString "" name_fs]) - - hashThis = unwords $ map unpackFS [pkg_fs, modl_fs, name_fs] - Fingerprint high low = fingerprintString hashThis - - int64 - | wORD_SIZE dflags == 4 = HsWord64Prim "" . fromIntegral - | otherwise = HsWordPrim "" . fromIntegral --} - - {- ************************************************************************ * * From git at git.haskell.org Wed Feb 11 23:48:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Feb 2015 23:48:12 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Remove more unused code. (971936a) Message-ID: <20150211234812.78F003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/971936affbecdbe8db4b77113fefde51ce08a0b0/ghc >--------------------------------------------------------------- commit 971936affbecdbe8db4b77113fefde51ce08a0b0 Author: Iavor S. Diatchki Date: Wed Feb 11 15:47:07 2015 -0800 Remove more unused code. >--------------------------------------------------------------- 971936affbecdbe8db4b77113fefde51ce08a0b0 compiler/basicTypes/OccName.hs | 6 ------ compiler/prelude/PrelNames.hs | 3 +-- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 03f11e6..efa871d 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -72,8 +72,6 @@ module OccName ( mkPReprTyConOcc, mkPADFunOcc, - mkTyConRepOcc, - -- ** Deconstruction occNameFS, occNameString, occNameSpace, @@ -609,7 +607,6 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc, mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc, mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc - :: OccName -> OccName -- These derived variables have a prefix that no Haskell value could have @@ -661,9 +658,6 @@ mkGenRCo = mk_simple_deriv tcName "CoRep_" mkDataTOcc = mk_simple_deriv varName "$t" mkDataCOcc = mk_simple_deriv varName "$c" -mkTyConRepOcc :: Maybe String -> OccName -> OccName -mkTyConRepOcc = mk_simple_deriv_with varName "$tcr" - -- Vectorisation mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, mkPADFunOcc, mkPReprTyConOcc, diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index d440b43..4e1ce9a 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -684,11 +684,10 @@ showString_RDR = varQual_RDR gHC_SHOW (fsLit "showString") showSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showSpace") showParen_RDR = varQual_RDR gHC_SHOW (fsLit "showParen") -typeRep_RDR, mkTyCon_RDR, mkTyConApp_RDR, typeable_TyCon_RDR :: RdrName +typeRep_RDR, mkTyCon_RDR, mkTyConApp_RDR :: RdrName typeRep_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "typeRep#") mkTyCon_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyCon") mkTyConApp_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyConApp") -typeable_TyCon_RDR = tcQual_RDR tYPEABLE_INTERNAL (fsLit "TyCon") undefined_RDR :: RdrName undefined_RDR = varQual_RDR gHC_ERR (fsLit "undefined") From git at git.haskell.org Thu Feb 12 01:11:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 01:11:44 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Bugfix: proxy# needs a kind, as well as a type. (50f6fd4) Message-ID: <20150212011144.175403A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/50f6fd4de629c4fcc467042e60b1df3a4ad4a96d/ghc >--------------------------------------------------------------- commit 50f6fd4de629c4fcc467042e60b1df3a4ad4a96d Author: Iavor S. Diatchki Date: Wed Feb 11 16:17:17 2015 -0800 Bugfix: proxy# needs a kind, as well as a type. >--------------------------------------------------------------- 50f6fd4de629c4fcc467042e60b1df3a4ad4a96d compiler/deSugar/DsBinds.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index eebf298..079cfbf 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -959,7 +959,7 @@ dsEvTypeable ev = do typeableExpr <- dsEvTerm ev let co = getTypeableCo tc t method = mkCast typeableExpr co - proxy = mkTyApps (Var proxyHashId) [t] + proxy = mkTyApps (Var proxyHashId) [typeKind t, t] return (mkApps method [proxy]) -- This part could be cached From git at git.haskell.org Thu Feb 12 01:11:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 01:11:46 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Disable `Ignoring derive Typeable` warnings. (4003132) Message-ID: <20150212011146.C910D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/4003132ff968dab0f28d92227061760cad6944dc/ghc >--------------------------------------------------------------- commit 4003132ff968dab0f28d92227061760cad6944dc Author: Iavor S. Diatchki Date: Wed Feb 11 17:13:17 2015 -0800 Disable `Ignoring derive Typeable` warnings. Very many things in base derive Typeable, so we'll need a huge commit to remove these warning. For the time being, I am jsut commenting out the warning. Perhaps, it'd be better to control the behavior with a flag. >--------------------------------------------------------------- 4003132ff968dab0f28d92227061760cad6944dc compiler/typecheck/TcDeriv.hs | 4 ++-- compiler/typecheck/TcInstDcls.hs | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 72fba3c..fe1c299 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -685,7 +685,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode)) ; case tcSplitTyConApp_maybe inst_ty of Just (tc, tc_args) | className cls == typeableClassName - -> do addWarnTc (text "Standalone deriving `Typeable` has no effect.") + -> do -- addWarnTc (text "Standalone deriving `Typeable` has no effect.") return [] | isAlgTyCon tc -- All other classes @@ -720,7 +720,7 @@ deriveTyData tvs tc tc_args (L loc deriv_pred) -- so the argument kind 'k' is not decomposable by splitKindFunTys -- as is the case for all other derivable type classes ; if className cls == typeableClassName - then do addWarnTc (text "Deriving `Typeable` has no effect.") + then do -- addWarnTc (text "Deriving `Typeable` has no effect.") return [] else diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index dfa272f..f4a98a1 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -443,10 +443,12 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls setSrcSpan (getSrcSpan (iSpec i)) $ do env <- getGblEnv if isHsBootOrSig (tcg_src env) - then addWarnTc $ vcat + then return () + {- + addWarnTc $ vcat [ ptext (sLit "`Typeable` instances in .hs-boot files are ignored.") , ptext (sLit "This warning will become an error in future versions of the compiler.") - ] + ] -} else addErrTc $ ptext (sLit "Class `Typeable` does not support user-specified instances.") addClsInsts :: [InstInfo Name] -> TcM a -> TcM a From git at git.haskell.org Thu Feb 12 01:11:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 01:11:49 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Remove unused imports to prevent warning, which leads to validation failure. (db64f55) Message-ID: <20150212011149.891A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/db64f55dc4d90a9f2ede2c0a46b41c1c0adb4a80/ghc >--------------------------------------------------------------- commit db64f55dc4d90a9f2ede2c0a46b41c1c0adb4a80 Author: Iavor S. Diatchki Date: Wed Feb 11 17:13:42 2015 -0800 Remove unused imports to prevent warning, which leads to validation failure. >--------------------------------------------------------------- db64f55dc4d90a9f2ede2c0a46b41c1c0adb4a80 libraries/base/Data/Typeable/Internal.hs | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index bf73611..46ab53e 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -47,33 +47,15 @@ module Data.Typeable.Internal ( typeRepArgs, showsTypeRep, tyConString, - listTc, funTc + listTc, funTc, + typeRepKinds, + typeLitTypeRep ) where import GHC.Base import GHC.Word import GHC.Show -import GHC.Read ( Read ) import Data.Proxy -import GHC.Num -import GHC.Real --- import GHC.IORef --- import GHC.IOArray --- import GHC.MVar -import GHC.ST ( ST, STret ) -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 ) -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 GHC.Fingerprint.Type import {-# SOURCE #-} GHC.Fingerprint From git at git.haskell.org Thu Feb 12 07:30:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 07:30:11 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Rewriten large parts of deSugar/Check.hs to do as the paper says (6104710) Message-ID: <20150212073011.9FFD43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/61047101a0d07895d8700931698d187010046442/ghc >--------------------------------------------------------------- commit 61047101a0d07895d8700931698d187010046442 Author: George Karachalias Date: Thu Feb 12 08:29:50 2015 +0100 Rewriten large parts of deSugar/Check.hs to do as the paper says For example, we now infer a type and constraints for a vector using function inferTyPmPats :: [PmPat Id] -> PmM ([Type], Bag EvVar) >--------------------------------------------------------------- 61047101a0d07895d8700931698d187010046442 compiler/deSugar/Check.hs | 787 ++++++++++++++++++++++++++-------------------- compiler/deSugar/Match.hs | 41 ++- compiler/hsSyn/HsExpr.hs | 4 + 3 files changed, 490 insertions(+), 342 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 61047101a0d07895d8700931698d187010046442 From git at git.haskell.org Thu Feb 12 10:02:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 10:02:29 +0000 (UTC) Subject: [commit: packages/haskell2010] branch 'wip/T9590' created Message-ID: <20150212100229.858A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 New branch : wip/T9590 Referencing: ac8801ad9b9126fce00073b8497df37aeeaeb42d From git at git.haskell.org Thu Feb 12 10:02:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 10:02:31 +0000 (UTC) Subject: [commit: packages/haskell2010] wip/T9590: Attempt at reviving the `haskell2010` package (ac8801a) Message-ID: <20150212100231.8C5203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 On branch : wip/T9590 Link : http://git.haskell.org/packages/haskell2010.git/commitdiff/ac8801ad9b9126fce00073b8497df37aeeaeb42d >--------------------------------------------------------------- commit ac8801ad9b9126fce00073b8497df37aeeaeb42d Author: Herbert Valerio Riedel Date: Thu Feb 12 10:57:07 2015 +0100 Attempt at reviving the `haskell2010` package This tries to compensate for AMP (the harder one) and FTP (easier one) This introduces a separate `Monad`-class from the one in `base`, which also means that with the current GHC feature-set, this only works in combination w/ -XRebindableSyntax (whereas a variant of that extension would be nicer which doesn't need enabling at each use-site, but rather only to be enabled inside the `Prelude` module currently in scope) Having this, we could also recover the strict H2010 `Num`-class version with the Eq/Ord constraint. >--------------------------------------------------------------- ac8801ad9b9126fce00073b8497df37aeeaeb42d Control/Monad.hs | 346 +++++++++++++++++++++++++++++++++++++++++++++++++++++- Data/List.hs | 128 +++++++++++++++++++- Prelude.hs | 24 +--- haskell2010.cabal | 2 +- 4 files changed, 465 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ac8801ad9b9126fce00073b8497df37aeeaeb42d From git at git.haskell.org Thu Feb 12 12:17:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 12:17:22 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Printing some more stuff (35b782c) Message-ID: <20150212121722.844B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/35b782cdf301087e9cd08d0e5e6a311f3263b3cd/ghc >--------------------------------------------------------------- commit 35b782cdf301087e9cd08d0e5e6a311f3263b3cd Author: George Karachalias Date: Thu Feb 12 13:19:01 2015 +0100 Printing some more stuff >--------------------------------------------------------------- 35b782cdf301087e9cd08d0e5e6a311f3263b3cd compiler/deSugar/Check.hs | 5 +++++ compiler/deSugar/Match.hs | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index a275193..a603c72 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -556,6 +556,11 @@ inferTyPmPats pats = do wt :: [Type] -> OutVec -> PmM Bool wt sig (_, vec) | length sig == length vec = do + + -- TEMPORARY3 + dflags <- getDynFlags + liftIO $ putStrLn $ "Signature we are using: " ++ showSDoc dflags (ppr sig) + (tys, cs) <- inferTyPmPats vec cs' <- zipWithM newEqPmM sig tys -- The vector should match the signature type diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 8815fe6..30113a5 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -65,11 +65,15 @@ matchCheck :: [Type] -- Types of the arguments -> [EquationInfo] -- Info about patterns, etc. (type synonym below) -> DsM MatchResult -- Desugared result! -matchCheck tys ctx vars ty qs +matchCheck tys ctx@(DsMatchContext hs_ctx srcspan) vars ty qs = do { dflags <- getDynFlags -- ; pm_result <- checkpm tys qs -- ; dsPmWarn dflags ctx pm_result -- check for flags inside (maybe shorten this?) + -- TEMPORARY + ; liftIO $ putStrLn $ "We are calling dsPmEmitWarning in context: " ++ showSDoc dflags (ppr srcspan <+> pprMatchContext hs_ctx) + ; liftIO $ putStrLn $ "sig: " ++ showSDoc dflags (ppr tys) + ; dsPmEmitWarns dflags ctx tys qs ; match vars ty qs } From git at git.haskell.org Thu Feb 12 14:11:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 14:11:08 +0000 (UTC) Subject: [commit: ghc] master: Comments and white space; plus structurally avoiding the previously "egregious bug" (b45309f) Message-ID: <20150212141108.5BA2B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b45309fb660955558a10cbde058cf5db2e37ef2b/ghc >--------------------------------------------------------------- commit b45309fb660955558a10cbde058cf5db2e37ef2b Author: Simon Peyton Jones Date: Thu Feb 12 14:12:43 2015 +0000 Comments and white space; plus structurally avoiding the previously "egregious bug" >--------------------------------------------------------------- b45309fb660955558a10cbde058cf5db2e37ef2b compiler/typecheck/TcUnify.hs | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 689e6f4..32a04de 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -980,21 +980,27 @@ checkTauTvUpdate dflags tv ty = ASSERT( not (isTyVarTy ty) ) return Nothing | otherwise - = do { ty1 <- zonkTcType ty - ; sub_k <- unifyKindX (tyVarKind tv) (typeKind ty1) + = do { ty <- zonkTcType ty + ; sub_k <- unifyKindX (tyVarKind tv) (typeKind ty) ; case sub_k of - Nothing -> return Nothing - Just LT -> return Nothing - _ | is_return_tv -> if tv `elemVarSet` tyVarsOfType ty1 - then return Nothing - else return (Just ty1) - _ | defer_me ty1 -- Quick test + Nothing -> return Nothing -- Kinds don't unify + Just LT -> return Nothing -- (tv :: *) ~ (ty :: ?) + -- Don't unify because that would widen tv's kind + + _ | is_return_tv -- ReturnTv: a simple occurs-check is all that we need + -- See Note [ReturnTv] in TcType + -> if tv `elemVarSet` tyVarsOfType ty + then return Nothing + else return (Just ty) + + _ | defer_me ty -- Quick test -> -- Failed quick test so try harder - case occurCheckExpand dflags tv ty1 of + case occurCheckExpand dflags tv ty of OC_OK ty2 | defer_me ty2 -> return Nothing | otherwise -> return (Just ty2) _ -> return Nothing - | otherwise -> return (Just ty1) } + + _ | otherwise -> return (Just ty) } where details = ASSERT2( isMetaTyVar tv, ppr tv ) tcTyVarDetails tv info = mtv_info details From git at git.haskell.org Thu Feb 12 15:29:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 15:29:41 +0000 (UTC) Subject: [commit: ghc] master: Tiny refactoring; no change in behaviour (6be91dd) Message-ID: <20150212152941.D3B023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6be91ddaffe8b4d3796cb78b261b318c9c380f4b/ghc >--------------------------------------------------------------- commit 6be91ddaffe8b4d3796cb78b261b318c9c380f4b Author: Simon Peyton Jones Date: Thu Feb 12 15:31:15 2015 +0000 Tiny refactoring; no change in behaviour >--------------------------------------------------------------- 6be91ddaffe8b4d3796cb78b261b318c9c380f4b compiler/typecheck/TcCanonical.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index b4ec62a..b87e257 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -746,22 +746,23 @@ canDecomposableTyConApp :: CtEvidence -> EqRel -> TcS (StopOrContinue Ct) -- See Note [Decomposing TyConApps] canDecomposableTyConApp ev eq_rel tc1 tys1 tc2 tys2 - | tc1 /= tc2 || length tys1 /= length tys2 - -- Fail straight away for better error messages - = let eq_failure - | isDataFamilyTyCon tc1 || isDataFamilyTyCon tc2 - -- See Note [Use canEqFailure in canDecomposableTyConApp] - = canEqFailure - | otherwise - = canEqHardFailure in - eq_failure ev eq_rel (mkTyConApp tc1 tys1) (mkTyConApp tc2 tys2) - - | otherwise + | tc1 == tc2 + , length tys1 == length tys2 -- Success: decompose! = do { traceTcS "canDecomposableTyConApp" (ppr ev $$ ppr eq_rel $$ ppr tc1 $$ ppr tys1 $$ ppr tys2) ; canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 ; stopWith ev "Decomposed TyConApp" } + -- Fail straight away for better error messages + -- See Note [Use canEqFailure in canDecomposableTyConApp] + | isDataFamilyTyCon tc1 || isDataFamilyTyCon tc2 + = canEqFailure ev eq_rel ty1 ty2 + | otherwise + = canEqHardFailure ev eq_rel ty1 ty2 + where + ty1 = mkTyConApp tc1 tys1 + ty2 = mkTyConApp tc2 tys2 + {- Note [Use canEqFailure in canDecomposableTyConApp] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Thu Feb 12 16:14:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 16:14:48 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix a profiling bug (1d401b4) Message-ID: <20150212161448.19F453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/1d401b4384b5f9c7429140320e1d0bc120172b8b/ghc >--------------------------------------------------------------- commit 1d401b4384b5f9c7429140320e1d0bc120172b8b Author: Simon Marlow Date: Wed Jan 28 11:25:52 2015 +0000 Fix a profiling bug Summary: We were erroneously discarding SCCs on function-typed variables. These can affect the call stack, so we have to retain them. The bug was introduced during the recent SourceNote refactoring. This is an alternative to the fix proposed in D616. I also added the scc005 test from that diff, which works with this change. While I was here, I also fixed up the other profiling tests, marking a few as expect_broken_for(10037) where the opt/unopt output differs in non-fatal ways. Test Plan: profiling tests Reviewers: scpmw, ezyang, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D636 GHC Trac Issues: #10007 (cherry picked from commit daed18c35cda114d8a5303bcb645195e1fd397e3) >--------------------------------------------------------------- 1d401b4384b5f9c7429140320e1d0bc120172b8b compiler/coreSyn/CoreUtils.hs | 12 ++++- .../tests/profiling/should_run/T2552.prof.sample | 56 ++++++++++------------ testsuite/tests/profiling/should_run/all.T | 19 ++++++-- .../tests/profiling/should_run/ioprof.prof.sample | 41 ++++++++-------- .../profiling/should_run/prof-doc-fib.prof.sample | 31 ++++++------ testsuite/tests/profiling/should_run/scc005.hs | 10 ++++ .../tests/profiling/should_run/scc005.prof.sample | 27 +++++++++++ 7 files changed, 125 insertions(+), 71 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1d401b4384b5f9c7429140320e1d0bc120172b8b From git at git.haskell.org Thu Feb 12 16:14:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 16:14:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Don't overwrite input file by default (ed4de44) Message-ID: <20150212161450.E2A573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/ed4de443b31bc383cc7194bef75d27c3a487e8de/ghc >--------------------------------------------------------------- commit ed4de443b31bc383cc7194bef75d27c3a487e8de Author: Phil Ruffwind Date: Mon Feb 9 13:39:12 2015 -0600 Don't overwrite input file by default Summary: If the default filename of the output executable coincides with that of main source file, throw an error instead of silently clobbering the input file. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D642 GHC Trac Issues: #9930 (cherry picked from commit 78833ca6305f0875add94351592e141c032cd088) >--------------------------------------------------------------- ed4de443b31bc383cc7194bef75d27c3a487e8de compiler/main/GhcMake.hs | 18 +++++++++++++----- testsuite/tests/ghc-e/should_fail/Makefile | 3 +++ testsuite/tests/ghc-e/should_fail/T9930 | 1 + testsuite/tests/ghc-e/should_fail/all.T | 3 +++ 4 files changed, 20 insertions(+), 5 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index cd670b3..5f3e315 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -427,14 +427,22 @@ guessOutputFile = modifySession $ \env -> ml_hs_file (ms_location ms) name = fmap dropExtension mainModuleSrcPath + name_exe = do #if defined(mingw32_HOST_OS) - -- we must add the .exe extention unconditionally here, otherwise - -- when name has an extension of its own, the .exe extension will - -- not be added by DriverPipeline.exeFileName. See #2248 - name_exe = fmap (<.> "exe") name + -- we must add the .exe extention unconditionally here, otherwise + -- when name has an extension of its own, the .exe extension will + -- not be added by DriverPipeline.exeFileName. See #2248 + name' <- fmap (<.> "exe") name #else - name_exe = name + name' <- name #endif + mainModuleSrcPath' <- mainModuleSrcPath + -- #9930: don't clobber input files (unless they ask for it) + if name' == mainModuleSrcPath' + then throwGhcException . UsageError $ + "default output name would overwrite the input file; " ++ + "must specify -o explicitly" + else Just name' in case outputFile dflags of Just _ -> env diff --git a/testsuite/tests/ghc-e/should_fail/Makefile b/testsuite/tests/ghc-e/should_fail/Makefile index 7a02f7b..897ed2a 100644 --- a/testsuite/tests/ghc-e/should_fail/Makefile +++ b/testsuite/tests/ghc-e/should_fail/Makefile @@ -13,3 +13,6 @@ T9905fail2: T9905fail3: '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "import Prelude (+)" # syntax error + +T9930fail: + '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -x hs T9930 diff --git a/testsuite/tests/ghc-e/should_fail/T9930 b/testsuite/tests/ghc-e/should_fail/T9930 new file mode 100644 index 0000000..45846a9 --- /dev/null +++ b/testsuite/tests/ghc-e/should_fail/T9930 @@ -0,0 +1 @@ +main = undefined diff --git a/testsuite/tests/ghc-e/should_fail/all.T b/testsuite/tests/ghc-e/should_fail/all.T index 07dc614..d9064d2 100644 --- a/testsuite/tests/ghc-e/should_fail/all.T +++ b/testsuite/tests/ghc-e/should_fail/all.T @@ -11,3 +11,6 @@ test('T9905fail2', [exit_code(2), req_interp, ignore_output], run_command, test('T9905fail3', [exit_code(2), req_interp, ignore_output], run_command, ['$MAKE --no-print-directory -s T9905fail3']) + +test('T9930fail', [exit_code(2), ignore_output], run_command, + ['$MAKE --no-print-directory -s T9930fail']) From git at git.haskell.org Thu Feb 12 16:14:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 16:14:53 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix #10079 by recurring after flattening exposes a TyConApp. (dfb6b9f) Message-ID: <20150212161453.E90F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/dfb6b9f8290ebed55636074cea53f583d3ce1134/ghc >--------------------------------------------------------------- commit dfb6b9f8290ebed55636074cea53f583d3ce1134 Author: Richard Eisenberg Date: Wed Feb 11 13:06:15 2015 -0500 Fix #10079 by recurring after flattening exposes a TyConApp. Previously, try_decompose_nom_app was smart enough to recur if flattening exposed a TyConApp, but try_decompose_repr_app was not. Now, if neither type in try_decompose_repr_app is an AppTy, recur. Seems all straightforward enough to avoid a Note. (cherry picked from commit befe2d7c8902096dd184ebca3f7f135ee5f479e8) >--------------------------------------------------------------- dfb6b9f8290ebed55636074cea53f583d3ce1134 compiler/typecheck/TcCanonical.hs | 13 +++++++++++-- .../tests/indexed-types/should_compile/T10079.hs | 20 ++++++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 32 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 75263fa..8df7ee1 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -642,9 +642,18 @@ try_decompose_repr_app ev ty1 ty2 | ty1 `eqType` ty2 -- See Note [AppTy reflexivity check] = canEqReflexive ev ReprEq ty1 - | otherwise + | AppTy {} <- ty1 + = canEqFailure ev ReprEq ty1 ty2 + + | AppTy {} <- ty2 = canEqFailure ev ReprEq ty1 ty2 + | otherwise -- flattening in can_eq_wanted_app exposed some TyConApps! + = ASSERT2( isJust (tcSplitTyConApp_maybe ty1) || isJust (tcSplitTyConApp_maybe ty2) + , ppr ty1 $$ ppr ty2 ) -- If this assertion fails, we may fall + -- into an infinite loop + canEqNC ev ReprEq ty1 ty2 + --------- try_decompose_nom_app :: CtEvidence -> TcType -> TcType -> TcS (StopOrContinue Ct) @@ -667,7 +676,7 @@ try_decompose_nom_app ev ty1 ty2 -- is good: See Note [Canonicalising type applications] = ASSERT2( isJust (tcSplitTyConApp_maybe ty1) || isJust (tcSplitTyConApp_maybe ty2) , ppr ty1 $$ ppr ty2 ) -- If this assertion fails, we may fall - -- into an inifinite loop (Trac #9971) + -- into an infinite loop (Trac #9971) canEqNC ev NomEq ty1 ty2 where -- do_decompose is like xCtEvidence, but recurses diff --git a/testsuite/tests/indexed-types/should_compile/T10079.hs b/testsuite/tests/indexed-types/should_compile/T10079.hs new file mode 100644 index 0000000..6651a74 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10079.hs @@ -0,0 +1,20 @@ + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleContexts #-} +module T10079 where + +import Control.Applicative +import Data.Coerce + +broken :: Bizarre (->) w => w a b t -> () +broken = getConst #. bazaar (Const #. const ()) + +class Profunctor p where + (#.) :: Coercible c b => (b -> c) -> p a b -> p a c + +instance Profunctor (->) where + (#.) = (.) + +class Bizarre p w | w -> p where + bazaar :: Applicative f => p a (f b) -> w a b t -> f t diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 9f76c7d..f4df933 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -251,3 +251,4 @@ test('T9747', normal, compile, ['']) test('T9582', normal, compile, ['']) test('T9090', normal, compile, ['']) test('T10020', normal, compile, ['']) +test('T10079', normal, compile, ['']) From git at git.haskell.org Thu Feb 12 16:14:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 16:14:57 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: nameIsLocalOrFrom should include interactive modules (4e25dc6) Message-ID: <20150212161457.510283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/4e25dc631b9c26365b57d315655723f088480f7e/ghc >--------------------------------------------------------------- commit 4e25dc631b9c26365b57d315655723f088480f7e Author: Simon Peyton Jones Date: Wed Feb 11 10:55:10 2015 +0000 nameIsLocalOrFrom should include interactive modules The provoking cause was Trac #10019, but it revealed that nameIsLocalOrFrom should really include all interactive modules (ones from the 'interactive' package). Previously we had some ad-hoc 'isInteractiveModule' tests with some (but not all) the calls to nameIsLocalOrFrom. See the new comments with Name.nameIsLocalOrFrom. (cherry picked from commit 6ff3db92140e3ac8cbda50d1a4aab976350ac8c4) >--------------------------------------------------------------- 4e25dc631b9c26365b57d315655723f088480f7e compiler/basicTypes/Name.hs | 31 +++++++++++++++++++++++++++---- compiler/iface/LoadIface.hs | 16 +++++++--------- compiler/rename/RnEnv.hs | 6 +++--- compiler/typecheck/TcDeriv.hs | 4 ++-- compiler/typecheck/TcRnDriver.hs | 18 ++++++++++++------ testsuite/tests/th/T10019.script | 4 ++++ testsuite/tests/th/T10019.stdout | 1 + testsuite/tests/th/all.T | 1 + 8 files changed, 57 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4e25dc631b9c26365b57d315655723f088480f7e From git at git.haskell.org Thu Feb 12 16:15:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 16:15:00 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix egregious typo in checkTauTvUpdate. (9970626) Message-ID: <20150212161500.025A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/9970626658b427df5e189a97496d89df76043e47/ghc >--------------------------------------------------------------- commit 9970626658b427df5e189a97496d89df76043e47 Author: Richard Eisenberg Date: Wed Feb 11 13:13:53 2015 -0500 Fix egregious typo in checkTauTvUpdate. The old code used an unzonked type in an occurs-check, which would sometimes lead to an infinite loop. Please merge to ghc-7.10. (cherry picked from commit d5cd94d7b57dc233ff40bb3e494b7baf1be4d285) >--------------------------------------------------------------- 9970626658b427df5e189a97496d89df76043e47 compiler/typecheck/TcUnify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 5d8ef5d..251cfbf 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -987,7 +987,7 @@ checkTauTvUpdate dflags tv ty ; case sub_k of Nothing -> return Nothing Just LT -> return Nothing - _ | is_return_tv -> if tv `elemVarSet` tyVarsOfType ty + _ | is_return_tv -> if tv `elemVarSet` tyVarsOfType ty1 then return Nothing else return (Just ty1) _ | defer_me ty1 -- Quick test From git at git.haskell.org Thu Feb 12 16:15:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Feb 2015 16:15:02 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Propagate ReturnTvs in matchExpectedFunTys (976e420) Message-ID: <20150212161502.9D8B83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/976e420fb2a7fa8bf3a22bc56bda7d15d2d27930/ghc >--------------------------------------------------------------- commit 976e420fb2a7fa8bf3a22bc56bda7d15d2d27930 Author: Richard Eisenberg Date: Wed Feb 11 13:40:21 2015 -0500 Propagate ReturnTvs in matchExpectedFunTys This really should have done a while ago, with the ReturnTv factoring. It's surprising that I can't tickle the bug! Please merge to ghc-7.10. (cherry picked from commit 849e25ca4bb5aac2d49d0e27a5dfba61b6f72640) >--------------------------------------------------------------- 976e420fb2a7fa8bf3a22bc56bda7d15d2d27930 compiler/typecheck/TcMType.hs | 5 ++++- compiler/typecheck/TcType.hs | 10 ++++++++-- compiler/typecheck/TcUnify.hs | 18 ++++++++++++------ testsuite/tests/gadt/gadt7.stderr | 18 +++++++++--------- 4 files changed, 33 insertions(+), 18 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 90e0762..08c0b8b 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -19,7 +19,7 @@ module TcMType ( newFlexiTyVar, newFlexiTyVarTy, -- Kind -> TcM TcType newFlexiTyVarTys, -- Int -> Kind -> TcM [TcType] - newReturnTyVar, + newReturnTyVar, newReturnTyVarTy, newMetaKindVar, newMetaKindVars, mkTcTyVarName, cloneMetaTyVar, @@ -454,6 +454,9 @@ newFlexiTyVarTys n kind = mapM newFlexiTyVarTy (nOfThem n kind) newReturnTyVar :: Kind -> TcM TcTyVar newReturnTyVar kind = newMetaTyVar ReturnTv kind +newReturnTyVarTy :: Kind -> TcM TcType +newReturnTyVarTy kind = TyVarTy <$> newReturnTyVar kind + tcInstTyVars :: [TKVar] -> TcM (TvSubst, [TcTyVar]) -- Instantiate with META type variables -- Note that this works for a sequence of kind and type diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index e760cc4..2d567ce 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -34,7 +34,7 @@ module TcType ( MetaDetails(Flexi, Indirect), MetaInfo(..), isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isTyVarTy, isSigTyVar, isOverlappableTyVar, isTyConableTyVar, - isFskTyVar, isFmvTyVar, isFlattenTyVar, + isFskTyVar, isFmvTyVar, isFlattenTyVar, isReturnTyVar, isAmbiguousTyVar, metaTvRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, isTypeVar, isKindVar, @@ -682,7 +682,7 @@ isImmutableTyVar tv isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar, isMetaTyVar, isAmbiguousTyVar, - isFmvTyVar, isFskTyVar, isFlattenTyVar :: TcTyVar -> Bool + isFmvTyVar, isFskTyVar, isFlattenTyVar, isReturnTyVar :: TcTyVar -> Bool isTyConableTyVar tv -- True of a meta-type variable that can be filled in @@ -732,6 +732,12 @@ isMetaTyVar tv MetaTv {} -> True _ -> False +isReturnTyVar tv + = ASSERT2( isTcTyVar tv, ppr tv ) + case tcTyVarDetails tv of + MetaTv { mtv_info = ReturnTv } -> True + _ -> False + -- isAmbiguousTyVar is used only when reporting type errors -- It picks out variables that are unbound, namely meta -- type variables and the RuntimUnk variables created by diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 251cfbf..b4a6ada 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -141,7 +141,7 @@ matchExpectedFunTys herald arity orig_ty = do { cts <- readMetaTyVar tv ; case cts of Indirect ty' -> go n_req ty' - Flexi -> defer n_req ty } + Flexi -> defer n_req ty (isReturnTyVar tv) } -- In all other cases we bale out into ordinary unification -- However unlike the meta-tyvar case, we are sure that the @@ -159,15 +159,21 @@ matchExpectedFunTys herald arity orig_ty -- But in that case we add specialized type into error context -- anyway, because it may be useful. See also Trac #9605. go n_req ty = addErrCtxtM mk_ctxt $ - defer n_req ty + defer n_req ty False ------------ - defer n_req fun_ty - = do { arg_tys <- newFlexiTyVarTys n_req openTypeKind + -- If we decide that a ReturnTv (see Note [ReturnTv] in TcType) should + -- really be a function type, then we need to allow the argument and + -- result types also to be ReturnTvs. + defer n_req fun_ty is_return + = do { arg_tys <- mapM new_ty_var_ty (nOfThem n_req openTypeKind) -- See Note [Foralls to left of arrow] - ; res_ty <- newFlexiTyVarTy openTypeKind + ; res_ty <- new_ty_var_ty openTypeKind ; co <- unifyType fun_ty (mkFunTys arg_tys res_ty) ; return (co, arg_tys, res_ty) } + where + new_ty_var_ty | is_return = newReturnTyVarTy + | otherwise = newFlexiTyVarTy ------------ mk_ctxt :: TidyEnv -> TcM (TidyEnv, MsgDoc) @@ -1000,7 +1006,7 @@ checkTauTvUpdate dflags tv ty where details = ASSERT2( isMetaTyVar tv, ppr tv ) tcTyVarDetails tv info = mtv_info details - is_return_tv = case info of { ReturnTv -> True; _ -> False } + is_return_tv = isReturnTyVar tv impredicative = canUnifyWithPolyType dflags details (tyVarKind tv) defer_me :: TcType -> Bool diff --git a/testsuite/tests/gadt/gadt7.stderr b/testsuite/tests/gadt/gadt7.stderr index 3fb4a6a..de781fc 100644 --- a/testsuite/tests/gadt/gadt7.stderr +++ b/testsuite/tests/gadt/gadt7.stderr @@ -1,20 +1,20 @@ gadt7.hs:16:38: - Couldn't match expected type ?t? with actual type ?t1? - ?t1? is untouchable - inside the constraints (t2 ~ Int) + Couldn't match expected type ?t? with actual type ?r? + ?r? is untouchable + inside the constraints (t1 ~ Int) bound by a pattern with constructor K :: T Int, in a case alternative at gadt7.hs:16:33 - ?t1? is a rigid type variable bound by - the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1 + ?r? is a rigid type variable bound by + the inferred type of i1b :: T t1 -> r -> t at gadt7.hs:16:1 ?t? is a rigid type variable bound by - the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1 + the inferred type of i1b :: T t1 -> r -> t at gadt7.hs:16:1 Possible fix: add a type signature for ?i1b? Relevant bindings include - y1 :: t1 (bound at gadt7.hs:16:16) - y :: t1 (bound at gadt7.hs:16:7) - i1b :: T t2 -> t1 -> t (bound at gadt7.hs:16:1) + y1 :: r (bound at gadt7.hs:16:16) + y :: r (bound at gadt7.hs:16:7) + i1b :: T t1 -> r -> t (bound at gadt7.hs:16:1) In the expression: y1 In a case alternative: K -> y1 From git at git.haskell.org Fri Feb 13 01:03:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Feb 2015 01:03:54 +0000 (UTC) Subject: [commit: ghc] typeable-with-kinds: Add flag to warn when deriving typeable, and update user manual (8447183) Message-ID: <20150213010354.0B04D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : typeable-with-kinds Link : http://ghc.haskell.org/trac/ghc/changeset/8447183280f775c6af7b441b1c32b5bb0685a748/ghc >--------------------------------------------------------------- commit 8447183280f775c6af7b441b1c32b5bb0685a748 Author: Iavor S. Diatchki Date: Thu Feb 12 17:05:51 2015 -0800 Add flag to warn when deriving typeable, and update user manual >--------------------------------------------------------------- 8447183280f775c6af7b441b1c32b5bb0685a748 compiler/main/DynFlags.hs | 2 ++ compiler/typecheck/TcDeriv.hs | 11 +++++--- compiler/typecheck/TcInstDcls.hs | 12 ++++----- docs/users_guide/flags.xml | 19 ++++++++++++-- docs/users_guide/glasgow_exts.xml | 53 +++++++++++++++++++++------------------ 5 files changed, 62 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8447183280f775c6af7b441b1c32b5bb0685a748 From git at git.haskell.org Fri Feb 13 23:08:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Feb 2015 23:08:52 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation of 'trace' (7fdded4) Message-ID: <20150213230852.677473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7fdded4ed7e670e0c83d312b56a59b36c52913c9/ghc >--------------------------------------------------------------- commit 7fdded4ed7e670e0c83d312b56a59b36c52913c9 Author: Simon Peyton Jones Date: Fri Feb 13 23:10:18 2015 +0000 Improve documentation of 'trace' See Trac #9795. >--------------------------------------------------------------- 7fdded4ed7e670e0c83d312b56a59b36c52913c9 libraries/base/Debug/Trace.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index 389eb19..c81abbf 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -102,6 +102,10 @@ For example, this returns the value of @f x@ but first outputs the message. > trace ("calling f with x = " ++ show x) (f x) +The 'trace' function evaluates the message (i.e. the first argument) completely +before printing it; so if the message is not fully defined, none of it +will be printed. + The 'trace' function should /only/ be used for debugging, or for monitoring execution. The function is not referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the From git at git.haskell.org Fri Feb 13 23:08:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Feb 2015 23:08:55 +0000 (UTC) Subject: [commit: ghc] master: Refactor decideQuantification (b96db75) Message-ID: <20150213230855.0B93A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b96db75c2ea3ea5756dac7d67ca366dab61bafa7/ghc >--------------------------------------------------------------- commit b96db75c2ea3ea5756dac7d67ca366dab61bafa7 Author: Simon Peyton Jones Date: Fri Feb 13 23:09:34 2015 +0000 Refactor decideQuantification Richard was interrogating me about decideQuantification yesterday. I got a bit stuck on the promote_tvs part. This refactoring * simplifes the API of decideQuantification * move mkMinimalBySCs into decideQuantification (a better place for it) * moves promotion out of decideQuantification (where it didn't really fit), and comments much more fully what is going on with the promtion stuff * comments decideQuantification more fully * coments the EqPred case of quantifyPred more fully It turned out that the theta returned by decideQuantification, and hence by simplifyInfer, is now fully zonked, so I could remove a zonking in TcBinds. >--------------------------------------------------------------- b96db75c2ea3ea5756dac7d67ca366dab61bafa7 compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcSimplify.hs | 133 +++++++++++++-------- .../tests/indexed-types/should_fail/T2693.stderr | 12 +- testsuite/tests/typecheck/should_fail/T4921.stderr | 2 +- 4 files changed, 94 insertions(+), 55 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b96db75c2ea3ea5756dac7d67ca366dab61bafa7 From git at git.haskell.org Sun Feb 15 20:21:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Feb 2015 20:21:54 +0000 (UTC) Subject: [commit: ghc] master: Comments only (36f2ad5) Message-ID: <20150215202154.C95C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36f2ad5db052bd3bf90c0058c030997c408f2a0d/ghc >--------------------------------------------------------------- commit 36f2ad5db052bd3bf90c0058c030997c408f2a0d Author: Simon Peyton Jones Date: Sun Feb 15 20:14:54 2015 +0000 Comments only >--------------------------------------------------------------- 36f2ad5db052bd3bf90c0058c030997c408f2a0d compiler/main/HscTypes.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 1965afa..067e9a9 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1410,7 +1410,8 @@ extendInteractiveContext ictxt ids tcs new_cls_insts new_fam_insts defaults new_ -- a new mod_index (Trac #9426) , ic_tythings = new_tythings ++ old_tythings , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings - , ic_instances = (new_cls_insts ++ old_cls_insts, new_fam_insts ++ old_fam_insts) + , ic_instances = ( new_cls_insts ++ old_cls_insts + , new_fam_insts ++ old_fam_insts ) , ic_default = defaults } where new_tythings = map AnId ids ++ map ATyCon tcs ++ map (AConLike . PatSynCon) new_patsyns From git at git.haskell.org Sun Feb 15 20:21:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Feb 2015 20:21:58 +0000 (UTC) Subject: [commit: ghc] master: Improve typechecking of RULEs, to account for type wildcard holes (5ab7518) Message-ID: <20150215202158.0B4583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ab7518f28e89515c73ff09acd48b5acab48b8a5/ghc >--------------------------------------------------------------- commit 5ab7518f28e89515c73ff09acd48b5acab48b8a5 Author: Simon Peyton Jones Date: Sun Feb 15 20:21:42 2015 +0000 Improve typechecking of RULEs, to account for type wildcard holes This fixes Trac #10072. Previously the type-hole constraint was escaping to top level, but it belongs in the scope of the skolems bound by the RULE. >--------------------------------------------------------------- 5ab7518f28e89515c73ff09acd48b5acab48b8a5 compiler/typecheck/TcMType.hs | 2 +- compiler/typecheck/TcRules.hs | 11 +++++++++-- testsuite/tests/typecheck/should_compile/T10072.hs | 4 ++++ testsuite/tests/typecheck/should_compile/T10072.stderr | 8 ++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 23 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index eb30227..e006907 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -586,7 +586,7 @@ skolemiseUnboundMetaTyVar tv details ; writeMetaTyVar tv (mkTyVarTy final_tv) ; return final_tv } where - -- If a wildcard type called _a is generalised, we rename it to tw_a + -- If a wildcard type called _a is generalised, we rename it to w_a generaliseWildcardVarName :: OccName -> OccName generaliseWildcardVarName name | startsWithUnderscore name = mkOccNameFS (occNameSpace name) (appendFS (fsLit "w") (occNameFS name)) diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs index 53b8c89..1684118 100644 --- a/compiler/typecheck/TcRules.hs +++ b/compiler/typecheck/TcRules.hs @@ -60,7 +60,13 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs) do { traceTc "---- Rule ------" (ppr name) -- Note [Typechecking rules] - ; vars <- tcRuleBndrs hs_bndrs + ; (vars, bndr_wanted) <- captureConstraints $ + tcRuleBndrs hs_bndrs + -- bndr_wanted constraints can include wildcard hole + -- constraints, which we should not forget about. + -- It may mention the skolem type variables bound by + -- the RULE. c.f. Trac #10072 + ; let (id_bndrs, tv_bndrs) = partition isId vars ; (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty) <- tcExtendTyVarEnv tv_bndrs $ @@ -70,7 +76,8 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs) ; (rhs', rhs_wanted) <- captureConstraints (tcMonoExpr rhs rule_ty) ; return (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty) } - ; (lhs_evs, other_lhs_wanted) <- simplifyRule (unLoc name) lhs_wanted + ; (lhs_evs, other_lhs_wanted) <- simplifyRule (unLoc name) + (bndr_wanted `andWC` lhs_wanted) rhs_wanted -- Now figure out what to quantify over diff --git a/testsuite/tests/typecheck/should_compile/T10072.hs b/testsuite/tests/typecheck/should_compile/T10072.hs new file mode 100644 index 0000000..78d47d4 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10072.hs @@ -0,0 +1,4 @@ +module T0072 where +{-# RULES +"map/empty" forall (f :: a -> _). map f [] = [] + #-} diff --git a/testsuite/tests/typecheck/should_compile/T10072.stderr b/testsuite/tests/typecheck/should_compile/T10072.stderr new file mode 100644 index 0000000..134a137 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10072.stderr @@ -0,0 +1,8 @@ + +T10072.hs:3:31: + Found hole ?_? with type: w_ + Where: ?w_? is a rigid type variable bound by + the RULE "map/empty" at T10072.hs:3:1 + To use the inferred type, enable PartialTypeSignatures + In a RULE for ?f?: a -> _ + When checking the transformation rule "map/empty" diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 4348ea3..b792629 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -442,3 +442,4 @@ test('T9973', normal, compile, ['']) test('T9971', normal, compile, ['']) test('T9999', normal, compile, ['']) test('T10031', normal, compile, ['']) +test('T10072', normal, compile_fail, ['']) From git at git.haskell.org Sun Feb 15 20:22:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Feb 2015 20:22:00 +0000 (UTC) Subject: [commit: ghc] master: Move comments about evaluating the message to the top of the module (6fa285d) Message-ID: <20150215202200.A21773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6fa285d77bba2d391b5d2b3c3abe1f19d298483c/ghc >--------------------------------------------------------------- commit 6fa285d77bba2d391b5d2b3c3abe1f19d298483c Author: Simon Peyton Jones Date: Sun Feb 15 20:22:57 2015 +0000 Move comments about evaluating the message to the top of the module The remarks apply equally to all the functions here (Trac #9795) >--------------------------------------------------------------- 6fa285d77bba2d391b5d2b3c3abe1f19d298483c libraries/base/Debug/Trace.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index c81abbf..47abcae 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -60,7 +60,11 @@ import Data.List -- The 'trace', 'traceShow' and 'traceIO' functions print messages to an output -- stream. They are intended for \"printf debugging\", that is: tracing the flow -- of execution and printing interesting values. - +-- +-- All these functions evaluate the message completely before printing +-- it; so if the message is not fully defined, none of it will be +-- printed. +-- -- The usual output stream is 'System.IO.stderr'. For Windows GUI applications -- (that have no stderr) the output is directed to the Windows debug console. -- Some implementations of these functions may decorate the string that\'s @@ -102,10 +106,6 @@ For example, this returns the value of @f x@ but first outputs the message. > trace ("calling f with x = " ++ show x) (f x) -The 'trace' function evaluates the message (i.e. the first argument) completely -before printing it; so if the message is not fully defined, none of it -will be printed. - The 'trace' function should /only/ be used for debugging, or for monitoring execution. The function is not referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the From git at git.haskell.org Mon Feb 16 15:20:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Feb 2015 15:20:01 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9968' created Message-ID: <20150216152001.4C3543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9968 Referencing: ecfc5adbc4af7e1e7ce37010d7cf5f1787dc84b9 From git at git.haskell.org Mon Feb 16 15:20:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Feb 2015 15:20:04 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Start fixing T9968 (ecfc5ad) Message-ID: <20150216152004.047B13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/ecfc5adbc4af7e1e7ce37010d7cf5f1787dc84b9/ghc >--------------------------------------------------------------- commit ecfc5adbc4af7e1e7ce37010d7cf5f1787dc84b9 Author: Jose Pedro Magalhaes Date: Mon Feb 16 15:17:15 2015 +0000 Start fixing T9968 >--------------------------------------------------------------- ecfc5adbc4af7e1e7ce37010d7cf5f1787dc84b9 compiler/typecheck/TcDeriv.hs | 56 ++++++++++++++++++++++++++++++------------- 1 file changed, 39 insertions(+), 17 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 9073720..abf01ae 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -48,6 +48,7 @@ import ErrUtils import DataCon import Maybes import RdrName +-- import Id ( idType ) import Name import NameSet import TyCon @@ -723,8 +724,7 @@ deriveTyData :: Bool -- False <=> data/newtype deriveTyData is_instance tvs tc tc_args (L loc deriv_pred) = setSrcSpan loc $ -- Use the location of the 'deriving' item do { (deriv_tvs, cls, cls_tys, cls_arg_kind) - <- tcExtendTyVarEnv tvs $ - tcHsDeriv deriv_pred + <- tcExtendTyVarEnv tvs (tcHsDeriv deriv_pred) -- Deriving preds may (now) mention -- the type variables for the type constructor, hence tcExtendTyVarenv -- The "deriv_pred" is a LHsType to take account of the fact that for @@ -1007,21 +1007,23 @@ mkDataTypeEqn dflags overlap_mode tvs cls cls_tys -- NB: pass the *representation* tycon to checkSideConditions NonDerivableClass msg -> bale_out (nonStdErr cls $$ msg) DerivableClassError msg -> bale_out msg - CanDerive -> go_for_it - DerivableViaInstance -> go_for_it + CanDerive -> go_for_it True + DerivableViaInstance -> go_for_it False where - go_for_it = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta - bale_out msg = failWithTc (derivingThingErr False cls cls_tys (mkTyConApp tycon tc_args) msg) + go_for_it std_cls = mk_data_eqn overlap_mode std_cls tvs cls cls_tys tycon + tc_args rep_tc rep_tc_args mtheta + bale_out msg = failWithTc (derivingThingErr False cls cls_tys + (mkTyConApp tycon tc_args) msg) -mk_data_eqn :: Maybe OverlapMode -> [TyVar] -> Class +mk_data_eqn :: Maybe OverlapMode -> Bool -> [TyVar] -> Class -> [Type] -> TyCon -> [TcType] -> TyCon -> [TcType] -> DerivContext -> TcM EarlyDerivSpec -mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta +mk_data_eqn overlap_mode std_cls tvs cls cls_tys tycon tc_args rep_tc rep_tc_args mtheta = do loc <- getSrcSpanM dfun_name <- new_dfun_name cls tycon case mtheta of Nothing -> do --Infer context - inferred_constraints <- inferConstraints cls inst_tys rep_tc rep_tc_args + inferred_constraints <- inferConstraints std_cls cls inst_tys rep_tc rep_tc_args return $ InferTheta $ DS { ds_loc = loc , ds_name = dfun_name, ds_tvs = tvs @@ -1040,7 +1042,7 @@ mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta , ds_overlap = overlap_mode , ds_newtype = False } where - inst_tys = [mkTyConApp tycon tc_args] + inst_tys = cls_tys ++ [mkTyConApp tycon tc_args] ---------------------- @@ -1076,13 +1078,14 @@ mkPolyKindedTypeableEqn cls tc tc_args = mkTyVarTys kvs tc_app = mkTyConApp tc tc_args -inferConstraints :: Class -> [TcType] +inferConstraints :: Bool + -> Class -> [TcType] -> TyCon -> [TcType] -> TcM ThetaOrigin -- Generate a sufficiently large set of constraints that typechecking the -- generated method definitions should succeed. This set will be simplified -- before being used in the instance declaration -inferConstraints cls inst_tys rep_tc rep_tc_args +inferConstraints std_cls cls inst_tys rep_tc rep_tc_args | cls `hasKey` genClassKey -- Generic constraints are easy = return [] @@ -1094,9 +1097,12 @@ 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 ) do { traceTc "inferConstraints" (vcat [ppr cls <+> ppr inst_tys, ppr arg_constraints]) - ; return (stupid_constraints ++ extra_constraints - ++ sc_constraints - ++ arg_constraints) } + ; dm_constraints <- return [] -- get_dm_constraints + ; let constraints = stupid_constraints ++ sc_constraints + ++ if std_cls + then extra_constraints ++ arg_constraints + else dm_constraints + ; return constraints } where arg_constraints = con_arg_constraints cls get_std_constrained_tys @@ -1134,6 +1140,21 @@ inferConstraints cls inst_tys rep_tc rep_tc_args = rep_tc_args ++ [mkTyVarTy last_tv] | otherwise = rep_tc_args + -- Constraints arising from default methods (only for DeriveAnyClass) +{- + get_dm_constraints = mapM f dms where + + dms = filter ((/= NoDefMeth) . snd) (classOpItems cls) + + f :: ClassOpItem -> TcM Type + f (_, DefMeth name) = tcLookupId name >>= return . idType + f (_, GenDefMeth name) = tcLookupId name >>= return . getClassPredTys_maybe . idType + f x = pprPanic "dm_constraints" (ppr x) + g :: Id -> ThetaOrigin + g x = case getClassPredTys_maybe (idType x) of + Nothing -> [] + Just (_, ty) -> mkThetaOrigin DerivOrigin +-} -- Constraints arising from superclasses -- See Note [Superclasses of derived instance] sc_constraints = mkThetaOrigin DerivOrigin $ @@ -1584,8 +1605,9 @@ mkNewTypeEqn dflags overlap_mode tvs where newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags deriveAnyClass = xopt Opt_DeriveAnyClass dflags - go_for_it = mk_data_eqn overlap_mode tvs cls tycon tc_args - rep_tycon rep_tc_args mtheta + go_for_it = mk_data_eqn overlap_mode (not deriveAnyClass) tvs + cls cls_tys tycon tc_args + rep_tycon rep_tc_args mtheta bale_out = bale_out' newtype_deriving bale_out' b = failWithTc . derivingThingErr b cls cls_tys inst_ty From git at git.haskell.org Tue Feb 17 09:22:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Feb 2015 09:22:43 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Short-circuit type-checking for non-GADT constructors (+cleanup) (2f97015) Message-ID: <20150217092243.CC7F13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/2f970157512f97d14b09e43b4ec32a43893bf621/ghc >--------------------------------------------------------------- commit 2f970157512f97d14b09e43b4ec32a43893bf621 Author: George Karachalias Date: Tue Feb 17 10:23:09 2015 +0100 Short-circuit type-checking for non-GADT constructors (+cleanup) * Do not tc if there are no GADT constructors in the match * Added a COMEHERE to everything that has to be adjusted for final submission * Removed all temporary prints * Fixed warning pretty printing >--------------------------------------------------------------- 2f970157512f97d14b09e43b4ec32a43893bf621 compiler/basicTypes/Var.hs | 5 +- compiler/deSugar/Check.hs | 137 +++++++++++++++++++--------------------- compiler/deSugar/DsMonad.hs | 7 -- compiler/deSugar/Match.hs | 97 +++++++++------------------- compiler/deSugar/MatchLit.hs | 1 - compiler/hsSyn/HsExpr.hs | 7 +- compiler/hsSyn/HsLit.hs | 1 - compiler/hsSyn/HsPat.hs | 38 ++++++++++- compiler/typecheck/TcMType.hs | 1 - compiler/typecheck/TcRnTypes.hs | 12 +--- 10 files changed, 141 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 2f970157512f97d14b09e43b4ec32a43893bf621 From git at git.haskell.org Tue Feb 17 14:59:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Feb 2015 14:59:27 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq: Merge branch 'master' into wip/generics-propeq (5f003d2) Message-ID: <20150217145927.524EC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq Link : http://ghc.haskell.org/trac/ghc/changeset/5f003d228340c3ce8e500f9053f353c58dc1dc94/ghc >--------------------------------------------------------------- commit 5f003d228340c3ce8e500f9053f353c58dc1dc94 Merge: ff9c557 dff0623 Author: Gabor Greif Date: Fri Aug 8 18:01:19 2014 +0200 Merge branch 'master' into wip/generics-propeq Conflicts: compiler/typecheck/TcGenGenerics.lhs >--------------------------------------------------------------- Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5f003d228340c3ce8e500f9053f353c58dc1dc94 From git at git.haskell.org Tue Feb 17 14:59:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Feb 2015 14:59:30 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: Datatypes are reflected in Constructors now, adapt test output (adc24a4) Message-ID: <20150217145930.1C8953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/adc24a40c88f54763f03787b3c45fedd666b952d/ghc >--------------------------------------------------------------- commit adc24a40c88f54763f03787b3c45fedd666b952d Author: Gabor Greif Date: Fri Sep 19 03:36:39 2014 +0200 Datatypes are reflected in Constructors now, adapt test output >--------------------------------------------------------------- adc24a40c88f54763f03787b3c45fedd666b952d testsuite/tests/generics/GenDerivOutput.stderr | 40 ++++++++---- testsuite/tests/generics/GenDerivOutput1_0.stderr | 13 ++-- testsuite/tests/generics/GenDerivOutput1_1.stderr | 80 ++++++++++++++++------- 3 files changed, 93 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 adc24a40c88f54763f03787b3c45fedd666b952d From git at git.haskell.org Tue Feb 17 14:59:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Feb 2015 14:59:32 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in error message (49d99eb) Message-ID: <20150217145932.D4DBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/49d99ebf6e341e26caf1d3db794cb6fa06ee72f6/ghc >--------------------------------------------------------------- commit 49d99ebf6e341e26caf1d3db794cb6fa06ee72f6 Author: Gabor Greif Date: Tue Feb 17 16:00:24 2015 +0100 Fix typo in error message >--------------------------------------------------------------- 49d99ebf6e341e26caf1d3db794cb6fa06ee72f6 libraries/base/GHC/IO/Exception.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index 6701fdf..ed8c802 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -321,7 +321,7 @@ instance Show IOErrorType where ResourceVanished -> "resource vanished" SystemError -> "system error" TimeExpired -> "timeout" - UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise! + UnsatisfiedConstraints -> "unsatisfied constraints" -- ultra-precise! UnsupportedOperation -> "unsupported operation" -- | Construct an 'IOError' value with a string describing the error. From git at git.haskell.org Tue Feb 17 14:59:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Feb 2015 14:59:36 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq's head updated: Merge branch 'master' into wip/generics-propeq (5f003d2) Message-ID: <20150217145936.A79433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/generics-propeq' now includes: 0763a2f Fix #9245 by always checking hi-boot for consistency if we find one. 767b9dd Simplify .gitignore files 88d85aa Add BUILD_DPH variable to GHC build-system 9b93ac6 Tyop in comment dab0fa0 Update Cabal to BinaryLiterals-aware 1.20 version 40ba3da Expect test failure for T8832 on 32bit (re #8832) f12075d Update 32bit & 64bit performance numbers 26f4192 Promote TcNullaryTC and TcCoercible to fast tests 9982715 Factor-out the `OverlapMode` from `OverlapFlag`. 6290eea Overlapable pragmas for individual instances (#9242) b7f9b6a Eliminate `Unify.validKindShape` (#9242) d5c6fd6 Document #8883 in the release notes abeb2bb Remove dead code. Fix comment typo. aed1723 Revert "Fix obscure problem with using the system linker (#8935)" 4ee4ab0 Re-add more primops for atomic ops on byte arrays c44da48 Remove extraneous debugging output (#9071) b735883 Avoid integer overflow in hp2ps (#9145) 9785bb7 Add a cast to new code in hp2ps da8baf2 Unbreak TcNullaryTC testcase, by using MPTC 288c21e Replace thenM/thenM_ with do-notation in RnExpr 47bf248 Refactor checkHiBootIface so that TcGblEnv is not necessary. 94c47f5 Update Haddock submodule with Iavor's validate fix. 5f3c538 Partially fix #9003 by reverting bad numbering. db64180 Check for integer overflow in allocate() (#9172) d6ee82b Fix demand analyser for unboxed types 127c45e Test Trac #9222 e7b9c41 Fixup nullary typeclasses (Trac #8993) f5fa0de Backpack docs: Compilation, surface syntax, and package database 70b24c0 Fix variable name in allocate() f48463e Finish the simple elaboration algo 8afe616 Finish up incomplete sections 34f7e9a Control CPP through settings file (#8683) b0316cd reading/writing blocking FDs over FD_SETSIZE is broken (Partially Trac #9169) 423caa8 compiler/ghc.mk: restore GhcHcOpts variable handling (Trac #8787) dd3a724 ghc-pkg register/update --enable-multi-instance 34bae1f includes/stg/SMP.h: use 'NOSMP' instead of never defined 'WITHSMP' (Trac #8789) b3d9636 remove redundant condition checking in profiling RTS code 5a963b8 Minor edits to Backpack design doc 3285a3d Mark HPC ticks labels as dynamic 23bfa70 Update transformers submodule to 0.4.1.0 release 4c91bc6 PrelNames cleanup 311c55d Update documentation 4b74f6c Update .gitignore 0567a31 Fix windows breakage (fallout from 34f7e9a3c998) 7cf2589 Set mdo in typewriter face fa8553d Fix imports in GHC.Event.Poll when not HAVE_POLL_H (#9275) 55e7ab1 Do not print the result of 'main' after invoking ':main' (fixes #9086). 1d225d1 Private axiom comment in Backpack 74b6b04 Track gitignore update in submodule unix ff7aaf5 More testsuite ignores. 7a15a68 Scott's updates to the impl paper. d68c77b [docs/backpack] Get lint to stop complaining afe7bc1 Add hyperref package. a77e079 Start expanding out linking text bd5f3ef rts: Fix #9003 with an annoying hack 77ecb7b Make the example a little more complex 61cce91 [backpack] Rework definite package compilation 3c9fc10 Avoid unnecessary clock_gettime() syscalls in GC stats. c80c574 remove SPARC related comment in PPC code generator e148d7d GHC.Conc: clarify that 'forkOn' binds to capability, not a 'CPU' or 'Task' 2f8d5e2 Fix typos in base documentation. dbbc1e8 Integrate changelog entries from base-4.7.0.1 rel 8e396b0 Remove unused parameter in rnHsTyVar edae31a Comments only 441d1b9 Declare official github home of libraries/unix 30518f0 Add a .travis.yml file 6a75bcd M-x untabify b8b8d19 Activate tab checks b7b3f01 Fix comment c70a720 Typoes in comments d591b19 Rectify some panic messages 31cde29 Fix note spelling 73bb054 Add travis-ci badge ce4477f testsuite: Tweak T6048 bounds 708062b integer-gmp: tweak gitignore. 47640ca Test case for #9305 8af2f70 Typo in comment 1d71e96 Fix ghci tab completion of duplicate identifiers. 39630ab Avoid deadlock in freeTask (called by forkProcess) 16403f0 Acquire all_tasks_mutex in forkProcess 6da6032 add support for x86_64-solaris2 platform 22e992e Type classes c85a3b0 Finish TCs section 194107e Update various performance benchmarks cfeeded New testsuite verbosity level 4 300c721 Give performance benchmark deviation also in percents 4690466 Partially revert 194107ea9333c1d9d61abf307db2da6a699847af c973c70 Add a clarifying comment about scoping of type variables in associated type decls f6f4f54 White space only f692e8e Define PrelNames.allNameStrings and use it in TcHsType 9b8ba62 Entirely re-jig the handling of default type-family instances (fixes Trac #9063) d761654 Improve documentation of :set/:seti 0fcf060 Improve documentation of overlapping instances (again) a065f9d Try to explain the applicativity problem 34ec0bd Rewrite coercionRole. (#9233) 5e7406d Optimise optCoercion. (#9233) 3b8b826 Workaround haddock parser error caused by 5e7406d9 da7cfa9 Richards optCoercion improvement made test cases fail the nice way ef4e8c5 Test Trac #9323 8b6cd6e Include test case name in performance result 13cb4c2 Adjust a few performance numbers 10f3d39 Correctly round when calculating the deviation 612d948 Remove unused parameters in OptCoercion (#9233) a520072 OK, I think we've finally solved granularity. b542698 Build on travis with CPUS=2 350ed08 Reduce volume of typechecker trace information 3214ec5 Comments only 4b3df0b Further improvements to floating equalities af28e61 Update Cabal submodule to HEAD (1.21) b34fa11 Set i686 as the minimum architecture on 32-bit mingw c41b716 travis: Install process via cabal 99c2823 Document OVERLAP pragmas. 23cd98f Documentation typo 8249b50 Comments only f23b212 Revert "Update Cabal submodule to HEAD (1.21)" 1486fc8 ghci: detabify/dewhitespace RtClosureInspect d2464b5 parser: detabify/dewhitespace Ctype 20986a6 parser: detabify/dewhitespace cutils.c fcfa8ce profiling: detabify/unwhitespace CostCentre fe6381b cmm: detabify/unwhitespace CmmInfo ffcb14d cmm: detabify/unwhitespace CmmLex bd4e855 ghci: detabify/unwhitespace ByteCodeGen 23aee51 ghci: detabify/unwhitespace ByteCodeInstr 3ccc80c main: detabify/unwhitespace PprTyThing b5b1a2d prelude: detabify/unwhitespace PrelInfo 4173ae8 nativeGen: detabify/dewhitespace Size a881813 nativeGen: detabify/dewhitespace Reg 960f4e1 nativeGen: detabify/dewhitespace X86/RegInfo 7bf273c nativeGen: detabify/dewhitespace PPC/Cond e6a32cc nativeGen: detabify/dewhitespace PPC/RegInfo e193380 nativeGen: detabify/dewhitespace RegClass c754599 nativeGen: detabify/dewhitespace TargetReg 2f7495d nativeGen: detabify/dewhitespace SPARC/Stack b80249d nativeGen: detabify/dewhitespace SPARC/Imm 234afe2 nativeGen: detabify/dewhitespace SPARC/ShortcutJump ef07ff7 nativeGen: detabify/dewhitespace SPARC/Instr 25c4629 nativeGen: detabify/dewhitespace SPARC/Regs 8707e45 nativeGen: detabify/dewhitespace SPARC/Cond 9924de2 nativeGen: detabify/dewhitespace SPARC/CodeGen/CondCode 6babdc8 nativeGen: detabify/dewhitespace SPARC/CodeGen/Amode 085713f nativeGen: detabify/dewhitespace SPARC/CodeGen/Expand 5ef0050 nativeGen: detabify/dewhitespace SPARC/CodeGen/Sanity 2ff9b90 nativeGen: detabify/dewhitespace SPARC/CodeGen/Gen32 8a8bc420 nativeGen: detabify/dewhitespace SPARC/CodeGen/Base 3c5fc8e utils: detabify/dewhitespace Digraph 893a4bf types: detabify/dewhitespace Kind 18b2c46 Add PolyKinds extension to Data.Monoid 00dd05e Adding more parser exports and some documentation. d996a1b fix inconsistency in exported functions from TcSplice.lhs/lhs-boot files when GHCI is not defined fb936e0 Make GHCi permissions checks ignore root user. 80868ec rts: drop unused 'SpinLockCount' typedef e0d4386 Data.List: Unterse/Obvious comment regarding CPP 021b797 driver: use absolute paths in ld scripts (#7452) 2b860ef utils: delete obsolete heap-view program ad785f6 utils: remove old pvm scripts 828e641 vagrant: move files around d3277f4 Revert "travis: Install process via cabal" 4dd7ae6 Typos in note bb06e2a Make 'ghc' a wired in package. d7c807f [ghc-pkg] Fix #5442 by using the flag db stack to modify packages. 2ad04d0 Update upstream Git repo url for `time` package a9445f8 arclint: update linting configuration 2c12d9e docs: Remove obsolete Visual Haskell document c26bba8 docs: Delete old docbook cheat sheet 4bebab2 Rename PackageId to PackageKey, distinguishing it from Cabal's PackageId. 0acd70a Documentation for substringCheck. 80ab62d Update Cabal submodule to HEAD (1.21) 9960afe Always qualify on hi interface mismatch. 7aabfa6 Unbreak the build on FreeBSD/i386, where the default target arch is i486. b709f0a Make last a good consumer 1db9983 Rewrite package/module identity section 6e9e855 Add a summary section. 505358c Definite compilation is a go e408678 Write up rename on entry d1f17f5 Ignore tix files. eb795ec Duplicate word 23773b2 X86 codegen: make LOCK a real instruction prefix c11b35f Fix test for fetchNandIntArray# fc53ed5 Add missing memory fence to atomicWriteIntArray# d294218 Fixed issue with detection of duplicate record fields 6ce708c Use the right kinds on the LHS in 'deriving' clauses a997f2d Check for boxed tau types in the LHS of type family instances 2070a8f [backpack] Rewrite compilation to be cleaner. 92587bf Refactor FFI error messages dae46da Update test suite output 7f5c1086 Module reexports, fixing #8407. 9487305 Fix build on OS X due to macro-like string in comment 97f499b Implement OVERLAPPING and OVERLAPPABLE pragmas (see #9242) 5dc0cea Comments only 57ed410 Increase precision of timings reported by RTS ba00258 Support ghc-pkg --ipid to query package ID. 546029e Add reexported modules to the list of IPID fields. a62c345 Don't call installed package IDs 'package IDs'; they're different. 34d7d25 rts: delint/detab/dewhitespace EventLog.c 426f2ac rts: delint/detab/dewhitespace GetEnv.c cebd37f rts: delint/detab/dewhitespace GetTime.c d72f3ad rts: delint/detab/dewhitespace Itimer.c b1fb531 rts: delint/detab/dewhitespace OSMem.c 3e0e489 rts: delint/detab/dewhitespace OSThreads.c 875f4c8 rts: delint/detab/dewhitespace TTY.c 22308d7 rts: delint/detab/dewhitespace Signals.h 386ec24 rts: delint/detab/dewhitespace Signals.c ded5ea8 rts: delint/detab/dewhitespace Select.c 3021fb7 rts: delint/detab/dewhitespace win32/AsyncIO.c fdcc699 rts: delint/detab/dewhitespace win32/AsyncIO.h b64958b rts: delint/detab/dewhitespace win32/AwaitEvent.c ab24d0b rts: delint/detab/dewhitespace win32/ConsoleHandler.c 20b506d rts: delint/detab/dewhitespace win32/GetEnv.c 59b6ea8 rts: delint/detab/dewhitespace win32/GetTime.c 94fba59 rts: delint/detab/dewhitespace win32/IOManager.h 36bbec0 rts: delint/detab/dewhitespace win32/IOManager.c 976c55c rts: delint/detab/dewhitespace win32/OSMem.c 43345dd rts: delint/detab/dewhitespace win32/OSThreads.c 9aa9d17 rts: delint/detab/dewhitespace win32/ThrIOManager.c 316c0d5 rts: delint/detab/dewhitespace win32/WorkQueue.h 9e8d258 rts: delint/detab/dewhitespace win32/WorkQueue.c 4f5966b rts: delint/detab/dewhitespace Arena.c a4aa6be rts: detab/dewhitespace FileLock.c 2e1a0ba rts: delint FileLock.c 4a09baa rts: delint/detab/dewhitespace Globals.h 7ee0b63 rts: delint/detab/dewhitespace Hash.c f2a3f53 rts: detab/dewhitespace Messages.c 1c89c96 rts: delint Messages.c 48cae79 rts: delint/detab/dewhitespace OldARMAtomic.c 42f3bdf rts: delint/detab/dewhitespace Papi.c ad36b1a rts: delint Papi.c a0fa13b rts: delint/detab/dewhitespace Papi.h 7113370 rts: delint/detab/dewhitespace PosixSource.h de5a4db rts: delint/detab/dewhitespace RetainerSet.h ee0fd62 rts: delint/detab/dewhitespace RetainerSet.c f81154f rts: delint/detab/dewhitespace RtsDllMain.c 60c6bd4 rts: delint/detab/dewhitespace RtsDllMain.h d765359 rts: delint/detab/dewhitespace StgRun.h a6fc4bd rts: delint/detab/dewhitespace ThreadLabels.c 95378c2 rts: detab/dewhitespace ThreadPaused.c cf2980c rts: detab/dewhitespace WSDeque.h 952f622 rts: detab/dewhitespace WSDeque.c 39b5c1c rts: add Emacs 'Local Variables' to every .c file cc37175 do not link with -lrt on Solaris for threaded way 524f15d add Solaris' linker warning messages filtering into link phase b9be82d Avoid to pass a socket to setmode/isatty in Windows 4ee8c27 use GHC-7.8.3's values for thread block reason (fixes #9333) 9a7440c Add Functor, Applicative, Monad instances for First, Last 003bcf2 Do not check permissions when running find on Windows. 8240312 driver: Fix usage of '$0' in ghcii.sh (#8873) b126ad3 Don't clean away inplace/mingw and inplace/perl. f510c7c base: make System.IO.openTempFile generate less predictable names b1f4356 Fix validate fallout c1336f7 rts: Detab OSThreads.c b6d5229 getCoerbileInsts: Move the two NT-unwrapping instances together 12644c3 New parser for pattern synonym declarations: 40e7774 Add parser support for explicitly bidirectional pattern synonyms 0279a7d Typechecker support for explicitly-bidirectional pattern synonyms d84a5cc Add renamer support for explicitly-bidirectional pattern synonyms 25c2eeb tcLookupPatSyn: look up the PatSyn record for a given Id 6a78503 Typecheck the wrapper definition of a pattern synonym, after everything in the same scope is typechecked 32bf8a5 When computing minimal recursive sets of bindings, don't include references in wrapper definitions for explicitly-bidirectional pattern synonyms f3262fe Add test cases for explicitly-bidirectional pattern synonym 893a261 Refactor PatSynBind so that we can pass around PSBs instead of several arguments 3219ed9 Add note about renaming of pattern synonym wrappers 535b37c Add user documentation for explicitly-bidirectional pattern synonyms 6640635 Fix variable name typo from commit 3021fb b06e83d Make mod73 test insensitive to minor variations (#9325) a2439c7 Add .gitignore line for stage=1 testsuite generated file 1837b2f comment update da70f9e Allow multiple entry points when allocating recursive groups (#9303) ab8f254 Comments and white space 49333bf Comments and minor refactoring 6fa6caa Compiler perf has improved a bit a0ff1eb [backpack] Package selection 0be7c2c Comments and white space dc7d3c2 Test Trac #9380 7381cee Add a fast-path in TcInteract.kickOutRewritable fe2d807 Comments only bfaa179 Add comments about the {-# INCOHERENT #-} for Typeable (f a) 1ae5fa4 Complete work on new OVERLAPPABLE/OVERLAPPING pragmas (Trac #9242) c97f853 Typo in comment fd47e26 Fix up ghci044 bdf0ef0 Minor wordsmithing of comments 58ed1cc Small tweaks to comment 1c1ef82 Typo fixes 52188ad Unbreak build. 3b9fe0c refactor to fix 80column overflow 6483b8a panic message fix 9d9a554 interruptible() was not returning true for BlockedOnSTM (#9379) 028630a Fix reference to note aab5937 update comment 6c06db1 add a comment 2989ffd A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) d4d4bef Improve the desugaring of RULES, esp those from SPECIALISE pragmas 8df7fea Bump haddock.base max_bytes_used 3faff73 [backpack] More revisions to various pieces. 0336588 Two new executables to ignore. 02975c9 Fix-up to d4d4bef2 'Improve the desugaring of RULES' 578fbec Dont allow hand-written Generic instances in Safe Haskell. e69619e Allow warning if could have been infered safe instead of explicit Trustworthy label. 105602f Update Safe Haskell typeable test outputs. fbd0586 Infer safety of modules correctly with new overlapping pragmas. ab90bf2 Add in (disabled for now) test of a Safe Haskell bug. f293931 Add missing *.stderr files 44853a1 Terminate in forkProcess like in real_main df1e775 docs: fix typo: 'OVERLAPPINGP' -> 'OVERLAPPING' 637978f Use 'install' command for 'inplace/' install as we do in 'make install' 65e5dbc fix linker_unload test on Solaris/i386 platform f686682 ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) 7328deb fix openFile003 test on Solaris/i386 (platform output is not needed anymore) 1f24a03 fix topHandler03 execution on Solaris where shell signals SIGTERM correctly edff1ef Disable package auto-hiding if -hide-all-packages is passed 66218d1 Package keys (for linking/type equality) separated from package IDs. 3663791 Disable ghc-pkg accepting multiple package IDs (differing package keys) for now. de3f064 Make PackageState an abstract type. 00b8f8c Refactor package state, also fixing a module reexport bug. 4accf60 Refactor PackageFlags so that ExposePackage is a single constructor. 2078752 Thinning and renaming modules from packages on the command line. 94b2b22 [no-ci] Minor bugfixes in Backpack docs. 7479df6 configure.ac: drop unused VOID_INT_SIGNALS 56ca32c Update Haddock submodule to know about profiling. d360d44 Filter out null bytes from trace, and warn accordingly, fixing #9395. c88559b Temporarily bump Haddock numbers; I'm going to fix it. 8e400d2 Revert "fix linker_unload test on Solaris/i386 platform" f4904fb Mark type-rep not as expect_broken when debugged f42fa9b fix linker_unload test _FILE_OFFSET_BITS redefined warning on Solaris/i386 2b3c621 fix linker_unload test for ghc configurations with --with-gmp-libraries 24a2e49 fix T658b/T5776 to use POSIX grep -c instead of GNU's --count 61baf71 Comments and white space 31399be Move Outputable instance for FloatBind to the data type definition d3fafbb Tiny refactoring, plus comments; no change in behaviour 93b1a43 Add Output instance for OrdList 6b96557 Make Core Lint check the let/app invariant 1736082 Don't float into unlifted function arguments 1fc60ea When desugaring Use the smart mkCoreConApps and friends d174f49 Make buildToArrPReprs obey the let/app invariant db17d58 Document the maintenance of the let/app invariant in the simplifier ab6480b Extensive Notes on can_fail and has_side_effects 8367f06 Refactor the handling of case-elimination 0957a9b Add has_side_effets to the raise# primop 2990e97 Test Trac #9390 18ac546 Fix some typos in recent comments/notes 4855be0 Give the Unique generated by strings a tag '$', fixes #9413. d026e9e Permanently accept the Haddock performance number bump, and add some TODOs c51498b [no-ci] Track Haddock submodule change: ignore TAGS. af1fc53 ghci: tweak option list indentation in ':show packages' 2cca0c0 testsuite: add signal_exit_code function to the driver d0ee4eb Update perf number for T5642 7d52e62 Update Haddock to attoparsec-0.12.1. Adjust perf. dff0623 Implement the final change to INCOHERENT from Trac #9242 5f003d2 Merge branch 'master' into wip/generics-propeq From git at git.haskell.org Tue Feb 17 16:28:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Feb 2015 16:28:04 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Some more work (b81be33) Message-ID: <20150217162804.9BB753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/b81be333a1920fbfc05a852a4dac5e2e8e29492d/ghc >--------------------------------------------------------------- commit b81be333a1920fbfc05a852a4dac5e2e8e29492d Author: Jose Pedro Magalhaes Date: Tue Feb 17 16:29:46 2015 +0000 Some more work >--------------------------------------------------------------- b81be333a1920fbfc05a852a4dac5e2e8e29492d compiler/typecheck/TcDeriv.hs | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index abf01ae..219bb2c 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -48,7 +48,7 @@ import ErrUtils import DataCon import Maybes import RdrName --- import Id ( idType ) +import Id ( idType ) import Name import NameSet import TyCon @@ -1097,11 +1097,11 @@ inferConstraints std_cls 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 ) do { traceTc "inferConstraints" (vcat [ppr cls <+> ppr inst_tys, ppr arg_constraints]) - ; dm_constraints <- return [] -- get_dm_constraints + ; dm_constraints <- get_dm_constraints ; let constraints = stupid_constraints ++ sc_constraints ++ if std_cls then extra_constraints ++ arg_constraints - else dm_constraints + else mkThetaOrigin DerivOrigin (concat dm_constraints) ; return constraints } where arg_constraints = con_arg_constraints cls get_std_constrained_tys @@ -1141,20 +1141,23 @@ inferConstraints std_cls cls inst_tys rep_tc rep_tc_args | otherwise = rep_tc_args -- Constraints arising from default methods (only for DeriveAnyClass) -{- get_dm_constraints = mapM f dms where dms = filter ((/= NoDefMeth) . snd) (classOpItems cls) - f :: ClassOpItem -> TcM Type - f (_, DefMeth name) = tcLookupId name >>= return . idType - f (_, GenDefMeth name) = tcLookupId name >>= return . getClassPredTys_maybe . idType + f :: ClassOpItem -> TcM ThetaType + f (_, DefMeth name) = tcLookupId name >>= return . g + f (_, GenDefMeth name) = tcLookupId name >>= return . g f x = pprPanic "dm_constraints" (ppr x) - g :: Id -> ThetaOrigin - g x = case getClassPredTys_maybe (idType x) of - Nothing -> [] - Just (_, ty) -> mkThetaOrigin DerivOrigin --} + + g :: Id -> ThetaType + g x = let (_, _, t) = tcSplitSigmaTy (idType x) -- tcSplitDFunTy? + (_, ctx, _) = tcSplitSigmaTy t + classTyVarSet = mkVarSet (classTyVars cls) + usefulCtx = filter (\p -> tcTyVarsOfType p `subVarSet` + classTyVarSet) ctx + in substTheta (zipOpenTvSubst (classTyVars cls) inst_tys) usefulCtx + -- Constraints arising from superclasses -- See Note [Superclasses of derived instance] sc_constraints = mkThetaOrigin DerivOrigin $ From git at git.haskell.org Wed Feb 18 00:51:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 00:51:56 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Removed redundant type from PmConPat and simplified mkConFull (18e58ea) Message-ID: <20150218005156.751BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/18e58ea6bef6c118fd60e6da7601d04e64471960/ghc >--------------------------------------------------------------- commit 18e58ea6bef6c118fd60e6da7601d04e64471960 Author: George Karachalias Date: Wed Feb 18 01:53:46 2015 +0100 Removed redundant type from PmConPat and simplified mkConFull >--------------------------------------------------------------- 18e58ea6bef6c118fd60e6da7601d04e64471960 compiler/deSugar/Check.hs | 84 +++++++++++++++++++++-------------------------- 1 file changed, 38 insertions(+), 46 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 18e58ea6bef6c118fd60e6da7601d04e64471960 From git at git.haskell.org Wed Feb 18 11:16:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 11:16:19 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Take environment EvVars into account when checking pattern matching (2476df2) Message-ID: <20150218111619.6A64E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/2476df238f2aec62b54a08a1f2090fbb66e3bdee/ghc >--------------------------------------------------------------- commit 2476df238f2aec62b54a08a1f2090fbb66e3bdee Author: George Karachalias Date: Wed Feb 18 12:18:02 2015 +0100 Take environment EvVars into account when checking pattern matching >--------------------------------------------------------------- 2476df238f2aec62b54a08a1f2090fbb66e3bdee compiler/deSugar/Check.hs | 3 ++- compiler/deSugar/Match.hs | 6 ++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 0e5f491..f525d58 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -570,7 +570,8 @@ wt sig (_, vec) | length sig == length vec = do (tys, cs) <- inferTyPmPats vec cs' <- zipWithM newEqPmM sig tys -- The vector should match the signature type - isSatisfiable (listToBag cs' `unionBags` cs) -- {COMEHERE: LOAD ENV CONSTRAINTS} + env_cs <- getDictsDs + isSatisfiable (listToBag cs' `unionBags` cs `unionBags` env_cs) | otherwise = pprPanic "wt: length mismatch:" (ppr sig $$ ppr vec) {- diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 2092598..e3928bd 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -705,10 +705,8 @@ matchWrapper ctxt (MG { mg_alts = matches where mk_eqn_info (L _ (Match pats _ grhss)) = do { let upats = map unLoc pats - -- dicts = toTcTypeBag (collectEvVarsPats upats) -- check rhs with constraints from match in scope -- Only TcTyVars - -- ; match_result <- addDictsDs dicts $ dsGRHSs ctxt upats grhss rhs_ty - -- {COMEHERE: ACTIVATE THIS BEFORE THE END, TO BE ABLE TO CATCH #4139} - ; match_result <- dsGRHSs ctxt upats grhss rhs_ty + dicts = toTcTypeBag (collectEvVarsPats upats) -- check rhs with constraints from match in scope -- Only TcTyVars + ; match_result <- addDictsDs dicts $ dsGRHSs ctxt upats grhss rhs_ty ; return (EqnInfo { eqn_pats = upats, eqn_rhs = match_result}) } handleWarnings = if isGenerated origin From git at git.haskell.org Wed Feb 18 15:48:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:02 +0000 (UTC) Subject: [commit: ghc] master: Delete vestigial external core code (#9402) (08102b3) Message-ID: <20150218154802.B94503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/08102b3dcffb715938cf197b455f873e615d2bc2/ghc >--------------------------------------------------------------- commit 08102b3dcffb715938cf197b455f873e615d2bc2 Author: Thomas Miedema Date: Tue Feb 17 08:39:43 2015 -0600 Delete vestigial external core code (#9402) Test Plan: harbormaster Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D659 GHC Trac Issues: #9402 >--------------------------------------------------------------- 08102b3dcffb715938cf197b455f873e615d2bc2 compiler/main/DynFlags.hs | 3 -- compiler/main/HscTypes.hs | 3 +- utils/genprimopcode/Main.hs | 120 -------------------------------------------- 3 files changed, 1 insertion(+), 125 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 08102b3dcffb715938cf197b455f873e615d2bc2 From git at git.haskell.org Wed Feb 18 15:48:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:05 +0000 (UTC) Subject: [commit: ghc] master: Add configurable verbosity level to hpc (1b82619) Message-ID: <20150218154805.8E62B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1b82619bc2ff36341d916c56b0cd67a378a9c222/ghc >--------------------------------------------------------------- commit 1b82619bc2ff36341d916c56b0cd67a378a9c222 Author: Yuras Shumovich Date: Tue Feb 17 08:39:54 2015 -0600 Add configurable verbosity level to hpc Summary: All commands now have `--verbosity` flag, so one can configure cabal package with `--hpc-options="--verbosity=0"`. Right now it is used only in `hpc markup` to supress unnecessary output. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D660 GHC Trac Issues: #10091 >--------------------------------------------------------------- 1b82619bc2ff36341d916c56b0cd67a378a9c222 utils/hpc/HpcCombine.hs | 3 +++ utils/hpc/HpcDraft.hs | 1 + utils/hpc/HpcFlags.hs | 21 ++++++++++++++++++++- utils/hpc/HpcMarkup.hs | 7 +++++-- utils/hpc/HpcOverlay.hs | 1 + utils/hpc/HpcReport.hs | 1 + utils/hpc/HpcShowTix.hs | 1 + 7 files changed, 32 insertions(+), 3 deletions(-) diff --git a/utils/hpc/HpcCombine.hs b/utils/hpc/HpcCombine.hs index b57112f..db6ae9c 100644 --- a/utils/hpc/HpcCombine.hs +++ b/utils/hpc/HpcCombine.hs @@ -21,6 +21,7 @@ sum_options . includeOpt . outputOpt . unionModuleOpt + . verbosityOpt sum_plugin :: Plugin sum_plugin = Plugin { name = "sum" @@ -40,6 +41,7 @@ combine_options . combineFunOpt . combineFunOptInfo . unionModuleOpt + . verbosityOpt combine_plugin :: Plugin combine_plugin = Plugin { name = "combine" @@ -59,6 +61,7 @@ map_options . mapFunOpt . mapFunOptInfo . unionModuleOpt + . verbosityOpt map_plugin :: Plugin map_plugin = Plugin { name = "map" diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs index b804d56..975dbf4 100644 --- a/utils/hpc/HpcDraft.hs +++ b/utils/hpc/HpcDraft.hs @@ -20,6 +20,7 @@ draft_options . hpcDirOpt . resetHpcDirsOpt . outputOpt + . verbosityOpt draft_plugin :: Plugin draft_plugin = Plugin { name = "draft" diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs index 3bb3163..0170309 100644 --- a/utils/hpc/HpcFlags.hs +++ b/utils/hpc/HpcFlags.hs @@ -27,6 +27,8 @@ data Flags = Flags , combineFun :: CombineFun -- tick-wise combine , postFun :: PostFun -- , mergeModule :: MergeFun -- module-wise merge + + , verbosity :: Verbosity } default_flags :: Flags @@ -48,9 +50,21 @@ default_flags = Flags , combineFun = ADD , postFun = ID , mergeModule = INTERSECTION + + , verbosity = Normal } +data Verbosity = Silent | Normal | Verbose + deriving (Eq, Ord) + +verbosityFromString :: String -> Verbosity +verbosityFromString "0" = Silent +verbosityFromString "1" = Normal +verbosityFromString "2" = Verbose +verbosityFromString v = error $ "unknown verbosity: " ++ v + + -- We do this after reading flags, because the defaults -- depends on if specific flags we used. @@ -73,7 +87,7 @@ infoArg :: String -> FlagOptSeq infoArg info = (:) $ Option [] [] (NoArg $ id) info excludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt, - destDirOpt, outputOpt, + destDirOpt, outputOpt, verbosityOpt, perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt, altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt, mapFunOptInfo, unionModuleOpt :: FlagOptSeq @@ -100,6 +114,11 @@ destDirOpt = anArg "destdir" "path to write output to" "DIR" outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a } + +verbosityOpt = anArg "verbosity" "verbosity level, 0-2" "[0-2]" + (\ a f -> f { verbosity = verbosityFromString a }) + . infoArg "default 1" + -- markup perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True } diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index c294b6a..1373bfb 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -32,6 +32,7 @@ markup_options . funTotalsOpt . altHighlightOpt . destDirOpt + . verbosityOpt markup_plugin :: Plugin markup_plugin = Plugin { name = "markup" @@ -76,7 +77,8 @@ markup_main flags (prog:modNames) = do let writeSummary filename cmp = do let mods' = sortBy cmp mods - putStrLn $ "Writing: " ++ (filename ++ ".html") + unless (verbosity flags < Normal) $ + putStrLn $ "Writing: " ++ (filename ++ ".html") writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ "" ++ @@ -223,7 +225,8 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do let addLine n xs = "" ++ padLeft 5 ' ' (show n) ++ " " ++ xs let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines let fileName = modName0 ++ ".hs.html" - putStrLn $ "Writing: " ++ fileName + unless (verbosity flags < Normal) $ + putStrLn $ "Writing: " ++ fileName writeFileUsing (dest_dir ++ "/" ++ fileName) $ unlines ["", "", diff --git a/utils/hpc/HpcOverlay.hs b/utils/hpc/HpcOverlay.hs index 531018c..c4f8e96 100644 --- a/utils/hpc/HpcOverlay.hs +++ b/utils/hpc/HpcOverlay.hs @@ -15,6 +15,7 @@ overlay_options . hpcDirOpt . resetHpcDirsOpt . outputOpt + . verbosityOpt overlay_plugin :: Plugin overlay_plugin = Plugin { name = "overlay" diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs index a97d6b0..4c975be 100644 --- a/utils/hpc/HpcReport.hs +++ b/utils/hpc/HpcReport.hs @@ -274,5 +274,6 @@ report_options . hpcDirOpt . resetHpcDirsOpt . xmlOutputOpt + . verbosityOpt diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs index 13a2875..f0c628e 100644 --- a/utils/hpc/HpcShowTix.hs +++ b/utils/hpc/HpcShowTix.hs @@ -15,6 +15,7 @@ showtix_options . hpcDirOpt . resetHpcDirsOpt . outputOpt + . verbosityOpt showtix_plugin :: Plugin showtix_plugin = Plugin { name = "show" From git at git.haskell.org Wed Feb 18 15:48:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:08 +0000 (UTC) Subject: [commit: ghc] master: Add missing va_end to va_start (310b636) Message-ID: <20150218154808.36E8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/310b6365c91731a797c7e592ebda9ca881f662d4/ghc >--------------------------------------------------------------- commit 310b6365c91731a797c7e592ebda9ca881f662d4 Author: Thomas Miedema Date: Tue Feb 17 08:37:49 2015 -0600 Add missing va_end to va_start Summary: See also ab9711d8. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D655 >--------------------------------------------------------------- 310b6365c91731a797c7e592ebda9ca881f662d4 rts/Trace.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rts/Trace.c b/rts/Trace.c index f28609b..a0783f3 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -702,6 +702,7 @@ static void traceFormatUserMsg(Capability *cap, char *msg, ...) } } dtraceUserMsg(cap->no, msg); + va_end(ap); } void traceUserMsg(Capability *cap, char *msg) @@ -778,6 +779,7 @@ void traceBegin (const char *str, ...) tracePreface(); vdebugBelch(str,ap); + va_end(ap); } void traceEnd (void) From git at git.haskell.org Wed Feb 18 15:48:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:10 +0000 (UTC) Subject: [commit: ghc] master: Remove RAWCPP_FLAGS (Task #9094) (555eef1) Message-ID: <20150218154810.EA2043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/555eef1d0fb5a7fd07971c1201b3c520f01125d4/ghc >--------------------------------------------------------------- commit 555eef1d0fb5a7fd07971c1201b3c520f01125d4 Author: Thomas Miedema Date: Tue Feb 17 08:36:56 2015 -0600 Remove RAWCPP_FLAGS (Task #9094) Reviewers: carter, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D648 GHC Trac Issues: #9094 >--------------------------------------------------------------- 555eef1d0fb5a7fd07971c1201b3c520f01125d4 aclocal.m4 | 10 ++++++---- compiler/ghc.mk | 2 +- configure.ac | 24 +++++++++++++----------- distrib/configure.ac.in | 2 ++ mk/config.mk.in | 11 ++--------- rules/manual-package-config.mk | 4 ++-- 6 files changed, 26 insertions(+), 27 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index 6933e6f..cb4aa83 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -2146,7 +2146,7 @@ dnl ** what cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AC_HELP_STRING([--with-hs-cpp=ARG], - [Use ARG as the path to cpp [default=autodetect]])], + [Path to the (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -2157,6 +2157,8 @@ AC_ARG_WITH(hs-cpp, ], [ + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". HS_CPP_CMD=$WhatGccIsCalled SOLARIS_GCC_CPP_BROKEN=NO @@ -2198,7 +2200,7 @@ dnl ** what cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AC_HELP_STRING([--with-hs-cpp-flags=ARG], - [Use ARG as the path to hs cpp [default=autodetect]])], + [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -2210,11 +2212,11 @@ AC_ARG_WITH(hs-cpp-flags, [ $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs " + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" else $HS_CPP_CMD -v > conftest.txt 2>&1 if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional " + HS_CPP_ARGS="-E -undef -traditional" else $HS_CPP_CMD --version > conftest.txt 2>&1 if grep "cpphs" conftest.txt >/dev/null 2>&1; then diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 200ec8f..07f5ec5 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -269,7 +269,7 @@ compiler_CPP_OPTS += ${GhcCppOpts} define preprocessCompilerFiles # $0 = stage compiler/stage$1/build/primops.txt: compiler/prelude/primops.txt.pp compiler/stage$1/$$(PLATFORM_H) - $$(CPP) $$(RAWCPP_FLAGS) -P $$(compiler_CPP_OPTS) -Icompiler/stage$1 -x c $$< | grep -v '^#pragma GCC' > $$@ + $$(HS_CPP) -P $$(compiler_CPP_OPTS) -Icompiler/stage$1 -x c $$< | grep -v '^#pragma GCC' > $$@ compiler/stage$1/build/primop-data-decl.hs-incl: compiler/stage$1/build/primops.txt $$$$(genprimopcode_INPLACE) "$$(genprimopcode_INPLACE)" --data-decl < $$< > $$@ diff --git a/configure.ac b/configure.ac index 16d1605..9740e15 100644 --- a/configure.ac +++ b/configure.ac @@ -426,8 +426,13 @@ export CC MAYBE_OVERRIDE_STAGE0([gcc],[CC_STAGE0]) MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) +dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) +AC_PROG_CPP + # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +AC_SUBST([HaskellCPPCmd]) +AC_SUBST([HaskellCPPArgs]) dnl ** Which ld to use? dnl -------------------------------------------------------------- @@ -596,9 +601,6 @@ FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAG FP_GCC_EXTRA_FLAGS -dnl ** figure out how to invoke cpp directly (gcc -E is no good) -AC_PROG_CPP - AC_SUBST(CONF_CC_OPTS_STAGE0) AC_SUBST(CONF_CC_OPTS_STAGE1) AC_SUBST(CONF_CC_OPTS_STAGE2) @@ -1031,14 +1033,14 @@ echo ["\ Using $CompilerName : $WhatGccIsCalled which is version : $GccVersion Building a cross compiler : $CrossCompiling - cpp : $HaskellCPPCmd - cpp-flags : $HaskellCPPArgs - ld : $LdCmd - Happy : $HappyCmd ($HappyVersion) - Alex : $AlexCmd ($AlexVersion) - Perl : $PerlCmd - dblatex : $DblatexCmd - xsltproc : $XsltprocCmd + hs-cpp : $HaskellCPPCmd + hs-cpp-flags : $HaskellCPPArgs + ld : $LdCmd + Happy : $HappyCmd ($HappyVersion) + Alex : $AlexCmd ($AlexVersion) + Perl : $PerlCmd + dblatex : $DblatexCmd + xsltproc : $XsltprocCmd Using LLVM tools llc : $LlcCmd diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 2ae0072..ab5c299 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -65,6 +65,8 @@ export CC # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +AC_SUBST([HaskellCPPCmd]) +AC_SUBST([HaskellCPPArgs]) dnl ** Which ld to use? dnl -------------------------------------------------------------- diff --git a/mk/config.mk.in b/mk/config.mk.in index 40c66d9..dfe8c2b 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -623,18 +623,11 @@ ArSupportsAtFile_STAGE3 = $(ArSupportsAtFile) CONTEXT_DIFF = @ContextDiffCmd@ CP = cp + # It's not easy to separate the CPP program from its flags, as # AC_PROG_CPP defines CPP as "/usr/bin/gcc -E" CPP = @CPP@ @CPPFLAGS@ -# -# RAWCPP_FLAGS are the flags to give to cpp (viz, gcc -E) to persuade it to -# behave plausibly on Haskell sources. -# -# Clang in particular is a bit more annoying, so we suppress some warnings. -RAWCPP_FLAGS = -undef -traditional -ifeq "$(CC_CLANG_BACKEND)" "1" -RAWCPP_FLAGS += -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs -endif +HS_CPP = @HaskellCPPCmd@ @HaskellCPPArgs@ FIND = @FindCmd@ diff --git a/rules/manual-package-config.mk b/rules/manual-package-config.mk index 10629aa..fe3a5e3 100644 --- a/rules/manual-package-config.mk +++ b/rules/manual-package-config.mk @@ -16,7 +16,7 @@ $(call trace, manual-package-config($1)) $(call profStart, manual-package-config($1)) $1/dist/package.conf.inplace : $1/package.conf.in $$$$(ghc-pkg_INPLACE) | $$$$(dir $$$$@)/. - $$(CPP) $$(RAWCPP_FLAGS) -P \ + $$(HS_CPP) -P \ -DTOP='"$$(TOP)"' \ $$($1_PACKAGE_CPP_OPTS) \ -x c $$(addprefix -I,$$(GHC_INCLUDE_DIRS)) $$< -o $$@.raw @@ -29,7 +29,7 @@ $1/dist/package.conf.inplace : $1/package.conf.in $$$$(ghc-pkg_INPLACE) | $$$$(d # "make install", so we declare it as phony .PHONY: $1/dist/package.conf.install $1/dist/package.conf.install: | $$$$(dir $$$$@)/. - $$(CPP) $$(RAWCPP_FLAGS) -P \ + $$(HS_CPP) -P \ -DINSTALLING \ -DLIB_DIR='"$$(if $$(filter YES,$$(RelocatableBuild)),$$$$topdir,$$(ghclibdir))"' \ -DINCLUDE_DIR='"$$(if $$(filter YES,$$(RelocatableBuild)),$$$$topdir,$$(ghclibdir))/include"' \ From git at git.haskell.org Wed Feb 18 15:48:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:13 +0000 (UTC) Subject: [commit: ghc] master: Don't truncate traceEvents to 512 bytes (#8309) (a82364c) Message-ID: <20150218154813.91BC73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a82364c9410d35fa9cb5031d553212267c3628c5/ghc >--------------------------------------------------------------- commit a82364c9410d35fa9cb5031d553212267c3628c5 Author: Thomas Miedema Date: Tue Feb 17 08:39:08 2015 -0600 Don't truncate traceEvents to 512 bytes (#8309) Summary: Don't call postLogMsg to post a user msg, because it truncates messages to 512 bytes. Rename traceCap_stderr and trace_stderr to vtraceCap_stderr and trace_stderr, to signal that they take a va_list (similar to vdebugBelch vs debugBelch). See #3874 for the original reason behind traceFormatUserMsg. See the commit msg in #9395 (d360d440) for a discussion about using null-terminated strings vs strings with an explicit length. Test Plan: Run `cabal install ghc-events` and inspect the result of `ghc-events show` on an eventlog file created with `ghc -eventlog Test.hs` and `./Test +RTS -l`, where Test.hs contains: ``` import Debug.Trace main = traceEvent (replicate 510 'a' ++ "bcd") $ return () ``` Depends on D655. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D656 GHC Trac Issues: #8309 >--------------------------------------------------------------- a82364c9410d35fa9cb5031d553212267c3628c5 rts/Trace.c | 39 ++++++++++++++++++--------------------- rts/eventlog/EventLog.c | 13 ++++--------- rts/eventlog/EventLog.h | 4 +--- testsuite/tests/rts/traceEvent.hs | 6 +++--- 4 files changed, 26 insertions(+), 36 deletions(-) diff --git a/rts/Trace.c b/rts/Trace.c index a0783f3..bd4d332 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -622,7 +622,7 @@ void traceTaskDelete_ (Task *task) } #ifdef DEBUG -static void traceCap_stderr(Capability *cap, char *msg, va_list ap) +static void vtraceCap_stderr(Capability *cap, char *msg, va_list ap) { ACQUIRE_LOCK(&trace_utx); @@ -633,6 +633,14 @@ static void traceCap_stderr(Capability *cap, char *msg, va_list ap) RELEASE_LOCK(&trace_utx); } + +static void traceCap_stderr(Capability *cap, char *msg, ...) +{ + va_list ap; + va_start(ap,msg); + vtraceCap_stderr(cap, msg, ap); + va_end(ap); +} #endif void traceCap_(Capability *cap, char *msg, ...) @@ -642,7 +650,7 @@ void traceCap_(Capability *cap, char *msg, ...) #ifdef DEBUG if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { - traceCap_stderr(cap, msg, ap); + vtraceCap_stderr(cap, msg, ap); } else #endif { @@ -653,7 +661,7 @@ void traceCap_(Capability *cap, char *msg, ...) } #ifdef DEBUG -static void trace_stderr(char *msg, va_list ap) +static void vtrace_stderr(char *msg, va_list ap) { ACQUIRE_LOCK(&trace_utx); @@ -672,7 +680,7 @@ void trace_(char *msg, ...) #ifdef DEBUG if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { - trace_stderr(msg, ap); + vtrace_stderr(msg, ap); } else #endif { @@ -682,32 +690,24 @@ void trace_(char *msg, ...) va_end(ap); } -static void traceFormatUserMsg(Capability *cap, char *msg, ...) +void traceUserMsg(Capability *cap, char *msg) { - va_list ap; - va_start(ap,msg); - /* Note: normally we don't check the TRACE_* flags here as they're checked by the wrappers in Trace.h. But traceUserMsg is special since it has no wrapper (it's called from cmm code), so we check TRACE_user here */ #ifdef DEBUG if (RtsFlags.TraceFlags.tracing == TRACE_STDERR && TRACE_user) { - traceCap_stderr(cap, msg, ap); + // Use "%s" as format string to ignore format specifiers in msg (#3874). + traceCap_stderr(cap, "%s", msg); } else #endif { if (eventlog_enabled && TRACE_user) { - postUserMsg(cap, msg, ap); + postUserEvent(cap, EVENT_USER_MSG, msg); } } dtraceUserMsg(cap->no, msg); - va_end(ap); -} - -void traceUserMsg(Capability *cap, char *msg) -{ - traceFormatUserMsg(cap, "%s", msg); } void traceUserMarker(Capability *cap, char *markername) @@ -717,15 +717,12 @@ void traceUserMarker(Capability *cap, char *markername) */ #ifdef DEBUG if (RtsFlags.TraceFlags.tracing == TRACE_STDERR && TRACE_user) { - ACQUIRE_LOCK(&trace_utx); - tracePreface(); - debugBelch("cap %d: User marker: %s\n", cap->no, markername); - RELEASE_LOCK(&trace_utx); + traceCap_stderr(cap, "User marker: %s", markername); } else #endif { if (eventlog_enabled && TRACE_user) { - postUserMarker(cap, markername); + postUserEvent(cap, EVENT_USER_MARKER, markername); } } dtraceUserMarker(cap->no, markername); diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c index f830ec1..5f021a6 100644 --- a/rts/eventlog/EventLog.c +++ b/rts/eventlog/EventLog.c @@ -1078,11 +1078,6 @@ void postCapMsg(Capability *cap, char *msg, va_list ap) postLogMsg(&capEventBuf[cap->no], EVENT_LOG_MSG, msg, ap); } -void postUserMsg(Capability *cap, char *msg, va_list ap) -{ - postLogMsg(&capEventBuf[cap->no], EVENT_USER_MSG, msg, ap); -} - void postEventStartup(EventCapNo n_caps) { ACQUIRE_LOCK(&eventBufMutex); @@ -1099,10 +1094,10 @@ void postEventStartup(EventCapNo n_caps) RELEASE_LOCK(&eventBufMutex); } -void postUserMarker(Capability *cap, char *markername) +void postUserEvent(Capability *cap, EventTypeNum type, char *msg) { EventsBuf *eb; - int size = strlen(markername); + int size = strlen(msg); eb = &capEventBuf[cap->no]; @@ -1115,9 +1110,9 @@ void postUserMarker(Capability *cap, char *markername) } } - postEventHeader(eb, EVENT_USER_MARKER); + postEventHeader(eb, type); postPayloadSize(eb, size); - postBuf(eb, (StgWord8*) markername, size); + postBuf(eb, (StgWord8*) msg, size); } void postThreadLabel(Capability *cap, diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h index 85370e9..9c2f265 100644 --- a/rts/eventlog/EventLog.h +++ b/rts/eventlog/EventLog.h @@ -45,12 +45,10 @@ void postEventAtTimestamp (Capability *cap, EventTimestamp ts, void postMsg(char *msg, va_list ap); -void postUserMsg(Capability *cap, char *msg, va_list ap); +void postUserEvent(Capability *cap, EventTypeNum type, char *msg); void postCapMsg(Capability *cap, char *msg, va_list ap); -void postUserMarker(Capability *cap, char *markername); - void postEventStartup(EventCapNo n_caps); /* diff --git a/testsuite/tests/rts/traceEvent.hs b/testsuite/tests/rts/traceEvent.hs index ef64181..a5e19a9 100644 --- a/testsuite/tests/rts/traceEvent.hs +++ b/testsuite/tests/rts/traceEvent.hs @@ -1,5 +1,5 @@ -import GHC.Exts +import Debug.Trace main = do - traceEvent "testing" - traceEvent "%s" -- see #3874 + traceEventIO "testing" + traceEventIO "%s" -- see #3874 From git at git.haskell.org Wed Feb 18 15:48:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:16 +0000 (UTC) Subject: [commit: ghc] master: Improve outdated ghc-pkg cache warning (#9606) (e7fab33) Message-ID: <20150218154816.54B593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7fab334b31dc516d2e8f2285630cbffe9825b76/ghc >--------------------------------------------------------------- commit e7fab334b31dc516d2e8f2285630cbffe9825b76 Author: Thomas Miedema Date: Tue Feb 17 08:39:35 2015 -0600 Improve outdated ghc-pkg cache warning (#9606) Summary: No more frustration. Test Plan: I tested it. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D658 GHC Trac Issues: #9606 >--------------------------------------------------------------- e7fab334b31dc516d2e8f2285630cbffe9825b76 utils/ghc-pkg/Main.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index b2815b8..53bc43b 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -706,7 +706,7 @@ readParseDatabase verbosity mb_user_conf modify use_cache path then do warn ("WARNING: cache does not exist: " ++ cache) warn ("ghc will fail to read this package db. " ++ - "Use 'ghc-pkg recache' to fix.") + recacheAdvice) else do warn ("WARNING: cache cannot be read: " ++ show ex) warn "ghc will fail to read this package db." @@ -736,7 +736,7 @@ readParseDatabase verbosity mb_user_conf modify use_cache path whenReportCacheErrors $ do warn ("WARNING: cache is out of date: " ++ cache) warn ("ghc will see an old view of this " ++ - "package db. Use 'ghc-pkg recache' to fix.") + "package db. " ++ recacheAdvice) ignore_cache compareTimestampToCache where ignore_cache :: (FilePath -> IO ()) -> IO PackageDB @@ -753,6 +753,12 @@ readParseDatabase verbosity mb_user_conf modify use_cache path when ( verbosity > Normal || verbosity >= Normal && not modify) where + recacheAdvice + | Just (user_conf, True) <- mb_user_conf, path == user_conf + = "Use 'ghc-pkg recache --user' to fix." + | otherwise + = "Use 'ghc-pkg recache' to fix." + mkPackageDB pkgs = do path_abs <- absolutePath path return PackageDB { From git at git.haskell.org Wed Feb 18 15:48:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:19 +0000 (UTC) Subject: [commit: ghc] master: Revert "Eta-expand argument to foldr in mapM_ for []" (91d9530) Message-ID: <20150218154819.104F13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/91d9530525803403c3c012901115d54ff4fc3b5e/ghc >--------------------------------------------------------------- commit 91d9530525803403c3c012901115d54ff4fc3b5e Author: Austin Seipp Date: Tue Feb 17 09:08:12 2015 -0600 Revert "Eta-expand argument to foldr in mapM_ for []" This change lacked justification (or a test!) for its improvements, and I merged it on a sweep of Phabricator without fixing this. Trac #10034. This reverts commit 7cf87fc6928f0252d9f61719e2344e6c69237079. >--------------------------------------------------------------- 91d9530525803403c3c012901115d54ff4fc3b5e libraries/base/Data/Foldable.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index b8b0973..a745f66 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -349,8 +349,7 @@ for_ = flip traverse_ -- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to -- 'Monad'. mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m () -{-# INLINE mapM_ #-} -mapM_ f = foldr (\m n -> f m >> n) (return ()) +mapM_ f= foldr ((>>) . f) (return ()) -- | 'forM_' is 'mapM_' with its arguments flipped. For a version that -- doesn't ignore the results see 'Data.Traversable.forM'. From git at git.haskell.org Wed Feb 18 15:48:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:21 +0000 (UTC) Subject: [commit: ghc] master: Do not clobber CPPFLAGS nor LDFLAGS, fixes #10093 (9caf71a) Message-ID: <20150218154821.CA89B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9caf71a8d9293cfebdbb5b28e2d6a455ad126882/ghc >--------------------------------------------------------------- commit 9caf71a8d9293cfebdbb5b28e2d6a455ad126882 Author: PHO Date: Wed Feb 18 09:46:30 2015 -0600 Do not clobber CPPFLAGS nor LDFLAGS, fixes #10093 Summary: Append -I/-L flags to CPPFLAGS/LDFLAGS instead of clobbering. Test Plan: Install libiconv into /some/non-standard/path. Set CONF_GCC_LINKER_OPTS_STAGE{0,1,2} to -Wl,-rpath,/some/non-standard/path/lib. And then run ./configure with arguments --with-iconv-includes=/some/non-standard/path/include and --with-iconv-libraries=/some/non-standard/path/lib Reviewers: hvr, austin Reviewed By: austin Subscribers: thomie, PHO Differential Revision: https://phabricator.haskell.org/D663 GHC Trac Issues: #10093 >--------------------------------------------------------------- 9caf71a8d9293cfebdbb5b28e2d6a455ad126882 libraries/base/configure.ac | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/libraries/base/configure.ac b/libraries/base/configure.ac index 4835a2b..85b2f2e 100644 --- a/libraries/base/configure.ac +++ b/libraries/base/configure.ac @@ -92,13 +92,13 @@ dnl-------------------------------------------------------------------- AC_ARG_WITH([iconv-includes], [AC_HELP_STRING([--with-iconv-includes], [directory containing iconv.h])], - [ICONV_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"], + [ICONV_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval $CPPFLAGS"], [ICONV_INCLUDE_DIRS=]) AC_ARG_WITH([iconv-libraries], [AC_HELP_STRING([--with-iconv-libraries], [directory containing iconv library])], - [ICONV_LIB_DIRS=$withval; LDFLAGS="-L$withval"], + [ICONV_LIB_DIRS=$withval; LDFLAGS="-L$withval $LDFLAGS"], [ICONV_LIB_DIRS=]) AC_SUBST(ICONV_INCLUDE_DIRS) @@ -205,7 +205,10 @@ fi # Hack - md5.h needs HsFFI.h. Is there a better way to do this? CFLAGS="-I../../includes $CFLAGS" -AC_CHECK_SIZEOF([struct MD5Context], ,[#include "include/md5.h"]) +dnl Calling AC_CHECK_TYPE(T) makes AC_CHECK_SIZEOF(T) abort on failure +dnl instead of considering sizeof(T) as 0. +AC_CHECK_TYPE([struct MD5Context], [], [], [#include "include/md5.h"]) +AC_CHECK_SIZEOF([struct MD5Context], [], [#include "include/md5.h"]) AC_SUBST(EXTRA_LIBS) AC_CONFIG_FILES([base.buildinfo]) From git at git.haskell.org Wed Feb 18 15:48:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:24 +0000 (UTC) Subject: [commit: ghc] master: runghc: be explicit about ghc version (#9054) (6d17125) Message-ID: <20150218154824.85E5E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d17125dccda76b7aafe33181df822045ff5b9bf/ghc >--------------------------------------------------------------- commit 6d17125dccda76b7aafe33181df822045ff5b9bf Author: Thomas Miedema Date: Wed Feb 18 09:46:40 2015 -0600 runghc: be explicit about ghc version (#9054) Summary: runghc-7.x should always call ghc-7.x Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D664 GHC Trac Issues: #9054 >--------------------------------------------------------------- 6d17125dccda76b7aafe33181df822045ff5b9bf rules/build-prog.mk | 6 +----- rules/shell-wrapper.mk | 8 +++++--- utils/runghc/ghc.mk | 8 ++++++++ utils/runghc/runghc.wrapper | 2 +- 4 files changed, 15 insertions(+), 9 deletions(-) diff --git a/rules/build-prog.mk b/rules/build-prog.mk index f93b99d..88f1b53 100644 --- a/rules/build-prog.mk +++ b/rules/build-prog.mk @@ -11,11 +11,7 @@ # ----------------------------------------------------------------------------- -# Build a program. Invoke like this: -# -# utils/genapply_MODULES = Main -# utils/genapply_HC_OPTS = -package Cabal -# utils/genapply_dist_PROGNAME = genapply +# Build a program. # # $(eval $(call build-prog,utils/genapply,dist-install,1)) diff --git a/rules/shell-wrapper.mk b/rules/shell-wrapper.mk index 05dd0ef..ae38e65 100644 --- a/rules/shell-wrapper.mk +++ b/rules/shell-wrapper.mk @@ -22,15 +22,17 @@ endif ifeq "$$($1_$2_WANT_INPLACE_WRAPPER)" "YES" +$1_$2_INPLACE_SHELL_WRAPPER_NAME = $$($1_$2_PROG) + ifeq "$$($1_$2_TOPDIR)" "YES" -INPLACE_WRAPPER = $$(INPLACE_LIB)/$$($1_$2_PROG) +INPLACE_WRAPPER = $$(INPLACE_LIB)/$$($1_$2_INPLACE_SHELL_WRAPPER_NAME) else -INPLACE_WRAPPER = $$(INPLACE_BIN)/$$($1_$2_PROG) +INPLACE_WRAPPER = $$(INPLACE_BIN)/$$($1_$2_INPLACE_SHELL_WRAPPER_NAME) endif all_$1_$2 : $$(INPLACE_WRAPPER) -$$(INPLACE_BIN)/$$($1_$2_PROG): WRAPPER=$$@ +$$(INPLACE_WRAPPER): WRAPPER=$$@ ifeq "$$($1_$2_SHELL_WRAPPER)" "YES" $$(INPLACE_WRAPPER): $$($1_$2_SHELL_WRAPPER_NAME) endif diff --git a/utils/runghc/ghc.mk b/utils/runghc/ghc.mk index 31bf089..6979d50 100644 --- a/utils/runghc/ghc.mk +++ b/utils/runghc/ghc.mk @@ -19,6 +19,14 @@ utils/runghc_dist-install_INSTALL_INPLACE = YES utils/runghc_dist-install_INSTALL_SHELL_WRAPPER_NAME = runghc-$(ProjectVersion) utils/runghc_dist-install_EXTRA_HC_OPTS = -cpp -DVERSION="\"$(ProjectVersion)\"" +# Be explicit about which version of ghc to call (#9054). +define utils/runghc_dist-install_INPLACE_SHELL_WRAPPER_EXTRA +echo 'ghcprog="$(ghc_stage2_INPLACE_SHELL_WRAPPER_NAME)"' >> "$(WRAPPER)" +endef +define utils/runghc_dist-install_INSTALL_SHELL_WRAPPER_EXTRA +echo 'ghcprog="$(ghc_stage$(INSTALL_GHC_STAGE)_INSTALL_SHELL_WRAPPER_NAME)"' >> "$(WRAPPER)" +endef + ifneq "$(BINDIST)" "YES" # hack: the build system has trouble with Main modules not called Main.hs utils/runghc/dist-install/build/Main.hs : utils/runghc/runghc.hs | $$(dir $$@)/. diff --git a/utils/runghc/runghc.wrapper b/utils/runghc/runghc.wrapper index 9110dcc..5caea0b 100644 --- a/utils/runghc/runghc.wrapper +++ b/utils/runghc/runghc.wrapper @@ -1,3 +1,3 @@ #!/bin/sh -exec "$executablename" -f "$bindir/ghc" ${1+"$@"} +exec "$executablename" -f "$bindir/$ghcprog" ${1+"$@"} From git at git.haskell.org Wed Feb 18 15:48:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 15:48:27 +0000 (UTC) Subject: [commit: ghc] master: Cleanup ghc-pkg (32d1a8a) Message-ID: <20150218154827.443103A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/32d1a8a5817de8a444d7f50c0a2aebb6a9174326/ghc >--------------------------------------------------------------- commit 32d1a8a5817de8a444d7f50c0a2aebb6a9174326 Author: Thomas Miedema Date: Wed Feb 18 09:46:49 2015 -0600 Cleanup ghc-pkg Summary: * Delete dead code in ghc-pkg (not_yet ready since 2004) * remove --auto-ghc-libs Commit 78185538b (2011) mentions: "Deprecate the ghc-pkg --auto-ghci-libs flag It was never a universal solution. It only worked with the GNU linker. It has not been used by Cabal for ages. GHCi can now load .a files so it will not be needed in future." "Warning: --auto-ghci-libs is deprecated and will be removed in GHC 7.4" Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D666 >--------------------------------------------------------------- 32d1a8a5817de8a444d7f50c0a2aebb6a9174326 utils/ghc-pkg/Main.hs | 149 +++++++++++++------------------------------------- 1 file changed, 37 insertions(+), 112 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 32d1a8a5817de8a444d7f50c0a2aebb6a9174326 From git at git.haskell.org Wed Feb 18 17:17:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Feb 2015 17:17:25 +0000 (UTC) Subject: [commit: ghc] master: Typo in function name (35d464b) Message-ID: <20150218171725.46CFE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/35d464bf54373cbe37e1e3310cc6a95f63f257f0/ghc >--------------------------------------------------------------- commit 35d464bf54373cbe37e1e3310cc6a95f63f257f0 Author: Gabor Greif Date: Wed Feb 18 18:18:49 2015 +0100 Typo in function name >--------------------------------------------------------------- 35d464bf54373cbe37e1e3310cc6a95f63f257f0 compiler/typecheck/TcInstDcls.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 4444101..3d9e425 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -1412,7 +1412,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys -- Check if one of the minimal complete definitions is satisfied checkMinimalDefinition = whenIsJust (isUnsatisfied methodExists (classMinimalDef clas)) $ - warnUnsatisifiedMinimalDefinition + warnUnsatisfiedMinimalDefinition where methodExists meth = isJust (findMethodBind meth binds) @@ -1616,8 +1616,8 @@ warnMissingMethodOrAT what name (ptext (sLit "No explicit") <+> text what <+> ptext (sLit "or default declaration for") <+> quotes (ppr name)) } -warnUnsatisifiedMinimalDefinition :: ClassMinimalDef -> TcM () -warnUnsatisifiedMinimalDefinition mindef +warnUnsatisfiedMinimalDefinition :: ClassMinimalDef -> TcM () +warnUnsatisfiedMinimalDefinition mindef = do { warn <- woptM Opt_WarnMissingMethods ; warnTc warn message } From git at git.haskell.org Thu Feb 19 01:18:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 01:18:08 +0000 (UTC) Subject: [commit: ghc] master: Fix #10045 (e9d72ce) Message-ID: <20150219011808.62B643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9d72cefeda243d5962d0615fe7ad22ff615d134/ghc >--------------------------------------------------------------- commit e9d72cefeda243d5962d0615fe7ad22ff615d134 Author: Thomas Winant Date: Wed Feb 18 10:13:37 2015 -0600 Fix #10045 Summary: SPJ's solution is to only bring the `TcId` (which includes the type) of a binder into scope when it had a non-partial type signature. Take care of this by only storing the `TcId` in `TcSigInfo` of non-partial type signatures, hence the change to `sig_poly_id :: Maybe TcId`. Only in case of a `Just` will we bring the `TcId` in scope. We still need to know the name of the binder, even when it has a partial type signature, so add a `sig_name :: Name` field. The field `sig_partial :: Bool` is no longer necessary, so reimplement `isPartialSig` in terms of `sig_poly_id`. Note that the new test case fails, but not because of a panic, but because the `Num a` constraint is missing. Adding an extra-constraints wildcard to `copy`'s signature would fix it. Test Plan: validate Reviewers: simonpj, austin Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D646 GHC Trac Issues: #10045 >--------------------------------------------------------------- e9d72cefeda243d5962d0615fe7ad22ff615d134 compiler/typecheck/TcBinds.hs | 55 ++++++++++++---------- compiler/typecheck/TcClassDcl.hs | 7 ++- compiler/typecheck/TcInstDcls.hs | 10 ++-- compiler/typecheck/TcPat.hs | 54 ++++++++++++++++----- .../tests/partial-sigs/should_fail/Trac10045.hs | 8 ++++ .../partial-sigs/should_fail/Trac10045.stderr | 45 ++++++++++++++++++ testsuite/tests/partial-sigs/should_fail/all.T | 1 + 7 files changed, 139 insertions(+), 41 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e9d72cefeda243d5962d0615fe7ad22ff615d134 From git at git.haskell.org Thu Feb 19 12:39:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 12:39:51 +0000 (UTC) Subject: [commit: ghc] wip/T9968: I think this was just wrong (f6be00a) Message-ID: <20150219123951.3176B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/f6be00ae48a425549448666757099f503037576d/ghc >--------------------------------------------------------------- commit f6be00ae48a425549448666757099f503037576d Author: Jose Pedro Magalhaes Date: Wed Feb 18 09:23:58 2015 +0000 I think this was just wrong >--------------------------------------------------------------- f6be00ae48a425549448666757099f503037576d compiler/typecheck/TcDeriv.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 219bb2c..a2fcc80 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -772,8 +772,9 @@ deriveTyData is_instance tvs tc tc_args (L loc deriv_pred) ; traceTc "derivTyData2" (vcat [ ppr univ_tvs ]) - ; checkTc (allDistinctTyVars args_to_drop && -- (a) and (b) - not (any (`elemVarSet` dropped_tvs) univ_tvs)) -- (c) + ; checkTc (allDistinctTyVars args_to_drop && -- (a) and (b) + dropped_tvs `disjointVarSet` + tyVarsOfTypes final_cls_tys) -- (c) (derivingEtaErr cls final_cls_tys (mkTyConApp tc final_tc_args)) -- Check that -- (a) The args to drop are all type variables; eg reject: From git at git.haskell.org Thu Feb 19 12:39:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 12:39:53 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Most work is done now (92fdc8d) Message-ID: <20150219123953.CF7923A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/92fdc8dcc69c79ed346e0fcf87ba6dc55f9561f8/ghc >--------------------------------------------------------------- commit 92fdc8dcc69c79ed346e0fcf87ba6dc55f9561f8 Author: Jose Pedro Magalhaes Date: Thu Feb 19 11:03:33 2015 +0000 Most work is done now >--------------------------------------------------------------- 92fdc8dcc69c79ed346e0fcf87ba6dc55f9561f8 compiler/main/HscTypes.hs | 2 +- compiler/typecheck/TcDeriv.hs | 152 ++++++++++++++++------------ compiler/typecheck/TcGenDeriv.hs | 185 ++++++++++++++++------------------ compiler/typecheck/TcGenGenerics.hs | 10 +- testsuite/tests/generics/GEq/GEq1A.hs | 0 testsuite/tests/generics/T5462Yes1.hs | 2 +- 6 files changed, 177 insertions(+), 174 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 92fdc8dcc69c79ed346e0fcf87ba6dc55f9561f8 From git at git.haskell.org Thu Feb 19 18:00:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 18:00:08 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Make the implementation of DeriveAnyClass more robust (5782905) Message-ID: <20150219180008.113FA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/57829051e5c566a8d463f0ce7396a3956d3f719a/ghc >--------------------------------------------------------------- commit 57829051e5c566a8d463f0ce7396a3956d3f719a Author: Jose Pedro Magalhaes Date: Mon Feb 16 15:17:15 2015 +0000 Make the implementation of DeriveAnyClass more robust Let DeriveAnyClass properly handle multiparameter type classes. Also use a new strategy for inferring constraints for derived classes. This fixes #9968 and #9821. >--------------------------------------------------------------- 57829051e5c566a8d463f0ce7396a3956d3f719a compiler/main/HscTypes.hs | 2 +- compiler/typecheck/Inst.hs | 2 +- compiler/typecheck/TcDeriv.hs | 269 +++++++++++++++++++++++----------- compiler/typecheck/TcGenDeriv.hs | 194 ++++++++++++------------ compiler/typecheck/TcGenGenerics.hs | 93 +++++++++--- testsuite/tests/generics/GEq/GEq1A.hs | 0 testsuite/tests/generics/T5462Yes1.hs | 2 +- 7 files changed, 350 insertions(+), 212 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 57829051e5c566a8d463f0ce7396a3956d3f719a From git at git.haskell.org Thu Feb 19 18:00:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 18:00:10 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Improve tests (d964bcf) Message-ID: <20150219180010.E64213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/d964bcfafe887a78a8c342fedd3591c9efe5f2a3/ghc >--------------------------------------------------------------- commit d964bcfafe887a78a8c342fedd3591c9efe5f2a3 Author: Jose Pedro Magalhaes Date: Thu Feb 19 18:00:58 2015 +0000 Improve tests >--------------------------------------------------------------- d964bcfafe887a78a8c342fedd3591c9efe5f2a3 testsuite/tests/generics/T5462Yes1.hs | 4 +++- testsuite/tests/generics/T5462Yes1.stdout | 2 +- testsuite/tests/generics/all.T | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/generics/T5462Yes1.hs b/testsuite/tests/generics/T5462Yes1.hs index b9a0933..254ba95 100644 --- a/testsuite/tests/generics/T5462Yes1.hs +++ b/testsuite/tests/generics/T5462Yes1.hs @@ -13,9 +13,10 @@ import GHC.Generics hiding (C, C1, D) import GEq1A import Enum import GFunctor +import GShow data A = A1 - deriving (Show, Generic, GEq, GEnum) + deriving (Show, Generic, GEq, GEnum, GShow) data B a = B1 | B2 a (B a) deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor) @@ -34,6 +35,7 @@ data E f a = E1 (f a) main = print ( geq A1 A1 , take 10 (genum :: [A]) + , gshow A1 , geq (B2 A1 B1) B1 , gmap (++ "lo") (B2 "hel" B1) diff --git a/testsuite/tests/generics/T5462Yes1.stdout b/testsuite/tests/generics/T5462Yes1.stdout index 6a2dc67..7aed256 100644 --- a/testsuite/tests/generics/T5462Yes1.stdout +++ b/testsuite/tests/generics/T5462Yes1.stdout @@ -1 +1 @@ -(True,[A1],False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"]) +(True,[A1],"A1",False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"]) diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T index c51de18..50894d6 100644 --- a/testsuite/tests/generics/all.T +++ b/testsuite/tests/generics/all.T @@ -20,7 +20,7 @@ test('GenCannotDoRep1_7', normal, compile_fail, ['']) test('GenCannotDoRep1_8', normal, compile_fail, ['']) test('T5462Yes1', extra_clean(['T5462Yes1/GFunctor.hi']) - , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -outputdir=out_T5462Yes1']) + , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -iGShow -outputdir=out_T5462Yes1']) test('T5462Yes2', extra_clean(['T5462Yes2/GFunctor.hi']) , multimod_compile_and_run, ['T5462Yes2', '-iGFunctor -outputdir=out_T5462Yes2']) test('T5462No1', extra_clean(['T5462No1/GFunctor.hi']) From git at git.haskell.org Thu Feb 19 18:00:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 18:00:13 +0000 (UTC) Subject: [commit: ghc] wip/T9968's head updated: Improve tests (d964bcf) Message-ID: <20150219180013.41CD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9968' now includes: 36f2ad5 Comments only 5ab7518 Improve typechecking of RULEs, to account for type wildcard holes 6fa285d Move comments about evaluating the message to the top of the module 49d99eb Fix typo in error message 555eef1 Remove RAWCPP_FLAGS (Task #9094) 310b636 Add missing va_end to va_start a82364c Don't truncate traceEvents to 512 bytes (#8309) e7fab33 Improve outdated ghc-pkg cache warning (#9606) 08102b3 Delete vestigial external core code (#9402) 1b82619 Add configurable verbosity level to hpc 91d9530 Revert "Eta-expand argument to foldr in mapM_ for []" 9caf71a Do not clobber CPPFLAGS nor LDFLAGS, fixes #10093 6d17125 runghc: be explicit about ghc version (#9054) 32d1a8a Cleanup ghc-pkg 35d464b Typo in function name e9d72ce Fix #10045 5782905 Make the implementation of DeriveAnyClass more robust d964bcf Improve tests From git at git.haskell.org Thu Feb 19 20:54:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 20:54:07 +0000 (UTC) Subject: [commit: ghc] master: Comments only (ef391f8) Message-ID: <20150219205407.7A1823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef391f88ecde6d66cae0fd216ba0d25956fec1fb/ghc >--------------------------------------------------------------- commit ef391f88ecde6d66cae0fd216ba0d25956fec1fb Author: Simon Peyton Jones Date: Thu Feb 19 20:53:55 2015 +0000 Comments only >--------------------------------------------------------------- ef391f88ecde6d66cae0fd216ba0d25956fec1fb compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcPat.hs | 37 +++++++++++++++++++++---------------- 2 files changed, 22 insertions(+), 17 deletions(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index acdaf8f..7b988da 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -542,7 +542,7 @@ tcPolyCheck :: RecFlag -- Whether it's recursive after breaking -> TcM (LHsBinds TcId, [TcId], TopLevelFlag) -- There is just one binding, -- it binds a single variable, --- it has a signature, +-- it has a complete type signature, tcPolyCheck rec_tc prag_fn sig@(TcSigInfo { sig_name = name, sig_poly_id = Just poly_id , sig_tvs = tvs_w_scoped diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 7856413..9f37a56 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -140,12 +140,16 @@ data TcSigInfo -- sig_id = Just id, then sig_name = idName id. sig_poly_id :: Maybe TcId, - -- Just <=> complete type signature of - -- which the polymorphic type is known. - -- Nothing <=> partial type signature of - -- which the type is not yet fully - -- known. - -- See Note [Complete and partial type signatures] + -- Just f <=> the type signature had no wildcards, so the precise, + -- complete polymorphic type is known. In that case, + -- f is the polymorphic Id, with that type + + -- Nothing <=> the type signature is partial (i.e. includes one or more + -- wildcards). In this case it doesn't make sense to give + -- the polymorphic Id, because we are going to /infer/ its + -- type, so we can't make the polymorphic Id ab-initio + -- + -- See Note [Complete and partial type signatures] sig_tvs :: [(Maybe Name, TcTyVar)], -- Instantiated type and kind variables @@ -154,16 +158,17 @@ data TcSigInfo sig_nwcs :: [(Name, TcTyVar)], -- Instantiated wildcard variables + -- If sig_poly_id = Just f, then sig_nwcs must be empty - sig_theta :: TcThetaType, -- Instantiated theta - - sig_extra_cts :: Maybe SrcSpan, -- Just loc <=> An extra-constraints - -- wildcard was present. Any extra - -- constraints inferred during - -- type-checking will be added to the - -- partial type signature. Stores the - -- location of the wildcard. + sig_extra_cts :: Maybe SrcSpan, + -- Just loc <=> An extra-constraints wildcard was present + -- at location loc + -- e.g. f :: (Eq a, _) => a -> a + -- Any extra constraints inferred during + -- type-checking will be added to the sig_theta. + -- If sig_poly_id = Just f, sig_extra_cts must be Nothing + sig_theta :: TcThetaType, -- Instantiated theta sig_tau :: TcSigmaType, -- Instantiated tau -- See Note [sig_tau may be polymorphic] @@ -288,8 +293,8 @@ res_ty free vars. Note [Complete and partial type signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A type signature is partial when it contains one or more wildcards. -The wildcard can either be: +A type signature is partial when it contains one or more wildcards +(= type holes). The wildcard can either be: * A (type) wildcard occurring in sig_theta or sig_tau. These are stored in sig_nwcs. f :: Bool -> _ From git at git.haskell.org Thu Feb 19 21:41:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Feb 2015 21:41:07 +0000 (UTC) Subject: [commit: ghc] master: fix T7600 run on bigendian platform (3f30912) Message-ID: <20150219214107.61F013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3f30912fcceceea68b8ea6ada6c3135447c6871a/ghc >--------------------------------------------------------------- commit 3f30912fcceceea68b8ea6ada6c3135447c6871a Author: Karel Gardas Date: Thu Feb 19 22:41:02 2015 +0100 fix T7600 run on bigendian platform >--------------------------------------------------------------- 3f30912fcceceea68b8ea6ada6c3135447c6871a testsuite/tests/codeGen/should_run/T7600_A.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/tests/codeGen/should_run/T7600_A.hs b/testsuite/tests/codeGen/should_run/T7600_A.hs index 52c28cb..df31b83 100644 --- a/testsuite/tests/codeGen/should_run/T7600_A.hs +++ b/testsuite/tests/codeGen/should_run/T7600_A.hs @@ -12,6 +12,8 @@ import Numeric import GHC.Float +#include "ghcconfig.h" + -- Test run test_run :: Float -> Double -> IO () test_run float_number double_number = do From git at git.haskell.org Fri Feb 20 04:30:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 04:30:44 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Fixed major bug in type of uni-patterns (ecbaa03) Message-ID: <20150220043044.98C7A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/ecbaa03e5bdddf19c25654fb295f8d5587d7d097/ghc >--------------------------------------------------------------- commit ecbaa03e5bdddf19c25654fb295f8d5587d7d097 Author: George Karachalias Date: Fri Feb 20 05:32:25 2015 +0100 Fixed major bug in type of uni-patterns >--------------------------------------------------------------- ecbaa03e5bdddf19c25654fb295f8d5587d7d097 compiler/deSugar/Check.hs | 6 +++--- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/Match.hs | 22 ++++++++++------------ 3 files changed, 14 insertions(+), 16 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index f525d58..e43a86c 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -316,9 +316,9 @@ process_vector vanilla sig uncovered clause = do uncovered_wt <- filterBagM checkwt uncovered return (covers, uncovered_wt, forces) where - checkwt = if vanilla -- If all constructors are vanilla constructors, do not bother checking types. - then \_ -> return True - else wt sig + checkwt = wt sig -- if vanilla -- If all constructors are vanilla constructors, do not bother checking types. + -- then \_ -> return True + -- else wt sig -- ----------------------------------------------------------------------- -- | Set versions of `alg_covers', `alg_forces' and `alg_uncovered' diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 8cabc6b..dbc9a76 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -163,7 +163,7 @@ dsStrictBind (PatBind {pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty }) body eqn = EqnInfo { eqn_pats = [upat], eqn_rhs = cantFailMatchResult body } ; var <- selectMatchVar upat - ; result <- matchEquations [ty] PatBindRhs [var] [eqn] (exprType body) + ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ; return (bindNonRec var rhs result) } dsStrictBind bind body = pprPanic "dsLet: unlifted" (ppr bind $$ ppr body) diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index e3928bd..ae1ba50 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -58,16 +58,15 @@ It can not be called matchWrapper because this name already exists :-( JJCQ 30-Nov-1997 -} -matchCheck :: [Type] -- Types of the arguments - -> DsMatchContext +matchCheck :: DsMatchContext -> [Id] -- Vars rep'ing the exprs we're matching with -> Type -- Type of the case expression -> [EquationInfo] -- Info about patterns, etc. (type synonym below) -> DsM MatchResult -- Desugared result! -matchCheck tys ctx vars ty qs +matchCheck ctx vars ty qs = do { dflags <- getDynFlags - ; dsPmWarn dflags ctx tys qs + ; dsPmWarn dflags ctx (map idType vars) qs ; match vars ty qs } {- @@ -700,7 +699,7 @@ matchWrapper ctxt (MG { mg_alts = matches [] -> mapM newSysLocalDs arg_tys (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m)) ; result_expr <- handleWarnings $ - matchEquations arg_tys ctxt new_vars eqns_info rhs_ty + matchEquations ctxt new_vars eqns_info rhs_ty ; return (new_vars, result_expr) } where mk_eqn_info (L _ (Match pats _ grhss)) @@ -714,15 +713,15 @@ matchWrapper ctxt (MG { mg_alts = matches else id -matchEquations :: [Type] -> HsMatchContext Name +matchEquations :: HsMatchContext Name -> [Id] -> [EquationInfo] -> Type -> DsM CoreExpr -matchEquations tys ctxt vars eqns_info rhs_ty +matchEquations ctxt vars eqns_info rhs_ty = do { locn <- getSrcSpanDs ; let ds_ctxt = DsMatchContext ctxt locn error_doc = matchContextErrString ctxt - ; match_result <- matchCheck tys ds_ctxt vars rhs_ty eqns_info + ; match_result <- matchCheck ds_ctxt vars rhs_ty eqns_info ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc ; extractMatchResult match_result fail_expr } @@ -761,8 +760,7 @@ matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat Id -- incomplete patterns are just fine matchSinglePat (Var var) ctx (L _ pat) ty match_result = do { locn <- getSrcSpanDs - ; matchCheck [ty] - (DsMatchContext ctx locn) + ; matchCheck (DsMatchContext ctx locn) [var] ty [EqnInfo { eqn_pats = [pat], eqn_rhs = match_result }] } @@ -1001,7 +999,7 @@ Hence we don't regard 1 and 2, or (n+1) and (n+2), as part of the same group. dsPmWarn :: DynFlags -> DsMatchContext -> [Type] -> [EquationInfo] -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) tys qs - = when (not (isPatBindRhs kind) && (flag_i || flag_u)) $ do + = when (flag_i || flag_u) $ do pm_result <- checkpm tys qs case pm_result of Nothing -> putSrcSpanDs loc (warnDs (gave_up_warn kind)) @@ -1014,7 +1012,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) tys qs when exists_u $ putSrcSpanDs loc (warnDs (pprEqnsU uncovered)) where flag_i = wopt Opt_WarnOverlappingPatterns dflags - && not (isStmtCtxt kind) + -- && not (isStmtCtxt kind) -- {COMEHERE: ^ MONAD BINDINGS AND LET BINDINGDS FROM TRansLATion -- GIVE US A WRONG TYPE. HENCE DEACTIVATED FOR NOW} flag_u = exhaustive_flag dflags kind From git at git.haskell.org Fri Feb 20 08:48:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 08:48:01 +0000 (UTC) Subject: [commit: ghc] master: Add a bizarre corner-case to cgExpr (Trac #9964) (9c78d09) Message-ID: <20150220084801.524D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9c78d09e344e97d2d5c37b9bb46e311a3cf031e2/ghc >--------------------------------------------------------------- commit 9c78d09e344e97d2d5c37b9bb46e311a3cf031e2 Author: Simon Peyton Jones Date: Fri Feb 20 08:49:32 2015 +0000 Add a bizarre corner-case to cgExpr (Trac #9964) David Feuer managed to tickle a corner case in the code generator. See Note [Scrutinising VoidRep] in StgCmmExpr. I rejigged the comments in that area of the code generator Note [Dodgy unsafeCoerce 1] Note [Dodgy unsafeCoerce 2] but I can't say I fully understand them, alas. >--------------------------------------------------------------- 9c78d09e344e97d2d5c37b9bb46e311a3cf031e2 compiler/codeGen/StgCmmExpr.hs | 78 +++++++++++++++++-------- testsuite/tests/codeGen/should_compile/T9964.hs | 11 ++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 3 files changed, 67 insertions(+), 23 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 480cc33..7d2ef78 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -355,30 +355,59 @@ of Bool-returning primops was that tagToEnum# was added implicitly in the codegen and then optimized away. Now the call to tagToEnum# is explicit in the source code, which allows to optimize it away at the earlier stages of compilation (i.e. at the Core level). + +Note [Scrutinising VoidRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have this STG code: + f = \[s : State# RealWorld] -> + case s of _ -> blah +This is very odd. Why are we scrutinising a state token? But it +can arise with bizarre NOINLINE pragmas (Trac #9964) + crash :: IO () + crash = IO (\s -> let {-# NOINLINE s' #-} + s' = s + in (# s', () #)) + +Now the trouble is that 's' has VoidRep, and we do not bind void +arguments in the environment; they don't live anywhere. See the +calls to nonVoidIds in various places. So we must not look up +'s' in the environment. Instead, just evaluate the RHS! Simple. + +Note [Dodgy unsafeCoerce 1] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + case (x :: MutVar# Int) |> co of (y :: HValue) + DEFAULT -> ... +We want to gnerate an assignment + y := x +We want to allow this assignment to be generated in the case when the +types are compatible, because this allows some slightly-dodgy but +occasionally-useful casts to be used, such as in RtClosureInspect +where we cast an HValue to a MutVar# so we can print out the contents +of the MutVar#. If instead we generate code that enters the HValue, +then we'll get a runtime panic, because the HValue really is a +MutVar#. The types are compatible though, so we can just generate an +assignment. + +Note [Dodgy unsafeCoerce 2] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [ticket #3132]: we might be looking at a case of a lifted Id that +was cast to an unlifted type. The Id will always be bottom, but we +don't want the code generator to fall over here. If we just emit an +assignment here, the assignment will be type-incorrect Cmm. Hence, we +emit the usual enter/return code, (and because bottom must be +untagged, it will be entered and the program will crash). The Sequel +is a type-correct assignment, albeit bogus. The (dead) continuation +loops; it would be better to invoke some kind of panic function here. -} +cgCase (StgApp v []) _ (PrimAlt _) alts + | isVoidRep (idPrimRep v) -- See Note [Scrutinising VoidRep] + , [(DEFAULT, _, _, rhs)] <- alts + = cgExpr rhs - -- Note [ticket #3132]: we might be looking at a case of a lifted Id - -- that was cast to an unlifted type. The Id will always be bottom, - -- but we don't want the code generator to fall over here. If we - -- just emit an assignment here, the assignment will be - -- type-incorrect Cmm. Hence, we emit the usual enter/return code, - -- (and because bottom must be untagged, it will be entered and the - -- program will crash). - -- The Sequel is a type-correct assignment, albeit bogus. - -- The (dead) continuation loops; it would be better to invoke some kind - -- of panic function here. - -- - -- However, we also want to allow an assignment to be generated - -- in the case when the types are compatible, because this allows - -- some slightly-dodgy but occasionally-useful casts to be used, - -- such as in RtClosureInspect where we cast an HValue to a MutVar# - -- so we can print out the contents of the MutVar#. If we generate - -- code that enters the HValue, then we'll get a runtime panic, because - -- the HValue really is a MutVar#. The types are compatible though, - -- so we can just generate an assignment. cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts - | isUnLiftedType (idType v) + | isUnLiftedType (idType v) -- Note [Dodgy unsafeCoerce 1] || reps_compatible = -- assignment suffices for unlifted types do { dflags <- getDynFlags @@ -392,7 +421,7 @@ cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts reps_compatible = idPrimRep v == idPrimRep bndr cgCase scrut@(StgApp v []) _ (PrimAlt _) _ - = -- fail at run-time, not compile-time + = -- See Note [Dodgy unsafeCoerce 2] do { dflags <- getDynFlags ; mb_cc <- maybeSaveCostCentre True ; _ <- withSequel (AssignTo [idToReg dflags (NonVoid v)] False) (cgExpr scrut) @@ -403,7 +432,9 @@ cgCase scrut@(StgApp v []) _ (PrimAlt _) _ ; emit (mkBranch l) ; return AssignedDirectly } -{- + +{- Note [Handle seq#] +~~~~~~~~~~~~~~~~~~~~~ case seq# a s of v (# s', a' #) -> e @@ -417,7 +448,8 @@ is the same as the return convention for just 'a') -} cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts - = -- handle seq#, same return convention as vanilla 'a'. + = -- Note [Handle seq#] + -- Use the same return convention as vanilla 'a'. cgCase (StgApp a []) bndr alt_type alts cgCase scrut bndr alt_type alts diff --git a/testsuite/tests/codeGen/should_compile/T9964.hs b/testsuite/tests/codeGen/should_compile/T9964.hs new file mode 100644 index 0000000..df15d47 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T9964.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedTuples #-} +module T9964 where + +import GHC.Base + +crash :: IO () +crash = IO (\s -> + let + {-# NOINLINE s' #-} + s' = s + in (# s', () #)) diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index b571839..e06cead 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -29,3 +29,4 @@ test('T9329', [cmm_src], compile, ['']) test('debug', extra_clean(['debug.cmm']), run_command, ['$MAKE -s --no-print-directory debug']) +test('T9964', normal, compile, ['-O']) From git at git.haskell.org Fri Feb 20 08:48:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 08:48:04 +0000 (UTC) Subject: [commit: ghc] master: Don't report instance constraints with fundeps as redundant (10fab31) Message-ID: <20150220084804.4CA563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/10fab31211961c9200d230556ec7742e07a6c831/ghc >--------------------------------------------------------------- commit 10fab31211961c9200d230556ec7742e07a6c831 Author: Simon Peyton Jones Date: Thu Feb 19 23:14:17 2015 +0000 Don't report instance constraints with fundeps as redundant More subtlety due to functional dependencies. Note [Redundant constraints in instance decls] in TcErrors. Fixes Trac #10100. >--------------------------------------------------------------- 10fab31211961c9200d230556ec7742e07a6c831 compiler/typecheck/TcCanonical.hs | 12 +-------- compiler/typecheck/TcErrors.hs | 30 ++++++++++++++++++--- compiler/typecheck/TcType.hs | 31 +++++++++++++++------- compiler/types/Class.hs | 5 +++- testsuite/tests/typecheck/should_compile/T10100.hs | 13 +++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 6 files changed, 68 insertions(+), 24 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index b87e257..0b88200 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -364,21 +364,11 @@ newSCWorkFromFlavored flavor cls xis | otherwise -- Wanted case, just add those SC that can lead to improvement. = do { let sc_rec_theta = transSuperClasses cls xis - impr_theta = filter is_improvement_pty sc_rec_theta + impr_theta = filter isImprovementPred sc_rec_theta loc = ctEvLoc flavor ; traceTcS "newSCWork/Derived" $ text "impr_theta =" <+> ppr impr_theta ; mapM_ (emitNewDerived loc) impr_theta } -is_improvement_pty :: PredType -> Bool --- Either it's an equality, or has some functional dependency -is_improvement_pty ty = go (classifyPredType ty) - where - go (EqPred NomEq t1 t2) = not (t1 `tcEqType` t2) - go (EqPred ReprEq _ _) = False - go (ClassPred cls _tys) = not $ null fundeps - where (_,fundeps) = classTvsFds cls - go (TuplePred ts) = any is_improvement_pty ts - go (IrredPred {}) = True -- Might have equalities after reduction? {- ************************************************************************ diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 6b9be01..7a61e19 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -240,7 +240,7 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given warnRedundantConstraints :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [EvVar] -> TcM () warnRedundantConstraints ctxt env info ev_vars - | null ev_vars + | null redundant_evs = return () | SigSkol {} <- info @@ -257,8 +257,32 @@ warnRedundantConstraints ctxt env info ev_vars = do { msg <- mkErrorMsg ctxt env doc ; reportWarning msg } where - doc = ptext (sLit "Redundant constraint") <> plural ev_vars <> colon - <+> pprEvVarTheta ev_vars + doc = ptext (sLit "Redundant constraint") <> plural redundant_evs <> colon + <+> pprEvVarTheta redundant_evs + + redundant_evs = case info of -- See Note [Redundant constraints in instance decls] + InstSkol -> filterOut improving ev_vars + _ -> ev_vars + + improving ev_var = any isImprovementPred $ + transSuperClassesPred (idType ev_var) + +{- Note [Redundant constraints in instance decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For instance declarations, we don't report unused givens if +they can give rise to improvement. Example (Trac #10100): + class Add a b ab | a b -> ab, a ab -> b + instance Add Zero b b + instance Add a b ab => Add (Succ a) b (Succ ab) +The context (Add a b ab) for the instance is clearly unused in terms +of evidence, since the dictionary has no feilds. But it is still +needed! With the context, a wanted constraint + Add (Succ Zero) beta (Succ Zero) +we will reduce to (Add Zero beta Zero), and thence we get beta := Zero. +But without the context we won't find beta := Zero. + +This only matters in instance declarations.. +-} reportWanteds :: ReportErrCtxt -> WantedConstraints -> TcM () reportWanteds ctxt (WC { wc_simple = simples, wc_insol = insols, wc_impl = implics }) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index d6fadc7..cf6836b 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -80,7 +80,9 @@ module TcType ( --------------------------------- -- Predicate types - mkMinimalBySCs, transSuperClasses, immSuperClasses, + mkMinimalBySCs, transSuperClasses, transSuperClassesPred, + immSuperClasses, + isImprovementPred, -- * Finding type instances tcTyFamInsts, @@ -1346,14 +1348,15 @@ mkMinimalBySCs ptys = [ ploc | ploc <- ptys transSuperClasses :: Class -> [Type] -> [PredType] transSuperClasses cls tys -- Superclasses of (cls tys), -- excluding (cls tys) itself - = concatMap trans_sc (immSuperClasses cls tys) - where - trans_sc :: PredType -> [PredType] - -- (trans_sc p) returns (p : p's superclasses) - trans_sc p = case classifyPredType p of - ClassPred cls tys -> p : transSuperClasses cls tys - TuplePred ps -> concatMap trans_sc ps - _ -> [p] + = concatMap transSuperClassesPred (immSuperClasses cls tys) + +transSuperClassesPred :: PredType -> [PredType] +-- (transSuperClassesPred p) returns (p : p's superclasses) +transSuperClassesPred p + = case classifyPredType p of + ClassPred cls tys -> p : transSuperClasses cls tys + TuplePred ps -> concatMap transSuperClassesPred ps + _ -> [p] immSuperClasses :: Class -> [Type] -> [PredType] immSuperClasses cls tys @@ -1361,6 +1364,16 @@ immSuperClasses cls tys where (tyvars,sc_theta,_,_) = classBigSig cls +isImprovementPred :: PredType -> Bool +-- Either it's an equality, or has some functional dependency +isImprovementPred ty + = case classifyPredType ty of + EqPred NomEq t1 t2 -> not (t1 `tcEqType` t2) + EqPred ReprEq _ _ -> False + ClassPred cls _ -> classHasFds cls + TuplePred ts -> any isImprovementPred ts + IrredPred {} -> True -- Might have equalities after reduction? + {- ************************************************************************ * * diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs index d51da7e..787ab6d 100644 --- a/compiler/types/Class.hs +++ b/compiler/types/Class.hs @@ -17,7 +17,7 @@ module Class ( mkClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classMinimalDef + classAllSelIds, classSCSelId, classMinimalDef, classHasFds ) where #include "HsVersions.h" @@ -235,6 +235,9 @@ classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) +classHasFds :: Class -> Bool +classHasFds (Class { classFunDeps = fds }) = not (null fds) + classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem]) classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta, classSCSels = sc_sels, classOpStuff = op_stuff}) diff --git a/testsuite/tests/typecheck/should_compile/T10100.hs b/testsuite/tests/typecheck/should_compile/T10100.hs new file mode 100644 index 0000000..b88803c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10100.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module T10100 where + +data Zero +data Succ a + +class Add a b ab | a b -> ab, a ab -> b +instance Add Zero b b +instance (Add a b ab) => Add (Succ a) b (Succ ab) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index b792629..c1ed579 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -443,3 +443,4 @@ test('T9971', normal, compile, ['']) test('T9999', normal, compile, ['']) test('T10031', normal, compile, ['']) test('T10072', normal, compile_fail, ['']) +test('T10100', normal, compile, ['']) From git at git.haskell.org Fri Feb 20 09:18:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:09 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Typo in comment (b4d85c1) Message-ID: <20150220091809.914C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/b4d85c167759a0978e9415b32d3bb2699d267a9c/ghc >--------------------------------------------------------------- commit b4d85c167759a0978e9415b32d3bb2699d267a9c Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:04:47 2015 +0000 Typo in comment >--------------------------------------------------------------- b4d85c167759a0978e9415b32d3bb2699d267a9c compiler/main/HscTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 2f63530..28039ea 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1684,7 +1684,7 @@ implicitTyConThings tc implicitCoTyCon tc ++ -- for each data constructor in order, - -- the contructor, worker, and (possibly) wrapper + -- the constructor, worker, and (possibly) wrapper concatMap (extras_plus . AConLike . RealDataCon) (tyConDataCons tc) -- NB. record selectors are *not* implicit, they have fully-fledged -- bindings that pass through the compilation pipeline as normal. From git at git.haskell.org Fri Feb 20 09:18:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:12 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Typo in comment (12ad3bd) Message-ID: <20150220091812.367D73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/12ad3bd534e1dd2ef8f8398b3d034137b0ee8fc5/ghc >--------------------------------------------------------------- commit 12ad3bd534e1dd2ef8f8398b3d034137b0ee8fc5 Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:06:10 2015 +0000 Typo in comment >--------------------------------------------------------------- 12ad3bd534e1dd2ef8f8398b3d034137b0ee8fc5 compiler/typecheck/Inst.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index b82a70c..3188a09 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -63,7 +63,7 @@ import Data.Maybe( isJust ) {- ************************************************************************ * * - Creating and emittind constraints + Creating and emitting constraints * * ************************************************************************ -} From git at git.haskell.org Fri Feb 20 09:18:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:14 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Typos in comments (39ed01f) Message-ID: <20150220091814.C36693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/39ed01f50d59097819891a3ab8c6ed9337f67662/ghc >--------------------------------------------------------------- commit 39ed01f50d59097819891a3ab8c6ed9337f67662 Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:09:02 2015 +0000 Typos in comments >--------------------------------------------------------------- 39ed01f50d59097819891a3ab8c6ed9337f67662 compiler/typecheck/TcDeriv.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 9073720..61ff6d0 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -2124,13 +2124,13 @@ The 'deriving C' clause generates, in effect instance (C [a], Eq a) => C (N a) where f = coerce (f :: [a] -> [a]) -This generates a cast for each method, but allows the superclasse to +This generates a cast for each method, but allows the superclasses to be worked out in the usual way. In this case the superclass (Eq (N a)) will be solved by the explicit Eq (N a) instance. We do *not* create the superclasses by casting the superclass dictionaries for the representation type. -See the paper "Safe zero-cost coercions for Hsakell". +See the paper "Safe zero-cost coercions for Haskell". ************************************************************************ From git at git.haskell.org Fri Feb 20 09:18:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:17 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Whitespace only (9c64f72) Message-ID: <20150220091817.688363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/9c64f724bdd251bcada781f8235f45de1a63eca6/ghc >--------------------------------------------------------------- commit 9c64f724bdd251bcada781f8235f45de1a63eca6 Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:11:08 2015 +0000 Whitespace only >--------------------------------------------------------------- 9c64f724bdd251bcada781f8235f45de1a63eca6 testsuite/tests/generics/GEq/GEq1A.hs | 0 testsuite/tests/generics/T5462Yes1.hs | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/generics/T5462Yes1.hs b/testsuite/tests/generics/T5462Yes1.hs index 3578529..b9a0933 100644 --- a/testsuite/tests/generics/T5462Yes1.hs +++ b/testsuite/tests/generics/T5462Yes1.hs @@ -5,7 +5,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveAnyClass #-} module Main where From git at git.haskell.org Fri Feb 20 09:18:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:19 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Whitespace only (98c9d05) Message-ID: <20150220091819.F1BC33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/98c9d05ff428e5de5c38d828553a37412c42467c/ghc >--------------------------------------------------------------- commit 98c9d05ff428e5de5c38d828553a37412c42467c Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:05:51 2015 +0000 Whitespace only >--------------------------------------------------------------- 98c9d05ff428e5de5c38d828553a37412c42467c compiler/typecheck/Inst.hs | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Fri Feb 20 09:18:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:22 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Make the implementation of DeriveAnyClass more robust (2aac932) Message-ID: <20150220091822.9E18E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/2aac932750e197300bde9f28d2a36b938fb0540b/ghc >--------------------------------------------------------------- commit 2aac932750e197300bde9f28d2a36b938fb0540b Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:12:55 2015 +0000 Make the implementation of DeriveAnyClass more robust Let DeriveAnyClass properly handle multiparameter type classes. Also use a new strategy for inferring constraints for derived classes. This fixes #9968 and #9821. >--------------------------------------------------------------- 2aac932750e197300bde9f28d2a36b938fb0540b compiler/typecheck/TcDeriv.hs | 265 +++++++++++++++++++++++++----------- compiler/typecheck/TcGenDeriv.hs | 194 ++++++++++++-------------- compiler/typecheck/TcGenGenerics.hs | 93 ++++++++++--- 3 files changed, 345 insertions(+), 207 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2aac932750e197300bde9f28d2a36b938fb0540b From git at git.haskell.org Fri Feb 20 09:18:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:25 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Add a test for T9968, and improve T5462Yes1 (78c292d) Message-ID: <20150220091825.7BB6C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/78c292d51cfbdc9fada37d6d0e893808d8f0fa49/ghc >--------------------------------------------------------------- commit 78c292d51cfbdc9fada37d6d0e893808d8f0fa49 Author: Jose Pedro Magalhaes Date: Thu Feb 19 18:00:58 2015 +0000 Add a test for T9968, and improve T5462Yes1 >--------------------------------------------------------------- 78c292d51cfbdc9fada37d6d0e893808d8f0fa49 testsuite/tests/generics/T5462Yes1.hs | 4 +- testsuite/tests/generics/T5462Yes1.stdout | 2 +- testsuite/tests/generics/all.T | 2 +- testsuite/tests/typecheck/should_compile/T9968.hs | 79 +++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 85 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/generics/T5462Yes1.hs b/testsuite/tests/generics/T5462Yes1.hs index b9a0933..254ba95 100644 --- a/testsuite/tests/generics/T5462Yes1.hs +++ b/testsuite/tests/generics/T5462Yes1.hs @@ -13,9 +13,10 @@ import GHC.Generics hiding (C, C1, D) import GEq1A import Enum import GFunctor +import GShow data A = A1 - deriving (Show, Generic, GEq, GEnum) + deriving (Show, Generic, GEq, GEnum, GShow) data B a = B1 | B2 a (B a) deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor) @@ -34,6 +35,7 @@ data E f a = E1 (f a) main = print ( geq A1 A1 , take 10 (genum :: [A]) + , gshow A1 , geq (B2 A1 B1) B1 , gmap (++ "lo") (B2 "hel" B1) diff --git a/testsuite/tests/generics/T5462Yes1.stdout b/testsuite/tests/generics/T5462Yes1.stdout index 6a2dc67..7aed256 100644 --- a/testsuite/tests/generics/T5462Yes1.stdout +++ b/testsuite/tests/generics/T5462Yes1.stdout @@ -1 +1 @@ -(True,[A1],False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"]) +(True,[A1],"A1",False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"]) diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T index c51de18..50894d6 100644 --- a/testsuite/tests/generics/all.T +++ b/testsuite/tests/generics/all.T @@ -20,7 +20,7 @@ test('GenCannotDoRep1_7', normal, compile_fail, ['']) test('GenCannotDoRep1_8', normal, compile_fail, ['']) test('T5462Yes1', extra_clean(['T5462Yes1/GFunctor.hi']) - , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -outputdir=out_T5462Yes1']) + , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -iGShow -outputdir=out_T5462Yes1']) test('T5462Yes2', extra_clean(['T5462Yes2/GFunctor.hi']) , multimod_compile_and_run, ['T5462Yes2', '-iGFunctor -outputdir=out_T5462Yes2']) test('T5462No1', extra_clean(['T5462No1/GFunctor.hi']) diff --git a/testsuite/tests/typecheck/should_compile/T9968.hs b/testsuite/tests/typecheck/should_compile/T9968.hs new file mode 100644 index 0000000..93a2907 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9968.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} + +module T9968 where + +import GHC.Generics ( Generic(..), Generic1(..), Rep, M1(..) ) + + +data D1 = D11 + deriving (C1, C8) + +newtype D2 = D21 Int + deriving (C1, C8) + +newtype D3 a = D31 a + deriving (Show, Foldable, C1, C2, C3 a, C5 Int, C8) + +data D4 a = D41 + deriving (Foldable, C2) + +data D5 a b = D51 a | D52 b + deriving (C9) + +data D6 f a = D61 (f a) + deriving (C1, C8) + +data D7 h f = D71 (h f) (f Int) + deriving (C1, C3 Int, C4) + +instance Show (D7 h f) where show = undefined + +data Proxy (t :: k) = Proxy + deriving (Foldable, C1, C2, C8) + + +class C1 a where + c11 :: a -> Int + c11 = undefined + +class Foldable f => C2 f where + c21 :: (Show a) => f a -> String + c21 = foldMap show + +class C3 a b where + c31 :: Read c => a -> b -> c + default c31 :: (Show a, Show b, Read c) => a -> b -> c + c31 a b = read (show a ++ show b) + +class C4 h where + c41 :: (f a -> f a) -> h f -> Int + c41 = undefined + +class C5 a f where + c51 :: f a -> Int + c51 = undefined + +class C6 a where + c61 :: a -> Int + default c61 :: (Generic a, C7 (Rep a)) => a -> Int + c61 = c71 . from + +-- trivial generic function that always returns 0 +class C7 f where c71 :: f p -> Int +instance C7 (M1 i c f) where c71 _ = 0 + +class C8 (a :: k) where + c81 :: Proxy a -> Int + c81 _ = 0 + +class C9 (h :: * -> * -> *) where + c91 :: h a b -> Int + c91 _ = 0 diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index b792629..ec9fdbd 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -438,6 +438,7 @@ test('T7643', normal, compile, ['']) test('T9834', normal, compile, ['']) test('T9892', normal, compile, ['']) test('T9939', normal, compile, ['']) +test('T9968', normal, compile, ['']) test('T9973', normal, compile, ['']) test('T9971', normal, compile, ['']) test('T9999', normal, compile, ['']) From git at git.haskell.org Fri Feb 20 09:18:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:28 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Accept new test output (33740ea) Message-ID: <20150220091828.1B1413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/33740ea49310dc6fb8bd0515012aafd040581270/ghc >--------------------------------------------------------------- commit 33740ea49310dc6fb8bd0515012aafd040581270 Author: Jose Pedro Magalhaes Date: Fri Feb 20 08:59:59 2015 +0000 Accept new test output >--------------------------------------------------------------- 33740ea49310dc6fb8bd0515012aafd040581270 testsuite/tests/generics/GenDerivOutput.stderr | 58 ++++++------ testsuite/tests/generics/GenDerivOutput1_1.stderr | 106 +++++++++++----------- 2 files changed, 82 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 33740ea49310dc6fb8bd0515012aafd040581270 From git at git.haskell.org Fri Feb 20 09:18:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 09:18:30 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Minor change to the user's guide (636feee) Message-ID: <20150220091830.B0FEC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/636feee8804103068046ce1e392530a2029ee23f/ghc >--------------------------------------------------------------- commit 636feee8804103068046ce1e392530a2029ee23f Author: Jose Pedro Magalhaes Date: Fri Feb 20 08:50:54 2015 +0000 Minor change to the user's guide >--------------------------------------------------------------- 636feee8804103068046ce1e392530a2029ee23f docs/users_guide/glasgow_exts.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index f38e0d7..0184b98 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -4321,7 +4321,7 @@ the standard method is used or the one described here.) With you can derive any other class. The compiler will simply generate an empty instance. The instance context will be -generated according to the same rules used when deriving Eq. +generated by looking at the signatures for the default methods of the class. This is mostly useful in classes whose minimal set is empty, and especially when writing generic functions. From git at git.haskell.org Fri Feb 20 12:25:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 12:25:45 +0000 (UTC) Subject: [commit: ghc] master: Comments only (f3e5c30) Message-ID: <20150220122545.EEFAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3e5c3049197e8f9e03375749ce0b024e2d1a1aa/ghc >--------------------------------------------------------------- commit f3e5c3049197e8f9e03375749ce0b024e2d1a1aa Author: Simon Peyton Jones Date: Fri Feb 13 13:53:14 2015 +0000 Comments only >--------------------------------------------------------------- f3e5c3049197e8f9e03375749ce0b024e2d1a1aa compiler/typecheck/TcFlatten.hs | 34 ++----------------------- compiler/typecheck/TcInteract.hs | 55 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 56 insertions(+), 33 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 9554bb0..ba25b8b 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -124,38 +124,8 @@ Note [The flattening story] This just unites the two fsks into one. Always solve given from wanted if poss. -* [Firing rule: wanteds] - (work item) [W] x : F tys ~ fmv - instantiate axiom: ax_co : F tys ~ rhs - - Dischard fmv: - fmv := alpha - x := ax_co ; sym x2 - [W] x2 : alpha ~ rhs (Non-canonical) - discharging the work item. This is the way that fmv's get - unified; even though they are "untouchable". - - NB: this deals with the case where fmv appears in xi, which can - happen; it just happens through the non-canonical stuff - - Possible short cut (shortCutReduction) if rhs = G rhs_tys, - where G is a type function. Then - - Flatten rhs_tys (cos : rhs_tys ~ rhs_xis) - - Add G rhs_xis ~ fmv to flat cache - - New wanted [W] x2 : G rhs_xis ~ fmv - - Discharge x := co ; G cos ; x2 - -* [Firing rule: givens] - (work item) [G] g : F tys ~ fsk - instantiate axiom: co : F tys ~ rhs - - Now add non-canonical (since rhs is not flat) - [G] (sym g ; co) : fsk ~ rhs - - Short cut (shortCutReduction) for when rhs = G rhs_tys and G is a type function - [G] (co ; g) : G tys ~ fsk - But need to flatten tys: flat_cos : tys ~ flat_tys - [G] (sym (G flat_cos) ; co ; g) : G flat_tys ~ fsk +* For top-level reductions, see Note [Top-level reductions for type functions] + in TcInteract Why given-fsks, alone, doesn't work diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index ee4ac6a..5ebeb27 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1327,6 +1327,7 @@ doTopReactDict _ w = pprPanic "doTopReactDict" (ppr w) -------------------- doTopReactFunEq :: Ct -> TcS (StopOrContinue Ct) +-- Note [Short cut for top-level reaction] doTopReactFunEq work_item@(CFunEqCan { cc_ev = old_ev, cc_fun = fam_tc , cc_tyargs = args , cc_fsk = fsk }) = ASSERT(isTypeFamilyTyCon fam_tc) -- No associated data families @@ -1394,6 +1395,7 @@ doTopReactFunEq w = pprPanic "doTopReactFunEq" (ppr w) shortCutReduction :: CtEvidence -> TcTyVar -> TcCoercion -> TyCon -> [TcType] -> TcS (StopOrContinue Ct) +-- See Note [Top-level reductions for type functions] shortCutReduction old_ev fsk ax_co fam_tc tc_args | isGiven old_ev = ASSERT( ctEvEqRel old_ev == NomEq ) @@ -1453,7 +1455,58 @@ dischargeFmv evar fmv co xi ; n_kicked <- kickOutRewritable Given NomEq fmv ; traceTcS "dischargeFuv" (ppr fmv <+> equals <+> ppr xi $$ ppr_kicked n_kicked) } -{- +{- Note [Top-level reductions for type functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +c.f. Note [The flattening story] in TcFlatten + +Suppose we have a CFunEqCan F tys ~ fmv/fsk, and a matching axiom. +Here is what we do, in four cases: + +* Wanteds: general firing rule + (work item) [W] x : F tys ~ fmv + instantiate axiom: ax_co : F tys ~ rhs + + Then: + Discharge fmv := alpha + Discharge x := ax_co ; sym x2 + New wanted [W] x2 : alpha ~ rhs (Non-canonical) + This is *the* way that fmv's get unified; even though they are + "untouchable". + + NB: it can be the case that fmv appears in the (instantiated) rhs. + In that case the new Non-canonical wanted will be loopy, but that's + ok. But it's good reason NOT to claim that it is canonical! + +* Wanteds: short cut firing rule + Applies when the RHS of the axiom is another type-function application + (work item) [W] x : F tys ~ fmv + instantiate axiom: ax_co : F tys ~ G rhs_tys + + It would be a waste to create yet another fmv for (G rhs_tys). + Instead (shortCutReduction): + - Flatten rhs_tys (cos : rhs_tys ~ rhs_xis) + - Add G rhs_xis ~ fmv to flat cache (note: the same old fmv) + - New canonical wanted [W] x2 : G rhs_xis ~ fmv (CFunEqCan) + - Discharge x := ax_co ; G cos ; x2 + +* Givens: general firing rule + (work item) [G] g : F tys ~ fsk + instantiate axiom: ax_co : F tys ~ rhs + + Now add non-canonical given (since rhs is not flat) + [G] (sym g ; ax_co) : fsk ~ rhs (Non-canonical) + +* Givens: short cut firing rule + Applies when the RHS of the axiom is another type-function application + (work item) [G] g : F tys ~ fsk + instantiate axiom: ax_co : F tys ~ G rhs_tys + + It would be a waste to create yet another fsk for (G rhs_tys). + Instead (shortCutReduction): + - Flatten rhs_tys: flat_cos : tys ~ flat_tys + - Add new Canonical given + [G] (sym (G flat_cos) ; co ; g) : G flat_tys ~ fsk (CFunEqCan) + Note [Cached solved FunEqs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ When trying to solve, say (FunExpensive big-type ~ ty), it's important From git at git.haskell.org Fri Feb 20 12:25:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 12:25:48 +0000 (UTC) Subject: [commit: ghc] master: Comments only (5f675e5) Message-ID: <20150220122548.8E8F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f675e5b5ee364a8da4ee04cd70e2dcea6cce4f1/ghc >--------------------------------------------------------------- commit 5f675e5b5ee364a8da4ee04cd70e2dcea6cce4f1 Author: Simon Peyton Jones Date: Fri Feb 13 17:43:39 2015 +0000 Comments only >--------------------------------------------------------------- 5f675e5b5ee364a8da4ee04cd70e2dcea6cce4f1 compiler/typecheck/TcCanonical.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 0b88200..6512343 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -536,7 +536,7 @@ can_eq_fam_nc :: CtEvidence -> EqRel -> SwapFlag -> TcS (StopOrContinue Ct) -- Canonicalise a non-canonical equality of form (F tys ~ ty) -- or the swapped version thereof --- Flatten both sides and go round again +-- Flatten the LHS and go round again can_eq_fam_nc ev eq_rel swapped fn tys rhs ps_rhs = do { (xi_lhs, co_lhs) <- flattenFamApp FM_FlattenAll ev fn tys ; rewriteEqEvidence ev eq_rel swapped xi_lhs rhs co_lhs From git at git.haskell.org Fri Feb 20 12:25:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 12:25:51 +0000 (UTC) Subject: [commit: ghc] master: Comments only (5094719) Message-ID: <20150220122551.453343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/50947195af59b7b288a67ef726006d18dbdfbbff/ghc >--------------------------------------------------------------- commit 50947195af59b7b288a67ef726006d18dbdfbbff Author: Simon Peyton Jones Date: Fri Feb 20 08:52:12 2015 +0000 Comments only >--------------------------------------------------------------- 50947195af59b7b288a67ef726006d18dbdfbbff compiler/typecheck/TcGenDeriv.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index c928108..3141311 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -102,7 +102,9 @@ data DerivStuff -- Please add this auxiliary stuff -} genDerivedBinds :: DynFlags -> (Name -> Fixity) -> Class -> SrcSpan -> TyCon - -> (LHsBinds RdrName, BagDerivStuff) + -> ( LHsBinds RdrName -- The method bindings of the instance declaration + , BagDerivStuff) -- Specifies extra top-level declarations needed + -- to support the instance declaration genDerivedBinds dflags fix_env clas loc tycon | Just gen_fn <- assocMaybe gen_list (getUnique clas) = gen_fn loc tycon From git at git.haskell.org Fri Feb 20 13:38:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 13:38:04 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Try to install llvm-3.6 (d40aba3) Message-ID: <20150220133804.39D0E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/d40aba347054fa234ba6d7a6e0b9031b224b3fa8/ghc >--------------------------------------------------------------- commit d40aba347054fa234ba6d7a6e0b9031b224b3fa8 Author: Joachim Breitner Date: Tue Feb 10 22:03:30 2015 +0100 travis: Try to install llvm-3.6 >--------------------------------------------------------------- d40aba347054fa234ba6d7a6e0b9031b224b3fa8 .travis.yml | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd4606f..d3de022 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,11 +12,16 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper + #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + #- travis_retry sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test + #- travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" + #- wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - + - travis_retry sudo add-apt-repository -y ppa:xorg-edgers/ppa # seems to be a source for llvm-3.6 - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 llvm-3.5 - - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.5/bin:$PATH + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - travis_retry sudo apt-get install llvm-3.6 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.6/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ From git at git.haskell.org Fri Feb 20 13:38:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 13:38:06 +0000 (UTC) Subject: [commit: ghc] wip/travis: llvm.org/apt now has 3.6 binaries (86da000) Message-ID: <20150220133806.EDE713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/86da0002aa6af0c5baab00a9fbad4913072838c5/ghc >--------------------------------------------------------------- commit 86da0002aa6af0c5baab00a9fbad4913072838c5 Author: Joachim Breitner Date: Fri Feb 20 14:39:35 2015 +0100 llvm.org/apt now has 3.6 binaries >--------------------------------------------------------------- 86da0002aa6af0c5baab00a9fbad4913072838c5 .travis.yml | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index d3de022..c161d6b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,12 +12,8 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper - #- travis_retry sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test - #- travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" - #- wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - - travis_retry sudo add-apt-repository -y ppa:xorg-edgers/ppa # seems to be a source for llvm-3.6 + - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" + - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 - travis_retry sudo apt-get install llvm-3.6 From git at git.haskell.org Fri Feb 20 13:38:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 13:38:09 +0000 (UTC) Subject: [commit: ghc] wip/travis: [ci skip] comment typo (9cb7c6e) Message-ID: <20150220133809.92D053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/9cb7c6e6b36ab7c51fc59bb610a20a47c39dbce8/ghc >--------------------------------------------------------------- commit 9cb7c6e6b36ab7c51fc59bb610a20a47c39dbce8 Author: Joachim Breitner Date: Mon Feb 2 14:10:31 2015 +0100 [ci skip] comment typo >--------------------------------------------------------------- 9cb7c6e6b36ab7c51fc59bb610a20a47c39dbce8 compiler/simplCore/CallArity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 5ee5fe2..7bfd2f5 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -347,7 +347,7 @@ t1) in the follwing code: t2 = if ... then go 1 else ... in go 0 -Detecting this would reqiure finding out what variables are only ever called +Detecting this would require finding out what variables are only ever called from thunks. While this is certainly possible, we yet have to see this to be relevant in the wild. From git at git.haskell.org Fri Feb 20 13:38:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Feb 2015 13:38:12 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: llvm.org/apt now has 3.6 binaries (86da000) Message-ID: <20150220133812.1C4D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: 1e651b9 Comments only 12698ff More comments and white space 1e58ed8 Add a couple of tcTraces around reify 1d982ba Do not complain about missing fields in Trac #10047 3568bf3 Do not share T9878.hs between test T9878 and T9878b 6ff3db9 nameIsLocalOrFrom should include interactive modules befe2d7 Fix #10079 by recurring after flattening exposes a TyConApp. d5cd94d Fix egregious typo in checkTauTvUpdate. 849e25c Propagate ReturnTvs in matchExpectedFunTys b45309f Comments and white space; plus structurally avoiding the previously "egregious bug" 6be91dd Tiny refactoring; no change in behaviour b96db75 Refactor decideQuantification 7fdded4 Improve documentation of 'trace' 36f2ad5 Comments only 5ab7518 Improve typechecking of RULEs, to account for type wildcard holes 6fa285d Move comments about evaluating the message to the top of the module 49d99eb Fix typo in error message 555eef1 Remove RAWCPP_FLAGS (Task #9094) 310b636 Add missing va_end to va_start a82364c Don't truncate traceEvents to 512 bytes (#8309) e7fab33 Improve outdated ghc-pkg cache warning (#9606) 08102b3 Delete vestigial external core code (#9402) 1b82619 Add configurable verbosity level to hpc 91d9530 Revert "Eta-expand argument to foldr in mapM_ for []" 9caf71a Do not clobber CPPFLAGS nor LDFLAGS, fixes #10093 6d17125 runghc: be explicit about ghc version (#9054) 32d1a8a Cleanup ghc-pkg 35d464b Typo in function name e9d72ce Fix #10045 ef391f8 Comments only 3f30912 fix T7600 run on bigendian platform 10fab31 Don't report instance constraints with fundeps as redundant 9c78d09 Add a bizarre corner-case to cgExpr (Trac #9964) f3e5c30 Comments only 5f675e5 Comments only 5094719 Comments only 9cb7c6e [ci skip] comment typo d40aba3 travis: Try to install llvm-3.6 86da000 llvm.org/apt now has 3.6 binaries From git at git.haskell.org Sat Feb 21 11:17:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Feb 2015 11:17:38 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Add missing test from previous commit (55199a97) (f9e68c5) Message-ID: <20150221111738.351183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/f9e68c5c890bf5d742344bd4e106c2cd2d76b65b/ghc >--------------------------------------------------------------- commit f9e68c5c890bf5d742344bd4e106c2cd2d76b65b Author: Austin Seipp Date: Mon Jan 19 08:10:58 2015 -0600 Add missing test from previous commit (55199a97) Signed-off-by: Austin Seipp (cherry picked from commit 960e3c92eace7f9b584cfc6f6eb69a37cd3d88f8) >--------------------------------------------------------------- f9e68c5c890bf5d742344bd4e106c2cd2d76b65b testsuite/tests/perf/compiler/T9961.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/testsuite/tests/perf/compiler/T9961.hs b/testsuite/tests/perf/compiler/T9961.hs new file mode 100644 index 0000000..888ae90 --- /dev/null +++ b/testsuite/tests/perf/compiler/T9961.hs @@ -0,0 +1,7 @@ + +module Lexer (alex_table) where + +import Data.Array + +alex_table :: Array Int Int +alex_table = listArray (0,1109) [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,18,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,20,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,- 1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,22,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,25,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,28,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1 ,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1] From git at git.haskell.org Sat Feb 21 12:30:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Feb 2015 12:30:41 +0000 (UTC) Subject: [commit: ghc] wip/travis: llvm.org/apt now has 3.6 binaries (424cb55) Message-ID: <20150221123041.20A683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/424cb55e95c5f91402f15f618a627799bfecc327/ghc >--------------------------------------------------------------- commit 424cb55e95c5f91402f15f618a627799bfecc327 Author: Joachim Breitner Date: Fri Feb 20 14:39:35 2015 +0100 llvm.org/apt now has 3.6 binaries >--------------------------------------------------------------- 424cb55e95c5f91402f15f618a627799bfecc327 .travis.yml | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index d3de022..79c7473 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,12 +12,8 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - #- travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper - #- travis_retry sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test - #- travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise main' >> /etc/apt/sources.list" - #- wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - - travis_retry sudo add-apt-repository -y ppa:xorg-edgers/ppa # seems to be a source for llvm-3.6 + - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise-3.6-binaries main' >> /etc/apt/sources.list" + - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 - travis_retry sudo apt-get install llvm-3.6 From git at git.haskell.org Sat Feb 21 12:59:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Feb 2015 12:59:12 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: more experimentation (0505964) Message-ID: <20150221125912.876D73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/0505964c52d4b5586b44364ba991c2a0b2d0128a/ghc >--------------------------------------------------------------- commit 0505964c52d4b5586b44364ba991c2a0b2d0128a Author: Joachim Breitner Date: Sat Feb 21 14:01:14 2015 +0100 travis: more experimentation >--------------------------------------------------------------- 0505964c52d4b5586b44364ba991c2a0b2d0128a .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 79c7473..91c3baf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,6 +12,7 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc + - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise-3.6-binaries main' >> /etc/apt/sources.list" - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update From git at git.haskell.org Sat Feb 21 14:41:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Feb 2015 14:41:26 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' deleted Message-ID: <20150221144126.84EA83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/travis From git at git.haskell.org Sat Feb 21 14:41:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Feb 2015 14:41:29 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] comment typo (547c40a) Message-ID: <20150221144129.355933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/547c40a324a4649c558147bb72befe1b9d7edf0d/ghc >--------------------------------------------------------------- commit 547c40a324a4649c558147bb72befe1b9d7edf0d Author: Joachim Breitner Date: Mon Feb 2 14:10:31 2015 +0100 [ci skip] comment typo >--------------------------------------------------------------- 547c40a324a4649c558147bb72befe1b9d7edf0d compiler/simplCore/CallArity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 5ee5fe2..7bfd2f5 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -347,7 +347,7 @@ t1) in the follwing code: t2 = if ... then go 1 else ... in go 0 -Detecting this would reqiure finding out what variables are only ever called +Detecting this would require finding out what variables are only ever called from thunks. While this is certainly possible, we yet have to see this to be relevant in the wild. From git at git.haskell.org Sat Feb 21 14:41:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Feb 2015 14:41:31 +0000 (UTC) Subject: [commit: ghc] master: Unbreak travis by installing llvm-3.6 (d4b6453) Message-ID: <20150221144131.C88213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4b645337d2d1a2fb4cfbbef0e5a160c5384f792/ghc >--------------------------------------------------------------- commit d4b645337d2d1a2fb4cfbbef0e5a160c5384f792 Author: Joachim Breitner Date: Sat Feb 21 15:42:39 2015 +0100 Unbreak travis by installing llvm-3.6 >--------------------------------------------------------------- d4b645337d2d1a2fb4cfbbef0e5a160c5384f792 .travis.yml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd4606f..91c3baf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,10 +13,12 @@ env: before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - travis_retry sudo add-apt-repository -y ppa:h-rayflood/gcc-upper - - travis_retry sudo add-apt-repository -y ppa:h-rayflood/llvm-upper + - travis_retry sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise-3.6-binaries main' >> /etc/apt/sources.list" + - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 llvm-3.5 - - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.5/bin:$PATH + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - travis_retry sudo apt-get install llvm-3.6 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.6/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ From git at git.haskell.org Sat Feb 21 16:14:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Feb 2015 16:14:27 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Data Families PROB: looking for the source of it (967c6c7) Message-ID: <20150221161427.266163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/967c6c7aa9c3d1cecc9d7e146c54f240250438f6/ghc >--------------------------------------------------------------- commit 967c6c7aa9c3d1cecc9d7e146c54f240250438f6 Author: George Karachalias Date: Sat Feb 21 17:15:25 2015 +0100 Data Families PROB: looking for the source of it >--------------------------------------------------------------- 967c6c7aa9c3d1cecc9d7e146c54f240250438f6 compiler/basicTypes/Var.hs | 5 +++-- compiler/deSugar/Check.hs | 20 +++++++++++++++++--- compiler/typecheck/TcRnTypes.hs | 10 ++++++++++ compiler/typecheck/TcSMonad.hs | 8 ++++---- 4 files changed, 34 insertions(+), 9 deletions(-) diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs index 925ffe3..cd26f48 100644 --- a/compiler/basicTypes/Var.hs +++ b/compiler/basicTypes/Var.hs @@ -205,7 +205,7 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds -} instance Outputable Var where - ppr var = ppr (varName var) <> getPprStyle (ppr_debug var) + ppr var = ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) ppr_debug :: Var -> PprStyle -> SDoc ppr_debug (TyVar {}) sty @@ -307,7 +307,8 @@ mkTcTyVar name kind details tcTyVarDetails :: TyVar -> TcTyVarDetails tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details -tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var) +tcTyVarDetails tv@(TyVar {}) = pprPanic "tcTyVarDetails" (ptext (sLit "TyVar") $$ ppr tv) +tcTyVarDetails tv@(Id {}) = pprPanic "tcTyVarDetails" (ptext (sLit "Id") $$ ppr tv) setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar setTcTyVarDetails tv details = tv { tc_tv_details = details } diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index e43a86c..fa335bd 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -49,6 +49,10 @@ import Control.Monad ( forM, foldM, zipWithM ) import MonadUtils -- MonadIO + +import TcRnTypes (pprInTcRnIf) +import Var (varType) + {- This module checks pattern matches for: \begin{enumerate} @@ -131,6 +135,8 @@ checkpm :: [Type] -> [EquationInfo] -> DsM (Maybe PmResult) checkpm tys eq_info | null eq_info = return (Just ([],[],[])) -- If we have an empty match, do not reason at all | otherwise = do + loc <- getSrcSpanDs + pprInTcRnIf (ptext (sLit "Checking match at") <+> ppr loc <+> ptext (sLit "with signature:") <+> ppr tys) uncovered0 <- initial_uncovered tys let allvanilla = all isVanillaEqn eq_info -- Need to pass this to process_vector, so that tc can be avoided @@ -545,10 +551,12 @@ inferTyPmPat (PmLitCon ty _) = return (ty, emptyBag) inferTyPmPat (PmConPat con args) = do (tys, cs) <- inferTyPmPats args -- Infer argument types and respective constraints (Just like the paper) subst <- mkConSigSubst con -- Create the substitution theta (Just like the paper) - let tycon = dataConOrigTyCon con -- Type constructor + let tycon = dataConTyCon con -- JUST A TEST dataConOrigTyCon con -- Type constructor arg_tys = substTys subst (dataConOrigArgTys con) -- Argument types univ_tys = substTyVars subst (dataConUnivTyVars con) -- Universal variables (to instantiate tycon) tau = mkTyConApp tycon univ_tys -- Type of the pattern + + pprInTcRnIf (ptext (sLit "pattern:") <+> ppr (PmConPat con args) <+> ptext (sLit "has univ tys length:") <+> ppr (length univ_tys)) con_thetas <- mapM (nameType "varcon") $ substTheta subst (dataConTheta con) -- Constraints from the constructor signature eq_thetas <- foldM (\acc (ty1, ty2) -> do eq_theta <- newEqPmM ty1 ty2 @@ -569,9 +577,15 @@ wt :: [Type] -> OutVec -> PmM Bool wt sig (_, vec) | length sig == length vec = do (tys, cs) <- inferTyPmPats vec - cs' <- zipWithM newEqPmM sig tys -- The vector should match the signature type + cs' <- zipWithM newEqPmM (map expandTypeSynonyms sig) tys -- The vector should match the signature type env_cs <- getDictsDs - isSatisfiable (listToBag cs' `unionBags` cs `unionBags` env_cs) + loc <- getSrcSpanDs + pprInTcRnIf (ptext (sLit "Checking in location:") <+> ppr loc) + pprInTcRnIf (ptext (sLit "Checking vector") <+> ppr vec <+> ptext (sLit "with inferred type:") <+> ppr tys) + pprInTcRnIf (ptext (sLit "With given signature:") <+> ppr sig) + let constraints = listToBag cs' `unionBags` cs `unionBags` env_cs + pprInTcRnIf (ptext (sLit "Constraints:") <+> ppr (mapBag varType constraints)) + isSatisfiable constraints | otherwise = pprPanic "wt: length mismatch:" (ppr sig $$ ppr vec) {- diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 8ad9e1d..9c21c19 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -91,6 +91,9 @@ module TcRnTypes( pprEvVars, pprEvVarWithType, pprArising, pprArisingAt, + -- Debugging + pprInTcRnIf, + -- Misc other types TcId, TcIdSet, HoleSort(..) @@ -2228,3 +2231,10 @@ data TcPluginResult -- These are removed from the inert set, -- and the evidence for them is recorded. -- The second field contains new work, that should be processed by + +--- - CHECKING MY PRINTING +pprInTcRnIf :: SDoc -> TcRnIf gbl lcl () +pprInTcRnIf doc = do + dflags <- getDynFlags + liftIO (putStrLn (showSDoc dflags doc)) + diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 6e50c96..3721f92 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -962,10 +962,10 @@ checkInsoluble :: TcS Bool -- True if there are any insoluble constraints checkInsoluble = do { icans <- getInertCans - -- ; let insols = inert_insols icans - -- ; if isEmptyBag insols - -- then return () - -- else wrapTcS $ pprInTcRnIf (ptext (sLit "insolubles:") $$ ppr insols) -- just to see + ; let insols = inert_insols icans + ; if isEmptyBag insols + then return () + else wrapTcS $ pprInTcRnIf (ptext (sLit "insolubles:") $$ ppr insols) -- just to see ; return (not (isEmptyBag (inert_insols icans))) } lookupFlatCache :: TyCon -> [Type] -> TcS (Maybe (TcCoercion, TcType, CtFlavour)) From git at git.haskell.org Sun Feb 22 12:48:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Feb 2015 12:48:54 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9388' created Message-ID: <20150222124854.4700F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9388 Referencing: c76f59b6d6cdea0b1ae8449e13777f9b9bfae80e From git at git.haskell.org Sun Feb 22 12:48:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Feb 2015 12:48:57 +0000 (UTC) Subject: [commit: ghc] wip/T9388: Remove old state hack (1393b8a) Message-ID: <20150222124857.240933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9388 Link : http://ghc.haskell.org/trac/ghc/changeset/1393b8a61db55a149003562cbcdf78789195a93a/ghc >--------------------------------------------------------------- commit 1393b8a61db55a149003562cbcdf78789195a93a Author: Joachim Breitner Date: Sun Feb 22 10:35:21 2015 +0100 Remove old state hack which applies the state hack to every lambda with a binder of type State# a, which destroys wanted sharing. >--------------------------------------------------------------- 1393b8a61db55a149003562cbcdf78789195a93a compiler/basicTypes/Id.hs | 14 ++------------ compiler/basicTypes/MkId.hs | 3 +-- compiler/coreSyn/CoreArity.hs | 2 +- 3 files changed, 4 insertions(+), 15 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 14e789b..23d9c30 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -71,7 +71,7 @@ module Id ( isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda, setOneShotLambda, clearOneShotLambda, updOneShotInfo, setIdOneShotInfo, - isStateHackType, stateHackOneShot, typeOneShot, + isStateHackType, -- ** Reading 'IdInfo' fields idArity, @@ -245,8 +245,7 @@ mkVanillaGlobalWithInfo = mkGlobalId VanillaId -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal" mkLocalId :: Name -> Type -> Id -mkLocalId name ty = mkLocalIdWithInfo name ty - (vanillaIdInfo `setOneShotInfo` typeOneShot ty) +mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info @@ -649,15 +648,6 @@ isOneShotBndr var | isTyVar var = True | otherwise = isOneShotLambda var --- | Should we apply the state hack to values of this 'Type'? -stateHackOneShot :: OneShotInfo -stateHackOneShot = OneShotLam -- Or maybe ProbOneShot? - -typeOneShot :: Type -> OneShotInfo -typeOneShot ty - | isStateHackType ty = stateHackOneShot - | otherwise = NoOneShotInfo - isStateHackType :: Type -> Bool isStateHackType ty | opt_NoStateHack diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 0b22a64..d1915e1 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1341,8 +1341,7 @@ inlined. realWorldPrimId :: Id -- :: State# RealWorld realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy - (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings] - `setOneShotInfo` stateHackOneShot) + (noCafIdInfo `setUnfoldingInfo` evaldUnfolding) -- Note [evaldUnfoldings] voidPrimId :: Id -- Global constant :: Void# voidPrimId = pcMiscPrelId voidPrimIdName voidPrimTy diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index 5e50642..7e054e4 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -110,7 +110,7 @@ typeArity ty = go rec_nts ty' | Just (arg,res) <- splitFunTy_maybe ty - = typeOneShot arg : go rec_nts res + = NoOneShotInfo : go rec_nts res | Just (tc,tys) <- splitTyConApp_maybe ty , Just (ty', _) <- instNewTyCon_maybe tc tys , Just rec_nts' <- checkRecTc rec_nts tc -- See Note [Expanding newtypes] From git at git.haskell.org Sun Feb 22 12:48:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Feb 2015 12:48:59 +0000 (UTC) Subject: [commit: ghc] wip/T9388: Introduce the new state hack in the demand analyzer (c76f59b) Message-ID: <20150222124859.E26D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9388 Link : http://ghc.haskell.org/trac/ghc/changeset/c76f59b6d6cdea0b1ae8449e13777f9b9bfae80e/ghc >--------------------------------------------------------------- commit c76f59b6d6cdea0b1ae8449e13777f9b9bfae80e Author: Joachim Breitner Date: Sun Feb 22 10:36:15 2015 +0100 Introduce the new state hack in the demand analyzer The new state hack, as proposed by SPJ in #9388, applies only to bound expressions. It is implemented by constructing an artificial incoming demand that claims that it is called at most once. (Currently, it also applies to non-top-level let-bound expressions. This needs to be revisited.) >--------------------------------------------------------------- c76f59b6d6cdea0b1ae8449e13777f9b9bfae80e compiler/basicTypes/Demand.hs | 5 ++++- compiler/basicTypes/Id.hs | 7 ++++++- compiler/stranal/DmdAnal.hs | 11 ++++++++--- 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index ecf22bc..7b08a71 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -37,7 +37,7 @@ module Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, - evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd, + evalDmd, cleanEvalDmd, cleanEvalProdDmd, cleanEvalStateHackDmd, isStrictDmd, splitDmdTy, splitFVs, deferAfterIO, postProcessUnsat, postProcessDmdTypeM, @@ -634,6 +634,9 @@ cleanEvalDmd = mkCleanDmd HeadStr Used cleanEvalProdDmd :: Arity -> CleanDemand cleanEvalProdDmd n = mkCleanDmd HeadStr (UProd (replicate n useTop)) +cleanEvalStateHackDmd :: CleanDemand +cleanEvalStateHackDmd = mkCleanDmd HeadStr (mkUCall One Used) + isSingleUsed :: JointDmd -> Bool isSingleUsed (JD {absd=a}) = is_used_once a where diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 23d9c30..7459cc1 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -71,7 +71,7 @@ module Id ( isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda, setOneShotLambda, clearOneShotLambda, updOneShotInfo, setIdOneShotInfo, - isStateHackType, + isStateHackType, isStateHackFunType, -- ** Reading 'IdInfo' fields idArity, @@ -674,6 +674,11 @@ isStateHackType ty -- Another good example is in fill_in in PrelPack.hs. We should be able to -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet. +isStateHackFunType :: Type -> Bool +isStateHackFunType ty + = case splitFunTy_maybe ty of + Just (arg_ty, _) -> isStateHackType arg_ty + Nothing -> False -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once. -- You probably want to use 'isOneShotBndr' instead diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 27fa35f..d615562 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -619,9 +619,14 @@ dmdAnalRhs top_lvl rec_flag env id rhs -- See Note [NOINLINE and strictness] -- See Note [Product demands for function body] - body_dmd = case deepSplitProductType_maybe (ae_fam_envs env) (exprType body) of - Nothing -> cleanEvalDmd - Just (dc, _, _, _) -> cleanEvalProdDmd (dataConRepArity dc) + body_dmd + | Just (dc, _, _, _) <- deepSplitProductType_maybe (ae_fam_envs env) (exprType body) + = cleanEvalProdDmd (dataConRepArity dc) + | isStateHackFunType $ topNormaliseType (ae_fam_envs env) (exprType body) + = -- pprTrace "new state hack" (ppr (exprType body)) $ + cleanEvalStateHackDmd + | otherwise + = cleanEvalDmd -- See Note [Lazy and unleashable free variables] -- See Note [Aggregated demand for cardinality] From git at git.haskell.org Sun Feb 22 12:49:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Feb 2015 12:49:02 +0000 (UTC) Subject: [commit: ghc] wip/T9388: Simplify typeArity (e7420c7) Message-ID: <20150222124902.AE9153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9388 Link : http://ghc.haskell.org/trac/ghc/changeset/e7420c731d0c307fcaf61c1a2ffd4daa64a8e7b1/ghc >--------------------------------------------------------------- commit e7420c731d0c307fcaf61c1a2ffd4daa64a8e7b1 Author: Joachim Breitner Date: Sun Feb 22 10:49:18 2015 +0100 Simplify typeArity Without the state hack here, this can have the very nice type typeArity :: Type -> Arity >--------------------------------------------------------------- e7420c731d0c307fcaf61c1a2ffd4daa64a8e7b1 compiler/coreSyn/CoreArity.hs | 20 ++++++++++---------- compiler/simplCore/CallArity.hs | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index 7e054e4..8c53f1f 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -95,10 +95,10 @@ exprArity e = go e go _ = 0 trim_arity :: Arity -> Type -> Arity - trim_arity arity ty = arity `min` length (typeArity ty) + trim_arity arity ty = arity `min` typeArity ty --------------- -typeArity :: Type -> [OneShotInfo] +typeArity :: Type -> Arity -- How many value arrows are visible in the type? -- We look through foralls, and newtypes -- See Note [exprArity invariant] @@ -109,8 +109,8 @@ typeArity ty | Just (_, ty') <- splitForAllTy_maybe ty = go rec_nts ty' - | Just (arg,res) <- splitFunTy_maybe ty - = NoOneShotInfo : go rec_nts res + | Just (_,res) <- splitFunTy_maybe ty + = 1 + go rec_nts res | Just (tc,tys) <- splitTyConApp_maybe ty , Just (ty', _) <- instNewTyCon_maybe tc tys , Just rec_nts' <- checkRecTc rec_nts tc -- See Note [Expanding newtypes] @@ -127,7 +127,7 @@ typeArity ty -- e.g. newtype Stream m a b = Stream (m (Either b (a, Stream m a b))) | otherwise - = [] + = 0 --------------- exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig) @@ -700,7 +700,7 @@ arityType env (Cast e co) ATop os -> ATop (take co_arity os) ABot n -> ABot (n `min` co_arity) where - co_arity = length (typeArity (pSnd (coercionKind co))) + co_arity = typeArity (pSnd (coercionKind co)) -- See Note [exprArity invariant] (2); must be true of -- arityType too, since that is how we compute the arity -- of variables, and they in turn affect result of exprArity @@ -714,12 +714,12 @@ arityType _ (Var v) , (ds, res) <- splitStrictSig strict_sig , let arity = length ds = if isBotRes res then ABot arity - else ATop (take arity one_shots) + else ATop (replicate (arity `min` type_arity) noOneShotInfo) | otherwise - = ATop (take (idArity v) one_shots) + = ATop (replicate (idArity v `min` type_arity) noOneShotInfo) where - one_shots :: [OneShotInfo] -- One-shot-ness derived from the type - one_shots = typeArity (idType v) + type_arity :: Arity -- maximum Arity derived from the type + type_arity = typeArity (idType v) -- Lambdas; increase arity arityType env (Lam x e) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 7bfd2f5..32226e8 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -475,7 +475,7 @@ callArityAnal arity int (Let bind e) -- See Note [Which variables are interesting] interestingBinds :: CoreBind -> [Var] interestingBinds = filter go . bindersOf - where go v = 0 < length (typeArity (idType v)) + where go v = 0 < typeArity (idType v) addInterestingBinds :: VarSet -> CoreBind -> VarSet addInterestingBinds int bind From git at git.haskell.org Sun Feb 22 14:45:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Feb 2015 14:45:48 +0000 (UTC) Subject: [commit: ghc] master: {Data, Generic(1), MonadZip} instances for Identity (1f60d63) Message-ID: <20150222144548.9BA113A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f60d635cee1ff3db72e0129f9035b147f52c9c4/ghc >--------------------------------------------------------------- commit 1f60d635cee1ff3db72e0129f9035b147f52c9c4 Author: Herbert Valerio Riedel Date: Sun Feb 22 15:21:18 2015 +0100 {Data,Generic(1),MonadZip} instances for Identity These instances were missed when the identity functor was added to the `base` package (re #9664). Reviewed By: ekmett Differential Revision: https://phabricator.haskell.org/D674 >--------------------------------------------------------------- 1f60d635cee1ff3db72e0129f9035b147f52c9c4 libraries/base/Data/Functor/Identity.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs index 2465a1e..ac47922 100644 --- a/libraries/base/Data/Functor/Identity.hs +++ b/libraries/base/Data/Functor/Identity.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE Trustworthy #-} {-# LANGUAGE AutoDeriveTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | @@ -33,14 +34,17 @@ module Data.Functor.Identity ( ) where import Control.Monad.Fix +import Control.Monad.Zip import Data.Coerce +import Data.Data (Data) import Data.Foldable +import GHC.Generics (Generic, Generic1) -- | Identity functor and monad. (a non-strict monad) -- -- @since 4.8.0.0 newtype Identity a = Identity { runIdentity :: a } - deriving (Eq, Ord, Traversable) + deriving (Eq, Ord, Data, Traversable, Generic, Generic1) -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed @@ -89,6 +93,9 @@ instance Monad Identity where instance MonadFix Identity where mfix f = Identity (fix (runIdentity . f)) +instance MonadZip Identity where + mzipWith = coerce + munzip = coerce -- | Internal (non-exported) 'Coercible' helper for 'elem' -- From git at git.haskell.org Sun Feb 22 17:03:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Feb 2015 17:03:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Update submodule to Cabal 1.22.1.0 release (a4b5805) Message-ID: <20150222170305.4510B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/a4b5805f81be8da7af9e375628faaa826f80ee7f/ghc >--------------------------------------------------------------- commit a4b5805f81be8da7af9e375628faaa826f80ee7f Author: Herbert Valerio Riedel Date: Sun Feb 22 18:04:27 2015 +0100 Update submodule to Cabal 1.22.1.0 release >--------------------------------------------------------------- a4b5805f81be8da7af9e375628faaa826f80ee7f libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 3c0e648..9225192 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 3c0e6480d5057dd616457a0ac0458e60946c9849 +Subproject commit 9225192b7afc2b96062fb991cc3d16cccb9de1b0 From git at git.haskell.org Mon Feb 23 09:25:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:25:50 +0000 (UTC) Subject: [commit: ghc] master: fix bus errors on SPARC caused by unalignment access to alloc_limit (fixes #10043) (b2be772) Message-ID: <20150223092550.762073A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b2be772a97f6e7fe9f1d1c28108949f81a13158b/ghc >--------------------------------------------------------------- commit b2be772a97f6e7fe9f1d1c28108949f81a13158b Author: Karel Gardas Date: Sat Feb 14 22:46:47 2015 +0100 fix bus errors on SPARC caused by unalignment access to alloc_limit (fixes #10043) Reviewers: austin, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D657 >--------------------------------------------------------------- b2be772a97f6e7fe9f1d1c28108949f81a13158b includes/rts/storage/TSO.h | 3 +++ rts/Schedule.c | 6 +++--- rts/Threads.c | 6 +++--- rts/sm/Storage.c | 10 ++++++++-- 4 files changed, 17 insertions(+), 8 deletions(-) diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h index 06056fe..744ab2b 100644 --- a/includes/rts/storage/TSO.h +++ b/includes/rts/storage/TSO.h @@ -155,6 +155,9 @@ typedef struct StgTSO_ { * This is an integer, because we might update it in a place where * it isn't convenient to raise the exception, so we want it to * stay negative until we get around to checking it. + * + * Use only PK_Int64/ASSIGN_Int64 macros to get/set the value of alloc_limit + * in C code otherwise you will cause alignment issues on SPARC */ StgInt64 alloc_limit; /* in bytes */ diff --git a/rts/Schedule.c b/rts/Schedule.c index f25b372..957aa4b 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1086,15 +1086,15 @@ schedulePostRunThread (Capability *cap, StgTSO *t) // If the current thread's allocation limit has run out, send it // the AllocationLimitExceeded exception. - if (t->alloc_limit < 0 && (t->flags & TSO_ALLOC_LIMIT)) { + if (PK_Int64((W_*)&(t->alloc_limit)) < 0 && (t->flags & TSO_ALLOC_LIMIT)) { // Use a throwToSelf rather than a throwToSingleThreaded, because // it correctly handles the case where the thread is currently // inside mask. Also the thread might be blocked (e.g. on an // MVar), and throwToSingleThreaded doesn't unblock it // correctly in that case. throwToSelf(cap, t, allocationLimitExceeded_closure); - t->alloc_limit = (StgInt64)RtsFlags.GcFlags.allocLimitGrace - * BLOCK_SIZE; + ASSIGN_Int64((W_*)&(t->alloc_limit), + (StgInt64)RtsFlags.GcFlags.allocLimitGrace * BLOCK_SIZE); } /* some statistics gathering in the parallel case */ diff --git a/rts/Threads.c b/rts/Threads.c index 90efd9c..99f2be7 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -110,7 +110,7 @@ createThread(Capability *cap, W_ size) tso->stackobj = stack; tso->tot_stack_size = stack->stack_size; - tso->alloc_limit = 0; + ASSIGN_Int64((W_*)&(tso->alloc_limit), 0); tso->trec = NO_TREC; @@ -173,12 +173,12 @@ HsInt64 rts_getThreadAllocationCounter(StgPtr tso) { // NB. doesn't take into account allocation in the current nursery // block, so it might be off by up to 4k. - return ((StgTSO *)tso)->alloc_limit; + return PK_Int64((W_*)&(((StgTSO *)tso)->alloc_limit)); } void rts_setThreadAllocationCounter(StgPtr tso, HsInt64 i) { - ((StgTSO *)tso)->alloc_limit = i; + ASSIGN_Int64((W_*)&(((StgTSO *)tso)->alloc_limit), i); } void rts_enableThreadAllocationLimit(StgPtr tso) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index f02c005..50926b7 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -746,7 +746,10 @@ StgPtr allocate (Capability *cap, W_ n) TICK_ALLOC_HEAP_NOCTR(WDS(n)); CCS_ALLOC(cap->r.rCCCS,n); if (cap->r.rCurrentTSO != NULL) { - cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_); + // cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_) + ASSIGN_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit), + (PK_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit)) + - n*sizeof(W_))); } if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { @@ -897,7 +900,10 @@ allocatePinned (Capability *cap, W_ n) TICK_ALLOC_HEAP_NOCTR(WDS(n)); CCS_ALLOC(cap->r.rCCCS,n); if (cap->r.rCurrentTSO != NULL) { - cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_); + // cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_); + ASSIGN_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit), + (PK_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit)) + - n*sizeof(W_))); } bd = cap->pinned_object_block; From git at git.haskell.org Mon Feb 23 09:40:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:40:21 +0000 (UTC) Subject: [commit: ghc] master: Error out on `Main` without `main` in GHCi (#7765) (0fa2072) Message-ID: <20150223094021.0B0B13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0fa20726b0587530712677e50a56c2b03ba43095/ghc >--------------------------------------------------------------- commit 0fa20726b0587530712677e50a56c2b03ba43095 Author: Thomas Miedema Date: Mon Feb 23 03:38:26 2015 -0600 Error out on `Main` without `main` in GHCi (#7765) Summary: GHC does 2 validation checks for module `Main`: * does `main` exist * is `main` exported (#414) The second check is done in ghc as well as in ghci (and runghc and ghc -e). The first check however is currently not done in ghci, to prevent "'main' is not in scope" errors when loading simple scripts. See commit d28ba8c8009 for more information. This commit tightens the special case for ghci. When the file does not contain a main function, but does contain an explicit module header (i.e. "module Main where"), then /do/ raise an error in ghci (and runghc and ghc -e) as well Test Plan: module/T7765: a module Main with an explicit module header but without a main function should be an error for all Ways. Additionaly: delete test module/mod174. It was added in commit 5a54c38, but it is a duplicate of module/T414. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D649 GHC Trac Issues: #7765 >--------------------------------------------------------------- 0fa20726b0587530712677e50a56c2b03ba43095 compiler/typecheck/TcRnDriver.hs | 37 +++++++--------------- compiler/typecheck/TcRnMonad.hs | 5 +-- compiler/typecheck/TcRnTypes.hs | 4 ++- compiler/utils/IOEnv.hs | 9 +++--- docs/users_guide/7.12.1-notes.xml | 3 +- testsuite/tests/deriving/should_fail/T5686.hs | 2 +- .../tests/ghci/prog012/{Main.hs => FooBar.hs} | 2 +- testsuite/tests/ghci/prog012/prog012.script | 2 +- testsuite/tests/ghci/scripts/ghci022.hs | 2 +- testsuite/tests/ghci/scripts/ghci027.script | 4 +-- testsuite/tests/ghci/scripts/ghci027_1.hs | 2 +- testsuite/tests/ghci/scripts/ghci027_2.hs | 2 +- .../{ghci/scripts/ghci022.hs => module/T7765.hs} | 1 - testsuite/tests/module/T7765.stderr | 2 ++ testsuite/tests/module/all.T | 4 +-- testsuite/tests/module/mod174.hs | 9 ------ testsuite/tests/module/mod174.stderr | 3 -- testsuite/tests/parser/should_fail/readFail013.hs | 2 +- 18 files changed, 36 insertions(+), 59 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0fa20726b0587530712677e50a56c2b03ba43095 From git at git.haskell.org Mon Feb 23 09:40:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:40:23 +0000 (UTC) Subject: [commit: ghc] master: Make top-level "configure" accept and propagate --with-curses-{includes, libraries} to libraries (bbb57a6) Message-ID: <20150223094023.A4D943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bbb57a6b3a31c22a5a24fa4b92abbe13a6736ad8/ghc >--------------------------------------------------------------- commit bbb57a6b3a31c22a5a24fa4b92abbe13a6736ad8 Author: PHO Date: Mon Feb 23 03:40:05 2015 -0600 Make top-level "configure" accept and propagate --with-curses-{includes,libraries} to libraries Summary: If curses is installed into some non-standard path, we currently have to say something like the following in mk/build.mk: libraries/terminfo_CONFIGURE_OPTS += \ --configure-option=--with-curses-includes=/somewhere/include \ --configure-option=--with-curses-libraries=/somewhere/lib This is because the top-level configure does not accept nor propagate --with-curses-{includes,libraries} to libraries while it does so for iconv, gmp and libffi. It would be nice if curses were handled in the same manner. Test Plan: Install curses into some non-standard path. Then run the top-level "configure" script with options "--with-curses-includes=/path/to/curses/include" and "--with-curses-libraries=/path/to/curses/lib". Reviewers: austin Reviewed By: austin Subscribers: thomie, PHO Differential Revision: https://phabricator.haskell.org/D665 GHC Trac Issues: #10096 >--------------------------------------------------------------- bbb57a6b3a31c22a5a24fa4b92abbe13a6736ad8 aclocal.m4 | 22 ++++++++++++++++++++++ configure.ac | 1 + mk/config.mk.in | 3 +++ rules/build-package-data.mk | 8 ++++++++ 4 files changed, 34 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index cb4aa83..73b8890 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1826,6 +1826,28 @@ AC_DEFUN([FP_GMP], AC_SUBST(GMP_LIB_DIRS) ])# FP_GMP +# FP_CURSES +# ------------- +AC_DEFUN([FP_CURSES], +[ + dnl-------------------------------------------------------------------- + dnl * Deal with arguments telling us curses is somewhere odd + dnl-------------------------------------------------------------------- + + AC_ARG_WITH([curses-includes], + [AC_HELP_STRING([--with-curses-includes], + [directory containing curses headers])], + [CURSES_INCLUDE_DIRS=$withval]) + + AC_ARG_WITH([curses-libraries], + [AC_HELP_STRING([--with-curses-libraries], + [directory containing curses libraries])], + [CURSES_LIB_DIRS=$withval]) + + AC_SUBST(CURSES_INCLUDE_DIRS) + AC_SUBST(CURSES_LIB_DIRS) +])# FP_CURSES + # -------------------------------------------------------------- # Calculate absolute path to build tree # -------------------------------------------------------------- diff --git a/configure.ac b/configure.ac index 9740e15..f65d133 100644 --- a/configure.ac +++ b/configure.ac @@ -357,6 +357,7 @@ fi FP_ICONV FP_GMP +FP_CURSES XCODE_VERSION() diff --git a/mk/config.mk.in b/mk/config.mk.in index dfe8c2b..b32f227 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -805,3 +805,6 @@ ICONV_LIB_DIRS = @ICONV_LIB_DIRS@ GMP_INCLUDE_DIRS = @GMP_INCLUDE_DIRS@ GMP_LIB_DIRS = @GMP_LIB_DIRS@ + +CURSES_INCLUDE_DIRS = @CURSES_INCLUDE_DIRS@ +CURSES_LIB_DIRS = @CURSES_LIB_DIRS@ diff --git a/rules/build-package-data.mk b/rules/build-package-data.mk index 2e61001..494b89a 100644 --- a/rules/build-package-data.mk +++ b/rules/build-package-data.mk @@ -77,6 +77,14 @@ ifneq "$$(GMP_LIB_DIRS)" "" $1_$2_CONFIGURE_OPTS += --configure-option=--with-gmp-libraries="$$(GMP_LIB_DIRS)" endif +ifneq "$$(CURSES_INCLUDE_DIRS)" "" +$1_$2_CONFIGURE_OPTS += --configure-option=--with-curses-includes="$$(CURSES_INCLUDE_DIRS)" +endif + +ifneq "$$(CURSES_LIB_DIRS)" "" +$1_$2_CONFIGURE_OPTS += --configure-option=--with-curses-libraries="$$(CURSES_LIB_DIRS)" +endif + ifeq "$$(CrossCompiling)" "YES" $1_$2_CONFIGURE_OPTS += --configure-option=--host=$(TargetPlatformFull) endif From git at git.haskell.org Mon Feb 23 09:40:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:40:26 +0000 (UTC) Subject: [commit: ghc] master: Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors (fd581a7) Message-ID: <20150223094026.7059B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fd581a7300abede9a070cb6e9b835b2e18f68b0b/ghc >--------------------------------------------------------------- commit fd581a7300abede9a070cb6e9b835b2e18f68b0b Author: Jan Bracker Date: Mon Feb 23 03:40:15 2015 -0600 Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors Summary: Remove unused variable that appeared through the fix for ticket #10078 Merge branch 'master' of git://git.haskell.org/ghc Added comment with bug ID. Reviewers: adamgundry, gridaphobe, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D667 GHC Trac Issues: #10078 >--------------------------------------------------------------- fd581a7300abede9a070cb6e9b835b2e18f68b0b compiler/typecheck/TcRnDriver.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 85d5a2a..2ac45fc 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2121,9 +2121,14 @@ withTcPlugins hsc_env m = case plugins of [] -> m -- Common fast case _ -> do (solvers,stops) <- unzip `fmap` mapM startPlugin plugins - res <- updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m + -- This ensures that tcPluginStop is called even if a type + -- error occurs during compilation (Fix of #10078) + eitherRes <- tryM $ do + updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m mapM_ runTcPluginM stops - return res + case eitherRes of + Left _ -> failM + Right res -> return res where startPlugin (TcPlugin start solve stop) = do s <- runTcPluginM start From git at git.haskell.org Mon Feb 23 09:40:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:40:29 +0000 (UTC) Subject: [commit: ghc] master: Always ignore user-package-db when running tests (30dc59e) Message-ID: <20150223094029.1D7DC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30dc59e889205ee62ce77168616f7a4183811d74/ghc >--------------------------------------------------------------- commit 30dc59e889205ee62ce77168616f7a4183811d74 Author: Thomas Miedema Date: Mon Feb 23 03:40:23 2015 -0600 Always ignore user-package-db when running tests Summary: The user package database was already ignored for systems that `have_subprocess`. To [wiki:Debugging/InstallingPackagesInplace install] a package inplace: `cabal install --with-compiler= --with-package-db=` Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D668 >--------------------------------------------------------------- 30dc59e889205ee62ce77168616f7a4183811d74 testsuite/driver/testlib.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 6fc86e4..ac6d97c 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -114,8 +114,8 @@ def _reqlib( name, opts, lib ): p.communicate() r = p.wait() else: - r = os.system(config.ghc_pkg + ' describe ' + lib - + ' > /dev/null 2> /dev/null') + r = os.system(config.ghc_pkg + ' --no-user-package-db describe ' + + lib + ' > /dev/null 2> /dev/null') got_it = r == 0 have_lib[lib] = got_it From git at git.haskell.org Mon Feb 23 09:40:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:40:31 +0000 (UTC) Subject: [commit: ghc] master: Declare some Makefile targets to be PHONY (a0ef626) Message-ID: <20150223094031.E3B343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a0ef626e8c51784cc0bf9b33e3c5b3e750b2786b/ghc >--------------------------------------------------------------- commit a0ef626e8c51784cc0bf9b33e3c5b3e750b2786b Author: Thomas Miedema Date: Mon Feb 23 03:40:34 2015 -0600 Declare some Makefile targets to be PHONY Summary: Given: a Makefile with a non-PHONY target called `target` If: after running `make target`, a file exists with the same name as `target` (it was either already there, or it was created by running `make target`) And: `target` has no dependencies, such as `clean`, that modify or delete that file Then: subsequent invocations of `make target` will not have any effect. Solution: make `target` PHONY. BAD: ``` foo: ... ./foo ``` BETTER: ``` foo: ... ./foo .PHONY: foo ``` Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D670 >--------------------------------------------------------------- a0ef626e8c51784cc0bf9b33e3c5b3e750b2786b testsuite/tests/driver/recomp014/Makefile | 2 ++ testsuite/tests/ghc-api/T7478/Makefile | 1 + testsuite/tests/ghc-api/annotations-literals/Makefile | 2 +- testsuite/tests/ghc-api/annotations/Makefile | 2 +- testsuite/tests/ghc-api/landmines/Makefile | 2 +- testsuite/tests/ghc-api/show-srcspan/Makefile | 2 +- 6 files changed, 7 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/driver/recomp014/Makefile b/testsuite/tests/driver/recomp014/Makefile index 58c6f2a..8bd9735 100644 --- a/testsuite/tests/driver/recomp014/Makefile +++ b/testsuite/tests/driver/recomp014/Makefile @@ -25,3 +25,5 @@ recomp014: clean '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) A1.o C.o -o recomp014 ./recomp014 + +.PHONY: clean recomp014 diff --git a/testsuite/tests/ghc-api/T7478/Makefile b/testsuite/tests/ghc-api/T7478/Makefile index 1afb16d..6214051 100644 --- a/testsuite/tests/ghc-api/T7478/Makefile +++ b/testsuite/tests/ghc-api/T7478/Makefile @@ -9,3 +9,4 @@ T7478: clean '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T7478.hs ./T7478 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" +.PHONY: clean T7478 diff --git a/testsuite/tests/ghc-api/annotations-literals/Makefile b/testsuite/tests/ghc-api/annotations-literals/Makefile index 875d063..5b06030 100644 --- a/testsuite/tests/ghc-api/annotations-literals/Makefile +++ b/testsuite/tests/ghc-api/annotations-literals/Makefile @@ -15,4 +15,4 @@ parsed: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc parsed ./parsed "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -.PHONY: clean +.PHONY: clean literals parsed diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 61474e9..f5ef3b4 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -26,4 +26,4 @@ exampleTest: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc exampleTest ./exampleTest "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -.PHONY: clean +.PHONY: clean annotations parseTree comments exampleTest diff --git a/testsuite/tests/ghc-api/landmines/Makefile b/testsuite/tests/ghc-api/landmines/Makefile index 3197647..c727b95 100644 --- a/testsuite/tests/ghc-api/landmines/Makefile +++ b/testsuite/tests/ghc-api/landmines/Makefile @@ -10,4 +10,4 @@ landmines: clean ./landmines "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -.PHONY: clean +.PHONY: clean landmines diff --git a/testsuite/tests/ghc-api/show-srcspan/Makefile b/testsuite/tests/ghc-api/show-srcspan/Makefile index e467b61..8adcaa4 100644 --- a/testsuite/tests/ghc-api/show-srcspan/Makefile +++ b/testsuite/tests/ghc-api/show-srcspan/Makefile @@ -10,4 +10,4 @@ showsrcspan: clean ./showsrcspan "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -.PHONY: clean +.PHONY: clean showsrcspan From git at git.haskell.org Mon Feb 23 09:40:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:40:34 +0000 (UTC) Subject: [commit: ghc] master: rts/linker: ignore unknown PE sections (a293925) Message-ID: <20150223094034.A1F8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a293925d810229fbea77d95f2b3068e78f8380cc/ghc >--------------------------------------------------------------- commit a293925d810229fbea77d95f2b3068e78f8380cc Author: Tamar Christina Date: Mon Feb 23 03:40:43 2015 -0600 rts/linker: ignore unknown PE sections Summary: Currently the linker tries to see if it understands/knows every section in the PE file before it continues. If it encounters a section it doesn't know about it errors out. Every time there's a change in MinGW compiler that adds a new section to the PE file this will break the ghc linker. The new sections don't need to be understood by `ghc` to continue so instead of erroring out the section is just ignored. When running with `-debug` the sections that are ignored will be printed. Test Plan: See the file `ghcilinkerbug.zip` in #9907. 1) unzip file content. 2) open examplecpp.cabal and change base <4.8 to <4.9. 3) execute cabal file with cabal repl. Applying the patch makes `cabal repl` in step 3) work. Note that the file will fail on a `___mingw_vprintf` not being found. This is because of the `cc-options` specifying `-std=c++0x`, which will also require `libmingwex.a` to be linked in but wasn't specified in the cabal file. To fix this, remove the `cc-options` which defaults to c99. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D671 GHC Trac Issues: #9907, #7103, #10051, #7056, #8546 >--------------------------------------------------------------- a293925d810229fbea77d95f2b3068e78f8380cc rts/Linker.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index 2ba84f8..0bd2aa8 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -4008,7 +4008,7 @@ lookupSymbolInDLLs ( UChar *lbl ) void *sym; for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */ + /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ if (lbl[0] == '_') { /* HACK: if the name has an initial underscore, try stripping @@ -4401,9 +4401,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) /* ignore linker directive sections */ && 0 != strcmp(".drectve", (char*)secname) ) { - errorBelch("Unknown PEi386 section name `%s' (while processing: %" PATH_FMT")", secname, oc->fileName); - stgFree(secname); - return 0; + IF_DEBUG(linker, debugBelch("Unknown PEi386 section name `%s' (while processing: %" PATH_FMT")", secname, oc->fileName)); } if (kind != SECTIONKIND_OTHER && end >= start) { From git at git.haskell.org Mon Feb 23 09:40:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:40:38 +0000 (UTC) Subject: [commit: ghc] master: Show '#' on unboxed literals (47175e0) Message-ID: <20150223094038.7D5D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47175e06ff8364c732607e3d76ef3b7b80d57f1c/ghc >--------------------------------------------------------------- commit 47175e06ff8364c732607e3d76ef3b7b80d57f1c Author: Thomas Miedema Date: Mon Feb 23 03:40:58 2015 -0600 Show '#' on unboxed literals Test Plan: deriving/should_run/T10104 Reviewers: austin, jstolarek Reviewed By: austin, jstolarek Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D672 GHC Trac Issues: #10104 >--------------------------------------------------------------- 47175e06ff8364c732607e3d76ef3b7b80d57f1c compiler/prelude/PrelNames.hs | 3 +- compiler/typecheck/TcDeriv.hs | 5 +-- compiler/typecheck/TcGenDeriv.hs | 44 +++++++++++++++++------ testsuite/.gitignore | 2 +- testsuite/tests/deriving/should_run/T10104.hs | 11 ++++++ testsuite/tests/deriving/should_run/T10104.stdout | 2 ++ testsuite/tests/deriving/should_run/T8280.hs | 8 ----- testsuite/tests/deriving/should_run/T8280.stdout | 1 - testsuite/tests/deriving/should_run/all.T | 3 +- 9 files changed, 55 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 47175e06ff8364c732607e3d76ef3b7b80d57f1c From git at git.haskell.org Mon Feb 23 09:54:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:54:12 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: rts/linker: ignore unknown PE sections (ad62865) Message-ID: <20150223095412.714763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/ad628657cd56362964d17677728f4ae4d6868613/ghc >--------------------------------------------------------------- commit ad628657cd56362964d17677728f4ae4d6868613 Author: Tamar Christina Date: Mon Feb 23 03:40:43 2015 -0600 rts/linker: ignore unknown PE sections Summary: Currently the linker tries to see if it understands/knows every section in the PE file before it continues. If it encounters a section it doesn't know about it errors out. Every time there's a change in MinGW compiler that adds a new section to the PE file this will break the ghc linker. The new sections don't need to be understood by `ghc` to continue so instead of erroring out the section is just ignored. When running with `-debug` the sections that are ignored will be printed. Test Plan: See the file `ghcilinkerbug.zip` in #9907. 1) unzip file content. 2) open examplecpp.cabal and change base <4.8 to <4.9. 3) execute cabal file with cabal repl. Applying the patch makes `cabal repl` in step 3) work. Note that the file will fail on a `___mingw_vprintf` not being found. This is because of the `cc-options` specifying `-std=c++0x`, which will also require `libmingwex.a` to be linked in but wasn't specified in the cabal file. To fix this, remove the `cc-options` which defaults to c99. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D671 GHC Trac Issues: #9907, #7103, #10051, #7056, #8546 (cherry picked from commit a293925d810229fbea77d95f2b3068e78f8380cc) >--------------------------------------------------------------- ad628657cd56362964d17677728f4ae4d6868613 rts/Linker.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index 2ba84f8..0bd2aa8 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -4008,7 +4008,7 @@ lookupSymbolInDLLs ( UChar *lbl ) void *sym; for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */ + /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ if (lbl[0] == '_') { /* HACK: if the name has an initial underscore, try stripping @@ -4401,9 +4401,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) /* ignore linker directive sections */ && 0 != strcmp(".drectve", (char*)secname) ) { - errorBelch("Unknown PEi386 section name `%s' (while processing: %" PATH_FMT")", secname, oc->fileName); - stgFree(secname); - return 0; + IF_DEBUG(linker, debugBelch("Unknown PEi386 section name `%s' (while processing: %" PATH_FMT")", secname, oc->fileName)); } if (kind != SECTIONKIND_OTHER && end >= start) { From git at git.haskell.org Mon Feb 23 09:54:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:54:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors (f163b15) Message-ID: <20150223095415.3078C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/f163b15ce15cbe6ce19e168efde400a630cbf8b1/ghc >--------------------------------------------------------------- commit f163b15ce15cbe6ce19e168efde400a630cbf8b1 Author: Jan Bracker Date: Mon Feb 23 03:40:15 2015 -0600 Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors Summary: Remove unused variable that appeared through the fix for ticket #10078 Merge branch 'master' of git://git.haskell.org/ghc Added comment with bug ID. Reviewers: adamgundry, gridaphobe, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D667 GHC Trac Issues: #10078 (cherry picked from commit fd581a7300abede9a070cb6e9b835b2e18f68b0b) >--------------------------------------------------------------- f163b15ce15cbe6ce19e168efde400a630cbf8b1 compiler/typecheck/TcRnDriver.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index ae1e261..b6e2973 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2127,9 +2127,14 @@ withTcPlugins hsc_env m = case plugins of [] -> m -- Common fast case _ -> do (solvers,stops) <- unzip `fmap` mapM startPlugin plugins - res <- updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m + -- This ensures that tcPluginStop is called even if a type + -- error occurs during compilation (Fix of #10078) + eitherRes <- tryM $ do + updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m mapM_ runTcPluginM stops - return res + case eitherRes of + Left _ -> failM + Right res -> return res where startPlugin (TcPlugin start solve stop) = do s <- runTcPluginM start From git at git.haskell.org Mon Feb 23 09:54:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:54:17 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Make top-level "configure" accept and propagate --with-curses-{includes, libraries} to libraries (d9e24f4) Message-ID: <20150223095417.EF8983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d9e24f4eb1f214a59f1d7d8a2535b1b255a45a51/ghc >--------------------------------------------------------------- commit d9e24f4eb1f214a59f1d7d8a2535b1b255a45a51 Author: PHO Date: Mon Feb 23 03:40:05 2015 -0600 Make top-level "configure" accept and propagate --with-curses-{includes,libraries} to libraries Summary: If curses is installed into some non-standard path, we currently have to say something like the following in mk/build.mk: libraries/terminfo_CONFIGURE_OPTS += \ --configure-option=--with-curses-includes=/somewhere/include \ --configure-option=--with-curses-libraries=/somewhere/lib This is because the top-level configure does not accept nor propagate --with-curses-{includes,libraries} to libraries while it does so for iconv, gmp and libffi. It would be nice if curses were handled in the same manner. Test Plan: Install curses into some non-standard path. Then run the top-level "configure" script with options "--with-curses-includes=/path/to/curses/include" and "--with-curses-libraries=/path/to/curses/lib". Reviewers: austin Reviewed By: austin Subscribers: thomie, PHO Differential Revision: https://phabricator.haskell.org/D665 GHC Trac Issues: #10096 (cherry picked from commit bbb57a6b3a31c22a5a24fa4b92abbe13a6736ad8) >--------------------------------------------------------------- d9e24f4eb1f214a59f1d7d8a2535b1b255a45a51 aclocal.m4 | 22 ++++++++++++++++++++++ configure.ac | 1 + mk/config.mk.in | 3 +++ rules/build-package-data.mk | 8 ++++++++ 4 files changed, 34 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index 6933e6f..0cc9dcc 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1826,6 +1826,28 @@ AC_DEFUN([FP_GMP], AC_SUBST(GMP_LIB_DIRS) ])# FP_GMP +# FP_CURSES +# ------------- +AC_DEFUN([FP_CURSES], +[ + dnl-------------------------------------------------------------------- + dnl * Deal with arguments telling us curses is somewhere odd + dnl-------------------------------------------------------------------- + + AC_ARG_WITH([curses-includes], + [AC_HELP_STRING([--with-curses-includes], + [directory containing curses headers])], + [CURSES_INCLUDE_DIRS=$withval]) + + AC_ARG_WITH([curses-libraries], + [AC_HELP_STRING([--with-curses-libraries], + [directory containing curses libraries])], + [CURSES_LIB_DIRS=$withval]) + + AC_SUBST(CURSES_INCLUDE_DIRS) + AC_SUBST(CURSES_LIB_DIRS) +])# FP_CURSES + # -------------------------------------------------------------- # Calculate absolute path to build tree # -------------------------------------------------------------- diff --git a/configure.ac b/configure.ac index c98feb8..689ebd8 100644 --- a/configure.ac +++ b/configure.ac @@ -413,6 +413,7 @@ AS_IF([test "$UseSystemLibFFI" = "YES"], [ FP_ICONV FP_GMP +FP_CURSES XCODE_VERSION() diff --git a/mk/config.mk.in b/mk/config.mk.in index 40c66d9..42720c8 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -812,3 +812,6 @@ ICONV_LIB_DIRS = @ICONV_LIB_DIRS@ GMP_INCLUDE_DIRS = @GMP_INCLUDE_DIRS@ GMP_LIB_DIRS = @GMP_LIB_DIRS@ + +CURSES_INCLUDE_DIRS = @CURSES_INCLUDE_DIRS@ +CURSES_LIB_DIRS = @CURSES_LIB_DIRS@ diff --git a/rules/build-package-data.mk b/rules/build-package-data.mk index 2e61001..494b89a 100644 --- a/rules/build-package-data.mk +++ b/rules/build-package-data.mk @@ -77,6 +77,14 @@ ifneq "$$(GMP_LIB_DIRS)" "" $1_$2_CONFIGURE_OPTS += --configure-option=--with-gmp-libraries="$$(GMP_LIB_DIRS)" endif +ifneq "$$(CURSES_INCLUDE_DIRS)" "" +$1_$2_CONFIGURE_OPTS += --configure-option=--with-curses-includes="$$(CURSES_INCLUDE_DIRS)" +endif + +ifneq "$$(CURSES_LIB_DIRS)" "" +$1_$2_CONFIGURE_OPTS += --configure-option=--with-curses-libraries="$$(CURSES_LIB_DIRS)" +endif + ifeq "$$(CrossCompiling)" "YES" $1_$2_CONFIGURE_OPTS += --configure-option=--host=$(TargetPlatformFull) endif From git at git.haskell.org Mon Feb 23 09:59:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 09:59:21 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Improve typechecking of RULEs, to account for type wildcard holes (20ccf72) Message-ID: <20150223095921.AD8BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/20ccf72614bab9a00767b2514b7cded4b6e3084e/ghc >--------------------------------------------------------------- commit 20ccf72614bab9a00767b2514b7cded4b6e3084e Author: Simon Peyton Jones Date: Sun Feb 15 20:21:42 2015 +0000 Improve typechecking of RULEs, to account for type wildcard holes This fixes Trac #10072. Previously the type-hole constraint was escaping to top level, but it belongs in the scope of the skolems bound by the RULE. (cherry picked from commit 5ab7518f28e89515c73ff09acd48b5acab48b8a5) >--------------------------------------------------------------- 20ccf72614bab9a00767b2514b7cded4b6e3084e compiler/typecheck/TcMType.hs | 2 +- compiler/typecheck/TcRules.hs | 11 +++++++++-- testsuite/tests/typecheck/should_compile/T10072.hs | 4 ++++ testsuite/tests/typecheck/should_compile/T10072.stderr | 8 ++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 23 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 08c0b8b..db76ee3 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -606,7 +606,7 @@ skolemiseUnboundMetaTyVar tv details ; writeMetaTyVar tv (mkTyVarTy final_tv) ; return final_tv } where - -- If a wildcard type called _a is generalised, we rename it to tw_a + -- If a wildcard type called _a is generalised, we rename it to w_a generaliseWildcardVarName :: OccName -> OccName generaliseWildcardVarName name | startsWithUnderscore name = mkOccNameFS (occNameSpace name) (appendFS (fsLit "w") (occNameFS name)) diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs index 56dad98..96de43e 100644 --- a/compiler/typecheck/TcRules.hs +++ b/compiler/typecheck/TcRules.hs @@ -132,7 +132,13 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs) do { traceTc "---- Rule ------" (ppr name) -- Note [Typechecking rules] - ; vars <- tcRuleBndrs hs_bndrs + ; (vars, bndr_wanted) <- captureConstraints $ + tcRuleBndrs hs_bndrs + -- bndr_wanted constraints can include wildcard hole + -- constraints, which we should not forget about. + -- It may mention the skolem type variables bound by + -- the RULE. c.f. Trac #10072 + ; let (id_bndrs, tv_bndrs) = partition isId vars ; (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty) <- tcExtendTyVarEnv tv_bndrs $ @@ -141,7 +147,8 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs) ; (rhs', rhs_wanted) <- captureConstraints (tcMonoExpr rhs rule_ty) ; return (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty) } - ; (lhs_evs, other_lhs_wanted) <- simplifyRule (unLoc name) lhs_wanted + ; (lhs_evs, other_lhs_wanted) <- simplifyRule (unLoc name) + (bndr_wanted `andWC` lhs_wanted) rhs_wanted -- Now figure out what to quantify over diff --git a/testsuite/tests/typecheck/should_compile/T10072.hs b/testsuite/tests/typecheck/should_compile/T10072.hs new file mode 100644 index 0000000..78d47d4 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10072.hs @@ -0,0 +1,4 @@ +module T0072 where +{-# RULES +"map/empty" forall (f :: a -> _). map f [] = [] + #-} diff --git a/testsuite/tests/typecheck/should_compile/T10072.stderr b/testsuite/tests/typecheck/should_compile/T10072.stderr new file mode 100644 index 0000000..134a137 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10072.stderr @@ -0,0 +1,8 @@ + +T10072.hs:3:31: + Found hole ?_? with type: w_ + Where: ?w_? is a rigid type variable bound by + the RULE "map/empty" at T10072.hs:3:1 + To use the inferred type, enable PartialTypeSignatures + In a RULE for ?f?: a -> _ + When checking the transformation rule "map/empty" diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index cce92d0..0b46cc6 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -440,3 +440,4 @@ test('T9892', normal, compile, ['']) test('T9971', normal, compile, ['']) test('T9999', normal, compile, ['']) test('T10031', normal, compile, ['']) +test('T10072', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 23 10:42:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 10:42:14 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: {Data, Generic(1), MonadZip} instances for Identity (873c398) Message-ID: <20150223104214.B6B063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/873c3981794e0823f3bfb5383068382445007837/ghc >--------------------------------------------------------------- commit 873c3981794e0823f3bfb5383068382445007837 Author: Herbert Valerio Riedel Date: Sun Feb 22 15:21:18 2015 +0100 {Data,Generic(1),MonadZip} instances for Identity These instances were missed when the identity functor was added to the `base` package (re #9664). (cherry picked from commit 1f60d635cee1ff3db72e0129f9035b147f52c9c4) >--------------------------------------------------------------- 873c3981794e0823f3bfb5383068382445007837 libraries/base/Data/Functor/Identity.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs index 2465a1e..ac47922 100644 --- a/libraries/base/Data/Functor/Identity.hs +++ b/libraries/base/Data/Functor/Identity.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE Trustworthy #-} {-# LANGUAGE AutoDeriveTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | @@ -33,14 +34,17 @@ module Data.Functor.Identity ( ) where import Control.Monad.Fix +import Control.Monad.Zip import Data.Coerce +import Data.Data (Data) import Data.Foldable +import GHC.Generics (Generic, Generic1) -- | Identity functor and monad. (a non-strict monad) -- -- @since 4.8.0.0 newtype Identity a = Identity { runIdentity :: a } - deriving (Eq, Ord, Traversable) + deriving (Eq, Ord, Data, Traversable, Generic, Generic1) -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed @@ -89,6 +93,9 @@ instance Monad Identity where instance MonadFix Identity where mfix f = Identity (fix (runIdentity . f)) +instance MonadZip Identity where + mzipWith = coerce + munzip = coerce -- | Internal (non-exported) 'Coercible' helper for 'elem' -- From git at git.haskell.org Mon Feb 23 11:22:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:22:43 +0000 (UTC) Subject: [commit: ghc] master: docs: add INSTALL.md to root dir (#9926) (9a1c8d9) Message-ID: <20150223112243.6445B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a1c8d96f0aaf7629cdcfad5ba67aa8a1a7b9cb3/ghc >--------------------------------------------------------------- commit 9a1c8d96f0aaf7629cdcfad5ba67aa8a1a7b9cb3 Author: Austin Seipp Date: Mon Feb 23 05:19:59 2015 -0600 docs: add INSTALL.md to root dir (#9926) This gives a very quick rundown on installation for end-users (HACKING etc is for developers/possible contributors). Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9a1c8d96f0aaf7629cdcfad5ba67aa8a1a7b9cb3 INSTALL.md | 40 ++++++++++++++++++++++++++++++++++++++++ ghc.mk | 4 ++-- 2 files changed, 42 insertions(+), 2 deletions(-) diff --git a/INSTALL.md b/INSTALL.md new file mode 100644 index 0000000..1db2595 --- /dev/null +++ b/INSTALL.md @@ -0,0 +1,40 @@ +Building & Installing +===================== + +For full information on building GHC, see the GHC Building Guide [1]. +Here follows a summary - if you get into trouble, the Building Guide +has all the answers. + +Before building GHC you may need to install some other tools and +libraries. See "Setting up your system for building GHC" [2]. + +NB. in particular you need GHC installed in order to build GHC, +because the compiler is itself written in Haskell. For instructions +on how to port GHC to a new platform, see the Building Guide [1]. + +For building library documentation, you'll need Haddock [3]. To build +the compiler documentation, you need a good DocBook XML toolchain and +dblatex. + +Quick start: the following gives you a default build: + + $ perl boot + $ ./configure + $ make + $ make install + +The "perl boot" step is only necessary if this is a tree checked out +from git. For source distributions downloaded from GHC's web site, +this step has already been performed. + +These steps give you the default build, which includes everything +optimised and built in various ways (eg. profiling libs are built). +It can take a long time. To customise the build, see the file +`HACKING.md`. + +References +========== + + [1] http://www.haskell.org/ghc/ + [2] http://hackage.haskell.org/trac/ghc/wiki/Building/Preparation + [3] http://www.haskell.org/haddock/ diff --git a/ghc.mk b/ghc.mk index 0322ba6..08dcf19 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1108,8 +1108,8 @@ SRC_DIST_GHC_DIRS = mk rules docs distrib bindisttest libffi includes \ utils docs rts compiler ghc driver libraries libffi-tarballs SRC_DIST_GHC_FILES += \ configure.ac config.guess config.sub configure \ - aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh \ - settings.in VERSION GIT_COMMIT_ID \ + aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile + install-sh settings.in VERSION GIT_COMMIT_ID \ boot packages ghc.mk .PHONY: VERSION From git at git.haskell.org Mon Feb 23 11:22:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:22:46 +0000 (UTC) Subject: [commit: ghc] master: docs: Flatten MAKEHELP/SUBMAKEHELP (c3f9eb4) Message-ID: <20150223112246.4F3683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c3f9eb4d0626fc40f77e61653deca84cc3e1542f/ghc >--------------------------------------------------------------- commit c3f9eb4d0626fc40f77e61653deca84cc3e1542f Author: Austin Seipp Date: Mon Feb 23 05:21:11 2015 -0600 docs: Flatten MAKEHELP/SUBMAKEHELP There's no reason to have two files, and this is one step towards a cleaner root directory. Signed-off-by: Austin Seipp >--------------------------------------------------------------- c3f9eb4d0626fc40f77e61653deca84cc3e1542f MAKEHELP | 49 ------------------------------------- MAKEHELP.md | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBMAKEHELP | 33 ------------------------- ghc.mk | 2 +- 4 files changed, 82 insertions(+), 83 deletions(-) diff --git a/MAKEHELP b/MAKEHELP deleted file mode 100644 index ab42ddf..0000000 --- a/MAKEHELP +++ /dev/null @@ -1,49 +0,0 @@ - -Using the GHC build system --------------------------- - -For a "Getting Started" guide, see: - - http://ghc.haskell.org/trac/ghc/wiki/Building/Hacking - -Common commands: - - make - - Builds everything: ghc stages 1 and 2, all libraries and tools. - - make -j2 - - Parallel build: runs up to 2 commands at a time (use the number of - CPUs in your machine in place of '2') - - cd ; make - - Builds everything in the given directory. - - cd ; make help - - Shows the targets available in - - make install - - Installs GHC, libraries and tools under $(prefix) - - make sdist - make binary-dist - - Builds a source or binary distribution respectively - - make show VALUE= - - Displays the value of make variable - - make clean - make distclean - make maintainer-clean - - Various levels of cleaning: "clean" restores the tree to the - state after "./configure", "distclean" restores to the state - after "perl boot", and maintainer-clean restores the tree to the - completely clean checked-out state. - diff --git a/MAKEHELP.md b/MAKEHELP.md new file mode 100644 index 0000000..ff0e434 --- /dev/null +++ b/MAKEHELP.md @@ -0,0 +1,81 @@ +Quick `make` guide for GHC +========================== + +For a "Getting Started" guide, see: + + http://ghc.haskell.org/trac/ghc/wiki/Building/Hacking + +Common commands: + + - `make` + + Builds everything: ghc stages 1 and 2, all libraries and tools. + + - `make -j2` + + Parallel build: runs up to 2 commands at a time. + + - `cd ; make` + + Builds everything in the given directory. + + - cd ; make help + + Shows the targets available in + + - make install + + Installs GHC, libraries and tools under $(prefix) + + - make sdist + - make binary-dist + + Builds a source or binary distribution respectively + + - `make show VALUE=` + + Displays the value of make variable + + - make clean + - make distclean + - make maintainer-clean + + Various levels of cleaning: "clean" restores the tree to the + state after "./configure", "distclean" restores to the state + after "perl boot", and maintainer-clean restores the tree to the + completely clean checked-out state. + +Using `make` in subdirectories +============================== + + - `make` + + Builds everything in this directory (including dependencies elsewhere + in the tree, if necessary) + + - `make fast` + + The same as 'make', but omits some phases and does not + recalculate dependencies. Useful for saving time if you are sure + the rest of the tree is up to date. + + - `make clean` + - `make distclean` + - `make maintainer-clean` + + Clean just this directory + + - `make html` + - `make pdf` + - `make ps` + + Make documentation in this directory (if any) + + - `make show VALUE=var` + + Show the value of $(var) + + - `make ` + + Bring a particular file up to date, e.g. make dist/build/Module.o + The name is relative to the current directory diff --git a/SUBMAKEHELP b/SUBMAKEHELP deleted file mode 100644 index e109d89..0000000 --- a/SUBMAKEHELP +++ /dev/null @@ -1,33 +0,0 @@ - - make - - Builds everything in this directory (including dependencies elsewhere - in the tree, if necessary) - - make fast - - The same as 'make', but omits some phases and does not - recalculate dependencies. Useful for saving time if you are sure - the rest of the tree is up to date. - - make clean - make distclean - make maintainer-clean - - Clean just this directory - - make html - make pdf - make ps - - Make documentation in this directory (if any) - - make show VALUE=var - - Show the value of $(var) - - make - - Bring a particular file up to date, e.g. make dist/build/Module.o - The name is relative to the current directory - diff --git a/ghc.mk b/ghc.mk index 08dcf19..aa29171 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1110,7 +1110,7 @@ SRC_DIST_GHC_FILES += \ configure.ac config.guess config.sub configure \ aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile install-sh settings.in VERSION GIT_COMMIT_ID \ - boot packages ghc.mk + boot packages ghc.mk MAKEHELP.md .PHONY: VERSION VERSION: From git at git.haskell.org Mon Feb 23 11:23:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:23:59 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: add INSTALL.md to root dir (#9926) (e34ca99) Message-ID: <20150223112359.925353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/e34ca9900d5a8acf7b8da0d07989d579a718f464/ghc >--------------------------------------------------------------- commit e34ca9900d5a8acf7b8da0d07989d579a718f464 Author: Austin Seipp Date: Mon Feb 23 05:19:59 2015 -0600 docs: add INSTALL.md to root dir (#9926) This gives a very quick rundown on installation for end-users (HACKING etc is for developers/possible contributors). Signed-off-by: Austin Seipp (cherry picked from commit 9a1c8d96f0aaf7629cdcfad5ba67aa8a1a7b9cb3) >--------------------------------------------------------------- e34ca9900d5a8acf7b8da0d07989d579a718f464 INSTALL.md | 40 ++++++++++++++++++++++++++++++++++++++++ ghc.mk | 4 ++-- 2 files changed, 42 insertions(+), 2 deletions(-) diff --git a/INSTALL.md b/INSTALL.md new file mode 100644 index 0000000..1db2595 --- /dev/null +++ b/INSTALL.md @@ -0,0 +1,40 @@ +Building & Installing +===================== + +For full information on building GHC, see the GHC Building Guide [1]. +Here follows a summary - if you get into trouble, the Building Guide +has all the answers. + +Before building GHC you may need to install some other tools and +libraries. See "Setting up your system for building GHC" [2]. + +NB. in particular you need GHC installed in order to build GHC, +because the compiler is itself written in Haskell. For instructions +on how to port GHC to a new platform, see the Building Guide [1]. + +For building library documentation, you'll need Haddock [3]. To build +the compiler documentation, you need a good DocBook XML toolchain and +dblatex. + +Quick start: the following gives you a default build: + + $ perl boot + $ ./configure + $ make + $ make install + +The "perl boot" step is only necessary if this is a tree checked out +from git. For source distributions downloaded from GHC's web site, +this step has already been performed. + +These steps give you the default build, which includes everything +optimised and built in various ways (eg. profiling libs are built). +It can take a long time. To customise the build, see the file +`HACKING.md`. + +References +========== + + [1] http://www.haskell.org/ghc/ + [2] http://hackage.haskell.org/trac/ghc/wiki/Building/Preparation + [3] http://www.haskell.org/haddock/ diff --git a/ghc.mk b/ghc.mk index 0322ba6..08dcf19 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1108,8 +1108,8 @@ SRC_DIST_GHC_DIRS = mk rules docs distrib bindisttest libffi includes \ utils docs rts compiler ghc driver libraries libffi-tarballs SRC_DIST_GHC_FILES += \ configure.ac config.guess config.sub configure \ - aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh \ - settings.in VERSION GIT_COMMIT_ID \ + aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile + install-sh settings.in VERSION GIT_COMMIT_ID \ boot packages ghc.mk .PHONY: VERSION From git at git.haskell.org Mon Feb 23 11:24:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:24:02 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: Flatten MAKEHELP/SUBMAKEHELP (b6fc8a9) Message-ID: <20150223112402.A8F2B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/b6fc8a97a306a984329a883bde09e11b5455f0aa/ghc >--------------------------------------------------------------- commit b6fc8a97a306a984329a883bde09e11b5455f0aa Author: Austin Seipp Date: Mon Feb 23 05:21:11 2015 -0600 docs: Flatten MAKEHELP/SUBMAKEHELP There's no reason to have two files, and this is one step towards a cleaner root directory. Signed-off-by: Austin Seipp (cherry picked from commit c3f9eb4d0626fc40f77e61653deca84cc3e1542f) >--------------------------------------------------------------- b6fc8a97a306a984329a883bde09e11b5455f0aa MAKEHELP | 49 ------------------------------------- MAKEHELP.md | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBMAKEHELP | 33 ------------------------- ghc.mk | 2 +- 4 files changed, 82 insertions(+), 83 deletions(-) diff --git a/MAKEHELP b/MAKEHELP deleted file mode 100644 index ab42ddf..0000000 --- a/MAKEHELP +++ /dev/null @@ -1,49 +0,0 @@ - -Using the GHC build system --------------------------- - -For a "Getting Started" guide, see: - - http://ghc.haskell.org/trac/ghc/wiki/Building/Hacking - -Common commands: - - make - - Builds everything: ghc stages 1 and 2, all libraries and tools. - - make -j2 - - Parallel build: runs up to 2 commands at a time (use the number of - CPUs in your machine in place of '2') - - cd ; make - - Builds everything in the given directory. - - cd ; make help - - Shows the targets available in - - make install - - Installs GHC, libraries and tools under $(prefix) - - make sdist - make binary-dist - - Builds a source or binary distribution respectively - - make show VALUE= - - Displays the value of make variable - - make clean - make distclean - make maintainer-clean - - Various levels of cleaning: "clean" restores the tree to the - state after "./configure", "distclean" restores to the state - after "perl boot", and maintainer-clean restores the tree to the - completely clean checked-out state. - diff --git a/MAKEHELP.md b/MAKEHELP.md new file mode 100644 index 0000000..ff0e434 --- /dev/null +++ b/MAKEHELP.md @@ -0,0 +1,81 @@ +Quick `make` guide for GHC +========================== + +For a "Getting Started" guide, see: + + http://ghc.haskell.org/trac/ghc/wiki/Building/Hacking + +Common commands: + + - `make` + + Builds everything: ghc stages 1 and 2, all libraries and tools. + + - `make -j2` + + Parallel build: runs up to 2 commands at a time. + + - `cd ; make` + + Builds everything in the given directory. + + - cd ; make help + + Shows the targets available in + + - make install + + Installs GHC, libraries and tools under $(prefix) + + - make sdist + - make binary-dist + + Builds a source or binary distribution respectively + + - `make show VALUE=` + + Displays the value of make variable + + - make clean + - make distclean + - make maintainer-clean + + Various levels of cleaning: "clean" restores the tree to the + state after "./configure", "distclean" restores to the state + after "perl boot", and maintainer-clean restores the tree to the + completely clean checked-out state. + +Using `make` in subdirectories +============================== + + - `make` + + Builds everything in this directory (including dependencies elsewhere + in the tree, if necessary) + + - `make fast` + + The same as 'make', but omits some phases and does not + recalculate dependencies. Useful for saving time if you are sure + the rest of the tree is up to date. + + - `make clean` + - `make distclean` + - `make maintainer-clean` + + Clean just this directory + + - `make html` + - `make pdf` + - `make ps` + + Make documentation in this directory (if any) + + - `make show VALUE=var` + + Show the value of $(var) + + - `make ` + + Bring a particular file up to date, e.g. make dist/build/Module.o + The name is relative to the current directory diff --git a/SUBMAKEHELP b/SUBMAKEHELP deleted file mode 100644 index e109d89..0000000 --- a/SUBMAKEHELP +++ /dev/null @@ -1,33 +0,0 @@ - - make - - Builds everything in this directory (including dependencies elsewhere - in the tree, if necessary) - - make fast - - The same as 'make', but omits some phases and does not - recalculate dependencies. Useful for saving time if you are sure - the rest of the tree is up to date. - - make clean - make distclean - make maintainer-clean - - Clean just this directory - - make html - make pdf - make ps - - Make documentation in this directory (if any) - - make show VALUE=var - - Show the value of $(var) - - make - - Bring a particular file up to date, e.g. make dist/build/Module.o - The name is relative to the current directory - diff --git a/ghc.mk b/ghc.mk index 08dcf19..aa29171 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1110,7 +1110,7 @@ SRC_DIST_GHC_FILES += \ configure.ac config.guess config.sub configure \ aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile install-sh settings.in VERSION GIT_COMMIT_ID \ - boot packages ghc.mk + boot packages ghc.mk MAKEHELP.md .PHONY: VERSION VERSION: From git at git.haskell.org Mon Feb 23 11:24:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:24:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: fix bus errors on SPARC caused by unalignment access to alloc_limit (fixes #10043) (4afc586) Message-ID: <20150223112405.704333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/4afc586615c71217f0f087b516d6e597c52d3506/ghc >--------------------------------------------------------------- commit 4afc586615c71217f0f087b516d6e597c52d3506 Author: Karel Gardas Date: Sat Feb 14 22:46:47 2015 +0100 fix bus errors on SPARC caused by unalignment access to alloc_limit (fixes #10043) Reviewers: austin, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D657 (cherry picked from commit b2be772a97f6e7fe9f1d1c28108949f81a13158b) >--------------------------------------------------------------- 4afc586615c71217f0f087b516d6e597c52d3506 includes/rts/storage/TSO.h | 3 +++ rts/Schedule.c | 6 +++--- rts/Threads.c | 6 +++--- rts/sm/Storage.c | 10 ++++++++-- 4 files changed, 17 insertions(+), 8 deletions(-) diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h index 06056fe..744ab2b 100644 --- a/includes/rts/storage/TSO.h +++ b/includes/rts/storage/TSO.h @@ -155,6 +155,9 @@ typedef struct StgTSO_ { * This is an integer, because we might update it in a place where * it isn't convenient to raise the exception, so we want it to * stay negative until we get around to checking it. + * + * Use only PK_Int64/ASSIGN_Int64 macros to get/set the value of alloc_limit + * in C code otherwise you will cause alignment issues on SPARC */ StgInt64 alloc_limit; /* in bytes */ diff --git a/rts/Schedule.c b/rts/Schedule.c index f25b372..957aa4b 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1086,15 +1086,15 @@ schedulePostRunThread (Capability *cap, StgTSO *t) // If the current thread's allocation limit has run out, send it // the AllocationLimitExceeded exception. - if (t->alloc_limit < 0 && (t->flags & TSO_ALLOC_LIMIT)) { + if (PK_Int64((W_*)&(t->alloc_limit)) < 0 && (t->flags & TSO_ALLOC_LIMIT)) { // Use a throwToSelf rather than a throwToSingleThreaded, because // it correctly handles the case where the thread is currently // inside mask. Also the thread might be blocked (e.g. on an // MVar), and throwToSingleThreaded doesn't unblock it // correctly in that case. throwToSelf(cap, t, allocationLimitExceeded_closure); - t->alloc_limit = (StgInt64)RtsFlags.GcFlags.allocLimitGrace - * BLOCK_SIZE; + ASSIGN_Int64((W_*)&(t->alloc_limit), + (StgInt64)RtsFlags.GcFlags.allocLimitGrace * BLOCK_SIZE); } /* some statistics gathering in the parallel case */ diff --git a/rts/Threads.c b/rts/Threads.c index 90efd9c..99f2be7 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -110,7 +110,7 @@ createThread(Capability *cap, W_ size) tso->stackobj = stack; tso->tot_stack_size = stack->stack_size; - tso->alloc_limit = 0; + ASSIGN_Int64((W_*)&(tso->alloc_limit), 0); tso->trec = NO_TREC; @@ -173,12 +173,12 @@ HsInt64 rts_getThreadAllocationCounter(StgPtr tso) { // NB. doesn't take into account allocation in the current nursery // block, so it might be off by up to 4k. - return ((StgTSO *)tso)->alloc_limit; + return PK_Int64((W_*)&(((StgTSO *)tso)->alloc_limit)); } void rts_setThreadAllocationCounter(StgPtr tso, HsInt64 i) { - ((StgTSO *)tso)->alloc_limit = i; + ASSIGN_Int64((W_*)&(((StgTSO *)tso)->alloc_limit), i); } void rts_enableThreadAllocationLimit(StgPtr tso) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index f02c005..50926b7 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -746,7 +746,10 @@ StgPtr allocate (Capability *cap, W_ n) TICK_ALLOC_HEAP_NOCTR(WDS(n)); CCS_ALLOC(cap->r.rCCCS,n); if (cap->r.rCurrentTSO != NULL) { - cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_); + // cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_) + ASSIGN_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit), + (PK_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit)) + - n*sizeof(W_))); } if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { @@ -897,7 +900,10 @@ allocatePinned (Capability *cap, W_ n) TICK_ALLOC_HEAP_NOCTR(WDS(n)); CCS_ALLOC(cap->r.rCCCS,n); if (cap->r.rCurrentTSO != NULL) { - cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_); + // cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_); + ASSIGN_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit), + (PK_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit)) + - n*sizeof(W_))); } bd = cap->pinned_object_block; From git at git.haskell.org Mon Feb 23 11:31:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:31:11 +0000 (UTC) Subject: [commit: ghc] master: base: fix broken link (#10088) (266fa70) Message-ID: <20150223113111.00D3A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/266fa701286e1cda406e3fbae368aa9666a18980/ghc >--------------------------------------------------------------- commit 266fa701286e1cda406e3fbae368aa9666a18980 Author: Austin Seipp Date: Mon Feb 23 05:32:56 2015 -0600 base: fix broken link (#10088) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 266fa701286e1cda406e3fbae368aa9666a18980 libraries/base/Data/Ix.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Ix.hs b/libraries/base/Data/Ix.hs index e7e1f34..0171431 100644 --- a/libraries/base/Data/Ix.hs +++ b/libraries/base/Data/Ix.hs @@ -56,8 +56,8 @@ module Data.Ix -- > inRange (Yellow,Blue) Red == False -- -- * For single-constructor datatypes, the derived instance declarations - -- are as shown for tuples in Figure 1 - -- . + -- are as shown for tuples in chapter 19, section 2 of the Haskell 2010 report: + -- . ) where From git at git.haskell.org Mon Feb 23 11:31:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:31:30 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: base: fix broken link (#10088) (2f2b5c8) Message-ID: <20150223113130.36F2D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2f2b5c8b10c86c6b1495eebf229de2c18ca95f85/ghc >--------------------------------------------------------------- commit 2f2b5c8b10c86c6b1495eebf229de2c18ca95f85 Author: Austin Seipp Date: Mon Feb 23 05:32:56 2015 -0600 base: fix broken link (#10088) Signed-off-by: Austin Seipp (cherry picked from commit 266fa701286e1cda406e3fbae368aa9666a18980) >--------------------------------------------------------------- 2f2b5c8b10c86c6b1495eebf229de2c18ca95f85 libraries/base/Data/Ix.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Ix.hs b/libraries/base/Data/Ix.hs index e7e1f34..0171431 100644 --- a/libraries/base/Data/Ix.hs +++ b/libraries/base/Data/Ix.hs @@ -56,8 +56,8 @@ module Data.Ix -- > inRange (Yellow,Blue) Red == False -- -- * For single-constructor datatypes, the derived instance declarations - -- are as shown for tuples in Figure 1 - -- . + -- are as shown for tuples in chapter 19, section 2 of the Haskell 2010 report: + -- . ) where From git at git.haskell.org Mon Feb 23 11:35:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:35:40 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Add configurable verbosity level to hpc (00693e1) Message-ID: <20150223113540.DC0F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/00693e1ca9bd7c3225e1cbc377e57fb80a28d835/ghc >--------------------------------------------------------------- commit 00693e1ca9bd7c3225e1cbc377e57fb80a28d835 Author: Yuras Shumovich Date: Tue Feb 17 08:39:54 2015 -0600 Add configurable verbosity level to hpc Summary: All commands now have `--verbosity` flag, so one can configure cabal package with `--hpc-options="--verbosity=0"`. Right now it is used only in `hpc markup` to supress unnecessary output. Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D660 GHC Trac Issues: #10091 (cherry picked from commit 1b82619bc2ff36341d916c56b0cd67a378a9c222) >--------------------------------------------------------------- 00693e1ca9bd7c3225e1cbc377e57fb80a28d835 utils/hpc/HpcCombine.hs | 3 +++ utils/hpc/HpcDraft.hs | 1 + utils/hpc/HpcFlags.hs | 21 ++++++++++++++++++++- utils/hpc/HpcMarkup.hs | 7 +++++-- utils/hpc/HpcOverlay.hs | 1 + utils/hpc/HpcReport.hs | 1 + utils/hpc/HpcShowTix.hs | 1 + 7 files changed, 32 insertions(+), 3 deletions(-) diff --git a/utils/hpc/HpcCombine.hs b/utils/hpc/HpcCombine.hs index b57112f..db6ae9c 100644 --- a/utils/hpc/HpcCombine.hs +++ b/utils/hpc/HpcCombine.hs @@ -21,6 +21,7 @@ sum_options . includeOpt . outputOpt . unionModuleOpt + . verbosityOpt sum_plugin :: Plugin sum_plugin = Plugin { name = "sum" @@ -40,6 +41,7 @@ combine_options . combineFunOpt . combineFunOptInfo . unionModuleOpt + . verbosityOpt combine_plugin :: Plugin combine_plugin = Plugin { name = "combine" @@ -59,6 +61,7 @@ map_options . mapFunOpt . mapFunOptInfo . unionModuleOpt + . verbosityOpt map_plugin :: Plugin map_plugin = Plugin { name = "map" diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs index b804d56..975dbf4 100644 --- a/utils/hpc/HpcDraft.hs +++ b/utils/hpc/HpcDraft.hs @@ -20,6 +20,7 @@ draft_options . hpcDirOpt . resetHpcDirsOpt . outputOpt + . verbosityOpt draft_plugin :: Plugin draft_plugin = Plugin { name = "draft" diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs index 3bb3163..0170309 100644 --- a/utils/hpc/HpcFlags.hs +++ b/utils/hpc/HpcFlags.hs @@ -27,6 +27,8 @@ data Flags = Flags , combineFun :: CombineFun -- tick-wise combine , postFun :: PostFun -- , mergeModule :: MergeFun -- module-wise merge + + , verbosity :: Verbosity } default_flags :: Flags @@ -48,9 +50,21 @@ default_flags = Flags , combineFun = ADD , postFun = ID , mergeModule = INTERSECTION + + , verbosity = Normal } +data Verbosity = Silent | Normal | Verbose + deriving (Eq, Ord) + +verbosityFromString :: String -> Verbosity +verbosityFromString "0" = Silent +verbosityFromString "1" = Normal +verbosityFromString "2" = Verbose +verbosityFromString v = error $ "unknown verbosity: " ++ v + + -- We do this after reading flags, because the defaults -- depends on if specific flags we used. @@ -73,7 +87,7 @@ infoArg :: String -> FlagOptSeq infoArg info = (:) $ Option [] [] (NoArg $ id) info excludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt, - destDirOpt, outputOpt, + destDirOpt, outputOpt, verbosityOpt, perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt, altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt, mapFunOptInfo, unionModuleOpt :: FlagOptSeq @@ -100,6 +114,11 @@ destDirOpt = anArg "destdir" "path to write output to" "DIR" outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a } + +verbosityOpt = anArg "verbosity" "verbosity level, 0-2" "[0-2]" + (\ a f -> f { verbosity = verbosityFromString a }) + . infoArg "default 1" + -- markup perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True } diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index c294b6a..1373bfb 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -32,6 +32,7 @@ markup_options . funTotalsOpt . altHighlightOpt . destDirOpt + . verbosityOpt markup_plugin :: Plugin markup_plugin = Plugin { name = "markup" @@ -76,7 +77,8 @@ markup_main flags (prog:modNames) = do let writeSummary filename cmp = do let mods' = sortBy cmp mods - putStrLn $ "Writing: " ++ (filename ++ ".html") + unless (verbosity flags < Normal) $ + putStrLn $ "Writing: " ++ (filename ++ ".html") writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ "" ++ @@ -223,7 +225,8 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do let addLine n xs = "" ++ padLeft 5 ' ' (show n) ++ " " ++ xs let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines let fileName = modName0 ++ ".hs.html" - putStrLn $ "Writing: " ++ fileName + unless (verbosity flags < Normal) $ + putStrLn $ "Writing: " ++ fileName writeFileUsing (dest_dir ++ "/" ++ fileName) $ unlines ["", "", diff --git a/utils/hpc/HpcOverlay.hs b/utils/hpc/HpcOverlay.hs index 531018c..c4f8e96 100644 --- a/utils/hpc/HpcOverlay.hs +++ b/utils/hpc/HpcOverlay.hs @@ -15,6 +15,7 @@ overlay_options . hpcDirOpt . resetHpcDirsOpt . outputOpt + . verbosityOpt overlay_plugin :: Plugin overlay_plugin = Plugin { name = "overlay" diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs index a97d6b0..4c975be 100644 --- a/utils/hpc/HpcReport.hs +++ b/utils/hpc/HpcReport.hs @@ -274,5 +274,6 @@ report_options . hpcDirOpt . resetHpcDirsOpt . xmlOutputOpt + . verbosityOpt diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs index 13a2875..f0c628e 100644 --- a/utils/hpc/HpcShowTix.hs +++ b/utils/hpc/HpcShowTix.hs @@ -15,6 +15,7 @@ showtix_options . hpcDirOpt . resetHpcDirsOpt . outputOpt + . verbosityOpt showtix_plugin :: Plugin showtix_plugin = Plugin { name = "show" From git at git.haskell.org Mon Feb 23 11:35:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:35:43 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: docs: Update release notes (d4a04dd) Message-ID: <20150223113543.84BC53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d4a04dde331f23c5de15c174983efc79b686900f/ghc >--------------------------------------------------------------- commit d4a04dde331f23c5de15c174983efc79b686900f Author: Austin Seipp Date: Mon Feb 23 05:37:42 2015 -0600 docs: Update release notes Signed-off-by: Austin Seipp >--------------------------------------------------------------- d4a04dde331f23c5de15c174983efc79b686900f docs/users_guide/7.10.1-notes.xml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 40f9e45..1bb5a5a 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -721,6 +721,13 @@ echo "[]" > package.conf Version number 0.6.0.2 (was 0.6.0.1) + + + The hpc command supports a new + flag, --verbosity=n, which + controls the verbosity level of subcommands. + + From git at git.haskell.org Mon Feb 23 11:46:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:46:19 +0000 (UTC) Subject: [commit: ghc] master: Fix build bogons due to missing separator (9004f0d) Message-ID: <20150223114619.C8C1E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9004f0d267613b9989fc2f3313c0bd64936103cd/ghc >--------------------------------------------------------------- commit 9004f0d267613b9989fc2f3313c0bd64936103cd Author: Austin Seipp Date: Mon Feb 23 05:48:15 2015 -0600 Fix build bogons due to missing separator Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9004f0d267613b9989fc2f3313c0bd64936103cd ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc.mk b/ghc.mk index aa29171..18ead9c 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1108,7 +1108,7 @@ SRC_DIST_GHC_DIRS = mk rules docs distrib bindisttest libffi includes \ utils docs rts compiler ghc driver libraries libffi-tarballs SRC_DIST_GHC_FILES += \ configure.ac config.guess config.sub configure \ - aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile + aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile \ install-sh settings.in VERSION GIT_COMMIT_ID \ boot packages ghc.mk MAKEHELP.md From git at git.haskell.org Mon Feb 23 11:46:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 11:46:34 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix build bogons due to missing separator (528b503) Message-ID: <20150223114634.D92D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/528b503ad7beacad9d35de99cc27cb6074794b71/ghc >--------------------------------------------------------------- commit 528b503ad7beacad9d35de99cc27cb6074794b71 Author: Austin Seipp Date: Mon Feb 23 05:48:15 2015 -0600 Fix build bogons due to missing separator Signed-off-by: Austin Seipp (cherry picked from commit 9004f0d267613b9989fc2f3313c0bd64936103cd) >--------------------------------------------------------------- 528b503ad7beacad9d35de99cc27cb6074794b71 ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc.mk b/ghc.mk index aa29171..18ead9c 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1108,7 +1108,7 @@ SRC_DIST_GHC_DIRS = mk rules docs distrib bindisttest libffi includes \ utils docs rts compiler ghc driver libraries libffi-tarballs SRC_DIST_GHC_FILES += \ configure.ac config.guess config.sub configure \ - aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile + aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile \ install-sh settings.in VERSION GIT_COMMIT_ID \ boot packages ghc.mk MAKEHELP.md From git at git.haskell.org Mon Feb 23 12:36:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 12:36:35 +0000 (UTC) Subject: [commit: ghc] master: base: Fix (**) implementation for Data.Complex (4f467b2) Message-ID: <20150223123635.BC73A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f467b2e57ee3060d158a6505873df8c75b38c5c/ghc >--------------------------------------------------------------- commit 4f467b2e57ee3060d158a6505873df8c75b38c5c Author: Alexander Date: Mon Feb 23 05:44:33 2015 -0600 base: Fix (**) implementation for Data.Complex See the extensive discussion in #8539. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4f467b2e57ee3060d158a6505873df8c75b38c5c libraries/base/Data/Complex.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs index 1c06d46..ecd8301 100644 --- a/libraries/base/Data/Complex.hs +++ b/libraries/base/Data/Complex.hs @@ -140,6 +140,22 @@ instance (RealFloat a) => Floating (Complex a) where where expx = exp x log z = log (magnitude z) :+ phase z + x ** y = case (x,y) of + (_ , (0:+0)) -> 1 :+ 0 + ((0:+0), (exp_re:+_)) -> case compare exp_re 0 of + GT -> 0 :+ 0 + LT -> inf :+ 0 + EQ -> nan :+ nan + ((re:+im), (exp_re:+_)) + | (isInfinite re || isInfinite im) -> case compare exp_re 0 of + GT -> inf :+ 0 + LT -> 0 :+ 0 + EQ -> nan :+ nan + | otherwise -> exp (log x * y) + where + inf = 1/0 + nan = 0/0 + sqrt (0:+0) = 0 sqrt z@(x:+y) = u :+ (if y < 0 then -v else v) where (u,v) = if x < 0 then (v',u') else (u',v') From git at git.haskell.org Mon Feb 23 12:40:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 12:40:57 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Improve documentation of 'trace' (d67b784) Message-ID: <20150223124057.259003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d67b7842548209b5d0f6bc04afab84c84adbe70c/ghc >--------------------------------------------------------------- commit d67b7842548209b5d0f6bc04afab84c84adbe70c Author: Simon Peyton Jones Date: Fri Feb 13 23:10:18 2015 +0000 Improve documentation of 'trace' See Trac #9795. (cherry picked from commit 7fdded4ed7e670e0c83d312b56a59b36c52913c9) >--------------------------------------------------------------- d67b7842548209b5d0f6bc04afab84c84adbe70c libraries/base/Debug/Trace.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index 389eb19..c81abbf 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -102,6 +102,10 @@ For example, this returns the value of @f x@ but first outputs the message. > trace ("calling f with x = " ++ show x) (f x) +The 'trace' function evaluates the message (i.e. the first argument) completely +before printing it; so if the message is not fully defined, none of it +will be printed. + The 'trace' function should /only/ be used for debugging, or for monitoring execution. The function is not referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the From git at git.haskell.org Mon Feb 23 12:41:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 12:41:00 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Move comments about evaluating the message to the top of the module (35a0b67) Message-ID: <20150223124100.062843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/35a0b67dc284f8dca47089538c9ee68b06dc6f39/ghc >--------------------------------------------------------------- commit 35a0b67dc284f8dca47089538c9ee68b06dc6f39 Author: Simon Peyton Jones Date: Sun Feb 15 20:22:57 2015 +0000 Move comments about evaluating the message to the top of the module The remarks apply equally to all the functions here (Trac #9795) (cherry picked from commit 6fa285d77bba2d391b5d2b3c3abe1f19d298483c) >--------------------------------------------------------------- 35a0b67dc284f8dca47089538c9ee68b06dc6f39 libraries/base/Debug/Trace.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index c81abbf..47abcae 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -60,7 +60,11 @@ import Data.List -- The 'trace', 'traceShow' and 'traceIO' functions print messages to an output -- stream. They are intended for \"printf debugging\", that is: tracing the flow -- of execution and printing interesting values. - +-- +-- All these functions evaluate the message completely before printing +-- it; so if the message is not fully defined, none of it will be +-- printed. +-- -- The usual output stream is 'System.IO.stderr'. For Windows GUI applications -- (that have no stderr) the output is directed to the Windows debug console. -- Some implementations of these functions may decorate the string that\'s @@ -102,10 +106,6 @@ For example, this returns the value of @f x@ but first outputs the message. > trace ("calling f with x = " ++ show x) (f x) -The 'trace' function evaluates the message (i.e. the first argument) completely -before printing it; so if the message is not fully defined, none of it -will be printed. - The 'trace' function should /only/ be used for debugging, or for monitoring execution. The function is not referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the From git at git.haskell.org Mon Feb 23 12:44:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 12:44:34 +0000 (UTC) Subject: [commit: ghc] master: Provide a faster implementation for the Read Integer instance (a5a4c25) Message-ID: <20150223124434.E11313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a5a4c25626e11e8b4be6687a9af8cfc85a77e9ba/ghc >--------------------------------------------------------------- commit a5a4c25626e11e8b4be6687a9af8cfc85a77e9ba Author: Marios Titas Date: Mon Feb 23 06:46:25 2015 -0600 Provide a faster implementation for the Read Integer instance Summary: The current implementation of the Read Integer instance has quadratic complexity and thus performs badly on large inputs. This patch provides a rather simple sub-quadratic algorithm. For small inputs, we use the old algorithm (there is a small penalty for that). The gains for large inputs can be dramatic: on my system, the time to perform read (take 1000000 $ cycle "1234567890") :: Integer drops from 65 seconds to less than a second. Note that we already provide an ad-hoc instance for Show Integer, so this patch essentially does the same thing for Read Integer. Test Plan: Check that read :: String -> Integer returns correct results for inputs of various sizes. Reviewers: austin, hvr Reviewed By: austin, hvr Subscribers: ekmett, thomie Differential Revision: https://phabricator.haskell.org/D645 GHC Trac Issues: #10067 >--------------------------------------------------------------- a5a4c25626e11e8b4be6687a9af8cfc85a77e9ba libraries/base/Text/Read/Lex.hs | 81 +++++++++++++++++++++++++++++++---------- 1 file changed, 61 insertions(+), 20 deletions(-) diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs index 2e682ff..d7d6547 100644 --- a/libraries/base/Text/Read/Lex.hs +++ b/libraries/base/Text/Read/Lex.hs @@ -40,8 +40,8 @@ import GHC.Char import GHC.Num( Num(..), Integer ) import GHC.Show( Show(..) ) import GHC.Unicode( isSpace, isAlpha, isAlphaNum ) -import GHC.Real( Rational, (%), fromIntegral, - toInteger, (^) ) +import GHC.Real( Rational, (%), fromIntegral, Integral, + toInteger, (^), quot, even ) import GHC.List import GHC.Enum( minBound, maxBound ) import Data.Maybe @@ -77,17 +77,17 @@ data Number = MkNumber Int -- Base -- | @since 4.5.1.0 numberToInteger :: Number -> Maybe Integer -numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart) -numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart) +numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) iPart) +numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 iPart) numberToInteger _ = Nothing -- | @since 4.7.0.0 numberToFixed :: Integer -> Number -> Maybe (Integer, Integer) -numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart, 0) -numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart, 0) +numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) iPart, 0) +numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 iPart, 0) numberToFixed p (MkDecimal iPart (Just fPart) Nothing) - = let i = val 10 0 iPart - f = val 10 0 (integerTake p (fPart ++ repeat 0)) + = let i = val 10 iPart + f = val 10 (integerTake p (fPart ++ repeat 0)) -- Sigh, we really want genericTake, but that's above us in -- the hierarchy, so we define our own version here (actually -- specialised to Integer) @@ -141,9 +141,9 @@ numberToRangedRational _ n = Just (numberToRational n) -- | @since 4.6.0.0 numberToRational :: Number -> Rational -numberToRational (MkNumber base iPart) = val (fromIntegral base) 0 iPart % 1 +numberToRational (MkNumber base iPart) = val (fromIntegral base) iPart % 1 numberToRational (MkDecimal iPart mFPart mExp) - = let i = val 10 0 iPart + = let i = val 10 iPart in case (mFPart, mExp) of (Nothing, Nothing) -> i % 1 (Nothing, Just exp) @@ -450,14 +450,50 @@ lexDigits base = lexInteger :: Base -> ReadP Integer lexInteger base = do xs <- lexDigits base - return (val (fromIntegral base) 0 xs) - -val :: Num a => a -> a -> Digits -> a --- val base y [d1,..,dn] = y ++ [d1,..,dn], as it were -val _ y [] = y -val base y (x:xs) = y' `seq` val base y' xs - where - y' = y * base + fromIntegral x + return (val (fromIntegral base) xs) + +val :: Num a => a -> Digits -> a +val = valSimple +{-# RULES +"val/Integer" val = valInteger + #-} +{-# INLINE [1] val #-} + +-- The following algorithm is only linear for types whose Num operations +-- are in constant time. +valSimple :: (Num a, Integral d) => a -> [d] -> a +valSimple base = go 0 + where + go r [] = r + go r (d : ds) = r' `seq` go r' ds + where + r' = r * base + fromIntegral d +{-# INLINE valSimple #-} + +-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b +-- digits are combined into a single radix b^2 digit. This process is +-- repeated until we are left with a single digit. This algorithm +-- performs well only on large inputs, so we use the simple algorithm +-- for smaller inputs. +valInteger :: Integer -> Digits -> Integer +valInteger b0 ds0 = go b0 (length ds0) $ map fromIntegral ds0 + where + go _ _ [] = 0 + go _ _ [d] = d + go b l ds + | l > 40 = b' `seq` go b' l' (combine b ds') + | otherwise = valSimple b ds + where + -- ensure that we have an even number of digits + -- before we call combine: + ds' = if even l then ds else 0 : ds + b' = b * b + l' = (l + 1) `quot` 2 + combine b (d1 : d2 : ds) = d `seq` (d : combine b ds) + where + d = d1 * b + d2 + combine _ [] = [] + combine _ [_] = error "this should not happen" -- Calculate a Rational from the exponent [of 10 to multiply with], -- the integral part of the mantissa and the digits of the fractional @@ -502,16 +538,21 @@ valDecDig c readIntP :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a readIntP base isDigit valDigit = do s <- munch1 isDigit - return (val base 0 (map valDigit s)) + return (val base (map valDigit s)) +{-# SPECIALISE readIntP + :: Integer -> (Char -> Bool) -> (Char -> Int) -> ReadP Integer #-} readIntP' :: (Eq a, Num a) => a -> ReadP a readIntP' base = readIntP base isDigit valDigit where isDigit c = maybe False (const True) (valDig base c) valDigit c = maybe 0 id (valDig base c) +{-# SPECIALISE readIntP' :: Integer -> ReadP Integer #-} readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a readOctP = readIntP' 8 readDecP = readIntP' 10 readHexP = readIntP' 16 - +{-# SPECIALISE readOctP :: ReadP Integer #-} +{-# SPECIALISE readDecP :: ReadP Integer #-} +{-# SPECIALISE readHexP :: ReadP Integer #-} From git at git.haskell.org Mon Feb 23 12:47:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 12:47:36 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Provide a faster implementation for the Read Integer instance (0e0a0b4) Message-ID: <20150223124736.309973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/0e0a0b4c9b2bd79f675014769e1a4777fc0e96f4/ghc >--------------------------------------------------------------- commit 0e0a0b4c9b2bd79f675014769e1a4777fc0e96f4 Author: Marios Titas Date: Mon Feb 23 06:46:25 2015 -0600 Provide a faster implementation for the Read Integer instance Summary: The current implementation of the Read Integer instance has quadratic complexity and thus performs badly on large inputs. This patch provides a rather simple sub-quadratic algorithm. For small inputs, we use the old algorithm (there is a small penalty for that). The gains for large inputs can be dramatic: on my system, the time to perform read (take 1000000 $ cycle "1234567890") :: Integer drops from 65 seconds to less than a second. Note that we already provide an ad-hoc instance for Show Integer, so this patch essentially does the same thing for Read Integer. Test Plan: Check that read :: String -> Integer returns correct results for inputs of various sizes. Reviewers: austin, hvr Reviewed By: austin, hvr Subscribers: ekmett, thomie Differential Revision: https://phabricator.haskell.org/D645 GHC Trac Issues: #10067 (cherry picked from commit a5a4c25626e11e8b4be6687a9af8cfc85a77e9ba) >--------------------------------------------------------------- 0e0a0b4c9b2bd79f675014769e1a4777fc0e96f4 libraries/base/Text/Read/Lex.hs | 81 +++++++++++++++++++++++++++++++---------- 1 file changed, 61 insertions(+), 20 deletions(-) diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs index 2e682ff..d7d6547 100644 --- a/libraries/base/Text/Read/Lex.hs +++ b/libraries/base/Text/Read/Lex.hs @@ -40,8 +40,8 @@ import GHC.Char import GHC.Num( Num(..), Integer ) import GHC.Show( Show(..) ) import GHC.Unicode( isSpace, isAlpha, isAlphaNum ) -import GHC.Real( Rational, (%), fromIntegral, - toInteger, (^) ) +import GHC.Real( Rational, (%), fromIntegral, Integral, + toInteger, (^), quot, even ) import GHC.List import GHC.Enum( minBound, maxBound ) import Data.Maybe @@ -77,17 +77,17 @@ data Number = MkNumber Int -- Base -- | @since 4.5.1.0 numberToInteger :: Number -> Maybe Integer -numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart) -numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart) +numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) iPart) +numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 iPart) numberToInteger _ = Nothing -- | @since 4.7.0.0 numberToFixed :: Integer -> Number -> Maybe (Integer, Integer) -numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart, 0) -numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart, 0) +numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) iPart, 0) +numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 iPart, 0) numberToFixed p (MkDecimal iPart (Just fPart) Nothing) - = let i = val 10 0 iPart - f = val 10 0 (integerTake p (fPart ++ repeat 0)) + = let i = val 10 iPart + f = val 10 (integerTake p (fPart ++ repeat 0)) -- Sigh, we really want genericTake, but that's above us in -- the hierarchy, so we define our own version here (actually -- specialised to Integer) @@ -141,9 +141,9 @@ numberToRangedRational _ n = Just (numberToRational n) -- | @since 4.6.0.0 numberToRational :: Number -> Rational -numberToRational (MkNumber base iPart) = val (fromIntegral base) 0 iPart % 1 +numberToRational (MkNumber base iPart) = val (fromIntegral base) iPart % 1 numberToRational (MkDecimal iPart mFPart mExp) - = let i = val 10 0 iPart + = let i = val 10 iPart in case (mFPart, mExp) of (Nothing, Nothing) -> i % 1 (Nothing, Just exp) @@ -450,14 +450,50 @@ lexDigits base = lexInteger :: Base -> ReadP Integer lexInteger base = do xs <- lexDigits base - return (val (fromIntegral base) 0 xs) - -val :: Num a => a -> a -> Digits -> a --- val base y [d1,..,dn] = y ++ [d1,..,dn], as it were -val _ y [] = y -val base y (x:xs) = y' `seq` val base y' xs - where - y' = y * base + fromIntegral x + return (val (fromIntegral base) xs) + +val :: Num a => a -> Digits -> a +val = valSimple +{-# RULES +"val/Integer" val = valInteger + #-} +{-# INLINE [1] val #-} + +-- The following algorithm is only linear for types whose Num operations +-- are in constant time. +valSimple :: (Num a, Integral d) => a -> [d] -> a +valSimple base = go 0 + where + go r [] = r + go r (d : ds) = r' `seq` go r' ds + where + r' = r * base + fromIntegral d +{-# INLINE valSimple #-} + +-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b +-- digits are combined into a single radix b^2 digit. This process is +-- repeated until we are left with a single digit. This algorithm +-- performs well only on large inputs, so we use the simple algorithm +-- for smaller inputs. +valInteger :: Integer -> Digits -> Integer +valInteger b0 ds0 = go b0 (length ds0) $ map fromIntegral ds0 + where + go _ _ [] = 0 + go _ _ [d] = d + go b l ds + | l > 40 = b' `seq` go b' l' (combine b ds') + | otherwise = valSimple b ds + where + -- ensure that we have an even number of digits + -- before we call combine: + ds' = if even l then ds else 0 : ds + b' = b * b + l' = (l + 1) `quot` 2 + combine b (d1 : d2 : ds) = d `seq` (d : combine b ds) + where + d = d1 * b + d2 + combine _ [] = [] + combine _ [_] = error "this should not happen" -- Calculate a Rational from the exponent [of 10 to multiply with], -- the integral part of the mantissa and the digits of the fractional @@ -502,16 +538,21 @@ valDecDig c readIntP :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a readIntP base isDigit valDigit = do s <- munch1 isDigit - return (val base 0 (map valDigit s)) + return (val base (map valDigit s)) +{-# SPECIALISE readIntP + :: Integer -> (Char -> Bool) -> (Char -> Int) -> ReadP Integer #-} readIntP' :: (Eq a, Num a) => a -> ReadP a readIntP' base = readIntP base isDigit valDigit where isDigit c = maybe False (const True) (valDig base c) valDigit c = maybe 0 id (valDig base c) +{-# SPECIALISE readIntP' :: Integer -> ReadP Integer #-} readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a readOctP = readIntP' 8 readDecP = readIntP' 10 readHexP = readIntP' 16 - +{-# SPECIALISE readOctP :: ReadP Integer #-} +{-# SPECIALISE readDecP :: ReadP Integer #-} +{-# SPECIALISE readHexP :: ReadP Integer #-} From git at git.haskell.org Mon Feb 23 14:09:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 14:09:09 +0000 (UTC) Subject: [commit: ghc] master: testsuite: update .gitignore (d1d02e8) Message-ID: <20150223140909.7E7933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1d02e8067745f5e553408252743586fcc76b385/ghc >--------------------------------------------------------------- commit d1d02e8067745f5e553408252743586fcc76b385 Author: Austin Seipp Date: Mon Feb 23 08:07:44 2015 -0600 testsuite: update .gitignore Signed-off-by: Austin Seipp >--------------------------------------------------------------- d1d02e8067745f5e553408252743586fcc76b385 testsuite/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 362c5a1..27ecc02 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1544,3 +1544,4 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk /timeout/calibrate.out /timeout/dist/ /timeout/install-inplace/ +/tests/driver/T7373/package.conf.d/ From git at git.haskell.org Mon Feb 23 14:23:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 14:23:01 +0000 (UTC) Subject: [commit: ghc] master: System.IO.Error: Fix a documentation link to Control.Exception.Exception (bb3b71a) Message-ID: <20150223142301.B01B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb3b71a02483bd119cd3fd9b7c4235681b92619f/ghc >--------------------------------------------------------------- commit bb3b71a02483bd119cd3fd9b7c4235681b92619f Author: Wieland Hoffmann Date: Mon Jan 5 16:44:30 2015 +0100 System.IO.Error: Fix a documentation link to Control.Exception.Exception Instead of using double quotes (which are used to link to modules), use single quotes (that are used to link, among others, to link to types, which C.E.Exception is). Signed-off-by: Austin Seipp >--------------------------------------------------------------- bb3b71a02483bd119cd3fd9b7c4235681b92619f libraries/base/GHC/IO/Exception.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index ed8c802..e9a32b6 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -246,7 +246,7 @@ ioError = ioException -- | The Haskell 2010 type for exceptions in the 'IO' monad. -- Any I\/O operation may raise an 'IOError' instead of returning a result. -- For a more general type of exception, including also those that arise --- in pure code, see "Control.Exception.Exception". +-- in pure code, see 'Control.Exception.Exception'. -- -- In Haskell 2010, this is an opaque type. type IOError = IOException From git at git.haskell.org Mon Feb 23 14:44:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 14:44:54 +0000 (UTC) Subject: [commit: ghc] master: Comment typo (26a85bd) Message-ID: <20150223144454.974693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/26a85bd8a84df9ac68d011603ad01f4e4dbd1364/ghc >--------------------------------------------------------------- commit 26a85bd8a84df9ac68d011603ad01f4e4dbd1364 Author: Joachim Breitner Date: Mon Feb 23 15:45:59 2015 +0100 Comment typo and reference to long-removed note in CallArity.hs >--------------------------------------------------------------- 26a85bd8a84df9ac68d011603ad01f4e4dbd1364 compiler/simplCore/CallArity.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 7bfd2f5..36a8b96 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -150,7 +150,7 @@ The interesting cases of the analysis: Return (alt? ? alt? ?...) * App e? e? (and analogously Case scrut alts): We get the results from both sides. Additionally, anything called by e? can - possibly called with anything from e?. + possibly be called with anything from e?. Return: C(e?) ? C(e?) ? (fv e?) ? (fv e?) * Let v = rhs in body: In addition to the results from the subexpressions, add all co-calls from @@ -443,7 +443,6 @@ callArityAnal arity int (App e1 e2) where (ae1, e1') = callArityAnal (arity + 1) int e1 (ae2, e2') = callArityAnal 0 int e2 - -- See Note [Case and App: Which side to take?] final_ae = ae1 `both` ae2 -- Case expression. @@ -457,7 +456,6 @@ callArityAnal arity int (Case scrut bndr ty alts) in (ae, (dc, bndrs, e')) alt_ae = lubRess alt_aes (scrut_ae, scrut') = callArityAnal 0 int scrut - -- See Note [Case and App: Which side to take?] final_ae = scrut_ae `both` alt_ae -- For lets, use callArityBind From git at git.haskell.org Mon Feb 23 14:52:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 14:52:07 +0000 (UTC) Subject: [commit: ghc] master: driver: split -fwarn-unused-binds into 3 flags (fixes #17) (aead019) Message-ID: <20150223145207.CA9F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aead01902e1c41e85b758dbafd15e60d08956374/ghc >--------------------------------------------------------------- commit aead01902e1c41e85b758dbafd15e60d08956374 Author: Oleg Grenrus Date: Mon Feb 23 08:51:28 2015 -0600 driver: split -fwarn-unused-binds into 3 flags (fixes #17) Summary: New flags: -fwarn-unused-top-binds -fwarn-unused-local-binds -fwarn-unused-pattern-binds Test Plan: `tests/rename/should_compile/T17` tests Correct other tests Reviewers: austin, rwbarton Reviewed By: austin, rwbarton Subscribers: rwbarton, carter, thomie Differential Revision: https://phabricator.haskell.org/D591 GHC Trac Issues: #17 >--------------------------------------------------------------- aead01902e1c41e85b758dbafd15e60d08956374 compiler/main/DynFlags.hs | 27 +++++++++-- compiler/main/InteractiveEval.hs | 4 +- compiler/rename/RnBinds.hs | 2 +- compiler/rename/RnEnv.hs | 4 +- docs/users_guide/flags.xml | 26 +++++++++- docs/users_guide/using.xml | 59 ++++++++++++++++++----- testsuite/tests/rename/should_compile/T17a.hs | 18 +++++++ testsuite/tests/rename/should_compile/T17a.stderr | 1 + testsuite/tests/rename/should_compile/T17b.hs | 18 +++++++ testsuite/tests/rename/should_compile/T17b.stderr | 1 + testsuite/tests/rename/should_compile/T17c.hs | 18 +++++++ testsuite/tests/rename/should_compile/T17c.stderr | 1 + testsuite/tests/rename/should_compile/T17d.hs | 18 +++++++ testsuite/tests/rename/should_compile/T17d.stderr | 1 + testsuite/tests/rename/should_compile/T17e.hs | 18 +++++++ testsuite/tests/rename/should_compile/T17e.stderr | 7 +++ testsuite/tests/rename/should_compile/all.T | 6 +++ testsuite/tests/rename/should_compile/rn040.hs | 0 18 files changed, 208 insertions(+), 21 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc aead01902e1c41e85b758dbafd15e60d08956374 From git at git.haskell.org Mon Feb 23 22:21:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Feb 2015 22:21:40 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Probably fixed the data family issue (e44c631) Message-ID: <20150223222140.51A3C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/e44c63196b6351261e0c734be134c8bcdee6e9ac/ghc >--------------------------------------------------------------- commit e44c63196b6351261e0c734be134c8bcdee6e9ac Author: George Karachalias Date: Mon Feb 23 23:23:31 2015 +0100 Probably fixed the data family issue >--------------------------------------------------------------- e44c63196b6351261e0c734be134c8bcdee6e9ac compiler/basicTypes/Var.hs | 2 +- compiler/deSugar/Check.hs | 43 ++++++++++++++++++++++++++++--------------- 2 files changed, 29 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs index cd26f48..d121793 100644 --- a/compiler/basicTypes/Var.hs +++ b/compiler/basicTypes/Var.hs @@ -205,7 +205,7 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds -} instance Outputable Var where - ppr var = ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) + ppr var = parens $ ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) <+> dcolon <+> ppr (varType var) ppr_debug :: Var -> PprStyle -> SDoc ppr_debug (TyVar {}) sty diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index fa335bd..ec852ff 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -52,6 +52,7 @@ import MonadUtils -- MonadIO import TcRnTypes (pprInTcRnIf) import Var (varType) +import Type {- This module checks pattern matches for: @@ -549,20 +550,26 @@ inferTyPmPat (PmVarPat ty _) = return (ty, emptyBag) -- instTypePmM ty >>= \ty' inferTyPmPat (PmLitPat ty _) = return (ty, emptyBag) inferTyPmPat (PmLitCon ty _) = return (ty, emptyBag) inferTyPmPat (PmConPat con args) = do + -- ---------------------------------------------------------------- + pprInTcRnIf (ptext (sLit "Iferring type for pattern:") <+> ppr (PmConPat con args)) + pprInTcRnIf (ptext (sLit "dataConUserType =") <+> ppr (dataConUserType con)) + pprInTcRnIf (ptext (sLit "dataConSig =") <+> ppr (dataConSig con)) + -- ---------------------------------------------------------------- (tys, cs) <- inferTyPmPats args -- Infer argument types and respective constraints (Just like the paper) - subst <- mkConSigSubst con -- Create the substitution theta (Just like the paper) - let tycon = dataConTyCon con -- JUST A TEST dataConOrigTyCon con -- Type constructor - arg_tys = substTys subst (dataConOrigArgTys con) -- Argument types - univ_tys = substTyVars subst (dataConUnivTyVars con) -- Universal variables (to instantiate tycon) - tau = mkTyConApp tycon univ_tys -- Type of the pattern - - pprInTcRnIf (ptext (sLit "pattern:") <+> ppr (PmConPat con args) <+> ptext (sLit "has univ tys length:") <+> ppr (length univ_tys)) - con_thetas <- mapM (nameType "varcon") $ substTheta subst (dataConTheta con) -- Constraints from the constructor signature - eq_thetas <- foldM (\acc (ty1, ty2) -> do - eq_theta <- newEqPmM ty1 ty2 - return (eq_theta `consBag` acc)) - cs (tys `zip` arg_tys) - return (tau, listToBag con_thetas `unionBags` eq_thetas) + + let (tvs, thetas', arg_tys', res_ty') = dataConSig con -- take apart the constructor + tkvs = varSetElemsKvsFirst (closeOverKinds (mkVarSet tvs)) -- as, bs and their kinds + (subst, _tvs) <- -- create the substitution for both as and bs + getSrcSpanDs >>= \loc -> genInstSkolTyVars loc tkvs + let res_ty = substTy subst res_ty' -- result type + arg_tys = substTys subst arg_tys' + thetas <- mapM (nameType "varcon") $ substTheta subst thetas' + + arg_thetas <- foldM (\acc (ty1, ty2) -> do + eq_theta <- newEqPmM ty1 ty2 + return (eq_theta `consBag` acc)) + cs (tys `zip` arg_tys) -- All thetas from the argument patterns and tau_i ~ t_i for all arguments + return (res_ty, listToBag thetas `unionBags` arg_thetas) inferTyPmPats :: [PmPat Id] -> PmM ([Type], Bag EvVar) inferTyPmPats pats = do @@ -581,8 +588,9 @@ wt sig (_, vec) env_cs <- getDictsDs loc <- getSrcSpanDs pprInTcRnIf (ptext (sLit "Checking in location:") <+> ppr loc) - pprInTcRnIf (ptext (sLit "Checking vector") <+> ppr vec <+> ptext (sLit "with inferred type:") <+> ppr tys) - pprInTcRnIf (ptext (sLit "With given signature:") <+> ppr sig) + pprInTcRnIf (ptext (sLit "Checking vector") <+> ppr vec <+> ptext (sLit "with inferred type:") <+> + sep (punctuate comma (map pprTyWithKind tys))) + pprInTcRnIf (ptext (sLit "With given signature:") <+> sep (punctuate comma (map pprTyWithKind sig))) let constraints = listToBag cs' `unionBags` cs `unionBags` env_cs pprInTcRnIf (ptext (sLit "Constraints:") <+> ppr (mapBag varType constraints)) isSatisfiable constraints @@ -766,3 +774,8 @@ To check this match, we should perform arbitrary computations at compile time returning a @Nothing at . -} + +-- +pprTyWithKind :: Type -> SDoc +pprTyWithKind ty = parens (ppr ty <+> dcolon <+> pprKind (typeKind ty)) + From git at git.haskell.org Tue Feb 24 08:57:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:57:43 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Typo in comment (3703886) Message-ID: <20150224085743.A26B03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/37038867cb1ad0bc0c06d4f1f19f32babee59b6b/ghc >--------------------------------------------------------------- commit 37038867cb1ad0bc0c06d4f1f19f32babee59b6b Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:04:47 2015 +0000 Typo in comment >--------------------------------------------------------------- 37038867cb1ad0bc0c06d4f1f19f32babee59b6b compiler/main/HscTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 2f63530..28039ea 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1684,7 +1684,7 @@ implicitTyConThings tc implicitCoTyCon tc ++ -- for each data constructor in order, - -- the contructor, worker, and (possibly) wrapper + -- the constructor, worker, and (possibly) wrapper concatMap (extras_plus . AConLike . RealDataCon) (tyConDataCons tc) -- NB. record selectors are *not* implicit, they have fully-fledged -- bindings that pass through the compilation pipeline as normal. From git at git.haskell.org Tue Feb 24 08:57:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:57:46 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Typo in comment (d92762f) Message-ID: <20150224085746.4646F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/d92762f5d3ca9957ebb1fb52909535adc144dc39/ghc >--------------------------------------------------------------- commit d92762f5d3ca9957ebb1fb52909535adc144dc39 Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:06:10 2015 +0000 Typo in comment >--------------------------------------------------------------- d92762f5d3ca9957ebb1fb52909535adc144dc39 compiler/typecheck/Inst.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index b82a70c..3188a09 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -63,7 +63,7 @@ import Data.Maybe( isJust ) {- ************************************************************************ * * - Creating and emittind constraints + Creating and emitting constraints * * ************************************************************************ -} From git at git.haskell.org Tue Feb 24 08:57:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:57:51 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Whitespace only (35061e3) Message-ID: <20150224085751.7362B3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/35061e3ca43bf03256106dc5b9e5c0c9df9e0d5f/ghc >--------------------------------------------------------------- commit 35061e3ca43bf03256106dc5b9e5c0c9df9e0d5f Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:05:51 2015 +0000 Whitespace only >--------------------------------------------------------------- 35061e3ca43bf03256106dc5b9e5c0c9df9e0d5f compiler/typecheck/Inst.hs | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Tue Feb 24 08:57:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:57:48 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Typos in comments (0086487) Message-ID: <20150224085748.D923E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/0086487906f0235b9f009afdfa67a7dadda7ac2a/ghc >--------------------------------------------------------------- commit 0086487906f0235b9f009afdfa67a7dadda7ac2a Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:09:02 2015 +0000 Typos in comments >--------------------------------------------------------------- 0086487906f0235b9f009afdfa67a7dadda7ac2a compiler/typecheck/TcDeriv.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 166d2f9..bbe2308 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -2125,13 +2125,13 @@ The 'deriving C' clause generates, in effect instance (C [a], Eq a) => C (N a) where f = coerce (f :: [a] -> [a]) -This generates a cast for each method, but allows the superclasse to +This generates a cast for each method, but allows the superclasses to be worked out in the usual way. In this case the superclass (Eq (N a)) will be solved by the explicit Eq (N a) instance. We do *not* create the superclasses by casting the superclass dictionaries for the representation type. -See the paper "Safe zero-cost coercions for Hsakell". +See the paper "Safe zero-cost coercions for Haskell". ************************************************************************ From git at git.haskell.org Tue Feb 24 08:57:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:57:54 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Whitespace only (2069999) Message-ID: <20150224085754.22E443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/20699994d0018b9c29714026b1e15c0bf861dfd3/ghc >--------------------------------------------------------------- commit 20699994d0018b9c29714026b1e15c0bf861dfd3 Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:11:08 2015 +0000 Whitespace only >--------------------------------------------------------------- 20699994d0018b9c29714026b1e15c0bf861dfd3 testsuite/tests/generics/GEq/GEq1A.hs | 0 testsuite/tests/generics/T5462Yes1.hs | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/generics/T5462Yes1.hs b/testsuite/tests/generics/T5462Yes1.hs index 3578529..b9a0933 100644 --- a/testsuite/tests/generics/T5462Yes1.hs +++ b/testsuite/tests/generics/T5462Yes1.hs @@ -5,7 +5,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveAnyClass #-} module Main where From git at git.haskell.org Tue Feb 24 08:57:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:57:56 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Make the implementation of DeriveAnyClass more robust (8e5f78d) Message-ID: <20150224085756.CAA3B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/8e5f78df14f1a54a9aae2d8d70d52ebb08aa4d95/ghc >--------------------------------------------------------------- commit 8e5f78df14f1a54a9aae2d8d70d52ebb08aa4d95 Author: Jose Pedro Magalhaes Date: Fri Feb 20 09:12:55 2015 +0000 Make the implementation of DeriveAnyClass more robust Let DeriveAnyClass properly handle multiparameter type classes. Also use a new strategy for inferring constraints for derived classes. This fixes #9968 and #9821. >--------------------------------------------------------------- 8e5f78df14f1a54a9aae2d8d70d52ebb08aa4d95 compiler/typecheck/TcDeriv.hs | 265 +++++++++++++++++++++++++----------- compiler/typecheck/TcGenDeriv.hs | 194 ++++++++++++-------------- compiler/typecheck/TcGenGenerics.hs | 93 ++++++++++--- 3 files changed, 345 insertions(+), 207 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8e5f78df14f1a54a9aae2d8d70d52ebb08aa4d95 From git at git.haskell.org Tue Feb 24 08:57:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:57:59 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Add a test for T9968, and improve T5462Yes1 (ef7da28) Message-ID: <20150224085759.BEFF73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/ef7da28a95b04ca138092fdbea5d6982e70a6c9d/ghc >--------------------------------------------------------------- commit ef7da28a95b04ca138092fdbea5d6982e70a6c9d Author: Jose Pedro Magalhaes Date: Thu Feb 19 18:00:58 2015 +0000 Add a test for T9968, and improve T5462Yes1 >--------------------------------------------------------------- ef7da28a95b04ca138092fdbea5d6982e70a6c9d testsuite/tests/generics/T5462Yes1.hs | 4 +- testsuite/tests/generics/T5462Yes1.stdout | 2 +- testsuite/tests/generics/all.T | 2 +- testsuite/tests/typecheck/should_compile/T9968.hs | 79 +++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 85 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/generics/T5462Yes1.hs b/testsuite/tests/generics/T5462Yes1.hs index b9a0933..254ba95 100644 --- a/testsuite/tests/generics/T5462Yes1.hs +++ b/testsuite/tests/generics/T5462Yes1.hs @@ -13,9 +13,10 @@ import GHC.Generics hiding (C, C1, D) import GEq1A import Enum import GFunctor +import GShow data A = A1 - deriving (Show, Generic, GEq, GEnum) + deriving (Show, Generic, GEq, GEnum, GShow) data B a = B1 | B2 a (B a) deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor) @@ -34,6 +35,7 @@ data E f a = E1 (f a) main = print ( geq A1 A1 , take 10 (genum :: [A]) + , gshow A1 , geq (B2 A1 B1) B1 , gmap (++ "lo") (B2 "hel" B1) diff --git a/testsuite/tests/generics/T5462Yes1.stdout b/testsuite/tests/generics/T5462Yes1.stdout index 6a2dc67..7aed256 100644 --- a/testsuite/tests/generics/T5462Yes1.stdout +++ b/testsuite/tests/generics/T5462Yes1.stdout @@ -1 +1 @@ -(True,[A1],False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"]) +(True,[A1],"A1",False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"]) diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T index c51de18..50894d6 100644 --- a/testsuite/tests/generics/all.T +++ b/testsuite/tests/generics/all.T @@ -20,7 +20,7 @@ test('GenCannotDoRep1_7', normal, compile_fail, ['']) test('GenCannotDoRep1_8', normal, compile_fail, ['']) test('T5462Yes1', extra_clean(['T5462Yes1/GFunctor.hi']) - , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -outputdir=out_T5462Yes1']) + , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -iGShow -outputdir=out_T5462Yes1']) test('T5462Yes2', extra_clean(['T5462Yes2/GFunctor.hi']) , multimod_compile_and_run, ['T5462Yes2', '-iGFunctor -outputdir=out_T5462Yes2']) test('T5462No1', extra_clean(['T5462No1/GFunctor.hi']) diff --git a/testsuite/tests/typecheck/should_compile/T9968.hs b/testsuite/tests/typecheck/should_compile/T9968.hs new file mode 100644 index 0000000..93a2907 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9968.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} + +module T9968 where + +import GHC.Generics ( Generic(..), Generic1(..), Rep, M1(..) ) + + +data D1 = D11 + deriving (C1, C8) + +newtype D2 = D21 Int + deriving (C1, C8) + +newtype D3 a = D31 a + deriving (Show, Foldable, C1, C2, C3 a, C5 Int, C8) + +data D4 a = D41 + deriving (Foldable, C2) + +data D5 a b = D51 a | D52 b + deriving (C9) + +data D6 f a = D61 (f a) + deriving (C1, C8) + +data D7 h f = D71 (h f) (f Int) + deriving (C1, C3 Int, C4) + +instance Show (D7 h f) where show = undefined + +data Proxy (t :: k) = Proxy + deriving (Foldable, C1, C2, C8) + + +class C1 a where + c11 :: a -> Int + c11 = undefined + +class Foldable f => C2 f where + c21 :: (Show a) => f a -> String + c21 = foldMap show + +class C3 a b where + c31 :: Read c => a -> b -> c + default c31 :: (Show a, Show b, Read c) => a -> b -> c + c31 a b = read (show a ++ show b) + +class C4 h where + c41 :: (f a -> f a) -> h f -> Int + c41 = undefined + +class C5 a f where + c51 :: f a -> Int + c51 = undefined + +class C6 a where + c61 :: a -> Int + default c61 :: (Generic a, C7 (Rep a)) => a -> Int + c61 = c71 . from + +-- trivial generic function that always returns 0 +class C7 f where c71 :: f p -> Int +instance C7 (M1 i c f) where c71 _ = 0 + +class C8 (a :: k) where + c81 :: Proxy a -> Int + c81 _ = 0 + +class C9 (h :: * -> * -> *) where + c91 :: h a b -> Int + c91 _ = 0 diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index c1ed579..848a373 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -438,6 +438,7 @@ test('T7643', normal, compile, ['']) test('T9834', normal, compile, ['']) test('T9892', normal, compile, ['']) test('T9939', normal, compile, ['']) +test('T9968', normal, compile, ['']) test('T9973', normal, compile, ['']) test('T9971', normal, compile, ['']) test('T9999', normal, compile, ['']) From git at git.haskell.org Tue Feb 24 08:58:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:58:02 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Minor change to the user's guide (66c352b) Message-ID: <20150224085802.624153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/66c352b000222b9878417db9080295d3b3971d16/ghc >--------------------------------------------------------------- commit 66c352b000222b9878417db9080295d3b3971d16 Author: Jose Pedro Magalhaes Date: Fri Feb 20 08:50:54 2015 +0000 Minor change to the user's guide >--------------------------------------------------------------- 66c352b000222b9878417db9080295d3b3971d16 docs/users_guide/glasgow_exts.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index f38e0d7..0184b98 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -4321,7 +4321,7 @@ the standard method is used or the one described here.) With you can derive any other class. The compiler will simply generate an empty instance. The instance context will be -generated according to the same rules used when deriving Eq. +generated by looking at the signatures for the default methods of the class. This is mostly useful in classes whose minimal set is empty, and especially when writing generic functions. From git at git.haskell.org Tue Feb 24 08:58:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:58:05 +0000 (UTC) Subject: [commit: ghc] wip/T9968: Accept new test output (5d101a4) Message-ID: <20150224085805.092A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9968 Link : http://ghc.haskell.org/trac/ghc/changeset/5d101a4de38c4fdd5797bdf855f8ab7a70612dc0/ghc >--------------------------------------------------------------- commit 5d101a4de38c4fdd5797bdf855f8ab7a70612dc0 Author: Jose Pedro Magalhaes Date: Fri Feb 20 08:59:59 2015 +0000 Accept new test output >--------------------------------------------------------------- 5d101a4de38c4fdd5797bdf855f8ab7a70612dc0 testsuite/tests/generics/GenDerivOutput.stderr | 58 ++++++------ testsuite/tests/generics/GenDerivOutput1_1.stderr | 106 +++++++++++----------- 2 files changed, 82 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 5d101a4de38c4fdd5797bdf855f8ab7a70612dc0 From git at git.haskell.org Tue Feb 24 08:58:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 08:58:07 +0000 (UTC) Subject: [commit: ghc] wip/T9968's head updated: Minor change to the user's guide (66c352b) Message-ID: <20150224085807.6B7BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9968' now includes: ef391f8 Comments only 3f30912 fix T7600 run on bigendian platform 10fab31 Don't report instance constraints with fundeps as redundant 9c78d09 Add a bizarre corner-case to cgExpr (Trac #9964) f3e5c30 Comments only 5f675e5 Comments only 5094719 Comments only 547c40a [ci skip] comment typo d4b6453 Unbreak travis by installing llvm-3.6 1f60d63 {Data,Generic(1),MonadZip} instances for Identity b2be772 fix bus errors on SPARC caused by unalignment access to alloc_limit (fixes #10043) 0fa2072 Error out on `Main` without `main` in GHCi (#7765) bbb57a6 Make top-level "configure" accept and propagate --with-curses-{includes,libraries} to libraries fd581a7 Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors 30dc59e Always ignore user-package-db when running tests a0ef626 Declare some Makefile targets to be PHONY a293925 rts/linker: ignore unknown PE sections 47175e0 Show '#' on unboxed literals 9a1c8d9 docs: add INSTALL.md to root dir (#9926) c3f9eb4 docs: Flatten MAKEHELP/SUBMAKEHELP 266fa70 base: fix broken link (#10088) 9004f0d Fix build bogons due to missing separator 4f467b2 base: Fix (**) implementation for Data.Complex a5a4c25 Provide a faster implementation for the Read Integer instance d1d02e8 testsuite: update .gitignore bb3b71a System.IO.Error: Fix a documentation link to Control.Exception.Exception 26a85bd Comment typo aead019 driver: split -fwarn-unused-binds into 3 flags (fixes #17) 3703886 Typo in comment d92762f Typo in comment 0086487 Typos in comments 2069999 Whitespace only 35061e3 Whitespace only 8e5f78d Make the implementation of DeriveAnyClass more robust ef7da28 Add a test for T9968, and improve T5462Yes1 5d101a4 Accept new test output 66c352b Minor change to the user's guide From git at git.haskell.org Tue Feb 24 09:13:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 09:13:30 +0000 (UTC) Subject: [commit: ghc] master: Emulate GMP 5+ operations for GMP 4.x compat (5be8ed4) Message-ID: <20150224091330.C73B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5be8ed4da1963ed2d45a65fb61d761c977707cce/ghc >--------------------------------------------------------------- commit 5be8ed4da1963ed2d45a65fb61d761c977707cce Author: Herbert Valerio Riedel Date: Sun Feb 22 17:50:07 2015 +0100 Emulate GMP 5+ operations for GMP 4.x compat The following operations are only (officially) available starting with GMP 5.0: - `mpn_and_n` - `mpn_andn_n` - `mpn_ior_n` - `mpn_xor_n` In order to properly support GMP 4.x, we simply emulate those operation in terms of `mpz_*` operations available in GMP 4.x (unless GMP>=5.x available, obviously) while incurring some overhead. Ideally, GMP 4.x environments will reach their EOL in the foreseeable future... This fixes #10003 Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D675 >--------------------------------------------------------------- 5be8ed4da1963ed2d45a65fb61d761c977707cce libraries/integer-gmp2/cbits/wrappers.c | 80 ++++++++++++++++++++++++++ libraries/integer-gmp2/src/GHC/Integer/Type.hs | 8 +-- 2 files changed, 84 insertions(+), 4 deletions(-) diff --git a/libraries/integer-gmp2/cbits/wrappers.c b/libraries/integer-gmp2/cbits/wrappers.c index 4b710dc..1736efd 100644 --- a/libraries/integer-gmp2/cbits/wrappers.c +++ b/libraries/integer-gmp2/cbits/wrappers.c @@ -750,3 +750,83 @@ integer_gmp_invert_word(const mp_limb_t x0, const mp_limb_t m0) return r0; } + + +/* Wrappers for GMP 4.x compat + * + * In GMP 5.0 the following operations were added: + * + * mpn_sqr, mpn_and_n, mpn_ior_n, mpn_xor_n, mpn_nand_n, mpn_nior_n, + * mpn_xnor_n, mpn_andn_n, mpn_iorn_n, mpn_com, mpn_neg, mpn_copyi, + * mpn_copyd, mpn_zero + * + * We use some of those, but for GMP 4.x compatibility we need to + * emulate those (while incurring some overhead). + */ +#if __GNU_MP_VERSION < 5 + +#define MPN_LOGIC_OP_WRAPPER(MPN_WRAPPER, MPZ_OP) \ +void \ +MPN_WRAPPER(mp_limb_t *rp, const mp_limb_t *s1p, \ + const mp_limb_t *s2p, mp_size_t n) \ +{ \ + assert(n > 0); \ + \ + const mpz_t s1 = CONST_MPZ_INIT(s1p, n); \ + const mpz_t s2 = CONST_MPZ_INIT(s2p, n); \ + \ + mpz_t r; \ + mpz_init (r); \ + MPZ_OP (r, s1, s2); \ + \ + const mp_size_t rn = r[0]._mp_size; \ + memset (rp, 0, n*sizeof(mp_limb_t)); \ + memcpy (rp, r[0]._mp_d, mp_size_minabs(rn,n)*sizeof(mp_limb_t)); \ + \ + mpz_clear (r); \ +} + +static void +__mpz_andn(mpz_t r, const mpz_t s1, const mpz_t s2) +{ + mpz_t s2c; + mpz_init (s2c); + mpz_com (s2c, s2); + mpz_and (r, s1, s2c); + mpz_clear (s2c); +} + +MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_and_n, mpz_and) +MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_andn_n, __mpz_andn) +MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_ior_n, mpz_ior) +MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_xor_n, mpz_xor) + +#else /* __GNU_MP_VERSION >= 5 */ +void +integer_gmp_mpn_and_n(mp_limb_t *rp, const mp_limb_t *s1p, + const mp_limb_t *s2p, mp_size_t n) +{ + mpn_and_n(rp, s1p, s2p, n); +} + +void +integer_gmp_mpn_andn_n(mp_limb_t *rp, const mp_limb_t *s1p, + const mp_limb_t *s2p, mp_size_t n) +{ + mpn_andn_n(rp, s1p, s2p, n); +} + +void +integer_gmp_mpn_ior_n(mp_limb_t *rp, const mp_limb_t *s1p, + const mp_limb_t *s2p, mp_size_t n) +{ + mpn_ior_n(rp, s1p, s2p, n); +} + +void +integer_gmp_mpn_xor_n(mp_limb_t *rp, const mp_limb_t *s1p, + const mp_limb_t *s2p, mp_size_t n) +{ + mpn_xor_n(rp, s1p, s2p, n); +} +#endif diff --git a/libraries/integer-gmp2/src/GHC/Integer/Type.hs b/libraries/integer-gmp2/src/GHC/Integer/Type.hs index e202855..5670bb4 100644 --- a/libraries/integer-gmp2/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp2/src/GHC/Integer/Type.hs @@ -1575,25 +1575,25 @@ foreign import ccall unsafe "integer_gmp_mpn_lshift" -- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, -- mp_size_t n) -foreign import ccall unsafe "gmp.h __gmpn_and_n" +foreign import ccall unsafe "integer_gmp_mpn_and_n" c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# -> IO () -- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, -- mp_size_t n) -foreign import ccall unsafe "gmp.h __gmpn_andn_n" +foreign import ccall unsafe "integer_gmp_mpn_andn_n" c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# -> IO () -- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, -- mp_size_t n) -foreign import ccall unsafe "gmp.h __gmpn_ior_n" +foreign import ccall unsafe "integer_gmp_mpn_ior_n" c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# -> IO () -- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, -- mp_size_t n) -foreign import ccall unsafe "gmp.h __gmpn_xor_n" +foreign import ccall unsafe "integer_gmp_mpn_xor_n" c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# -> IO () From git at git.haskell.org Tue Feb 24 09:13:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 09:13:33 +0000 (UTC) Subject: [commit: ghc] master: Update submodule to Cabal 1.22.1.0 release (00c971e) Message-ID: <20150224091333.6A2003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00c971ef9dbd16e2201df3ac63f2a68c4b9c0ff0/ghc >--------------------------------------------------------------- commit 00c971ef9dbd16e2201df3ac63f2a68c4b9c0ff0 Author: Herbert Valerio Riedel Date: Sun Feb 22 18:04:27 2015 +0100 Update submodule to Cabal 1.22.1.0 release >--------------------------------------------------------------- 00c971ef9dbd16e2201df3ac63f2a68c4b9c0ff0 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 18c17cb..9225192 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 18c17cbad1e36275ca878cce89539cf4ffa1a6ff +Subproject commit 9225192b7afc2b96062fb991cc3d16cccb9de1b0 From git at git.haskell.org Tue Feb 24 12:50:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 12:50:10 +0000 (UTC) Subject: [commit: ghc] master: Fix comments, and a little reformatting (7a3d7c0) Message-ID: <20150224125010.376793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a3d7c0ecdb79ada44cb700fdca3d54beca96476/ghc >--------------------------------------------------------------- commit 7a3d7c0ecdb79ada44cb700fdca3d54beca96476 Author: Simon Marlow Date: Tue Feb 24 08:22:25 2015 +0000 Fix comments, and a little reformatting >--------------------------------------------------------------- 7a3d7c0ecdb79ada44cb700fdca3d54beca96476 compiler/codeGen/StgCmmExpr.hs | 52 +++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 7d2ef78..747f71a 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} ----------------------------------------------------------------------------- -- @@ -372,11 +373,17 @@ Now the trouble is that 's' has VoidRep, and we do not bind void arguments in the environment; they don't live anywhere. See the calls to nonVoidIds in various places. So we must not look up 's' in the environment. Instead, just evaluate the RHS! Simple. +-} -Note [Dodgy unsafeCoerce 1] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ +cgCase (StgApp v []) _ (PrimAlt _) alts + | isVoidRep (idPrimRep v) -- See Note [Scrutinising VoidRep] + , [(DEFAULT, _, _, rhs)] <- alts + = cgExpr rhs + +{- Note [Dodgy unsafeCoerce 1] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider - case (x :: MutVar# Int) |> co of (y :: HValue) + case (x :: HValue) |> co of (y :: MutVar# Int) DEFAULT -> ... We want to gnerate an assignment y := x @@ -388,24 +395,7 @@ of the MutVar#. If instead we generate code that enters the HValue, then we'll get a runtime panic, because the HValue really is a MutVar#. The types are compatible though, so we can just generate an assignment. - -Note [Dodgy unsafeCoerce 2] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Note [ticket #3132]: we might be looking at a case of a lifted Id that -was cast to an unlifted type. The Id will always be bottom, but we -don't want the code generator to fall over here. If we just emit an -assignment here, the assignment will be type-incorrect Cmm. Hence, we -emit the usual enter/return code, (and because bottom must be -untagged, it will be entered and the program will crash). The Sequel -is a type-correct assignment, albeit bogus. The (dead) continuation -loops; it would be better to invoke some kind of panic function here. -} - -cgCase (StgApp v []) _ (PrimAlt _) alts - | isVoidRep (idPrimRep v) -- See Note [Scrutinising VoidRep] - , [(DEFAULT, _, _, rhs)] <- alts - = cgExpr rhs - cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts | isUnLiftedType (idType v) -- Note [Dodgy unsafeCoerce 1] || reps_compatible @@ -414,22 +404,32 @@ cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts ; when (not reps_compatible) $ panic "cgCase: reps do not match, perhaps a dodgy unsafeCoerce?" ; v_info <- getCgIdInfo v - ; emitAssign (CmmLocal (idToReg dflags (NonVoid bndr))) (idInfoToAmode v_info) - ; _ <- bindArgsToRegs [NonVoid bndr] + ; emitAssign (CmmLocal (idToReg dflags (NonVoid bndr))) + (idInfoToAmode v_info) + ; bindArgsToRegs [NonVoid bndr] ; cgAlts (NoGcInAlts,AssignedDirectly) (NonVoid bndr) alt_type alts } where reps_compatible = idPrimRep v == idPrimRep bndr +{- Note [Dodgy unsafeCoerce 2, #3132] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In all other cases of a lifted Id being cast to an unlifted type, the +Id should be bound to bottom, otherwise this is an unsafe use of +unsafeCoerce. We can generate code to enter the Id and assume that +it will never return. Hence, we emit the usual enter/return code, and +because bottom must be untagged, it will be entered. The Sequel is a +type-correct assignment, albeit bogus. The (dead) continuation loops; +it would be better to invoke some kind of panic function here. +-} cgCase scrut@(StgApp v []) _ (PrimAlt _) _ - = -- See Note [Dodgy unsafeCoerce 2] - do { dflags <- getDynFlags + = do { dflags <- getDynFlags ; mb_cc <- maybeSaveCostCentre True - ; _ <- withSequel (AssignTo [idToReg dflags (NonVoid v)] False) (cgExpr scrut) + ; withSequel (AssignTo [idToReg dflags (NonVoid v)] False) (cgExpr scrut) ; restoreCurrentCostCentre mb_cc ; emitComment $ mkFastString "should be unreachable code" ; l <- newLabelC ; emitLabel l - ; emit (mkBranch l) + ; emit (mkBranch l) -- an infinite loop ; return AssignedDirectly } From git at git.haskell.org Tue Feb 24 22:32:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Feb 2015 22:32:10 +0000 (UTC) Subject: [commit: ghc] master: Axe ModFinderCache, folding it into a generalized FinderCache. (ea3b4cf) Message-ID: <20150224223210.07DB13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ea3b4cfff397312429626be4a45f9969ff9a0b0e/ghc >--------------------------------------------------------------- commit ea3b4cfff397312429626be4a45f9969ff9a0b0e Author: Edward Z. Yang Date: Tue Jan 27 15:55:52 2015 -0800 Axe ModFinderCache, folding it into a generalized FinderCache. Summary: FinderCache is now keyed by a module, ModuleNames in the home package are turned into Modules using thisPackage in the dynamic flags. Simplifies some code! Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D634 >--------------------------------------------------------------- ea3b4cfff397312429626be4a45f9969ff9a0b0e compiler/main/Finder.hs | 69 +++++++++++------------------------------------ compiler/main/HscMain.hs | 5 +--- compiler/main/HscTypes.hs | 14 +++------- 3 files changed, 20 insertions(+), 68 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ea3b4cfff397312429626be4a45f9969ff9a0b0e From git at git.haskell.org Wed Feb 25 15:44:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Feb 2015 15:44:31 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Fixes: removed closeOverKinds, Get Qs from signature, not so chatty (1e2783b) Message-ID: <20150225154431.EA6C03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/1e2783b4a95db11b3ce3dc59d0012b80961db74f/ghc >--------------------------------------------------------------- commit 1e2783b4a95db11b3ce3dc59d0012b80961db74f Author: George Karachalias Date: Wed Feb 25 16:45:02 2015 +0100 Fixes: removed closeOverKinds, Get Qs from signature, not so chatty >--------------------------------------------------------------- 1e2783b4a95db11b3ce3dc59d0012b80961db74f compiler/basicTypes/Var.hs | 3 ++- compiler/deSugar/Check.hs | 22 +++++++++++----------- compiler/deSugar/DsBinds.hs | 3 ++- compiler/typecheck/TcSMonad.hs | 8 ++++---- 4 files changed, 19 insertions(+), 17 deletions(-) diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs index d121793..4079a1e 100644 --- a/compiler/basicTypes/Var.hs +++ b/compiler/basicTypes/Var.hs @@ -205,7 +205,8 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds -} instance Outputable Var where - ppr var = parens $ ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) <+> dcolon <+> ppr (varType var) + ppr var = ppr (varName var) <> getPprStyle (ppr_debug var) + -- ppr var = parens $ ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) <+> dcolon <+> ppr (varType var) ppr_debug :: Var -> PprStyle -> SDoc ppr_debug (TyVar {}) sty diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index ec852ff..306647b 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -136,8 +136,8 @@ checkpm :: [Type] -> [EquationInfo] -> DsM (Maybe PmResult) checkpm tys eq_info | null eq_info = return (Just ([],[],[])) -- If we have an empty match, do not reason at all | otherwise = do - loc <- getSrcSpanDs - pprInTcRnIf (ptext (sLit "Checking match at") <+> ppr loc <+> ptext (sLit "with signature:") <+> ppr tys) + -- loc <- getSrcSpanDs + -- pprInTcRnIf (ptext (sLit "Checking match at") <+> ppr loc <+> ptext (sLit "with signature:") <+> ppr tys) uncovered0 <- initial_uncovered tys let allvanilla = all isVanillaEqn eq_info -- Need to pass this to process_vector, so that tc can be avoided @@ -551,14 +551,14 @@ inferTyPmPat (PmLitPat ty _) = return (ty, emptyBag) inferTyPmPat (PmLitCon ty _) = return (ty, emptyBag) inferTyPmPat (PmConPat con args) = do -- ---------------------------------------------------------------- - pprInTcRnIf (ptext (sLit "Iferring type for pattern:") <+> ppr (PmConPat con args)) - pprInTcRnIf (ptext (sLit "dataConUserType =") <+> ppr (dataConUserType con)) - pprInTcRnIf (ptext (sLit "dataConSig =") <+> ppr (dataConSig con)) + -- pprInTcRnIf (ptext (sLit "Iferring type for pattern:") <+> ppr (PmConPat con args)) + -- pprInTcRnIf (ptext (sLit "dataConUserType =") <+> ppr (dataConUserType con)) + -- pprInTcRnIf (ptext (sLit "dataConSig =") <+> ppr (dataConSig con)) -- ---------------------------------------------------------------- (tys, cs) <- inferTyPmPats args -- Infer argument types and respective constraints (Just like the paper) let (tvs, thetas', arg_tys', res_ty') = dataConSig con -- take apart the constructor - tkvs = varSetElemsKvsFirst (closeOverKinds (mkVarSet tvs)) -- as, bs and their kinds + tkvs = varSetElemsKvsFirst (mkVarSet tvs) -- as, bs and their kinds (subst, _tvs) <- -- create the substitution for both as and bs getSrcSpanDs >>= \loc -> genInstSkolTyVars loc tkvs let res_ty = substTy subst res_ty' -- result type @@ -587,12 +587,12 @@ wt sig (_, vec) cs' <- zipWithM newEqPmM (map expandTypeSynonyms sig) tys -- The vector should match the signature type env_cs <- getDictsDs loc <- getSrcSpanDs - pprInTcRnIf (ptext (sLit "Checking in location:") <+> ppr loc) - pprInTcRnIf (ptext (sLit "Checking vector") <+> ppr vec <+> ptext (sLit "with inferred type:") <+> - sep (punctuate comma (map pprTyWithKind tys))) - pprInTcRnIf (ptext (sLit "With given signature:") <+> sep (punctuate comma (map pprTyWithKind sig))) + -- pprInTcRnIf (ptext (sLit "Checking in location:") <+> ppr loc) + -- pprInTcRnIf (ptext (sLit "Checking vector") <+> ppr vec <+> ptext (sLit "with inferred type:") <+> + -- sep (punctuate comma (map pprTyWithKind tys))) + -- pprInTcRnIf (ptext (sLit "With given signature:") <+> sep (punctuate comma (map pprTyWithKind sig))) let constraints = listToBag cs' `unionBags` cs `unionBags` env_cs - pprInTcRnIf (ptext (sLit "Constraints:") <+> ppr (mapBag varType constraints)) + -- pprInTcRnIf (ptext (sLit "Constraints:") <+> ppr (mapBag varType constraints)) isSatisfiable constraints | otherwise = pprPanic "wt: length mismatch:" (ppr sig $$ ppr vec) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 3e91806..d4b0db4 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -136,7 +136,8 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_ev_binds = ev_binds, abs_binds = binds }) | ABE { abe_wrap = wrap, abe_poly = global , abe_mono = local, abe_prags = prags } <- export - = do { dflags <- getDynFlags + = addDictsDs (toTcTypeBag (listToBag dicts)) $ + do { dflags <- getDynFlags ; bind_prs <- ds_lhs_binds binds ; let core_bind = Rec (fromOL bind_prs) ; ds_binds <- dsTcEvBinds_s ev_binds diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 3721f92..6e50c96 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -962,10 +962,10 @@ checkInsoluble :: TcS Bool -- True if there are any insoluble constraints checkInsoluble = do { icans <- getInertCans - ; let insols = inert_insols icans - ; if isEmptyBag insols - then return () - else wrapTcS $ pprInTcRnIf (ptext (sLit "insolubles:") $$ ppr insols) -- just to see + -- ; let insols = inert_insols icans + -- ; if isEmptyBag insols + -- then return () + -- else wrapTcS $ pprInTcRnIf (ptext (sLit "insolubles:") $$ ppr insols) -- just to see ; return (not (isEmptyBag (inert_insols icans))) } lookupFlatCache :: TyCon -> [Type] -> TcS (Maybe (TcCoercion, TcType, CtFlavour)) From git at git.haskell.org Thu Feb 26 00:26:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Feb 2015 00:26:13 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Make pmcheck more chatty about types and kinds (eb04a09) Message-ID: <20150226002613.C96183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/eb04a09efaefe7ada566d5af99f077fbc3bc2f39/ghc >--------------------------------------------------------------- commit eb04a09efaefe7ada566d5af99f077fbc3bc2f39 Author: George Karachalias Date: Thu Feb 26 01:28:12 2015 +0100 Make pmcheck more chatty about types and kinds >--------------------------------------------------------------- eb04a09efaefe7ada566d5af99f077fbc3bc2f39 compiler/basicTypes/Var.hs | 4 ++-- compiler/deSugar/Check.hs | 12 ++++++++---- compiler/typecheck/TcSMonad.hs | 8 ++++---- 3 files changed, 14 insertions(+), 10 deletions(-) diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs index 4079a1e..3971b84 100644 --- a/compiler/basicTypes/Var.hs +++ b/compiler/basicTypes/Var.hs @@ -205,8 +205,8 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds -} instance Outputable Var where - ppr var = ppr (varName var) <> getPprStyle (ppr_debug var) - -- ppr var = parens $ ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) <+> dcolon <+> ppr (varType var) + -- ppr var = ppr (varName var) <> getPprStyle (ppr_debug var) + ppr var = parens $ ppr (varName var) <> ptext (sLit "_") <> ppr (varUnique var) <> getPprStyle (ppr_debug var) <+> dcolon <+> ppr (varType var) ppr_debug :: Var -> PprStyle -> SDoc ppr_debug (TyVar {}) sty diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 306647b..c846e42 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -136,8 +136,9 @@ checkpm :: [Type] -> [EquationInfo] -> DsM (Maybe PmResult) checkpm tys eq_info | null eq_info = return (Just ([],[],[])) -- If we have an empty match, do not reason at all | otherwise = do - -- loc <- getSrcSpanDs - -- pprInTcRnIf (ptext (sLit "Checking match at") <+> ppr loc <+> ptext (sLit "with signature:") <+> ppr tys) + loc <- getSrcSpanDs + pprInTcRnIf (ptext (sLit "Checking match at") <+> ppr loc <+> + ptext (sLit "with signature:") <+> sep (punctuate comma (map pprTyWithKind tys))) uncovered0 <- initial_uncovered tys let allvanilla = all isVanillaEqn eq_info -- Need to pass this to process_vector, so that tc can be avoided @@ -551,7 +552,7 @@ inferTyPmPat (PmLitPat ty _) = return (ty, emptyBag) inferTyPmPat (PmLitCon ty _) = return (ty, emptyBag) inferTyPmPat (PmConPat con args) = do -- ---------------------------------------------------------------- - -- pprInTcRnIf (ptext (sLit "Iferring type for pattern:") <+> ppr (PmConPat con args)) + -- pprInTcRnIf (ptext (sLit "For pattern:") <+> ppr (PmConPat con args)) -- pprInTcRnIf (ptext (sLit "dataConUserType =") <+> ppr (dataConUserType con)) -- pprInTcRnIf (ptext (sLit "dataConSig =") <+> ppr (dataConSig con)) -- ---------------------------------------------------------------- @@ -591,8 +592,11 @@ wt sig (_, vec) -- pprInTcRnIf (ptext (sLit "Checking vector") <+> ppr vec <+> ptext (sLit "with inferred type:") <+> -- sep (punctuate comma (map pprTyWithKind tys))) -- pprInTcRnIf (ptext (sLit "With given signature:") <+> sep (punctuate comma (map pprTyWithKind sig))) + pprInTcRnIf (ppr loc <+> ptext (sLit "vector:") <+> ppr vec) + pprInTcRnIf (ptext (sLit "with inferred type:") <+> sep (punctuate comma (map pprTyWithKind tys))) let constraints = listToBag cs' `unionBags` cs `unionBags` env_cs - -- pprInTcRnIf (ptext (sLit "Constraints:") <+> ppr (mapBag varType constraints)) + pprInTcRnIf (ptext (sLit "And constraints:") <+> ppr (mapBag varType constraints)) + isSatisfiable constraints | otherwise = pprPanic "wt: length mismatch:" (ppr sig $$ ppr vec) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 6e50c96..3721f92 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -962,10 +962,10 @@ checkInsoluble :: TcS Bool -- True if there are any insoluble constraints checkInsoluble = do { icans <- getInertCans - -- ; let insols = inert_insols icans - -- ; if isEmptyBag insols - -- then return () - -- else wrapTcS $ pprInTcRnIf (ptext (sLit "insolubles:") $$ ppr insols) -- just to see + ; let insols = inert_insols icans + ; if isEmptyBag insols + then return () + else wrapTcS $ pprInTcRnIf (ptext (sLit "insolubles:") $$ ppr insols) -- just to see ; return (not (isEmptyBag (inert_insols icans))) } lookupFlatCache :: TyCon -> [Type] -> TcS (Maybe (TcCoercion, TcType, CtFlavour)) From git at git.haskell.org Thu Feb 26 11:41:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Feb 2015 11:41:09 +0000 (UTC) Subject: [commit: ghc] master: AllocationLimitExceeded should be a child of SomeAsyncException (b7f7889) Message-ID: <20150226114109.0DF2A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7f7889fc28460e3e8be3ea8e29f98ff473fd934/ghc >--------------------------------------------------------------- commit b7f7889fc28460e3e8be3ea8e29f98ff473fd934 Author: Simon Marlow Date: Wed Feb 25 09:31:18 2015 +0000 AllocationLimitExceeded should be a child of SomeAsyncException >--------------------------------------------------------------- b7f7889fc28460e3e8be3ea8e29f98ff473fd934 libraries/base/GHC/IO/Exception.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index e9a32b6..eed5362 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -107,7 +107,9 @@ instance Show Deadlock where data AllocationLimitExceeded = AllocationLimitExceeded deriving Typeable -instance Exception AllocationLimitExceeded +instance Exception AllocationLimitExceeded where + toException = asyncExceptionToException + fromException = asyncExceptionFromException instance Show AllocationLimitExceeded where showsPrec _ AllocationLimitExceeded = From git at git.haskell.org Thu Feb 26 12:03:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Feb 2015 12:03:46 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Fixed kind polymorphism (01641b4) Message-ID: <20150226120346.A915C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/01641b493eb350937baabfb0753fefc28de78590/ghc >--------------------------------------------------------------- commit 01641b493eb350937baabfb0753fefc28de78590 Author: Simon Peyton Jones Date: Thu Feb 26 12:05:37 2015 +0000 Fixed kind polymorphism >--------------------------------------------------------------- 01641b493eb350937baabfb0753fefc28de78590 compiler/deSugar/Check.hs | 83 ++++++++++++++++++++++++++++++++++++------- compiler/typecheck/TcMType.hs | 6 ++-- 2 files changed, 74 insertions(+), 15 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index c846e42..83016b2 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -26,6 +26,7 @@ import Util import BasicTypes import Outputable import FastString +import Unify( tcMatchTys ) -- For the new checker (We need to remove and reorder things) import DsMonad ( DsM, initTcDsForSolver, getDictsDs, getSrcSpanDs) @@ -41,11 +42,11 @@ import Type ( substTy, substTys, substTyVars, substTheta, TvSubst import TypeRep ( Type(..) ) import Bag import ErrUtils -import TcMType (genInstSkolTyVars) +import TcMType (genInstSkolTyVarsX) import IOEnv (tryM, failM) import Data.Maybe (isJust) -import Control.Monad ( forM, foldM, zipWithM ) +import Control.Monad ( forM, foldM, zipWithM, when ) import MonadUtils -- MonadIO @@ -540,6 +541,7 @@ isSatisfiable evs Just sat -> return sat Nothing -> pprPanic "isSatisfiable" (vcat $ pprErrMsgBagWithLoc errs) } +{- -- ----------------------------------------------------------------------- -- | Infer types -- INVARIANTS: @@ -559,9 +561,8 @@ inferTyPmPat (PmConPat con args) = do (tys, cs) <- inferTyPmPats args -- Infer argument types and respective constraints (Just like the paper) let (tvs, thetas', arg_tys', res_ty') = dataConSig con -- take apart the constructor - tkvs = varSetElemsKvsFirst (mkVarSet tvs) -- as, bs and their kinds (subst, _tvs) <- -- create the substitution for both as and bs - getSrcSpanDs >>= \loc -> genInstSkolTyVars loc tkvs + getSrcSpanDs >>= \loc -> genInstSkolTyVars loc tvs let res_ty = substTy subst res_ty' -- result type arg_tys = substTys subst arg_tys' thetas <- mapM (nameType "varcon") $ substTheta subst thetas' @@ -577,6 +578,58 @@ inferTyPmPats pats = do tys_cs <- mapM inferTyPmPat pats let (tys, cs) = unzip tys_cs return (tys, unionManyBags cs) +-} + +checkTyPmPat :: PmPat Id -> Type -> PmM (Bag EvVar) -- check a type and a set of constraints +checkTyPmPat (PmGuardPat _) _ = panic "checkTyPmPat: PmGuardPat" +checkTyPmPat (PmVarPat {}) _ = return emptyBag +checkTyPmPat (PmLitPat {}) _ = return emptyBag +checkTyPmPat (PmLitCon {}) _ = return emptyBag +checkTyPmPat pat@(PmConPat con args) res_ty = do + let (univ_tvs, ex_tvs, eq_spec, thetas, arg_tys, dc_res_ty) = dataConFullSig con + data_tc = dataConTyCon con -- The representation TyCon + mb_tc_args = case splitTyConApp_maybe res_ty of + Nothing -> Nothing + Just (res_tc, res_tc_tys) + | Just (fam_tc, fam_args, _) <- tyConFamInstSig_maybe data_tc + , let fam_tc_tvs = tyConTyVars fam_tc + -> ASSERT( res_tc == fam_tc ) + case tcMatchTys (mkVarSet fam_tc_tvs) fam_args res_tc_tys of + Just fam_subst -> Just (map (substTyVar fam_subst) fam_tc_tvs) + Nothing -> Nothing + | otherwise + -> ASSERT( res_tc == data_tc ) Just res_tc_tys + + pprInTcRnIf (text "checkTyPmPat con" <+> vcat [ ppr con, ppr univ_tvs, ppr dc_res_ty, ppr res_ty, ppr mb_tc_args ]) + loc <- getSrcSpanDs + (subst, res_eq) <- case mb_tc_args of + Nothing -> -- The context type doesn't have a type constructor at the head. + -- so generate an equality. But this doesn't really work if there + -- are kind variables involved + do when (any isKindVar univ_tvs) + (pprInTcRnIf (text "checkTyPmPat: Danger! Kind variables" <+> ppr pat)) + (subst, _) <- genInstSkolTyVars loc univ_tvs + res_eq <- newEqPmM (substTy subst dc_res_ty) res_ty + return (subst, unitBag res_eq) + Just tys -> return (zipTopTvSubst univ_tvs tys, emptyBag) + + (subst, _) <- genInstSkolTyVarsX loc subst ex_tvs + arg_cs <- checkTyPmPats args (substTys subst arg_tys) + theta_cs <- mapM (nameType "varcon") $ + substTheta subst (eqSpecPreds eq_spec ++ thetas) + + return (listToBag theta_cs `unionBags` arg_cs `unionBags` res_eq) + +checkTyPmPats :: [PmPat Id] -> [Type] -> PmM (Bag EvVar) +checkTyPmPats pats tys + = do { cs <- zipWithM checkTyPmPat pats tys + ; return (unionManyBags cs) } + +genInstSkolTyVars :: SrcSpan -> [TyVar] -> PmM (TvSubst, [TyVar]) +-- Precondition: tyvars should be ordered (kind vars first) +-- see Note [Kind substitution when instantiating] +-- Get the location from the monad; this is a complete freshening operation +genInstSkolTyVars loc tvs = genInstSkolTyVarsX loc emptyTvSubst tvs -- ----------------------------------------------------------------------- -- | Given a signature sig and an output vector, check whether the vector's type @@ -584,20 +637,26 @@ inferTyPmPats pats = do wt :: [Type] -> OutVec -> PmM Bool wt sig (_, vec) | length sig == length vec = do - (tys, cs) <- inferTyPmPats vec - cs' <- zipWithM newEqPmM (map expandTypeSynonyms sig) tys -- The vector should match the signature type +-- (tys, cs) <- inferTyPmPats vec +-- cs' <- zipWithM newEqPmM (map expandTypeSynonyms sig) tys -- The vector should match the signature type + cs <- checkTyPmPats vec sig env_cs <- getDictsDs - loc <- getSrcSpanDs + loc <- getSrcSpanDs -- pprInTcRnIf (ptext (sLit "Checking in location:") <+> ppr loc) -- pprInTcRnIf (ptext (sLit "Checking vector") <+> ppr vec <+> ptext (sLit "with inferred type:") <+> -- sep (punctuate comma (map pprTyWithKind tys))) - -- pprInTcRnIf (ptext (sLit "With given signature:") <+> sep (punctuate comma (map pprTyWithKind sig))) + pprInTcRnIf (ptext (sLit "With given signature:") <+> sep (punctuate comma (map pprTyWithKind sig))) pprInTcRnIf (ppr loc <+> ptext (sLit "vector:") <+> ppr vec) - pprInTcRnIf (ptext (sLit "with inferred type:") <+> sep (punctuate comma (map pprTyWithKind tys))) - let constraints = listToBag cs' `unionBags` cs `unionBags` env_cs - pprInTcRnIf (ptext (sLit "And constraints:") <+> ppr (mapBag varType constraints)) +-- pprInTcRnIf (ptext (sLit "with type:") <+> sep (punctuate comma (map pprTyWithKind ys))) + let constraints = cs `unionBags` env_cs + pprInTcRnIf (ptext (sLit "And constraints:") + <+> vcat [ text "cs:" <+> ppr (mapBag varType cs) + , text "env_cs:" <+> ppr (mapBag varType env_cs) ]) + + is_sat <- isSatisfiable constraints + pprInTcRnIf (ptext (sLit "Satisfiable:") <+> ppr is_sat) + return is_sat - isSatisfiable constraints | otherwise = pprPanic "wt: length mismatch:" (ppr sig $$ ppr vec) {- diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index a8ae14c..2f118fc 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -28,7 +28,7 @@ module TcMType ( -------------------------------- -- Creating fresh type variables for pm checking - genInstSkolTyVars, + genInstSkolTyVarsX, -------------------------------- -- Creating new evidence variables @@ -1006,8 +1006,8 @@ isWildcardVar _ = False -} -- UNINSTANTIATED VERSION OF tcInstSkolTyVars -genInstSkolTyVars :: SrcSpan -> [TyVar] -> TcRnIf gbl lcl (TvSubst, [TcTyVar]) +genInstSkolTyVarsX :: SrcSpan -> TvSubst -> [TyVar] -> TcRnIf gbl lcl (TvSubst, [TcTyVar]) -- Precondition: tyvars should be ordered (kind vars first) -- see Note [Kind substitution when instantiating] -- Get the location from the monad; this is a complete freshening operation -genInstSkolTyVars loc tvs = instSkolTyVarsX (mkTcSkolTyVar loc False) emptyTvSubst tvs +genInstSkolTyVarsX loc subst tvs = instSkolTyVarsX (mkTcSkolTyVar loc False) subst tvs From git at git.haskell.org Fri Feb 27 08:10:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Feb 2015 08:10:00 +0000 (UTC) Subject: [commit: ghc] master: Update process submodule to 1.2.3.0 snapshot (1def53f) Message-ID: <20150227081000.772843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1def53fec6a6ef985de0e665fede4744dfd456fb/ghc >--------------------------------------------------------------- commit 1def53fec6a6ef985de0e665fede4744dfd456fb Author: Herbert Valerio Riedel Date: Fri Feb 27 08:47:36 2015 +0100 Update process submodule to 1.2.3.0 snapshot This fixes the compilation failure libraries\process\System\Process\Internals.hs:36:5: Not in scope: `stopDelegateControlC' ... (however, GHC HEAD skipped process-1.2.2 which has that issue) >--------------------------------------------------------------- 1def53fec6a6ef985de0e665fede4744dfd456fb libraries/process | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/process b/libraries/process index 1a62f86..160bdd1 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 1a62f86e77118520143985d9baf62d31a9d1c748 +Subproject commit 160bdd16722d85c2644bd2353121d8eb5e1597e4 From git at git.haskell.org Fri Feb 27 08:13:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Feb 2015 08:13:01 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Update process submodule to 1.2.3.0 snapshot (d4903a4) Message-ID: <20150227081301.5030B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/d4903a4496dea63809a1a870b589bc466e1577e3/ghc >--------------------------------------------------------------- commit d4903a4496dea63809a1a870b589bc466e1577e3 Author: Herbert Valerio Riedel Date: Fri Feb 27 08:47:36 2015 +0100 Update process submodule to 1.2.3.0 snapshot This fixes the compilation failure libraries\process\System\Process\Internals.hs:36:5: Not in scope: `stopDelegateControlC' ... (cherry picked from commit 1def53fec6a6ef985de0e665fede4744dfd456fb) >--------------------------------------------------------------- d4903a4496dea63809a1a870b589bc466e1577e3 libraries/process | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/process b/libraries/process index 93d8b62..160bdd1 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 93d8b624252feea034683508eb3f112f9dc76662 +Subproject commit 160bdd16722d85c2644bd2353121d8eb5e1597e4