From git at git.haskell.org Tue Jul 1 02:06:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 02:06:46 +0000 (UTC) Subject: [commit: ghc] master: Avoid integer overflow in hp2ps (#9145) (b735883) Message-ID: <20140701020646.E01242406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b735883016b946372cb44b6c5d86dc36c126a8cf/ghc >--------------------------------------------------------------- commit b735883016b946372cb44b6c5d86dc36c126a8cf Author: Reid Barton Date: Mon Jun 30 22:01:57 2014 -0400 Avoid integer overflow in hp2ps (#9145) This is slightly hackish, but hp2ps is already convoluted enough that I don't feel bad about it. >--------------------------------------------------------------- b735883016b946372cb44b6c5d86dc36c126a8cf utils/hp2ps/HpFile.c | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/utils/hp2ps/HpFile.c b/utils/hp2ps/HpFile.c index 5ee9cc2..f2a01cd 100644 --- a/utils/hp2ps/HpFile.c +++ b/utils/hp2ps/HpFile.c @@ -227,7 +227,7 @@ GetHpLine(FILE *infp) Error("%s, line %d: integer must follow identifier", hpfile, linenum); } - StoreSample(GetEntry(theident), nsamples, (floatish) theinteger); + StoreSample(GetEntry(theident), nsamples, thefloatish); GetHpTok(infp); break; @@ -358,8 +358,13 @@ GetNumber(FILE *infp) thefloatish = (floatish) atof(numberstring); return FLOAT_TOK; } else { - theinteger = atoi(numberstring); - return INTEGER_TOK; + theinteger = atoi(numberstring); + /* Set thefloatish too. + If this is an identifier line, the value might exceed + the size of 'int', and we are going to convert it to + a floatish anyways. */ + thefloatish = atof(numberstring); + return INTEGER_TOK; } } From git at git.haskell.org Tue Jul 1 02:15:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 02:15:07 +0000 (UTC) Subject: [commit: ghc] master: Add a cast to new code in hp2ps (9785bb7) Message-ID: <20140701021507.32CD32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9785bb7cb96ecee409a40fb413035758dd278db7/ghc >--------------------------------------------------------------- commit 9785bb7cb96ecee409a40fb413035758dd278db7 Author: Reid Barton Date: Mon Jun 30 22:11:03 2014 -0400 Add a cast to new code in hp2ps For parallelism with the existing code. I don't think it should make any difference. >--------------------------------------------------------------- 9785bb7cb96ecee409a40fb413035758dd278db7 utils/hp2ps/HpFile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/hp2ps/HpFile.c b/utils/hp2ps/HpFile.c index f2a01cd..9459247 100644 --- a/utils/hp2ps/HpFile.c +++ b/utils/hp2ps/HpFile.c @@ -363,7 +363,7 @@ GetNumber(FILE *infp) If this is an identifier line, the value might exceed the size of 'int', and we are going to convert it to a floatish anyways. */ - thefloatish = atof(numberstring); + thefloatish = (floatish) atof(numberstring); return INTEGER_TOK; } } From git at git.haskell.org Tue Jul 1 07:11:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 07:11:36 +0000 (UTC) Subject: [commit: ghc] master: Unbreak TcNullaryTC testcase, by using MPTC (da8baf2) Message-ID: <20140701071136.3824C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da8baf2cf41b102d215dee7b3e10eb01e2c5462f/ghc >--------------------------------------------------------------- commit da8baf2cf41b102d215dee7b3e10eb01e2c5462f Author: Joachim Breitner Date: Tue Jul 1 09:11:30 2014 +0200 Unbreak TcNullaryTC testcase, by using MPTC >--------------------------------------------------------------- da8baf2cf41b102d215dee7b3e10eb01e2c5462f testsuite/tests/typecheck/should_run/TcNullaryTC.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_run/TcNullaryTC.hs b/testsuite/tests/typecheck/should_run/TcNullaryTC.hs index a94d305..17e3f4c 100644 --- a/testsuite/tests/typecheck/should_run/TcNullaryTC.hs +++ b/testsuite/tests/typecheck/should_run/TcNullaryTC.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NullaryTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Main where From git at git.haskell.org Tue Jul 1 10:11:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 10:11:49 +0000 (UTC) Subject: [commit: ghc] master: Replace thenM/thenM_ with do-notation in RnExpr (288c21e) Message-ID: <20140701101150.169302406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/288c21ebfc268f16582c1ff0250dd59a442b57e3/ghc >--------------------------------------------------------------- commit 288c21ebfc268f16582c1ff0250dd59a442b57e3 Author: Jan Stolarek Date: Mon Jun 30 15:42:24 2014 +0200 Replace thenM/thenM_ with do-notation in RnExpr >--------------------------------------------------------------- 288c21ebfc268f16582c1ff0250dd59a442b57e3 compiler/rename/RnExpr.lhs | 230 ++++++++++++++++++++------------------------- 1 file changed, 104 insertions(+), 126 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 288c21ebfc268f16582c1ff0250dd59a442b57e3 From git at git.haskell.org Tue Jul 1 10:41:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 10:41:53 +0000 (UTC) Subject: [commit: ghc] master: Update Haddock submodule with Iavor's validate fix. (94c47f5) Message-ID: <20140701104153.7C4EA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/94c47f570f23f157f06c77782977210cbfbd2bd1/ghc >--------------------------------------------------------------- commit 94c47f570f23f157f06c77782977210cbfbd2bd1 Author: Edward Z. Yang Date: Tue Jul 1 03:40:46 2014 -0700 Update Haddock submodule with Iavor's validate fix. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 94c47f570f23f157f06c77782977210cbfbd2bd1 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 1a3f8f7..8d20ca8 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 1a3f8f74116d749a17467c79ee30c5efabd694d2 +Subproject commit 8d20ca8d5a9bee73252ff2035ec45f9c03d0820c From git at git.haskell.org Tue Jul 1 10:41:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 10:41:56 +0000 (UTC) Subject: [commit: ghc] master: Refactor checkHiBootIface so that TcGblEnv is not necessary. (47bf248) Message-ID: <20140701104156.23BE02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47bf248d6b7b2ab2d86a7e080f594e68dff484c7/ghc >--------------------------------------------------------------- commit 47bf248d6b7b2ab2d86a7e080f594e68dff484c7 Author: Edward Z. Yang Date: Mon Jun 30 09:07:23 2014 +0100 Refactor checkHiBootIface so that TcGblEnv is not necessary. Summary: This patch is a prelude to implementation of hi-to-hi compatibility checking. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D35 >--------------------------------------------------------------- 47bf248d6b7b2ab2d86a7e080f594e68dff484c7 compiler/typecheck/TcRnDriver.lhs | 41 ++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 67fa39e..0836c32 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -545,12 +545,35 @@ checkHiBootIface tcg_env@(TcGblEnv { tcg_src = hs_src, tcg_binds = binds, tcg_insts = local_insts, tcg_type_env = local_type_env, tcg_exports = local_exports }) - (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts, - md_types = boot_type_env, md_exports = boot_exports }) + boot_details | isHsBoot hs_src -- Current module is already a hs-boot file! = return tcg_env | otherwise + = do { mb_dfun_prs <- checkHiBootIface' local_insts local_type_env + local_exports boot_details + ; let dfun_prs = catMaybes mb_dfun_prs + boot_dfuns = map fst dfun_prs + dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun) + | (boot_dfun, dfun) <- dfun_prs ] + type_env' = extendTypeEnvWithIds local_type_env boot_dfuns + tcg_env' = tcg_env { tcg_binds = binds `unionBags` dfun_binds } + + ; setGlobalTypeEnv tcg_env' type_env' } + -- Update the global type env *including* the knot-tied one + -- so that if the source module reads in an interface unfolding + -- mentioning one of the dfuns from the boot module, then it + -- can "see" that boot dfun. See Trac #4003 + +checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo] + -> ModDetails -> TcM [Maybe (Id, Id)] +-- Variant which doesn't require a full TcGblEnv; you could get the +-- local components from another ModDetails. + +checkHiBootIface' + local_insts local_type_env local_exports + (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts, + md_types = boot_type_env, md_exports = boot_exports }) = do { traceTc "checkHiBootIface" $ vcat [ ppr boot_type_env, ppr boot_insts, ppr boot_exports] @@ -567,19 +590,11 @@ checkHiBootIface -- Check instance declarations ; mb_dfun_prs <- mapM check_inst boot_insts - ; let dfun_prs = catMaybes mb_dfun_prs - boot_dfuns = map fst dfun_prs - dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun) - | (boot_dfun, dfun) <- dfun_prs ] - type_env' = extendTypeEnvWithIds local_type_env boot_dfuns - tcg_env' = tcg_env { tcg_binds = binds `unionBags` dfun_binds } ; failIfErrsM - ; setGlobalTypeEnv tcg_env' type_env' } - -- Update the global type env *including* the knot-tied one - -- so that if the source module reads in an interface unfolding - -- mentioning one of the dfuns from the boot module, then it - -- can "see" that boot dfun. See Trac #4003 + + ; return mb_dfun_prs } + where check_export boot_avail -- boot_avail is exported by the boot iface | name `elem` dfun_names = return () From git at git.haskell.org Tue Jul 1 14:13:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 14:13:53 +0000 (UTC) Subject: [commit: ghc] master: Partially fix #9003 by reverting bad numbering. (5f3c538) Message-ID: <20140701141353.D1EE52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f3c5384df59717ca8013c5df8d1f65692867825/ghc >--------------------------------------------------------------- commit 5f3c5384df59717ca8013c5df8d1f65692867825 Author: Edward Z. Yang Date: Tue Jul 1 14:43:50 2014 +0100 Partially fix #9003 by reverting bad numbering. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 5f3c5384df59717ca8013c5df8d1f65692867825 includes/rts/Constants.h | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/includes/rts/Constants.h b/includes/rts/Constants.h index 842c37b..6fd0dc0 100644 --- a/includes/rts/Constants.h +++ b/includes/rts/Constants.h @@ -202,32 +202,34 @@ */ #define NotBlocked 0 #define BlockedOnMVar 1 -#define BlockedOnMVarRead 2 -#define BlockedOnBlackHole 3 -#define BlockedOnRead 4 -#define BlockedOnWrite 5 -#define BlockedOnDelay 6 -#define BlockedOnSTM 7 +#define BlockedOnMVarRead 14 /* TODO: renumber me, see #9003 */ +#define BlockedOnBlackHole 2 +#define BlockedOnRead 3 +#define BlockedOnWrite 4 +#define BlockedOnDelay 5 +#define BlockedOnSTM 6 /* Win32 only: */ -#define BlockedOnDoProc 8 +#define BlockedOnDoProc 7 /* Only relevant for PAR: */ /* blocked on a remote closure represented by a Global Address: */ -#define BlockedOnGA 9 +#define BlockedOnGA 8 /* same as above but without sending a Fetch message */ -#define BlockedOnGA_NoSend 10 +#define BlockedOnGA_NoSend 9 /* Only relevant for THREADED_RTS: */ -#define BlockedOnCCall 11 -#define BlockedOnCCall_Interruptible 12 +#define BlockedOnCCall 10 +#define BlockedOnCCall_Interruptible 11 /* same as above but permit killing the worker thread */ /* Involved in a message sent to tso->msg_cap */ -#define BlockedOnMsgThrowTo 13 +#define BlockedOnMsgThrowTo 12 /* The thread is not on any run queues, but can be woken up by tryWakeupThread() */ -#define ThreadMigrating 14 +#define ThreadMigrating 13 + +/* WARNING WARNING top number is BlockedOnMVarRead 14, not 13!! */ /* * These constants are returned to the scheduler by a thread that has From git at git.haskell.org Tue Jul 1 14:20:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 14:20:42 +0000 (UTC) Subject: [commit: ghc] master: Check for integer overflow in allocate() (#9172) (db64180) Message-ID: <20140701142042.CDFA52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db64180896b395283f443d66a308048c605b217d/ghc >--------------------------------------------------------------- commit db64180896b395283f443d66a308048c605b217d Author: Reid Barton Date: Tue Jul 1 10:20:31 2014 -0400 Check for integer overflow in allocate() (#9172) Summary: Check for integer overflow in allocate() (#9172) Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D36 >--------------------------------------------------------------- db64180896b395283f443d66a308048c605b217d rts/sm/Storage.c | 10 +++++++++- testsuite/.gitignore | 3 +++ testsuite/tests/rts/all.T | 5 +++++ testsuite/tests/rts/overflow1.hs | 11 +++++++++++ testsuite/tests/rts/overflow1.stderr | 1 + testsuite/tests/rts/overflow2.hs | 20 ++++++++++++++++++++ testsuite/tests/rts/overflow2.stderr | 1 + testsuite/tests/rts/overflow3.hs | 20 ++++++++++++++++++++ testsuite/tests/rts/overflow3.stderr | 1 + 9 files changed, 71 insertions(+), 1 deletion(-) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 86bd1c2..d002fec 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -686,7 +686,15 @@ StgPtr allocate (Capability *cap, W_ n) CCS_ALLOC(cap->r.rCCCS,n); if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - W_ req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; + // The largest number of bytes such that + // the computation of req_blocks will not overflow. + W_ max_bytes = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_); + W_ req_blocks; + + if (n > max_bytes) + req_blocks = HS_WORD_MAX; // signal overflow below + else + req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; // Attempting to allocate an object larger than maxHeapSize // should definitely be disallowed. (bug #1791) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index f28edef..376318d 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1293,6 +1293,9 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/rts/linker_unload /tests/rts/outofmem /tests/rts/outofmem2 +/tests/rts/overflow1 +/tests/rts/overflow2 +/tests/rts/overflow3 /tests/rts/prep.out /tests/rts/return_mem_to_os /tests/rts/rtsflags001 diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index a56a3f3..d7c74c5 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -230,3 +230,8 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # I couldn't reproduce 9078 with the -threaded runtime, but could easily # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) + +# 251 = RTS exit code for "out of memory" +test('overflow1', [ exit_code(251) ], compile_and_run, ['']) +test('overflow2', [ exit_code(251) ], compile_and_run, ['']) +test('overflow3', [ exit_code(251) ], compile_and_run, ['']) diff --git a/testsuite/tests/rts/overflow1.hs b/testsuite/tests/rts/overflow1.hs new file mode 100644 index 0000000..63ed5a4 --- /dev/null +++ b/testsuite/tests/rts/overflow1.hs @@ -0,0 +1,11 @@ +module Main where + +import Data.Array.IO +import Data.Word + +-- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate() +-- Here we invoke allocate() via newByteArray# and the array package. +-- Request a number of bytes close to HS_WORD_MAX, +-- subtracting a few words for overhead in newByteArray#. +-- Allocate Word32s (rather than Word8s) to get around bounds-checking in array. +main = newArray (0,maxBound `div` 4 - 10) 0 :: IO (IOUArray Word Word32) diff --git a/testsuite/tests/rts/overflow1.stderr b/testsuite/tests/rts/overflow1.stderr new file mode 100644 index 0000000..734ca95 --- /dev/null +++ b/testsuite/tests/rts/overflow1.stderr @@ -0,0 +1 @@ +overflow1: out of memory diff --git a/testsuite/tests/rts/overflow2.hs b/testsuite/tests/rts/overflow2.hs new file mode 100644 index 0000000..ac72158 --- /dev/null +++ b/testsuite/tests/rts/overflow2.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount - 1) diff --git a/testsuite/tests/rts/overflow2.stderr b/testsuite/tests/rts/overflow2.stderr new file mode 100644 index 0000000..be65509 --- /dev/null +++ b/testsuite/tests/rts/overflow2.stderr @@ -0,0 +1 @@ +overflow2: out of memory diff --git a/testsuite/tests/rts/overflow3.hs b/testsuite/tests/rts/overflow3.hs new file mode 100644 index 0000000..31dfd5d --- /dev/null +++ b/testsuite/tests/rts/overflow3.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount + 1) diff --git a/testsuite/tests/rts/overflow3.stderr b/testsuite/tests/rts/overflow3.stderr new file mode 100644 index 0000000..6c804e5 --- /dev/null +++ b/testsuite/tests/rts/overflow3.stderr @@ -0,0 +1 @@ +overflow3: out of memory From git at git.haskell.org Tue Jul 1 14:24:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 14:24:07 +0000 (UTC) Subject: [commit: ghc] master: Fix demand analyser for unboxed types (d6ee82b) Message-ID: <20140701142408.4FAC82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d6ee82b29598dcc1028773dd987b7a2fb17519b7/ghc >--------------------------------------------------------------- commit d6ee82b29598dcc1028773dd987b7a2fb17519b7 Author: Simon Peyton Jones Date: Tue Jul 1 13:31:18 2014 +0100 Fix demand analyser for unboxed types This is a tricky case exposed by Trac #9254. I'm surprised it hasn't shown up before, because it's happens when you use unsafePerformIO in the right way. Anyway, fixed now. See Note [Analysing with absent demand] in Demand.lhs >--------------------------------------------------------------- d6ee82b29598dcc1028773dd987b7a2fb17519b7 compiler/basicTypes/Demand.lhs | 59 +++++++++++++++++++--- compiler/stranal/DmdAnal.lhs | 2 +- testsuite/tests/stranal/should_run/T9254.hs | 20 ++++++++ .../should_run/T9254.stdout} | 0 testsuite/tests/stranal/should_run/all.T | 1 + 5 files changed, 74 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index f3615bc..ed055b5 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -66,7 +66,7 @@ import BasicTypes import Binary import Maybes ( orElse ) -import Type ( Type ) +import Type ( Type, isUnLiftedType ) import TyCon ( isNewTyCon, isClassTyCon ) import DataCon ( splitDataProductType_maybe ) import FastString @@ -1201,13 +1201,18 @@ type DeferAndUse -- Describes how to degrade a result type type DeferAndUseM = Maybe DeferAndUse -- Nothing <=> absent-ify the result type; it will never be used -toCleanDmd :: Demand -> (CleanDemand, DeferAndUseM) --- See Note [Analyzing with lazy demand and lambdas] -toCleanDmd (JD { strd = s, absd = u }) +toCleanDmd :: Demand -> Type -> (CleanDemand, DeferAndUseM) +toCleanDmd (JD { strd = s, absd = u }) expr_ty = case (s,u) of - (Str s', Use c u') -> (CD { sd = s', ud = u' }, Just (False, c)) - (Lazy, Use c u') -> (CD { sd = HeadStr, ud = u' }, Just (True, c)) - (_, Abs) -> (CD { sd = HeadStr, ud = Used }, Nothing) + (Str s', Use c u') -> -- The normal case + (CD { sd = s', ud = u' }, Just (False, c)) + + (Lazy, Use c u') -> -- See Note [Analyzing with lazy demand and lambdas] + (CD { sd = HeadStr, ud = u' }, Just (True, c)) + + (_, Abs) -- See Note [Analysing with absent demand] + | isUnLiftedType expr_ty -> (CD { sd = HeadStr, ud = Used }, Just (False, One)) + | otherwise -> (CD { sd = HeadStr, ud = Used }, Nothing) -- This is used in dmdAnalStar when post-processing -- a function's argument demand. So we only care about what @@ -1397,6 +1402,46 @@ demand . This is achieved by, first, converting the lazy demand L into the strict S by the second clause of the analysis. +Note [Analysing with absent demand] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we analyse an expression with demand . The "A" means +"absent", so this expression will never be needed. What should happen? +There are several wrinkles: + +* We *do* want to analyse the expression regardless. + Reason: Note [Always analyse in virgin pass] + + But we can post-process the results to ignore all the usage + demands coming back. This is done by postProcessDmdTypeM. + +* But in the case of an *unlifted type* we must be extra careful, + because unlifted values are evaluated even if they are not used. + Example (see Trac #9254): + f :: (() -> (# Int#, () #)) -> () + -- Strictness signature is + -- + -- I.e. calls k, but discards first component of result + f k = case k () of (# _, r #) -> r + + g :: Int -> () + g y = f (\n -> (# case y of I# y2 -> y2, n #)) + + Here f's strictness signature says (correctly) that it calls its + argument function and ignores the first component of its result. + This is correct in the sense that it'd be fine to (say) modify the + function so that always returned 0# in the first component. + + But in function g, we *will* evaluate the 'case y of ...', because + it has type Int#. So 'y' will be evaluated. So we must record this + usage of 'y', else 'g' will say 'y' is absent, and will w/w so that + 'y' is bound to an aBSENT_ERROR thunk. + + An alternative would be to replace the 'case y of ...' with (say) 0#, + but I have not tried that. It's not a common situation, but it is + not theoretical: unsafePerformIO's implementation is very very like + 'f' above. + + %************************************************************************ %* * Demand signatures diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index f240be4..a3b7c0b 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -115,7 +115,7 @@ dmdAnalStar :: AnalEnv -> Demand -- This one takes a *Demand* -> CoreExpr -> (BothDmdArg, CoreExpr) dmdAnalStar env dmd e - | (cd, defer_and_use) <- toCleanDmd dmd + | (cd, defer_and_use) <- toCleanDmd dmd (exprType e) , (dmd_ty, e') <- dmdAnal env cd e = (postProcessDmdTypeM defer_and_use dmd_ty, e') diff --git a/testsuite/tests/stranal/should_run/T9254.hs b/testsuite/tests/stranal/should_run/T9254.hs new file mode 100644 index 0000000..279eb5c --- /dev/null +++ b/testsuite/tests/stranal/should_run/T9254.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module Main where +import GHC.Exts + +f :: (() -> (# Int#, () #)) -> () +{-# NOINLINE f #-} +-- Strictness signature was (7.8.2) +-- +-- I.e. calls k, but discards first component of result +f k = case k () of (# _, r #) -> r + +g :: Int -> () +g y = f (\n -> (# case y of I# y2 -> h (h (h (h (h (h (h y2)))))), n #)) + -- RHS is big enough to force worker/wrapper + +{-# NOINLINE h #-} +h :: Int# -> Int# +h n = n +# 1# + +main = print (g 1) diff --git a/testsuite/tests/codeGen/should_run/T3207.stdout b/testsuite/tests/stranal/should_run/T9254.stdout similarity index 100% copy from testsuite/tests/codeGen/should_run/T3207.stdout copy to testsuite/tests/stranal/should_run/T9254.stdout diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index 0c43aac..2ca65b5 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, ['']) test('strun004', normal, compile_and_run, ['']) test('T2756b', normal, compile_and_run, ['']) test('T7649', normal, compile_and_run, ['']) +test('T9254', normal, compile_and_run, ['']) From git at git.haskell.org Tue Jul 1 14:24:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 14:24:11 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #9222 (127c45e) Message-ID: <20140701142411.2A0972406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/127c45ea30eaee6b5244b3f30aaa701d0ad327ac/ghc >--------------------------------------------------------------- commit 127c45ea30eaee6b5244b3f30aaa701d0ad327ac Author: Simon Peyton Jones Date: Tue Jul 1 15:23:30 2014 +0100 Test Trac #9222 >--------------------------------------------------------------- 127c45ea30eaee6b5244b3f30aaa701d0ad327ac testsuite/tests/polykinds/T9222.hs | 7 +++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 8 insertions(+) diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs new file mode 100644 index 0000000..df11251 --- /dev/null +++ b/testsuite/tests/polykinds/T9222.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes, GADTs, DataKinds, PolyKinds, TypeOperators, TypeFamilies #-} +module T9222 where + +import Data.Proxy + +data Want :: (i,j) -> * where + Want :: (a ~ '(b,c) => Proxy b) -> Want a diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 09c7254..f642acd 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -102,3 +102,4 @@ test('T8705', normal, compile, ['']) test('T8985', normal, compile, ['']) test('T9106', normal, compile_fail, ['']) test('T9144', normal, compile_fail, ['']) +test('T9222', normal, compile, ['']) From git at git.haskell.org Tue Jul 1 18:19:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 18:19:29 +0000 (UTC) Subject: [commit: ghc] master: Fixup nullary typeclasses (Trac #8993) (e7b9c41) Message-ID: <20140701181929.177EC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7b9c4125321308a7f71cacf4c24b7d40261ccfd/ghc >--------------------------------------------------------------- commit e7b9c4125321308a7f71cacf4c24b7d40261ccfd Author: Krzysztof Gogolewski Date: Tue Jul 1 20:19:20 2014 +0200 Fixup nullary typeclasses (Trac #8993) Summary: Fix test broken after Trac #8993 Test Plan: validate Reviewers: austin, simonpj, hvr Reviewed By: austin, hvr Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D34 >--------------------------------------------------------------- e7b9c4125321308a7f71cacf4c24b7d40261ccfd compiler/typecheck/TcTyClsDecls.lhs | 7 +++++-- compiler/typecheck/TcValidity.lhs | 4 +++- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index c21631f..8723d8b 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1578,11 +1578,14 @@ checkValidClass :: Class -> TcM () checkValidClass cls = do { constrained_class_methods <- xoptM Opt_ConstrainedClassMethods ; multi_param_type_classes <- xoptM Opt_MultiParamTypeClasses + ; nullary_type_classes <- xoptM Opt_NullaryTypeClasses ; fundep_classes <- xoptM Opt_FunctionalDependencies -- Check that the class is unary, unless multiparameter type classes - -- are enabled (which allows nullary type classes) - ; checkTc (multi_param_type_classes || arity == 1) + -- 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 (fundep_classes || null fundeps) (classFunDepsErr cls) diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index 8f6a773..c7ba56c 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -776,7 +776,9 @@ checkValidInstHead ctxt clas cls_args all tcInstHeadTyAppAllTyVars ty_args) (instTypeErr clas cls_args head_type_args_tyvars_msg) ; checkTc (xopt Opt_MultiParamTypeClasses dflags || - length ty_args == 1) -- Only count type arguments + length ty_args == 1 || -- Only count type arguments + (xopt Opt_NullaryTypeClasses dflags && + null ty_args)) (instTypeErr clas cls_args head_one_type_msg) } -- May not contain type family applications From git at git.haskell.org Tue Jul 1 18:41:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 18:41:33 +0000 (UTC) Subject: [commit: ghc] master: Backpack docs: Compilation, surface syntax, and package database (f5fa0de) Message-ID: <20140701184133.430C32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f5fa0dee87a0032aa73ab81141f39af87c2a324d/ghc >--------------------------------------------------------------- commit f5fa0dee87a0032aa73ab81141f39af87c2a324d Author: Edward Z. Yang Date: Tue Jul 1 19:41:00 2014 +0100 Backpack docs: Compilation, surface syntax, and package database Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- f5fa0dee87a0032aa73ab81141f39af87c2a324d docs/backpack/backpack-impl.tex | 526 +++++++++++++++++++++++++++++++++------- 1 file changed, 434 insertions(+), 92 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f5fa0dee87a0032aa73ab81141f39af87c2a324d From git at git.haskell.org Tue Jul 1 18:52:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Jul 2014 18:52:44 +0000 (UTC) Subject: [commit: ghc] master: Fix variable name in allocate() (70b24c0) Message-ID: <20140701185244.46A752406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70b24c0217ea219813b7e8c1b3c92d189900bb3a/ghc >--------------------------------------------------------------- commit 70b24c0217ea219813b7e8c1b3c92d189900bb3a Author: Reid Barton Date: Tue Jul 1 14:00:28 2014 -0400 Fix variable name in allocate() >--------------------------------------------------------------- 70b24c0217ea219813b7e8c1b3c92d189900bb3a rts/sm/Storage.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index d002fec..379d9da 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -686,12 +686,12 @@ StgPtr allocate (Capability *cap, W_ n) CCS_ALLOC(cap->r.rCCCS,n); if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - // The largest number of bytes such that + // The largest number of words such that // the computation of req_blocks will not overflow. - W_ max_bytes = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_); + W_ max_words = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_); W_ req_blocks; - if (n > max_bytes) + if (n > max_words) req_blocks = HS_WORD_MAX; // signal overflow below else req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; From git at git.haskell.org Wed Jul 2 10:38:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 10:38:36 +0000 (UTC) Subject: [commit: ghc] master: Finish the simple elaboration algo (f48463e) Message-ID: <20140702103836.C4BF82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f48463ea4f56252767444aa96e40f2784f236122/ghc >--------------------------------------------------------------- commit f48463ea4f56252767444aa96e40f2784f236122 Author: Edward Z. Yang Date: Tue Jul 1 20:02:18 2014 +0100 Finish the simple elaboration algo Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- f48463ea4f56252767444aa96e40f2784f236122 docs/backpack/backpack-impl.tex | 61 +++++++++++++++++++++++++++-------------- 1 file changed, 41 insertions(+), 20 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index 99fb832..35e5ca2 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -428,7 +428,7 @@ versions of \verb|Q|). The upshot is that we are in an awkward position, where package \verb|a| contains some modules which must be distinct, and other modules which must be unified over several installs. -The solution to this conundrum is to flatten the package database, so +The theory, thus, demands that we flatten the package database, so that we no longer insist that all compiled code associate with a package live together in a single directory: instead, \emph{the installed package database is a directory of physical module identities to @@ -472,16 +472,20 @@ interaction could still be surprising: Backpack can remodularize modules, but it can't remodularize values inside a module, so if a module has a dependency but some global state in the module doesn't, the resulting behavior can be surprising. Perhaps the moral of the story really is, ``Don't do side effects -in an applicative module system! No really!''} +in an applicative module system! No really!''} \\ -\paragraph{Package slicing} Another possibility is to automatically +\noindent Flattening the package database may be too stiff a medicine for this +project. Here are two alternatives. + +\paragraph{Package slicing} Instead of changing the package database, +we automatically slice a single package into multiple packages, so that the sliced packages have dependencies which accurately reflect their constitutent modules. For a well modularized package, the slicing operation should be a no-op. This would also be useful in some other situations (see the \verb|-module-env| discussion in Section~\ref{sec:compiling-definite}). In fact, which slice a module should be placed in can be automatically -calculated by taking the package identity with the regular tree +calculated by taking the package name with the regular tree associated with the module (Section~\ref{sec:ipi}). A minor downside of package slicing is in a dynamically linked environment, @@ -502,7 +506,8 @@ Our motivating example, then, would fail to witness sharing. This might be the simplest thing to do, but it is a change in the Backpack semantics, and rules out modularization without splitting a package -into multiple packages. +into multiple packages. Maybe Scott can give other reasons why this +would not be so good. \subsection{Exposed modules should allow external modules}\label{sec:reexport} @@ -1087,8 +1092,10 @@ all of the signatures and modules are placed in appropriately named files): \begin{verbatim} +package: libfoo +... build-depends: base, libfoo (Foo, Bar as Baz) -holes: A A2 +holes: A A2 -- deferred for now exposed-modules: Foo B C aliases: A = A2 other-modules: D @@ -1099,24 +1106,38 @@ The key idea is use of the \verb|{-# SOURCE #-}| pragma, which is enough to solve the important ordering constraint between signatures and modules. -Here is how the elaboration works: +Here is how the elaboration works. For simplicity, in this algorithm +description, we assume all packages being compiled have no holes. Later, +we'll discuss how to extend the algorithm to handle holes. \begin{enumerate} - \item Run Cabal's constraint solver to determine which specific - packages we will depend on (i.e., resolve the names in \verb|build-depends|). - For each package $p$ in this order, record a \verb|include p| in - the Backpack package. Because of the topological sorting, every - included package has all of its holes filled in upon inclusion, - preserving the linking invariant. - \item (XXX something wonderful) + + \item At the top-level with \verb|package| $p$ and + \verb|exposed-modules| $ms$, record \verb|package p (ms) where| + + \item For each package $p$ with thinning/renaming $ms$ in + \verb|build-depends|, record a \verb|include p (ms)| in the + Backpack package. The ordering of these includes does not + matter, since none of these packages have holes. + + \item Take all modules $m$ in \verb|other-modules| and + \verb|exposed-modules| which were not exported by build + dependencies, and create a directed graph where hs and hs-boot + files are nodes and imports are edges (the target of an edge is + an hs file if it is a normal import, and an hs-boot file if it + is a SOURCE import). Topologically sort this graph, erroring if + this graph contains cycles (even with recursive modules, the + cycle should have been broken by an hs-boot file). For each + node, in this order, record \verb|M = [ ... ]| or \verb|M :: [ ... ]| + depending on whether or not it is an hs or hs-boot. + \end{enumerate} -\paragraph{Thinning and renaming} The elaboration above is over-simplified, -because it cannot deal with thinning and renaming. The obvious choice of -simply taking the thinning/renaming and slapping it on the include does not -work, because this renaming will affect +XXX do an example + +\paragraph{Holes} XXX build-depends resolution becomes more complicated -\paragraph{Multiple signatures} The proposal +\paragraph{Multiple signatures} XXX allow SOURCE and then refer to a specific file \paragraph{Explicit or implicit reexports} One annoying property of this proposal is that, looking at the \verb|exposed-modules| list, it is @@ -1124,7 +1145,7 @@ not immediately clear what source files one would expect to find in the current package. It's not obvious what the proper way to go about doing this is. -\paragraph{Better syntax for SOURCE} +\paragraph{Better syntax for SOURCE} XXX self explanatory \section{Open questions}\label{sec:open-questions} From git at git.haskell.org Wed Jul 2 11:24:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 11:24:09 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Update baseline shift/reduce conflict number (ca08570) Message-ID: <20140702112409.6F0482406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/ca085703370b4559b5d5d8eeb5475d113ca55fa0/ghc >--------------------------------------------------------------- commit ca085703370b4559b5d5d8eeb5475d113ca55fa0 Author: Dr. ERDI Gergo Date: Wed Jul 2 19:18:43 2014 +0800 Update baseline shift/reduce conflict number >--------------------------------------------------------------- ca085703370b4559b5d5d8eeb5475d113ca55fa0 compiler/parser/Parser.y.pp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 27d6c38..68f7e5b 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -55,6 +55,12 @@ import Control.Monad ( mplus ) {- ----------------------------------------------------------------------------- +25 June 2014 + +Conflicts: 47 shift/reduce + 1 reduce/reduce + +----------------------------------------------------------------------------- 12 October 2012 Conflicts: 43 shift/reduce From git at git.haskell.org Wed Jul 2 11:24:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 11:24:11 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Add toPatSynSigDetails to turn a HsConDeclDetails into a HsPatSynDetails (2d86eef) Message-ID: <20140702112411.D5E942406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/2d86eeff134baac96d708eaa4c161455350da14d/ghc >--------------------------------------------------------------- commit 2d86eeff134baac96d708eaa4c161455350da14d Author: Dr. ERDI Gergo Date: Wed Jul 2 19:16:23 2014 +0800 Add toPatSynSigDetails to turn a HsConDeclDetails into a HsPatSynDetails >--------------------------------------------------------------- 2d86eeff134baac96d708eaa4c161455350da14d compiler/parser/RdrHsSyn.lhs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 29e88ea..932ccd2 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -14,7 +14,7 @@ module RdrHsSyn ( mkTySynonym, mkTyFamInstEqn, mkTyFamInst, mkFamDecl, - splitCon, mkInlinePragma, + splitCon, toPatSynSigDetails, mkInlinePragma, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -410,6 +410,16 @@ splitCon ty mk_rest [L _ (HsRecTy flds)] = RecCon flds mk_rest ts = PrefixCon ts +toPatSynSigDetails :: SrcSpan -> HsConDeclDetails RdrName + -> P (HsPatSynDetails (LHsType RdrName)) +toPatSynSigDetails _ (PrefixCon ts) = return $ PrefixPatSyn ts +toPatSynSigDetails _ (InfixCon t1 t2) = return $ InfixPatSyn t1 t2 +toPatSynSigDetails loc (RecCon flds) + = parseErrorSDoc loc $ + text "record syntax not supported for pattern synonym:" <+> ppr_rec + where + ppr_rec = ppr (noLoc $ HsRecTy flds) + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] From git at git.haskell.org Wed Jul 2 11:24:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 11:24:14 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Add parser for pattern synonym signatures (dbe2c5c) Message-ID: <20140702112414.6F8292406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/dbe2c5c44ffffb9252b33ec049edb189103c49a4/ghc >--------------------------------------------------------------- commit dbe2c5c44ffffb9252b33ec049edb189103c49a4 Author: Dr. ERDI Gergo Date: Wed Jul 2 19:23:47 2014 +0800 Add parser for pattern synonym signatures >--------------------------------------------------------------- dbe2c5c44ffffb9252b33ec049edb189103c49a4 compiler/parser/Parser.y.pp | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 68f7e5b..6e4a3d5 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -816,8 +816,25 @@ role : VARID { L1 $ Just $ getVARID $1 } -- Glasgow extension: pattern synonyms pattern_synonym_decl :: { LHsDecl RdrName } - : 'pattern' con vars0 patsyn_token pat { LL . ValD $ mkPatSynBind $2 (PrefixPatSyn $3) $5 $4 } - | 'pattern' varid conop varid patsyn_token pat { LL . ValD $ mkPatSynBind $3 (InfixPatSyn $2 $4) $6 $5 } + : 'pattern' con vars0 patsyn_token pat + { LL . ValD $ mkPatSynBind $2 (PrefixPatSyn $3) $5 $4 } + | 'pattern' varid conop varid patsyn_token pat + { LL . ValD $ mkPatSynBind $3 (InfixPatSyn $2 $4) $6 $5 } + +pattern_synonym_sig :: { LSig RdrName } + : 'pattern' patsyn_context patsyn_stuff '::' patsyn_context type + { let (name, details) = unLoc $3 + in LL $ PatSynSig name details $6 $2 $5 } + +patsyn_stuff :: { Located (Located RdrName, HsPatSynDetails (LHsType RdrName)) } + : constr_stuff + {% do { let { (L loc (name, con_details)) = $1 } + ; ps_details <- toPatSynSigDetails loc con_details + ; return $ LL (name, ps_details) } } + +patsyn_context :: { LHsContext RdrName } + : forall { L0 [] } + | forall context '=>' { $2 } vars0 :: { [Located RdrName] } : {- empty -} { [] } @@ -1432,6 +1449,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } { LL $ toOL [ LL $ SigD (TypeSig ($1 : unLoc $3) $5) ] } | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | n <- unLoc $3 ] } + | pattern_synonym_sig { LL . unitOL $ LL . SigD . unLoc $ $1 } | '{-# INLINE' activation qvar '#-}' { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) } | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}' From git at git.haskell.org Wed Jul 2 11:49:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 11:49:00 +0000 (UTC) Subject: [commit: ghc] master: Finish up incomplete sections (8afe616) Message-ID: <20140702114902.14CF92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8afe616d52c652db249c4d00b24c82a35ca75068/ghc >--------------------------------------------------------------- commit 8afe616d52c652db249c4d00b24c82a35ca75068 Author: Edward Z. Yang Date: Wed Jul 2 12:48:53 2014 +0100 Finish up incomplete sections Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 8afe616d52c652db249c4d00b24c82a35ca75068 docs/backpack/backpack-impl.tex | 320 +++++++++++++++++++++++++++++----------- 1 file changed, 230 insertions(+), 90 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8afe616d52c652db249c4d00b24c82a35ca75068 From git at git.haskell.org Wed Jul 2 15:12:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 15:12:06 +0000 (UTC) Subject: [commit: ghc] master: Control CPP through settings file (#8683) (34f7e9a) Message-ID: <20140702151206.8C0732406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34f7e9a3c99850859901ca74370f55f1d4e2279a/ghc >--------------------------------------------------------------- commit 34f7e9a3c99850859901ca74370f55f1d4e2279a Author: Carter Tazio Schonwald Date: Wed Jul 2 08:52:53 2014 -0500 Control CPP through settings file (#8683) Summary: Allow the CPP program and flag choices for GHC be configured via the the ghc settings file Test Plan: ran validate yesterday Reviewers: hvr, austin, mzero, simonmar Reviewed By: austin, mzero, simonmar Subscribers: mzero, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D26 >--------------------------------------------------------------- 34f7e9a3c99850859901ca74370f55f1d4e2279a aclocal.m4 | 9 ++++++ compiler/ghc.mk | 2 -- compiler/main/SysTools.lhs | 8 ++--- configure.ac | 73 +++++++++++++++++++++++++++++++++++++++++----- distrib/configure.ac.in | 59 +++++++++++++++++++++++++++++++++++++ settings.in | 2 ++ 6 files changed, 140 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 34f7e9a3c99850859901ca74370f55f1d4e2279a From git at git.haskell.org Wed Jul 2 15:12:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 15:12:09 +0000 (UTC) Subject: [commit: ghc] master: reading/writing blocking FDs over FD_SETSIZE is broken (Partially Trac #9169) (b0316cd) Message-ID: <20140702151209.73ABF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0316cdb10fbd9eaca7ede28c7bb3eb19f7766bf/ghc >--------------------------------------------------------------- commit b0316cdb10fbd9eaca7ede28c7bb3eb19f7766bf Author: Sergei Trofimovich Date: Wed Jul 2 08:53:34 2014 -0500 reading/writing blocking FDs over FD_SETSIZE is broken (Partially Trac #9169) Summary: libraries/base/cbits/inputReady.c had no limits on file descriptors. Add a limit as non-threaded RTS does. Signed-off-by: Sergei Trofimovich Test Plan: none Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D28 >--------------------------------------------------------------- b0316cdb10fbd9eaca7ede28c7bb3eb19f7766bf libraries/base/cbits/inputReady.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/cbits/inputReady.c b/libraries/base/cbits/inputReady.c index 51f278f..dac9d9b 100644 --- a/libraries/base/cbits/inputReady.c +++ b/libraries/base/cbits/inputReady.c @@ -25,7 +25,11 @@ fdReady(int fd, int write, int msecs, int isSock) int maxfd, ready; fd_set rfd, wfd; struct timeval tv; - + if ((fd >= (int)FD_SETSIZE) || (fd < 0)) { + /* avoid memory corruption on too large FDs */ + errno = EINVAL; + return -1; + } FD_ZERO(&rfd); FD_ZERO(&wfd); if (write) { From git at git.haskell.org Wed Jul 2 15:12:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 15:12:11 +0000 (UTC) Subject: [commit: ghc] master: compiler/ghc.mk: restore GhcHcOpts variable handling (Trac #8787) (423caa8) Message-ID: <20140702151211.E55162406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/423caa85db277a63df8c2aa071cada82d2181b6e/ghc >--------------------------------------------------------------- commit 423caa85db277a63df8c2aa071cada82d2181b6e Author: Sergei Trofimovich Date: Wed Jul 2 08:54:06 2014 -0500 compiler/ghc.mk: restore GhcHcOpts variable handling (Trac #8787) Summary: wiki and mk/config.mk.in suggests setting GhcHcOpts for compiler-wide haskell flags. But it does not work for a while now (broke around ca07d92837fc1e3ae9be67bb7d9e7f1b8035b00f) Signed-off-by: Sergei Trofimovich Test Plan: 'make' shows now ghc timing as it used to be Reviewers: simonmar, austin Reviewed By: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D29 >--------------------------------------------------------------- 423caa85db277a63df8c2aa071cada82d2181b6e compiler/ghc.mk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 389543f..c236bcf 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -665,9 +665,9 @@ compiler_stage2_CONFIGURE_OPTS += --disable-library-for-ghci compiler_stage3_CONFIGURE_OPTS += --disable-library-for-ghci # after build-package, because that sets compiler_stage1_HC_OPTS: -compiler_stage1_HC_OPTS += $(GhcStage1HcOpts) -compiler_stage2_HC_OPTS += $(GhcStage2HcOpts) -compiler_stage3_HC_OPTS += $(GhcStage3HcOpts) +compiler_stage1_HC_OPTS += $(GhcHcOpts) $(GhcStage1HcOpts) +compiler_stage2_HC_OPTS += $(GhcHcOpts) $(GhcStage2HcOpts) +compiler_stage3_HC_OPTS += $(GhcHcOpts) $(GhcStage3HcOpts) ifneq "$(BINDIST)" "YES" From git at git.haskell.org Wed Jul 2 15:12:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 15:12:14 +0000 (UTC) Subject: [commit: ghc] master: ghc-pkg register/update --enable-multi-instance (dd3a724) Message-ID: <20140702151214.5D1A02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd3a7245d4d557b9e19bfa53b0fb2733c6fd4f88/ghc >--------------------------------------------------------------- commit dd3a7245d4d557b9e19bfa53b0fb2733c6fd4f88 Author: Austin Seipp Date: Wed Jul 2 08:54:22 2014 -0500 ghc-pkg register/update --enable-multi-instance Summary: New flag to ghc-pkg register/update to lift the restriction on multiple instances of the same package version being in a db at once. Lifting the restriction is easy. The tricky bit is checking ghc does something sensible, but from the reading of the code it should treat such instances the same way it does with multiple instances between multiple DBs. We'll also need a way to unregister by installed package id. Test Plan: need to test that ghc is doing what we expect, at least if you use it like -hide-all-packages -package-id this -package-id that Reviewers: ezyang, simonmar Reviewed By: simonmar Subscribers: relrod Projects: #ghc Differential Revision: https://phabricator.haskell.org/D32 >--------------------------------------------------------------- dd3a7245d4d557b9e19bfa53b0fb2733c6fd4f88 utils/ghc-pkg/Main.hs | 49 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 36 insertions(+), 13 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 290fb82..e51755c 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -114,6 +114,7 @@ data Flag | FlagForce | FlagForceFiles | FlagAutoGHCiLibs + | FlagMultiInstance | FlagExpandEnvVars | FlagExpandPkgroot | FlagNoExpandPkgroot @@ -146,6 +147,8 @@ flags = [ "ignore missing directories and libraries only", Option ['g'] ["auto-ghci-libs"] (NoArg FlagAutoGHCiLibs) "automatically build libs for GHCi (with register)", + Option [] ["enable-multi-instance"] (NoArg FlagMultiInstance) + "allow registering multiple instances of the same package version", Option [] ["expand-env-vars"] (NoArg FlagExpandEnvVars) "expand environment variables (${name}-style) in input package descriptions", Option [] ["expand-pkgroot"] (NoArg FlagExpandPkgroot) @@ -309,6 +312,7 @@ runit verbosity cli nonopts = do | FlagForceFiles `elem` cli = ForceFiles | otherwise = NoForce auto_ghci_libs = FlagAutoGHCiLibs `elem` cli + multi_instance = FlagMultiInstance `elem` cli expand_env_vars= FlagExpandEnvVars `elem` cli mexpand_pkgroot= foldl' accumExpandPkgroot Nothing cli where accumExpandPkgroot _ FlagExpandPkgroot = Just True @@ -355,10 +359,12 @@ runit verbosity cli nonopts = do initPackageDB filename verbosity cli ["register", filename] -> registerPackage filename verbosity cli - auto_ghci_libs expand_env_vars False force + auto_ghci_libs multi_instance + expand_env_vars False force ["update", filename] -> registerPackage filename verbosity cli - auto_ghci_libs expand_env_vars True force + auto_ghci_libs multi_instance + expand_env_vars True force ["unregister", pkgid_str] -> do pkgid <- readGlobPkgId pkgid_str unregisterPackage pkgid verbosity cli force @@ -782,11 +788,13 @@ registerPackage :: FilePath -> Verbosity -> [Flag] -> Bool -- auto_ghci_libs + -> Bool -- multi_instance -> Bool -- expand_env_vars -> Bool -- update -> Force -> IO () -registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update force = do +registerPackage input verbosity my_flags auto_ghci_libs multi_instance + expand_env_vars update force = do (db_stack, Just to_modify, _flag_dbs) <- getPkgDatabases verbosity True True False{-expand vars-} my_flags @@ -829,10 +837,16 @@ registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update f let truncated_stack = dropWhile ((/= to_modify).location) db_stack -- truncate the stack for validation, because we don't allow -- packages lower in the stack to refer to those higher up. - validatePackageConfig pkg_expanded verbosity truncated_stack auto_ghci_libs update force + validatePackageConfig pkg_expanded verbosity truncated_stack + auto_ghci_libs multi_instance update force let + -- In the normal mode, we only allow one version of each package, so we + -- remove all instances with the same source package id as the one we're + -- adding. In the multi instance mode we don't do that, thus allowing + -- multiple instances with the same source package id. removes = [ RemovePackage p - | p <- packages db_to_operate_on, + | not multi_instance, + p <- packages db_to_operate_on, sourcePackageId p == sourcePackageId pkg ] -- changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on @@ -1204,7 +1218,8 @@ checkConsistency verbosity my_flags = do let pkgs = allPackagesInStack db_stack checkPackage p = do - (_,es,ws) <- runValidate $ checkPackageConfig p verbosity db_stack False True + (_,es,ws) <- runValidate $ checkPackageConfig p verbosity db_stack + False True True if null es then do when (not simple_output) $ do _ <- reportValidateErrors [] ws "" Nothing @@ -1354,11 +1369,15 @@ validatePackageConfig :: InstalledPackageInfo -> Verbosity -> PackageDBStack -> Bool -- auto-ghc-libs + -> Bool -- multi_instance -> Bool -- update, or check -> Force -> IO () -validatePackageConfig pkg verbosity db_stack auto_ghci_libs update force = do - (_,es,ws) <- runValidate $ checkPackageConfig pkg verbosity db_stack auto_ghci_libs update +validatePackageConfig pkg verbosity db_stack auto_ghci_libs + multi_instance update force = do + (_,es,ws) <- runValidate $ + checkPackageConfig pkg verbosity db_stack + auto_ghci_libs multi_instance update ok <- reportValidateErrors es ws (display (sourcePackageId pkg) ++ ": ") (Just force) when (not ok) $ exitWith (ExitFailure 1) @@ -1366,12 +1385,14 @@ checkPackageConfig :: InstalledPackageInfo -> Verbosity -> PackageDBStack -> Bool -- auto-ghc-libs + -> Bool -- multi_instance -> Bool -- update, or check -> Validate () -checkPackageConfig pkg verbosity db_stack auto_ghci_libs update = do +checkPackageConfig pkg verbosity db_stack auto_ghci_libs + multi_instance update = do checkInstalledPackageId pkg db_stack update checkPackageId pkg - checkDuplicates db_stack pkg update + checkDuplicates db_stack pkg multi_instance update mapM_ (checkDep db_stack) (depends pkg) checkDuplicateDepends (depends pkg) mapM_ (checkDir False "import-dirs") (importDirs pkg) @@ -1410,15 +1431,17 @@ checkPackageId ipi = [] -> verror CannotForce ("invalid package identifier: " ++ str) _ -> verror CannotForce ("ambiguous package identifier: " ++ str) -checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Validate () -checkDuplicates db_stack pkg update = do +checkDuplicates :: PackageDBStack -> InstalledPackageInfo + -> Bool -> Bool-> Validate () +checkDuplicates db_stack pkg multi_instance update = do let pkgid = sourcePackageId pkg pkgs = packages (head db_stack) -- -- Check whether this package id already exists in this DB -- - when (not update && (pkgid `elem` map sourcePackageId pkgs)) $ + when (not update && not multi_instance + && (pkgid `elem` map sourcePackageId pkgs)) $ verror CannotForce $ "package " ++ display pkgid ++ " is already installed" From git at git.haskell.org Wed Jul 2 15:12:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 15:12:16 +0000 (UTC) Subject: [commit: ghc] master: includes/stg/SMP.h: use 'NOSMP' instead of never defined 'WITHSMP' (Trac #8789) (34bae1f) Message-ID: <20140702151216.C6DC32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34bae1f737e1492c152ccaafd457697b621c606b/ghc >--------------------------------------------------------------- commit 34bae1f737e1492c152ccaafd457697b621c606b Author: Sergei Trofimovich Date: Wed Jul 2 08:54:35 2014 -0500 includes/stg/SMP.h: use 'NOSMP' instead of never defined 'WITHSMP' (Trac #8789) Summary: git history does not contain state where 'WITHSMP' macro was ever defined. It should have always been '!NOSMP'. Signed-off-by: Sergei Trofimovich Test Plan: build tested Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D33 >--------------------------------------------------------------- 34bae1f737e1492c152ccaafd457697b621c606b includes/stg/SMP.h | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h index 01663dd..00608c7 100644 --- a/includes/stg/SMP.h +++ b/includes/stg/SMP.h @@ -107,7 +107,10 @@ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) { StgWord result; -#if i386_HOST_ARCH || x86_64_HOST_ARCH +#if defined(NOSMP) + result = *p; + *p = w; +#elif i386_HOST_ARCH || x86_64_HOST_ARCH result = w; __asm__ __volatile__ ( // NB: the xchg instruction is implicitly locked, so we do not @@ -154,9 +157,6 @@ xchg(StgPtr p, StgWord w) : "r" (w), "r" (p) : "memory" ); -#elif !defined(WITHSMP) - result = *p; - *p = w; #else #error xchg() unimplemented on this architecture #endif @@ -170,7 +170,14 @@ xchg(StgPtr p, StgWord w) EXTERN_INLINE StgWord cas(StgVolatilePtr p, StgWord o, StgWord n) { -#if i386_HOST_ARCH || x86_64_HOST_ARCH +#if defined(NOSMP) + StgWord result; + result = *p; + if (result == o) { + *p = n; + } + return result; +#elif i386_HOST_ARCH || x86_64_HOST_ARCH __asm__ __volatile__ ( "lock\ncmpxchg %3,%1" :"=a"(o), "+m" (*(volatile unsigned int *)p) @@ -225,13 +232,6 @@ cas(StgVolatilePtr p, StgWord o, StgWord n) : "cc","memory"); return result; -#elif !defined(WITHSMP) - StgWord result; - result = *p; - if (result == o) { - *p = n; - } - return result; #else #error cas() unimplemented on this architecture #endif @@ -302,7 +302,9 @@ busy_wait_nop(void) */ EXTERN_INLINE void write_barrier(void) { -#if i386_HOST_ARCH || x86_64_HOST_ARCH +#if defined(NOSMP) + return; +#elif i386_HOST_ARCH || x86_64_HOST_ARCH __asm__ __volatile__ ("" : : : "memory"); #elif powerpc_HOST_ARCH __asm__ __volatile__ ("lwsync" : : : "memory"); @@ -313,8 +315,6 @@ write_barrier(void) { __asm__ __volatile__ ("" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb st" : : : "memory"); -#elif !defined(WITHSMP) - return; #else #error memory barriers unimplemented on this architecture #endif @@ -322,7 +322,9 @@ write_barrier(void) { EXTERN_INLINE void store_load_barrier(void) { -#if i386_HOST_ARCH +#if defined(NOSMP) + return; +#elif i386_HOST_ARCH __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); #elif x86_64_HOST_ARCH __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); @@ -332,8 +334,6 @@ store_load_barrier(void) { __asm__ __volatile__ ("membar #StoreLoad" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb" : : : "memory"); -#elif !defined(WITHSMP) - return; #else #error memory barriers unimplemented on this architecture #endif @@ -341,7 +341,9 @@ store_load_barrier(void) { EXTERN_INLINE void load_load_barrier(void) { -#if i386_HOST_ARCH +#if defined(NOSMP) + return; +#elif i386_HOST_ARCH __asm__ __volatile__ ("" : : : "memory"); #elif x86_64_HOST_ARCH __asm__ __volatile__ ("" : : : "memory"); @@ -352,8 +354,6 @@ load_load_barrier(void) { __asm__ __volatile__ ("" : : : "memory"); #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7) __asm__ __volatile__ ("dmb" : : : "memory"); -#elif !defined(WITHSMP) - return; #else #error memory barriers unimplemented on this architecture #endif From git at git.haskell.org Wed Jul 2 15:12:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 15:12:19 +0000 (UTC) Subject: [commit: ghc] master: remove redundant condition checking in profiling RTS code (b3d9636) Message-ID: <20140702151219.429732406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b3d9636af37cfafbc947b69dff5747065f437804/ghc >--------------------------------------------------------------- commit b3d9636af37cfafbc947b69dff5747065f437804 Author: osa1 Date: Wed Jul 2 08:55:04 2014 -0500 remove redundant condition checking in profiling RTS code Summary: A redundant condition checking is removed, as discussed in http://www.haskell.org/pipermail/ghc-devs/2014-June/005088.html Test Plan: validate Reviewers: simonmar, austin Reviewed By: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D37 >--------------------------------------------------------------- b3d9636af37cfafbc947b69dff5747065f437804 rts/Profiling.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/rts/Profiling.c b/rts/Profiling.c index 50c9c39..53f64a7 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -619,10 +619,8 @@ actualPush_ (CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs) ccsSetSelected(new_ccs); /* update the memoization table for the parent stack */ - if (ccs != EMPTY_STACK) { - ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc, - 0/*not a back edge*/); - } + ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc, + 0/*not a back edge*/); /* return a pointer to the new stack */ return new_ccs; From git at git.haskell.org Wed Jul 2 16:11:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:32 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix T9160 under ./validate (9fa818d) Message-ID: <20140702161132.434EE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/9fa818dea9b0aca2e55a21b7fe7520d00814d6db/ghc >--------------------------------------------------------------- commit 9fa818dea9b0aca2e55a21b7fe7520d00814d6db Author: Austin Seipp Date: Wed Jul 2 10:27:16 2014 -0500 Fix T9160 under ./validate Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9fa818dea9b0aca2e55a21b7fe7520d00814d6db testsuite/tests/indexed-types/should_fail/T9160.stderr | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/indexed-types/should_fail/T9160.stderr b/testsuite/tests/indexed-types/should_fail/T9160.stderr index 7a476d4..38e79b3 100644 --- a/testsuite/tests/indexed-types/should_fail/T9160.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9160.stderr @@ -1,6 +1,9 @@ Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. +Loading package array-0.5.0.0 ... linking ... done. +Loading package deepseq-1.3.0.2 ... linking ... done. +Loading package containers-0.5.5.1 ... linking ... done. Loading package pretty-1.1.1.1 ... linking ... done. Loading package template-haskell ... linking ... done. From git at git.haskell.org Wed Jul 2 16:11:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:34 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Control CPP through settings file (#8683) (2c95add) Message-ID: <20140702161134.B4D602406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/2c95addb8605ac8348bf10f774cf2fedd689288d/ghc >--------------------------------------------------------------- commit 2c95addb8605ac8348bf10f774cf2fedd689288d Author: Carter Tazio Schonwald Date: Wed Jul 2 08:52:53 2014 -0500 Control CPP through settings file (#8683) Summary: Allow the CPP program and flag choices for GHC be configured via the the ghc settings file Test Plan: ran validate yesterday Reviewers: hvr, austin, mzero, simonmar Reviewed By: austin, mzero, simonmar Subscribers: mzero, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D26 (cherry picked from commit 34f7e9a3c99850859901ca74370f55f1d4e2279a) >--------------------------------------------------------------- 2c95addb8605ac8348bf10f774cf2fedd689288d aclocal.m4 | 9 ++++++ compiler/ghc.mk | 2 -- compiler/main/SysTools.lhs | 8 ++--- configure.ac | 73 +++++++++++++++++++++++++++++++++++++++++----- distrib/configure.ac.in | 59 +++++++++++++++++++++++++++++++++++++ settings.in | 2 ++ 6 files changed, 140 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2c95addb8605ac8348bf10f774cf2fedd689288d From git at git.haskell.org Wed Jul 2 16:11:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:37 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Remove extraneous debugging output (#9071) (1054e02) Message-ID: <20140702161137.24A5B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/1054e022cd7627a9f313a2df32f8d5331c6a7453/ghc >--------------------------------------------------------------- commit 1054e022cd7627a9f313a2df32f8d5331c6a7453 Author: Reid Barton Date: Mon Jun 30 17:27:14 2014 -0400 Remove extraneous debugging output (#9071) (cherry picked from commit c44da48c6d19b3d8cc0ba34328576683410f8ec2) >--------------------------------------------------------------- 1054e022cd7627a9f313a2df32f8d5331c6a7453 compiler/typecheck/TcRnTypes.lhs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index bacaba6..44dc3fa 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1845,8 +1845,7 @@ pprO TupleOrigin = ptext (sLit "a tuple") pprO NegateOrigin = ptext (sLit "a use of syntactic negation") pprO ScOrigin = ptext (sLit "the superclasses of an instance declaration") pprO DerivOrigin = ptext (sLit "the 'deriving' clause of a data type declaration") -pprO (DerivOriginDC dc n) = pprTrace "dco" (ppr dc <+> ppr n) $ - hsep [ ptext (sLit "the"), speakNth n, +pprO (DerivOriginDC dc n) = hsep [ ptext (sLit "the"), speakNth n, ptext (sLit "field of"), quotes (ppr dc), parens (ptext (sLit "type") <+> quotes (ppr ty)) ] where ty = dataConOrigArgTys dc !! (n-1) From git at git.haskell.org Wed Jul 2 16:11:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:39 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix demand analyser for unboxed types (642d599) Message-ID: <20140702161142.9581B2406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/642d5992ba89788bd2b488f60bbc1f0c990dae43/ghc >--------------------------------------------------------------- commit 642d5992ba89788bd2b488f60bbc1f0c990dae43 Author: Simon Peyton Jones Date: Tue Jul 1 13:31:18 2014 +0100 Fix demand analyser for unboxed types This is a tricky case exposed by Trac #9254. I'm surprised it hasn't shown up before, because it's happens when you use unsafePerformIO in the right way. Anyway, fixed now. See Note [Analysing with absent demand] in Demand.lhs (cherry picked from commit d6ee82b29598dcc1028773dd987b7a2fb17519b7) >--------------------------------------------------------------- 642d5992ba89788bd2b488f60bbc1f0c990dae43 compiler/basicTypes/Demand.lhs | 59 +++++++++++++++++++--- compiler/stranal/DmdAnal.lhs | 2 +- testsuite/tests/stranal/should_run/T9254.hs | 20 ++++++++ .../should_run/T9254.stdout} | 0 testsuite/tests/stranal/should_run/all.T | 1 + 5 files changed, 74 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index db5ac5c..fcef7a6 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -64,7 +64,7 @@ import BasicTypes import Binary import Maybes ( orElse ) -import Type ( Type ) +import Type ( Type, isUnLiftedType ) import TyCon ( isNewTyCon, isClassTyCon ) import DataCon ( splitDataProductType_maybe ) \end{code} @@ -1139,13 +1139,18 @@ type DeferAndUse -- Describes how to degrade a result type type DeferAndUseM = Maybe DeferAndUse -- Nothing <=> absent-ify the result type; it will never be used -toCleanDmd :: Demand -> (CleanDemand, DeferAndUseM) --- See Note [Analyzing with lazy demand and lambdas] -toCleanDmd (JD { strd = s, absd = u }) +toCleanDmd :: Demand -> Type -> (CleanDemand, DeferAndUseM) +toCleanDmd (JD { strd = s, absd = u }) expr_ty = case (s,u) of - (Str s', Use c u') -> (CD { sd = s', ud = u' }, Just (False, c)) - (Lazy, Use c u') -> (CD { sd = HeadStr, ud = u' }, Just (True, c)) - (_, Abs) -> (CD { sd = HeadStr, ud = Used }, Nothing) + (Str s', Use c u') -> -- The normal case + (CD { sd = s', ud = u' }, Just (False, c)) + + (Lazy, Use c u') -> -- See Note [Analyzing with lazy demand and lambdas] + (CD { sd = HeadStr, ud = u' }, Just (True, c)) + + (_, Abs) -- See Note [Analysing with absent demand] + | isUnLiftedType expr_ty -> (CD { sd = HeadStr, ud = Used }, Just (False, One)) + | otherwise -> (CD { sd = HeadStr, ud = Used }, Nothing) -- This is used in dmdAnalStar when post-processing -- a function's argument demand. So we only care about what @@ -1335,6 +1340,46 @@ demand . This is achieved by, first, converting the lazy demand L into the strict S by the second clause of the analysis. +Note [Analysing with absent demand] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we analyse an expression with demand . The "A" means +"absent", so this expression will never be needed. What should happen? +There are several wrinkles: + +* We *do* want to analyse the expression regardless. + Reason: Note [Always analyse in virgin pass] + + But we can post-process the results to ignore all the usage + demands coming back. This is done by postProcessDmdTypeM. + +* But in the case of an *unlifted type* we must be extra careful, + because unlifted values are evaluated even if they are not used. + Example (see Trac #9254): + f :: (() -> (# Int#, () #)) -> () + -- Strictness signature is + -- + -- I.e. calls k, but discards first component of result + f k = case k () of (# _, r #) -> r + + g :: Int -> () + g y = f (\n -> (# case y of I# y2 -> y2, n #)) + + Here f's strictness signature says (correctly) that it calls its + argument function and ignores the first component of its result. + This is correct in the sense that it'd be fine to (say) modify the + function so that always returned 0# in the first component. + + But in function g, we *will* evaluate the 'case y of ...', because + it has type Int#. So 'y' will be evaluated. So we must record this + usage of 'y', else 'g' will say 'y' is absent, and will w/w so that + 'y' is bound to an aBSENT_ERROR thunk. + + An alternative would be to replace the 'case y of ...' with (say) 0#, + but I have not tried that. It's not a common situation, but it is + not theoretical: unsafePerformIO's implementation is very very like + 'f' above. + + %************************************************************************ %* * Demand signatures diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 31996cb..972d830 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -118,7 +118,7 @@ dmdAnalStar :: AnalEnv -> Demand -- This one takes a *Demand* -> CoreExpr -> (BothDmdArg, CoreExpr) dmdAnalStar env dmd e - | (cd, defer_and_use) <- toCleanDmd dmd + | (cd, defer_and_use) <- toCleanDmd dmd (exprType e) , (dmd_ty, e') <- dmdAnal env cd e = (postProcessDmdTypeM defer_and_use dmd_ty, e') diff --git a/testsuite/tests/stranal/should_run/T9254.hs b/testsuite/tests/stranal/should_run/T9254.hs new file mode 100644 index 0000000..279eb5c --- /dev/null +++ b/testsuite/tests/stranal/should_run/T9254.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module Main where +import GHC.Exts + +f :: (() -> (# Int#, () #)) -> () +{-# NOINLINE f #-} +-- Strictness signature was (7.8.2) +-- +-- I.e. calls k, but discards first component of result +f k = case k () of (# _, r #) -> r + +g :: Int -> () +g y = f (\n -> (# case y of I# y2 -> h (h (h (h (h (h (h y2)))))), n #)) + -- RHS is big enough to force worker/wrapper + +{-# NOINLINE h #-} +h :: Int# -> Int# +h n = n +# 1# + +main = print (g 1) diff --git a/testsuite/tests/codeGen/should_run/T3207.stdout b/testsuite/tests/stranal/should_run/T9254.stdout similarity index 100% copy from testsuite/tests/codeGen/should_run/T3207.stdout copy to testsuite/tests/stranal/should_run/T9254.stdout diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index 0c43aac..2ca65b5 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, ['']) test('strun004', normal, compile_and_run, ['']) test('T2756b', normal, compile_and_run, ['']) test('T7649', normal, compile_and_run, ['']) +test('T9254', normal, compile_and_run, ['']) From git at git.haskell.org Wed Jul 2 16:11:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:42 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: In TcValidity.checkAmbiguity, skolemise kind vars that appear free in the kinds of type variables (030cba6) Message-ID: <20140702161142.A0B9B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/030cba65c855dfa01ae0dc461029638ed3d7539f/ghc >--------------------------------------------------------------- commit 030cba65c855dfa01ae0dc461029638ed3d7539f Author: Simon Peyton Jones Date: Tue Jun 24 22:23:29 2014 +0100 In TcValidity.checkAmbiguity, skolemise kind vars that appear free in the kinds of type variables This was shown up by Trac #9222. (cherry picked from commit 2be99d2309471bc75ddb9cb47acda9ccbcb7ab63) >--------------------------------------------------------------- 030cba65c855dfa01ae0dc461029638ed3d7539f compiler/typecheck/TcValidity.lhs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index d080c08..d85287c 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -69,11 +69,16 @@ checkAmbiguity ctxt ty | otherwise = do { traceTc "Ambiguity check for" (ppr ty) - ; (subst, _tvs) <- tcInstSkolTyVars (varSetElems (tyVarsOfType ty)) + ; let free_tkvs = varSetElemsKvsFirst (closeOverKinds (tyVarsOfType ty)) + ; (subst, _tvs) <- tcInstSkolTyVars free_tkvs ; let ty' = substTy subst ty - -- The type might have free TyVars, - -- so we skolemise them as TcTyVars + -- The type might have free TyVars, esp when the ambiguity check + -- happens during a call to checkValidType, + -- so we skolemise them as TcTyVars. -- Tiresome; but the type inference engine expects TcTyVars + -- NB: The free tyvar might be (a::k), so k is also free + -- and we must skolemise it as well. Hence closeOverKinds. + -- (Trac #9222) -- Solve the constraints eagerly because an ambiguous type -- can cause a cascade of further errors. Since the free From git at git.haskell.org Wed Jul 2 16:11:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:44 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Test Trac #9222 (f3f4589) Message-ID: <20140702161144.C949A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f3f45895ccafd9b87566c063626cf516c0a13123/ghc >--------------------------------------------------------------- commit f3f45895ccafd9b87566c063626cf516c0a13123 Author: Simon Peyton Jones Date: Tue Jul 1 15:23:30 2014 +0100 Test Trac #9222 (cherry picked from commit 127c45ea30eaee6b5244b3f30aaa701d0ad327ac) Conflicts: testsuite/tests/polykinds/all.T >--------------------------------------------------------------- f3f45895ccafd9b87566c063626cf516c0a13123 testsuite/tests/polykinds/T9222.hs | 7 +++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 8 insertions(+) diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs new file mode 100644 index 0000000..df11251 --- /dev/null +++ b/testsuite/tests/polykinds/T9222.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes, GADTs, DataKinds, PolyKinds, TypeOperators, TypeFamilies #-} +module T9222 where + +import Data.Proxy + +data Want :: (i,j) -> * where + Want :: (a ~ '(b,c) => Proxy b) -> Want a diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 96faa67..de73b37 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -101,3 +101,4 @@ test('T7481', normal, compile_fail,['']) test('T8705', normal, compile, ['']) test('T8985', normal, compile, ['']) test('T9106', normal, compile_fail, ['']) +test('T9222', normal, compile, ['']) From git at git.haskell.org Wed Jul 2 16:11:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:47 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Check for integer overflow in allocate() (#9172) (291681a) Message-ID: <20140702161147.986B12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/291681ad101fe7fc68cb0f875b3e39aa5e8e8f37/ghc >--------------------------------------------------------------- commit 291681ad101fe7fc68cb0f875b3e39aa5e8e8f37 Author: Reid Barton Date: Tue Jul 1 10:20:31 2014 -0400 Check for integer overflow in allocate() (#9172) Summary: Check for integer overflow in allocate() (#9172) Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D36 (cherry picked from commit db64180896b395283f443d66a308048c605b217d) Conflicts: testsuite/.gitignore >--------------------------------------------------------------- 291681ad101fe7fc68cb0f875b3e39aa5e8e8f37 rts/sm/Storage.c | 10 +++++++++- testsuite/tests/rts/all.T | 5 +++++ testsuite/tests/rts/overflow1.hs | 11 +++++++++++ testsuite/tests/rts/overflow1.stderr | 1 + testsuite/tests/rts/overflow2.hs | 20 ++++++++++++++++++++ testsuite/tests/rts/overflow2.stderr | 1 + testsuite/tests/rts/overflow3.hs | 20 ++++++++++++++++++++ testsuite/tests/rts/overflow3.stderr | 1 + 8 files changed, 68 insertions(+), 1 deletion(-) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 86bd1c2..d002fec 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -686,7 +686,15 @@ StgPtr allocate (Capability *cap, W_ n) CCS_ALLOC(cap->r.rCCCS,n); if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - W_ req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; + // The largest number of bytes such that + // the computation of req_blocks will not overflow. + W_ max_bytes = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_); + W_ req_blocks; + + if (n > max_bytes) + req_blocks = HS_WORD_MAX; // signal overflow below + else + req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; // Attempting to allocate an object larger than maxHeapSize // should definitely be disallowed. (bug #1791) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 8b4fdfa..920368a 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -215,3 +215,8 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # I couldn't reproduce 9078 with the -threaded runtime, but could easily # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) + +# 251 = RTS exit code for "out of memory" +test('overflow1', [ exit_code(251) ], compile_and_run, ['']) +test('overflow2', [ exit_code(251) ], compile_and_run, ['']) +test('overflow3', [ exit_code(251) ], compile_and_run, ['']) diff --git a/testsuite/tests/rts/overflow1.hs b/testsuite/tests/rts/overflow1.hs new file mode 100644 index 0000000..63ed5a4 --- /dev/null +++ b/testsuite/tests/rts/overflow1.hs @@ -0,0 +1,11 @@ +module Main where + +import Data.Array.IO +import Data.Word + +-- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate() +-- Here we invoke allocate() via newByteArray# and the array package. +-- Request a number of bytes close to HS_WORD_MAX, +-- subtracting a few words for overhead in newByteArray#. +-- Allocate Word32s (rather than Word8s) to get around bounds-checking in array. +main = newArray (0,maxBound `div` 4 - 10) 0 :: IO (IOUArray Word Word32) diff --git a/testsuite/tests/rts/overflow1.stderr b/testsuite/tests/rts/overflow1.stderr new file mode 100644 index 0000000..734ca95 --- /dev/null +++ b/testsuite/tests/rts/overflow1.stderr @@ -0,0 +1 @@ +overflow1: out of memory diff --git a/testsuite/tests/rts/overflow2.hs b/testsuite/tests/rts/overflow2.hs new file mode 100644 index 0000000..ac72158 --- /dev/null +++ b/testsuite/tests/rts/overflow2.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount - 1) diff --git a/testsuite/tests/rts/overflow2.stderr b/testsuite/tests/rts/overflow2.stderr new file mode 100644 index 0000000..be65509 --- /dev/null +++ b/testsuite/tests/rts/overflow2.stderr @@ -0,0 +1 @@ +overflow2: out of memory diff --git a/testsuite/tests/rts/overflow3.hs b/testsuite/tests/rts/overflow3.hs new file mode 100644 index 0000000..31dfd5d --- /dev/null +++ b/testsuite/tests/rts/overflow3.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount + 1) diff --git a/testsuite/tests/rts/overflow3.stderr b/testsuite/tests/rts/overflow3.stderr new file mode 100644 index 0000000..6c804e5 --- /dev/null +++ b/testsuite/tests/rts/overflow3.stderr @@ -0,0 +1 @@ +overflow3: out of memory From git at git.haskell.org Wed Jul 2 16:11:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:49 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #9085. (105d8d1) Message-ID: <20140702161150.100B12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/105d8d1c65c6eb0f1c7657dc3a395ec7bfd7c13a/ghc >--------------------------------------------------------------- commit 105d8d1c65c6eb0f1c7657dc3a395ec7bfd7c13a Author: Richard Eisenberg Date: Tue Jun 10 15:25:36 2014 -0400 Fix #9085. Inaccessible equations in a closed type family now leads to a warning, not an error. This echoes what happens at the term level. (cherry picked from commit 6a1d7f9736098d47463a71323d28ece792a59e52) >--------------------------------------------------------------- 105d8d1c65c6eb0f1c7657dc3a395ec7bfd7c13a compiler/typecheck/TcTyClsDecls.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 817fbb3..c03af38 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1464,8 +1464,8 @@ checkValidClosedCoAxiom (CoAxiom { co_ax_branches = branches, co_ax_tc = tc }) -- ones and hence is inaccessible check_accessibility prev_branches cur_branch = do { when (cur_branch `isDominatedBy` prev_branches) $ - setSrcSpan (coAxBranchSpan cur_branch) $ - addErrTc $ inaccessibleCoAxBranch tc cur_branch + addWarnAt (coAxBranchSpan cur_branch) $ + inaccessibleCoAxBranch tc cur_branch ; return (cur_branch : prev_branches) } checkFieldCompat :: Name -> DataCon -> DataCon -> TyVarSet @@ -2161,7 +2161,7 @@ wrongNamesInInstGroup first cur inaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc inaccessibleCoAxBranch tc fi - = ptext (sLit "Inaccessible family instance equation:") $$ + = ptext (sLit "Overlapped type family instance equation:") $$ (pprCoAxBranch tc fi) badRoleAnnot :: Name -> Role -> Role -> SDoc From git at git.haskell.org Wed Jul 2 16:11:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:11:52 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Test #9085. (87e6123) Message-ID: <20140702161152.C2D222406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/87e6123dad5c43921a8c5bde712904be9245febd/ghc >--------------------------------------------------------------- commit 87e6123dad5c43921a8c5bde712904be9245febd Author: Richard Eisenberg Date: Wed Jun 11 08:29:27 2014 -0400 Test #9085. (cherry picked from commit f502617065c8716a062c83fc923c3b3a2395c4a8) >--------------------------------------------------------------- 87e6123dad5c43921a8c5bde712904be9245febd testsuite/tests/indexed-types/should_compile/T9085.hs | 7 +++++++ testsuite/tests/indexed-types/should_compile/T9085.stderr | 4 ++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 12 insertions(+) diff --git a/testsuite/tests/indexed-types/should_compile/T9085.hs b/testsuite/tests/indexed-types/should_compile/T9085.hs new file mode 100644 index 0000000..13c9321 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T9085.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +module T9085 where + +type family F a where + F a = Int + F Bool = Bool diff --git a/testsuite/tests/indexed-types/should_compile/T9085.stderr b/testsuite/tests/indexed-types/should_compile/T9085.stderr new file mode 100644 index 0000000..ee968e0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T9085.stderr @@ -0,0 +1,4 @@ + +T9085.hs:7:3: Warning: + Overlapped type family instance equation: + F Bool = Bool diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 5f30446..7c41be8 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -243,3 +243,4 @@ test('T8889', normal, compile, ['']) test('T8913', normal, compile, ['']) test('T8978', normal, compile, ['']) test('T8979', normal, compile, ['']) +test('T9085', normal, compile, ['']) From git at git.haskell.org Wed Jul 2 16:16:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:16:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Mark T9208 as broken when debugging is on (882f653) Message-ID: <20140702161625.5BA302406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/882f6535ba257c20c491c6637ca4270a56d95fae/ghc >--------------------------------------------------------------- commit 882f6535ba257c20c491c6637ca4270a56d95fae Author: Joachim Breitner Date: Mon Jun 23 08:50:47 2014 -0700 Mark T9208 as broken when debugging is on this seems to be expected, as explained by SPJ in comment 7 of #9208. (cherry picked from commit 518ada5cda08d3256826ed0383888111f8096de5) >--------------------------------------------------------------- 882f6535ba257c20c491c6637ca4270a56d95fae testsuite/tests/stranal/should_compile/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index b88c49f..3a9a35d 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -19,4 +19,4 @@ test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) -test('T9208', normal, compile, ['']) +test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, ['']) From git at git.haskell.org Wed Jul 2 16:16:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 16:16:27 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Comment the expect_broken for Trac #9208 (4ca496c) Message-ID: <20140702161627.B92EA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/4ca496c5c4aa565e945f4c25b8d278317d5ee4da/ghc >--------------------------------------------------------------- commit 4ca496c5c4aa565e945f4c25b8d278317d5ee4da Author: Simon Peyton Jones Date: Mon Jun 23 17:37:56 2014 +0100 Comment the expect_broken for Trac #9208 (cherry picked from commit 8a0aa198f78cac1ca8d0695bd711778e8ad086aa) >--------------------------------------------------------------- 4ca496c5c4aa565e945f4c25b8d278317d5ee4da testsuite/tests/stranal/should_compile/all.T | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 3a9a35d..184ff1e 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -19,4 +19,7 @@ test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) + test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, ['']) +# T9208 fails (and should do so) if you have assertion checking on in the compiler +# Hence the above expect_broken. See comments in the Trac ticket \ No newline at end of file From git at git.haskell.org Wed Jul 2 17:27:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 17:27:31 +0000 (UTC) Subject: [commit: ghc] master: Minor edits to Backpack design doc (5a963b8) Message-ID: <20140702172731.9A4FF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a963b8238cb52cb1e5bfcfae7f467cd00c171a0/ghc >--------------------------------------------------------------- commit 5a963b8238cb52cb1e5bfcfae7f467cd00c171a0 Author: Edward Z. Yang Date: Wed Jul 2 18:27:17 2014 +0100 Minor edits to Backpack design doc Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 5a963b8238cb52cb1e5bfcfae7f467cd00c171a0 docs/backpack/backpack-impl.tex | 111 +++++++++++++++++++++++++++++++++------- 1 file changed, 92 insertions(+), 19 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index 4e56d4b..e45cead 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -513,7 +513,7 @@ Our motivating example, then, would fail to witness sharing. This might be the simplest thing to do, but it is a change in the Backpack semantics, and rules out modularization without splitting a package into multiple packages. Maybe Scott can give other reasons why this -would not be so good. +would not be so good. SPJ is quite keen on this plan. \subsection{Exposed modules should allow external modules}\label{sec:reexport} @@ -808,6 +808,8 @@ implementation, we can skip the compilation process and reuse the version. This is because the calculated \verb|BDEPS| will be the same, and thus the package IDs will be the same. +XXX ToDo: actually write down pseudocode algorithm for this + \paragraph{Module environment or package flags?} In the previous section, I presented two ways by which one can tweak the behavior of GHC's module finder, which is responsible for resolving \verb|import B| @@ -878,17 +880,28 @@ It should be possible to support GHC-style mutual recursion using the Backpack formalism immediately using hs-boot files. However, to avoid the need for a shaping pass, we must adopt an existing constraint that already applies to hs-boot files: \emph{at the time we define a signature, -we must know what the original name for all data types is}. We then -compile modules as usual, but compiling against the signature as if it -were an hs-boot file. - -(ToDo: Figure out why this eliminates the shaping pass) +we must know what the original name for all data types is}. In practice, +GHC enforces this by stating that: (1) an hs-boot file must be +accompanied with an implementation, and (2) the implementation must +in fact define (and not reexport) all of the declarations in the signature. + +Why does this not require a shaping pass? The reason is that the +signature is not really polymorphic: we require that the $\alpha$ module +variable be resolved to a concrete module later in the same package, and +that all the $\beta$ module variables be unified with $\alpha$. Thus, we +know ahead of time the original names and don't need to deal with any +renaming.\footnote{This strategy doesn't completely resolve the problem +of cross-package mutual recursion, because we need to first compile a +bit of the first package (signatures), then the second package, and then +the rest of the first package.} Compiling packages in this way gives the tantalizing possibility of true separate compilation: the only thing we don't know is what the actual package name of an indefinite package will be, and what the correct references to have are. This is a very minor change to the assembly, so one could conceive -of dynamically rewriting these references at the linking stage. +of dynamically rewriting these references at the linking stage. But +separate compilation achieved in this fashion would not be able to take +advantage of cross-module optimizations. \section{Shaped Backpack} @@ -1031,14 +1044,12 @@ to determine the dependency graph, so that it can have some order to compile modules in. There is a specialized parser which just parses these statements, and then ignores the rest of the file. -It is not difficult to imagine extending this parser to pick up other entities -which a Haskell file may define, while skipping their actual definitions -(it's enough to know if the module defines it or not.) If this can be -done acceptably quickly, there is no need to perform a renaming pass or -anything complicated; that is all the preprocessing necessary. +A bit of background: the \emph{renamer} is responsible for resolving +imports and figuring out where all of these entities actually come from. +SPJ would really like to avoid having to run the renamer in order to perform +a shaping pass. -(XXX maybe you can do something even more sophisticated and avoid picking -up entities. ToDo: show a counterexample for this case.) +XXX Primary open question here: is it possible to do shaping without renaming? \subsection{Installing indefinite packages}\label{sec:installing-indefinite} @@ -1237,10 +1248,19 @@ can affect how a hole is instantiated by another entry. This might be a bit weird to users, who might like to explicitly say how holes are filled when instantiating a package. Food for thought, surface syntax wise. -\paragraph{Holes in the package} XXX Actually, I think this is simple: -these holes are just part of the module graph from step (3), and get -sorted in a normal way. You can probably just place them all up top without -causing any problems. +\paragraph{Holes in the package} Actually, this is quite simple: the +ordering of includes goes as before, but some indefinite packages in the +database are less constrained as they're ``dependencies'' are fulfilled +by the holes at the top-level of this package. It's also worth noting +that some dependencies will go unresolved, since the following package +is valid: + +\begin{verbatim} +package a where + A :: ... +package b where + include a +\end{verbatim} \paragraph{Multiple signatures} In Backpack syntax, it's possible to define a signature multiple times, which is necessary for mutually @@ -1285,7 +1305,60 @@ abstract import Data.Foo \end{verbatim} which makes it clear that this module is pluggable, typechecking against -a signature. +a signature. Note that this only indicates how type checking should be +done: when actually compiling the module we will compile against the +interface file for the true implementation of the module. + +It's worth noting that the SOURCE annotation was originally made a +pragma because, in principle, it should have been possible to compile +some recursive modules without needing the hs-boot file at all. But if +we're moving towards boot files as signatures, this concern is less +relevant. + +\section{Bits and bobs} + +\subsection{Abstract type synonyms} + +In Paper Backpack, abstract type synonyms are not permitted, because GHC doesn't +understand how to deal with them. The purpose of this section is to describe +one particularly nastiness of abstract type synonyms, by way of the occurs check: + +\begin{verbatim} +A :: [ type T ] +B :: [ import qualified A; type T = [A.T] ] +\end{verbatim} + +At this point, it is illegal for \verb|A = B|, otherwise this type synonym would +fail the occurs check. This seems like pretty bad news, since every instance +of the occurs check in the type-checker could constitute a module inequality. + +\subsection{Type families} + +Like type classes, type families must not overlap (and this is a question of +type safety!) + +A more subtle question is compatibility and apartness of type family +equations. Under these checks, aliasing of modules can fail if it causes +two type families to be identified, but their definitions are not apart. +Here is a simple example: + +\begin{verbatim} +A :: [ + type family F a :: * + type instance F Int = Char +] +B :: [ + type family F a :: * + type instance F Int = Bool +] +\end{verbatim} + +Now it is illegal for \verb|A = B|, because when the type families are +unified, the instances now fail the apartness check. However, if the second +instance was \verb|F Int = Char|, the families would be able to link together. + +It would be nice to solve this problem before getting to the linking phase. (But, +channeling SPJ for a moment, ``Why would anyone want to do that?!'') \section{Open questions}\label{sec:open-questions} From git at git.haskell.org Wed Jul 2 17:39:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 17:39:33 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Lint should check that TyConAppCo doesn't have a synonym in the tycon position (0fe1f41) Message-ID: <20140702173933.330082406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/0fe1f41ed7f351e6a8b6e8f7e4f6b5b859e7d06c/ghc >--------------------------------------------------------------- commit 0fe1f41ed7f351e6a8b6e8f7e4f6b5b859e7d06c Author: Simon Peyton Jones Date: Tue May 13 13:15:45 2014 +0100 Lint should check that TyConAppCo doesn't have a synonym in the tycon position That is why Lint didn't nail Trac #9102 (cherry picked from commit 4cfc1fae11ec9a5c4b34ac747f0ce50f52423eba) >--------------------------------------------------------------- 0fe1f41ed7f351e6a8b6e8f7e4f6b5b859e7d06c compiler/coreSyn/CoreLint.lhs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index b5c7985..3d3deab 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -856,6 +856,9 @@ lintCoercion co@(TyConAppCo r tc cos) ; checkRole co2 r r2 ; return (rk, mkFunTy s1 s2, mkFunTy t1 t2, r) } + | isSynTyCon tc + = failWithL (ptext (sLit "Synonym in TyConAppCo:") <+> ppr co) + | otherwise = do { (ks,ss,ts,rs) <- mapAndUnzip4M lintCoercion cos ; rk <- lint_co_app co (tyConKind tc) (ss `zip` ks) From git at git.haskell.org Wed Jul 2 17:39:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 17:39:36 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix invariant in mkAppCoFlexible (0bbcdc8) Message-ID: <20140702173936.5E7322406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/0bbcdc88ca8596e1abd1ecfea1ad0835d2b99258/ghc >--------------------------------------------------------------- commit 0bbcdc88ca8596e1abd1ecfea1ad0835d2b99258 Author: Simon Peyton Jones Date: Tue May 13 13:17:19 2014 +0100 Fix invariant in mkAppCoFlexible mkAppCoFlexible was breaking the invariant that the head of a TyConAppCo cannot be a type synonym. This small patch fixes it. (cherry picked from commit 21f17d06aa5c33e639f1b0d37b4bf888b494c441) >--------------------------------------------------------------- 0bbcdc88ca8596e1abd1ecfea1ad0835d2b99258 compiler/types/Coercion.lhs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index af2b2fa..d9e0740 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -899,7 +899,9 @@ mkAppCo co1 co2 = mkAppCoFlexible co1 Nominal co2 mkAppCoFlexible :: Coercion -> Role -> Coercion -> Coercion mkAppCoFlexible (Refl r ty1) _ (Refl _ ty2) = Refl r (mkAppTy ty1 ty2) -mkAppCoFlexible (Refl r (TyConApp tc tys)) r2 co2 +mkAppCoFlexible (Refl r ty1) r2 co2 + | Just (tc, tys) <- splitTyConApp_maybe ty1 + -- Expand type synonyms; a TyConAppCo can't have a type synonym (Trac #9102) = TyConAppCo r tc (zip_roles (tyConRolesX r tc) tys) where zip_roles (r1:_) [] = [maybeSubCo2 r1 r2 co2] From git at git.haskell.org Wed Jul 2 17:39:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 17:39:38 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Refactoring around TyCon.isSynTyCon (5c97e93) Message-ID: <20140702173938.DCC662406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/5c97e932df780d3679da9a64676fe2af944e5c94/ghc >--------------------------------------------------------------- commit 5c97e932df780d3679da9a64676fe2af944e5c94 Author: Simon Peyton Jones Date: Wed Jul 2 12:18:41 2014 -0500 Refactoring around TyCon.isSynTyCon * Document isSynTyCon better * Add isTypeSyonymTyCon for regular H98 type synonyms * Use isTypeSynonymTyCon rather than isSynTyCon where the former is really intended All arose as part of a bug I introduced when fixing Trac #9102, thinking that isSynTyCon meant H98 type syononyms. (cherry picked from commit 022f8750edf6f413fba31293435dcc62600eab77) >--------------------------------------------------------------- 5c97e932df780d3679da9a64676fe2af944e5c94 compiler/main/PprTyThing.hs | 2 +- compiler/typecheck/TcInstDcls.lhs | 7 +++--- compiler/typecheck/TcTyClsDecls.lhs | 20 ++++++++--------- compiler/typecheck/TcTyDecls.lhs | 8 +++---- compiler/typecheck/TcType.lhs | 2 +- compiler/typecheck/TcValidity.lhs | 2 +- compiler/types/TyCon.lhs | 45 ++++++++++++++++++++----------------- 7 files changed, 44 insertions(+), 42 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5c97e932df780d3679da9a64676fe2af944e5c94 From git at git.haskell.org Wed Jul 2 17:39:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 17:39:41 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Wibble to 4cfc1fae (7d06f63) Message-ID: <20140702173942.092BB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/7d06f63e516bbf1260b4c48cde67c099d0ade42f/ghc >--------------------------------------------------------------- commit 7d06f63e516bbf1260b4c48cde67c099d0ade42f Author: Simon Peyton Jones Date: Wed May 14 00:15:48 2014 +0100 Wibble to 4cfc1fae isSynTyCon is true of type *family* TyCons, which *are* allowed in TyConAppCo (cherry picked from commit 3fd7f543efe977de6f3cce9fcdfdad8b6825f948) >--------------------------------------------------------------- 7d06f63e516bbf1260b4c48cde67c099d0ade42f compiler/coreSyn/CoreLint.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 3d3deab..8665ec4 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -856,7 +856,7 @@ lintCoercion co@(TyConAppCo r tc cos) ; checkRole co2 r r2 ; return (rk, mkFunTy s1 s2, mkFunTy t1 t2, r) } - | isSynTyCon tc + | Just {} <- synTyConDefn_maybe tc = failWithL (ptext (sLit "Synonym in TyConAppCo:") <+> ppr co) | otherwise From git at git.haskell.org Wed Jul 2 17:43:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 17:43:01 +0000 (UTC) Subject: [commit: ghc] master: Mark HPC ticks labels as dynamic (3285a3d) Message-ID: <20140702174302.00E102406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3285a3d5bc7419464f5d2e6cef7c3adb9bca65c3/ghc >--------------------------------------------------------------- commit 3285a3d5bc7419464f5d2e6cef7c3adb9bca65c3 Author: Reid Barton Date: Tue Jul 1 01:04:18 2014 -0400 Mark HPC ticks labels as dynamic This enables GHC's PIC machinery for accessing tickboxes of other packages correctly when building dynamic libraries. Previously GHC was doing strange and wrong things in that situation. See #9012. >--------------------------------------------------------------- 3285a3d5bc7419464f5d2e6cef7c3adb9bca65c3 compiler/cmm/CLabel.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 407002f..9dccd29 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -888,6 +888,8 @@ labelDynamic dflags this_pkg this_mod lbl = PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m) + HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m) + -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False where os = platformOS (targetPlatform dflags) From git at git.haskell.org Wed Jul 2 18:27:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 18:27:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix yet another bug in 'deriving' for polykinded classes (Trac #7269) (bb3fdb4) Message-ID: <20140702182750.A221B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/bb3fdb4eb3a9cdf644e4f117e1e9916a6b4d7f79/ghc >--------------------------------------------------------------- commit bb3fdb4eb3a9cdf644e4f117e1e9916a6b4d7f79 Author: Simon Peyton Jones Date: Wed Jul 2 12:47:11 2014 -0500 Fix yet another bug in 'deriving' for polykinded classes (Trac #7269) This patch makes the code a bit simpler if anything. (cherry picked from commit b1436f55da2b0e005ac09be6651a2c4d934027ec) >--------------------------------------------------------------- bb3fdb4eb3a9cdf644e4f117e1e9916a6b4d7f79 compiler/typecheck/TcDeriv.lhs | 24 +++++++--------------- compiler/typecheck/TcHsType.lhs | 24 +++++++++++++--------- testsuite/tests/deriving/should_compile/all.T | 1 + testsuite/tests/deriving/should_fail/T7959.stderr | 2 +- .../tests/deriving/should_fail/drvfail005.stderr | 4 ++-- .../tests/deriving/should_fail/drvfail009.stderr | 6 +++--- 6 files changed, 28 insertions(+), 33 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bb3fdb4eb3a9cdf644e4f117e1e9916a6b4d7f79 From git at git.haskell.org Wed Jul 2 18:27:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 18:27:53 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add missing test file T7269 (fde01f5) Message-ID: <20140702182753.569EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/fde01f549441eaac81ed7b976764e99634fce8d9/ghc >--------------------------------------------------------------- commit fde01f549441eaac81ed7b976764e99634fce8d9 Author: Simon Peyton Jones Date: Mon May 26 17:03:23 2014 +0100 Add missing test file T7269 (cherry picked from commit db869e7521387db0513d1dc2b49641ce32688cdd) >--------------------------------------------------------------- fde01f549441eaac81ed7b976764e99634fce8d9 testsuite/tests/deriving/should_compile/T7269.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/testsuite/tests/deriving/should_compile/T7269.hs b/testsuite/tests/deriving/should_compile/T7269.hs new file mode 100644 index 0000000..2d7331b --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T7269.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, GeneralizedNewtypeDeriving #-} + +module T7269 where + +class C (a :: k) + +instance C Int + +newtype MyInt = MyInt Int deriving C + +newtype YourInt = YourInt Int +deriving instance C YourInt From git at git.haskell.org Wed Jul 2 18:28:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 18:28:27 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: reading/writing blocking FDs over FD_SETSIZE is broken (Partially Trac #9168) (566fa60) Message-ID: <20140702182827.47A512406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/566fa608b0b98f4976370afbc635248929794ed9/base >--------------------------------------------------------------- commit 566fa608b0b98f4976370afbc635248929794ed9 Author: Sergei Trofimovich Date: Wed Jul 2 12:52:26 2014 -0500 reading/writing blocking FDs over FD_SETSIZE is broken (Partially Trac #9168) Summary: libraries/base/cbits/inputReady.c had no limits on file descriptors. Add a limit as non-threaded RTS does. Signed-off-by: Sergei Trofimovich Test Plan: none Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D28 (cherry picked from commit b0316cdb10fbd9eaca7ede28c7bb3eb19f7766bf) >--------------------------------------------------------------- 566fa608b0b98f4976370afbc635248929794ed9 cbits/inputReady.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cbits/inputReady.c b/cbits/inputReady.c index 51f278f..dac9d9b 100644 --- a/cbits/inputReady.c +++ b/cbits/inputReady.c @@ -25,7 +25,11 @@ fdReady(int fd, int write, int msecs, int isSock) int maxfd, ready; fd_set rfd, wfd; struct timeval tv; - + if ((fd >= (int)FD_SETSIZE) || (fd < 0)) { + /* avoid memory corruption on too large FDs */ + errno = EINVAL; + return -1; + } FD_ZERO(&rfd); FD_ZERO(&wfd); if (write) { From git at git.haskell.org Wed Jul 2 19:17:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 19:17:07 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Mark HPC ticks labels as dynamic (8732b20) Message-ID: <20140702191707.122052406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/8732b205858318d0e2bd6d2ad4ae93664297380d/ghc >--------------------------------------------------------------- commit 8732b205858318d0e2bd6d2ad4ae93664297380d Author: Reid Barton Date: Tue Jul 1 01:04:18 2014 -0400 Mark HPC ticks labels as dynamic This enables GHC's PIC machinery for accessing tickboxes of other packages correctly when building dynamic libraries. Previously GHC was doing strange and wrong things in that situation. See #9012. (cherry picked from commit 3285a3d5bc7419464f5d2e6cef7c3adb9bca65c3) >--------------------------------------------------------------- 8732b205858318d0e2bd6d2ad4ae93664297380d compiler/cmm/CLabel.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 1b86f3d..65c597c 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -876,6 +876,8 @@ labelDynamic dflags this_pkg this_mod lbl = PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m) + HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m) + -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False where os = platformOS (targetPlatform dflags) From git at git.haskell.org Wed Jul 2 21:38:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Jul 2014 21:38:39 +0000 (UTC) Subject: [commit: ghc] master: Update transformers submodule to 0.4.1.0 release (23bfa70) Message-ID: <20140702213839.B72D62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23bfa704827e69b55de40a93bfdc5a7238b05436/ghc >--------------------------------------------------------------- commit 23bfa704827e69b55de40a93bfdc5a7238b05436 Author: Herbert Valerio Riedel Date: Wed Jul 2 23:35:34 2014 +0200 Update transformers submodule to 0.4.1.0 release >--------------------------------------------------------------- 23bfa704827e69b55de40a93bfdc5a7238b05436 libraries/transformers | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/transformers b/libraries/transformers index 5df683c..87d9892 160000 --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit 5df683cd87cb0ed13f915f73b83a7673e18aa294 +Subproject commit 87d9892a604b56d687ce70f1d1abc7848f78c6e4 From git at git.haskell.org Thu Jul 3 10:45:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 10:45:24 +0000 (UTC) Subject: [commit: ghc] master: PrelNames cleanup (4c91bc6) Message-ID: <20140703104524.633142406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c91bc6d76662cec3be045e99eae68093148b2b8/ghc >--------------------------------------------------------------- commit 4c91bc6d76662cec3be045e99eae68093148b2b8 Author: Jan Stolarek Date: Thu Jul 3 07:12:12 2014 +0200 PrelNames cleanup * Replace usage of methName with varQual, because they are identical * Minor formatting adjustments >--------------------------------------------------------------- 4c91bc6d76662cec3be045e99eae68093148b2b8 compiler/prelude/PrelNames.lhs | 148 ++++++++++++++++++++--------------------- 1 file changed, 72 insertions(+), 76 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4c91bc6d76662cec3be045e99eae68093148b2b8 From git at git.haskell.org Thu Jul 3 10:45:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 10:45:26 +0000 (UTC) Subject: [commit: ghc] master: Update documentation (311c55d) Message-ID: <20140703104526.D63BA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/311c55d132a65e657771e5f58b12a205e0a4af99/ghc >--------------------------------------------------------------- commit 311c55d132a65e657771e5f58b12a205e0a4af99 Author: Jan Stolarek Date: Thu Jul 3 08:16:28 2014 +0200 Update documentation * fix links to the User's Guide in ghc and ghci --help messages * fix default stack size info in RTS help message >--------------------------------------------------------------- 311c55d132a65e657771e5f58b12a205e0a4af99 driver/ghc-usage.txt | 2 +- driver/ghci-usage.txt | 2 +- rts/RtsFlags.c | 3 ++- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/driver/ghc-usage.txt b/driver/ghc-usage.txt index 9de4090..0b56db7 100644 --- a/driver/ghc-usage.txt +++ b/driver/ghc-usage.txt @@ -73,7 +73,7 @@ Given the above, here are some TYPICAL invocations of $$: The User's Guide has more information about GHC's *many* options. An online copy can be found here: - http://haskell.org/haskellwiki/GHC + http://www.haskell.org/ghc/docs/latest/html/users_guide/ If you *really* want to see every option, then you can pass '--show-options' to the compiler. diff --git a/driver/ghci-usage.txt b/driver/ghci-usage.txt index d9628b2..1a848fc 100644 --- a/driver/ghci-usage.txt +++ b/driver/ghci-usage.txt @@ -21,4 +21,4 @@ GHC does. Some of the options that are commonly used are: Full details can be found in the User's Guide, an online copy of which can be found here: - http://haskell.org/haskellwiki/GHC + http://www.haskell.org/ghc/docs/latest/html/users_guide/ diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index af1b204..44c05ce 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -241,7 +241,8 @@ usage_text[] = { " -? Prints this message and exits; the program is not executed", " --info Print information about the RTS used by this program", "", -" -K Sets the maximum stack size (default 8M) Egs: -K32k -K512k", +" -K Sets the maximum stack size (default: 80% of the heap)", +" Egs: -K32k -K512k -K8M", " -ki Sets the initial thread stack size (default 1k) Egs: -ki4k -ki2m", " -kc Sets the stack chunk size (default 32k)", " -kb Sets the stack chunk buffer size (default 1k)", From git at git.haskell.org Thu Jul 3 14:57:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 14:57:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Update documentation (b18bfda) Message-ID: <20140703145705.56CF52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/b18bfda27a5caa10e899712ac2a1a5af778a8d52/ghc >--------------------------------------------------------------- commit b18bfda27a5caa10e899712ac2a1a5af778a8d52 Author: Jan Stolarek Date: Thu Jul 3 08:16:28 2014 +0200 Update documentation * fix links to the User's Guide in ghc and ghci --help messages * fix default stack size info in RTS help message (cherry picked from commit 311c55d132a65e657771e5f58b12a205e0a4af99) >--------------------------------------------------------------- b18bfda27a5caa10e899712ac2a1a5af778a8d52 driver/ghc-usage.txt | 2 +- driver/ghci-usage.txt | 2 +- rts/RtsFlags.c | 3 ++- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/driver/ghc-usage.txt b/driver/ghc-usage.txt index 9de4090..0b56db7 100644 --- a/driver/ghc-usage.txt +++ b/driver/ghc-usage.txt @@ -73,7 +73,7 @@ Given the above, here are some TYPICAL invocations of $$: The User's Guide has more information about GHC's *many* options. An online copy can be found here: - http://haskell.org/haskellwiki/GHC + http://www.haskell.org/ghc/docs/latest/html/users_guide/ If you *really* want to see every option, then you can pass '--show-options' to the compiler. diff --git a/driver/ghci-usage.txt b/driver/ghci-usage.txt index d9628b2..1a848fc 100644 --- a/driver/ghci-usage.txt +++ b/driver/ghci-usage.txt @@ -21,4 +21,4 @@ GHC does. Some of the options that are commonly used are: Full details can be found in the User's Guide, an online copy of which can be found here: - http://haskell.org/haskellwiki/GHC + http://www.haskell.org/ghc/docs/latest/html/users_guide/ diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index af1b204..44c05ce 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -241,7 +241,8 @@ usage_text[] = { " -? Prints this message and exits; the program is not executed", " --info Print information about the RTS used by this program", "", -" -K Sets the maximum stack size (default 8M) Egs: -K32k -K512k", +" -K Sets the maximum stack size (default: 80% of the heap)", +" Egs: -K32k -K512k -K8M", " -ki Sets the initial thread stack size (default 1k) Egs: -ki4k -ki2m", " -kc Sets the stack chunk size (default 32k)", " -kb Sets the stack chunk buffer size (default 1k)", From git at git.haskell.org Thu Jul 3 22:25:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:25:52 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add comments & notes explaining the typing of pattern synonym definitions (a43d536) Message-ID: <20140703222553.0009C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/a43d536b2f55340f1f749fe7504b732fecacf3a7/ghc >--------------------------------------------------------------- commit a43d536b2f55340f1f749fe7504b732fecacf3a7 Author: Dr. ERDI Gergo Date: Tue Apr 8 22:29:23 2014 +0800 Add comments & notes explaining the typing of pattern synonym definitions (cherry picked from commit d2c4f9758ca735f294033401efef225699c292f8) >--------------------------------------------------------------- a43d536b2f55340f1f749fe7504b732fecacf3a7 compiler/typecheck/TcPatSyn.lhs | 100 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 94 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index 1464980..4e63a1e 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -36,6 +36,27 @@ import BuildTyCl #include "HsVersions.h" \end{code} +Note [Pattern synonym typechecking] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider the following pattern synonym declaration + + pattern P x = MkT [x] (Just 42) + +where + data T a where + MkT :: (Show a, Ord b) => [b] -> a -> T a + +The pattern synonym's type is described with five axes, given here for +the above example: + + Pattern type: T (Maybe t) + Arguments: [x :: b] + Universal type variables: [t] + Required theta: (Eq t, Num t) + Existential type variables: [b] + Provided theta: (Show (Maybe t), Ord b) + \begin{code} tcPatSynDecl :: Located Name -> HsPatSynDetails (Located Name) @@ -104,6 +125,44 @@ tcPatSynDecl lname@(L _ name) details lpat dir matcher_id (fmap fst m_wrapper) ; return (patSyn, binds) } +\end{code} + +Note [Matchers and wrappers for pattern synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +For each pattern synonym, we generate a single matcher function which +implements the actual matching. For the above example, the matcher +will have type: + + $mP :: forall r t. (Eq t, Num t) + => T (Maybe t) + -> (forall b. (Show (Maybe t), Ord b) => b -> r) + -> r + -> r + +with the following implementation: + + $mP @r @t $dEq $dNum scrut cont fail = case scrut of + MkT @b $dShow $dOrd [x] (Just 42) -> cont @b $dShow $dOrd x + _ -> fail + +For bidirectional pattern synonyms, we also generate a single wrapper +function which implements the pattern synonym in an expression +context. For our running example, it will be: + + $WP :: forall t b. (Show (Maybe t), Ord b, Eq t, Num t) + => b -> T (Maybe t) + $WP x = MkT [x] (Just 42) + +N.b. the existential/universal and required/provided split does not +apply to the wrapper since you are only putting stuff in, not getting +stuff out. + +Injectivity of bidirectional pattern synonyms is checked in +tcPatToExpr which walks the pattern and returns its corresponding +expression when available. + +\begin{code} tcPatSynMatcher :: Located Name -> LPat Id -> [Var] @@ -227,14 +286,29 @@ tc_pat_syn_wrapper_from_expr (L loc name) lexpr args univ_tvs ex_tvs theta pat_t ; traceTc "tcPatSynDecl wrapper type" $ ppr (varType wrapper_id) ; return (wrapper_id, wrapper_binds) } -tcNothing :: MaybeT TcM a -tcNothing = MaybeT (return Nothing) +\end{code} -withLoc :: (a -> MaybeT TcM b) -> Located a -> MaybeT TcM (Located b) -withLoc fn (L loc x) = MaybeT $ setSrcSpan loc $ - do { y <- runMaybeT $ fn x - ; return (fmap (L loc) y) } +Note [As-patterns in pattern synonym definitions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Beside returning the inverted pattern (when injectivity holds), we +also check the pattern on its own here. In particular, we reject +as-patterns. + +The rationale for that is that an as-pattern would introduce +nonindependent pattern synonym arguments, e.g. given a pattern synonym +like: + + pattern K x y = x@(Just y) + +one could write a nonsensical function like + + f (K Nothing x) = ... +or + g (K (Just True) False) = ... + +\begin{code} tcPatToExpr :: NameSet -> LPat Name -> MaybeT TcM (LHsExpr Name) tcPatToExpr lhsVars = go where @@ -287,6 +361,20 @@ cannotInvertPatSynErr (L loc pat) hang (ptext (sLit "Right-hand side of bidirectional pattern synonym cannot be used as an expression")) 2 (ppr pat) +tcNothing :: MaybeT TcM a +tcNothing = MaybeT (return Nothing) + +withLoc :: (a -> MaybeT TcM b) -> Located a -> MaybeT TcM (Located b) +withLoc fn (L loc x) = MaybeT $ setSrcSpan loc $ + do { y <- runMaybeT $ fn x + ; return (fmap (L loc) y) } + +-- Walk the whole pattern and for all ConPatOuts, collect the +-- existentially-bound type variables and evidence binding variables. +-- +-- These are used in computing the type of a pattern synonym and also +-- in generating matcher functions, since success continuations need +-- to be passed these pattern-bound evidences. tcCollectEx :: LPat Id -> TcM (TyVarSet, [EvVar]) tcCollectEx = return . go where From git at git.haskell.org Thu Jul 3 22:25:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:25:56 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Split off pattern synonym definition checking from pattern inversion (2f84670) Message-ID: <20140703222556.53D312406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/2f846706883e892406afa82f9076082eb362a188/ghc >--------------------------------------------------------------- commit 2f846706883e892406afa82f9076082eb362a188 Author: Dr. ERDI Gergo Date: Thu Apr 10 22:13:00 2014 +0800 Split off pattern synonym definition checking from pattern inversion (cherry picked from commit c269b7e85524f4a8be3cd0f00e107207ab9197af) >--------------------------------------------------------------- 2f846706883e892406afa82f9076082eb362a188 compiler/typecheck/TcPatSyn.lhs | 110 +++++++++++++++++++------------ testsuite/tests/patsyn/should_fail/all.T | 1 + 2 files changed, 69 insertions(+), 42 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index 4e63a1e..00dfbe3 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -16,7 +16,6 @@ import TysPrim import Name import SrcLoc import PatSyn -import Maybes import NameSet import Panic import Outputable @@ -65,6 +64,7 @@ tcPatSynDecl :: Located Name -> TcM (PatSyn, LHsBinds Id) tcPatSynDecl lname@(L _ name) details lpat dir = do { traceTc "tcPatSynDecl {" $ ppr name $$ ppr lpat + ; tcCheckPatSynPat lpat ; pat_ty <- newFlexiTyVarTy openTypeKind ; let (arg_names, is_infix) = case details of @@ -240,8 +240,7 @@ tcPatSynWrapper :: Located Name -> TcM (Maybe (Id, LHsBinds Id)) tcPatSynWrapper lname lpat dir args univ_tvs ex_tvs theta pat_ty = do { let argNames = mkNameSet (map Var.varName args) - ; m_expr <- runMaybeT $ tcPatToExpr argNames lpat - ; case (dir, m_expr) of + ; case (dir, tcPatToExpr argNames lpat) of (Unidirectional, _) -> return Nothing (ImplicitBidirectional, Nothing) -> @@ -291,13 +290,9 @@ tc_pat_syn_wrapper_from_expr (L loc name) lexpr args univ_tvs ex_tvs theta pat_t Note [As-patterns in pattern synonym definitions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Beside returning the inverted pattern (when injectivity holds), we -also check the pattern on its own here. In particular, we reject -as-patterns. - -The rationale for that is that an as-pattern would introduce -nonindependent pattern synonym arguments, e.g. given a pattern synonym -like: +The rationale for rejecting as-patterns in pattern synonym definitions +is that an as-pattern would introduce nonindependent pattern synonym +arguments, e.g. given a pattern synonym like: pattern K x y = x@(Just y) @@ -309,51 +304,90 @@ or g (K (Just True) False) = ... \begin{code} -tcPatToExpr :: NameSet -> LPat Name -> MaybeT TcM (LHsExpr Name) +tcCheckPatSynPat :: LPat Name -> TcM () +tcCheckPatSynPat = go + where + go :: LPat Name -> TcM () + go = addLocM go1 + + go1 :: Pat Name -> TcM () + go1 (ConPatIn _ info) = mapM_ go (hsConPatArgs info) + go1 VarPat{} = return () + go1 WildPat{} = return () + go1 p@(AsPat _ _) = asPatInPatSynErr p + go1 (LazyPat pat) = go pat + go1 (ParPat pat) = go pat + go1 (BangPat pat) = go pat + go1 (PArrPat pats _) = mapM_ go pats + go1 (ListPat pats _ _) = mapM_ go pats + go1 (TuplePat pats _ _) = mapM_ go pats + go1 (LitPat lit) = return () + go1 (NPat n _ _) = return () + go1 (SigPatIn pat _) = go pat + go1 (ViewPat _ pat _) = go pat + go1 p at SplicePat{} = thInPatSynErr p + go1 p at QuasiQuotePat{} = thInPatSynErr p + go1 p at NPlusKPat{} = nPlusKPatInPatSynErr p + go1 ConPatOut{} = panic "ConPatOut in output of renamer" + go1 SigPatOut{} = panic "SigPatOut in output of renamer" + go1 CoPat{} = panic "CoPat in output of renamer" + +asPatInPatSynErr :: OutputableBndr name => Pat name -> TcM a +asPatInPatSynErr pat + = failWithTc $ + hang (ptext (sLit "Pattern synonym definition cannot contain as-patterns (@):")) + 2 (ppr pat) + +thInPatSynErr :: OutputableBndr name => Pat name -> TcM a +thInPatSynErr pat + = failWithTc $ + hang (ptext (sLit "Pattern synonym definition cannot contain Template Haskell:")) + 2 (ppr pat) + +nPlusKPatInPatSynErr :: OutputableBndr name => Pat name -> TcM a +nPlusKPatInPatSynErr pat + = failWithTc $ + hang (ptext (sLit "Pattern synonym definition cannot contain n+k-pattern:")) + 2 (ppr pat) + +tcPatToExpr :: NameSet -> LPat Name -> Maybe (LHsExpr Name) tcPatToExpr lhsVars = go where - go :: LPat Name -> MaybeT TcM (LHsExpr Name) + go :: LPat Name -> Maybe (LHsExpr Name) go (L loc (ConPatIn conName info)) - = MaybeT . setSrcSpan loc . runMaybeT $ do + = do { let con = L loc (HsVar (unLoc conName)) ; exprs <- mapM go (hsConPatArgs info) ; return $ foldl (\x y -> L loc (HsApp x y)) con exprs } - go p = withLoc go1 p + go (L loc p) = fmap (L loc) $ go1 p - go1 :: Pat Name -> MaybeT TcM (HsExpr Name) + go1 :: Pat Name -> Maybe (HsExpr Name) go1 (VarPat var) - | var `elemNameSet` lhsVars = return (HsVar var) - | otherwise = tcNothing - go1 p@(AsPat _ _) = asPatInPatSynErr p - go1 (LazyPat pat) = fmap HsPar (go pat) - go1 (ParPat pat) = fmap HsPar (go pat) - go1 (BangPat pat) = fmap HsPar (go pat) + | var `elemNameSet` lhsVars = return $ HsVar var + | otherwise = Nothing + go1 (LazyPat pat) = fmap HsPar $ go pat + go1 (ParPat pat) = fmap HsPar $ go pat + go1 (BangPat pat) = fmap HsPar $ go pat go1 (PArrPat pats ptt) = do { exprs <- mapM go pats - ; return (ExplicitPArr ptt exprs) } + ; return $ ExplicitPArr ptt exprs } go1 (ListPat pats ptt reb) = do { exprs <- mapM go pats - ; return (ExplicitList ptt (fmap snd reb) exprs) } + ; return $ ExplicitList ptt (fmap snd reb) exprs } go1 (TuplePat pats box _) = do { exprs <- mapM go pats ; return (ExplicitTuple (map Present exprs) box) } - go1 (LitPat lit) = return (HsLit lit) - go1 (NPat n Nothing _) = return (HsOverLit n) - go1 (NPat n (Just neg) _) = return (noLoc neg `HsApp` noLoc (HsOverLit n)) + go1 (LitPat lit) = return $ HsLit lit + go1 (NPat n Nothing _) = return $ HsOverLit n + go1 (NPat n (Just neg) _) = return $ noLoc neg `HsApp` noLoc (HsOverLit n) go1 (SigPatIn pat (HsWB ty _ _)) = do { expr <- go pat - ; return (ExprWithTySig expr ty) } + ; return $ ExprWithTySig expr ty } go1 (ConPatOut{}) = panic "ConPatOut in output of renamer" go1 (SigPatOut{}) = panic "SigPatOut in output of renamer" go1 (CoPat{}) = panic "CoPat in output of renamer" - go1 _ = tcNothing - -asPatInPatSynErr :: OutputableBndr name => Pat name -> MaybeT TcM a -asPatInPatSynErr pat - = MaybeT . failWithTc $ - hang (ptext (sLit "Pattern synonym definition cannot contain as-patterns (@):")) - 2 (ppr pat) + go1 _ = Nothing cannotInvertPatSynErr :: OutputableBndr name => LPat name -> TcM a cannotInvertPatSynErr (L loc pat) @@ -361,14 +395,6 @@ cannotInvertPatSynErr (L loc pat) hang (ptext (sLit "Right-hand side of bidirectional pattern synonym cannot be used as an expression")) 2 (ppr pat) -tcNothing :: MaybeT TcM a -tcNothing = MaybeT (return Nothing) - -withLoc :: (a -> MaybeT TcM b) -> Located a -> MaybeT TcM (Located b) -withLoc fn (L loc x) = MaybeT $ setSrcSpan loc $ - do { y <- runMaybeT $ fn x - ; return (fmap (L loc) y) } - -- Walk the whole pattern and for all ConPatOuts, collect the -- existentially-bound type variables and evidence binding variables. -- diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 2590a30..897808e 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -3,3 +3,4 @@ test('mono', normal, compile_fail, ['']) test('unidir', normal, compile_fail, ['']) test('local', normal, compile_fail, ['']) test('T8961', normal, multimod_compile_fail, ['T8961','']) +test('as-pattern', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 3 22:25:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:25:59 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Remove unused variable binding to fix validate (5c2ba23) Message-ID: <20140703222559.801902406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/5c2ba23f119e03a6c26e2967ab305a8f7a000773/ghc >--------------------------------------------------------------- commit 5c2ba23f119e03a6c26e2967ab305a8f7a000773 Author: Dr. ERDI Gergo Date: Sat Apr 12 08:57:27 2014 +0800 Remove unused variable binding to fix validate (cherry picked from commit b7f51d60093ea13d0854bd7e1d4ecf58d12628a1) >--------------------------------------------------------------- 5c2ba23f119e03a6c26e2967ab305a8f7a000773 compiler/typecheck/TcPatSyn.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index 00dfbe3..fdbee92 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -321,8 +321,8 @@ tcCheckPatSynPat = go go1 (PArrPat pats _) = mapM_ go pats go1 (ListPat pats _ _) = mapM_ go pats go1 (TuplePat pats _ _) = mapM_ go pats - go1 (LitPat lit) = return () - go1 (NPat n _ _) = return () + go1 LitPat{} = return () + go1 NPat{} = return () go1 (SigPatIn pat _) = go pat go1 (ViewPat _ pat _) = go pat go1 p at SplicePat{} = thInPatSynErr p From git at git.haskell.org Thu Jul 3 22:26:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:01 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add source file for new test that checks that as-patterns are rejected in pattern synonym definitions (87504d6) Message-ID: <20140703222601.B4D582406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/87504d68b4fdfb9e9ac2915f8a68864025abdadd/ghc >--------------------------------------------------------------- commit 87504d68b4fdfb9e9ac2915f8a68864025abdadd Author: Dr. ERDI Gergo Date: Sat Apr 12 16:35:44 2014 +0800 Add source file for new test that checks that as-patterns are rejected in pattern synonym definitions (cherry picked from commit dd3a6d270f827a59f7a33f32facc506cb35af1fa) >--------------------------------------------------------------- 87504d68b4fdfb9e9ac2915f8a68864025abdadd testsuite/tests/patsyn/should_fail/{unidir.hs => as-pattern.hs} | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/patsyn/should_fail/unidir.hs b/testsuite/tests/patsyn/should_fail/as-pattern.hs similarity index 67% copy from testsuite/tests/patsyn/should_fail/unidir.hs copy to testsuite/tests/patsyn/should_fail/as-pattern.hs index 020fc12..2794bed 100644 --- a/testsuite/tests/patsyn/should_fail/unidir.hs +++ b/testsuite/tests/patsyn/should_fail/as-pattern.hs @@ -1,4 +1,4 @@ {-# LANGUAGE PatternSynonyms #-} module ShouldFail where -pattern Head x = x:_ +pattern P x y <- x@(Just y) From git at git.haskell.org Thu Jul 3 22:26:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:04 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Expected output of as-pattern test (19be8de) Message-ID: <20140703222604.D2F0C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/19be8de834220e1420226246d8ca3e1b3dfb00a4/ghc >--------------------------------------------------------------- commit 19be8de834220e1420226246d8ca3e1b3dfb00a4 Author: Dr. ERDI Gergo Date: Sat Apr 12 17:52:26 2014 +0800 Expected output of as-pattern test (cherry picked from commit 7233638ba6e82179cc4bd1b981eff5292b18e118) >--------------------------------------------------------------- 19be8de834220e1420226246d8ca3e1b3dfb00a4 testsuite/tests/patsyn/should_fail/as-pattern.stderr | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/testsuite/tests/patsyn/should_fail/as-pattern.stderr b/testsuite/tests/patsyn/should_fail/as-pattern.stderr new file mode 100644 index 0000000..62db28f --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/as-pattern.stderr @@ -0,0 +1,4 @@ + +as-pattern.hs:4:18: + Pattern synonym definition cannot contain as-patterns (@): + x@(Just y) From git at git.haskell.org Thu Jul 3 22:26:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:07 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Instead of tracking Origin in LHsBindsLR, track it in MatchGroup (3308b40) Message-ID: <20140703222607.760EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/3308b405331f92b23b4438df737ab2bcc5d6cea1/ghc >--------------------------------------------------------------- commit 3308b405331f92b23b4438df737ab2bcc5d6cea1 Author: Dr. ERDI Gergo Date: Sat Apr 12 19:36:31 2014 +0800 Instead of tracking Origin in LHsBindsLR, track it in MatchGroup (cherry picked from commit eeaea2df3fa585db503034f419c6e4331a4d8a84) >--------------------------------------------------------------- 3308b405331f92b23b4438df737ab2bcc5d6cea1 compiler/deSugar/Coverage.lhs | 8 +--- compiler/deSugar/DsArrows.lhs | 4 +- compiler/deSugar/DsBinds.lhs | 9 +--- compiler/deSugar/DsExpr.lhs | 17 +++---- compiler/deSugar/DsMeta.hs | 2 +- compiler/deSugar/Match.lhs | 12 +++-- compiler/hsSyn/Convert.lhs | 12 +++-- compiler/hsSyn/HsBinds.lhs | 6 +-- compiler/hsSyn/HsExpr.lhs | 3 +- compiler/hsSyn/HsUtils.lhs | 46 +++++++++---------- compiler/main/HscStats.hs | 4 +- compiler/parser/Parser.y.pp | 8 ++-- compiler/parser/RdrHsSyn.lhs | 4 +- compiler/rename/RnBinds.lhs | 27 ++++++------ compiler/rename/RnSource.lhs | 4 +- compiler/typecheck/TcArrows.lhs | 4 +- compiler/typecheck/TcBinds.lhs | 88 ++++++++++++++++++------------------- compiler/typecheck/TcClassDcl.lhs | 18 ++++---- compiler/typecheck/TcDeriv.lhs | 3 +- compiler/typecheck/TcForeign.lhs | 3 +- compiler/typecheck/TcGenDeriv.lhs | 20 ++++----- compiler/typecheck/TcHsSyn.lhs | 10 ++--- compiler/typecheck/TcInstDcls.lhs | 28 ++++++------ compiler/typecheck/TcMatches.lhs | 6 +-- compiler/typecheck/TcPatSyn.lhs | 9 ++-- compiler/typecheck/TcRnDriver.lhs | 12 +++-- compiler/typecheck/TcRnMonad.lhs | 7 +-- compiler/typecheck/TcTyClsDecls.lhs | 8 ++-- utils/ghctags/Main.hs | 2 +- 29 files changed, 185 insertions(+), 199 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3308b405331f92b23b4438df737ab2bcc5d6cea1 From git at git.haskell.org Thu Jul 3 22:26:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:09 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. (1501027) Message-ID: <20140703222609.F013C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/15010272ca6c9f77121e86b5f65f87e1698537b7/ghc >--------------------------------------------------------------- commit 15010272ca6c9f77121e86b5f65f87e1698537b7 Author: Dr. ERDI Gergo Date: Tue May 27 21:16:41 2014 +0800 Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. Also updates haddock submodule to accomodate tweaks in PatSyn representation (cherry picked from commit ac2796e6ddbd54c5762c53e2fcf29f20ea162fd5) Conflicts: utils/haddock >--------------------------------------------------------------- 15010272ca6c9f77121e86b5f65f87e1698537b7 compiler/basicTypes/PatSyn.lhs | 103 +++++++++++++++++++++++++++++----------- compiler/coreSyn/CorePrep.lhs | 1 + compiler/iface/BuildTyCl.lhs | 81 ++++++++----------------------- compiler/iface/IfaceSyn.lhs | 28 ++++++----- compiler/iface/LoadIface.lhs | 3 +- compiler/iface/MkIface.lhs | 13 ++--- compiler/iface/TcIface.lhs | 35 +++++--------- compiler/main/HscTypes.lhs | 20 ++++---- compiler/main/TidyPgm.lhs | 2 +- compiler/typecheck/TcPat.lhs | 4 +- compiler/typecheck/TcPatSyn.lhs | 89 ++++++++-------------------------- 11 files changed, 169 insertions(+), 210 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 15010272ca6c9f77121e86b5f65f87e1698537b7 From git at git.haskell.org Thu Jul 3 22:26:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:12 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Improve tracing slightly (eb10678) Message-ID: <20140703222612.D5AD62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/eb1067870ced67c3e7250c0eeb94de138ef60b4b/ghc >--------------------------------------------------------------- commit eb1067870ced67c3e7250c0eeb94de138ef60b4b Author: Simon Peyton Jones Date: Tue Apr 8 09:41:20 2014 +0100 Improve tracing slightly (cherry picked from commit cbe59d89f2f1cc41147fabb4a4c58126152bef7f) >--------------------------------------------------------------- eb1067870ced67c3e7250c0eeb94de138ef60b4b compiler/typecheck/TcPat.lhs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index ca2aa06..951c168 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -736,7 +736,8 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside arg_tys' = substTys tenv arg_tys - ; traceTc "tcConPat" (ppr con_name $$ ppr ex_tvs' $$ ppr pat_ty' $$ ppr arg_tys') + ; traceTc "tcConPat" (vcat [ ppr con_name, ppr univ_tvs, ppr ex_tvs, ppr eq_spec + , ppr ex_tvs', ppr pat_ty', ppr arg_tys' ]) ; if null ex_tvs && null eq_spec && null theta then do { -- The common case; no class bindings etc -- (see Note [Arrows and patterns]) From git at git.haskell.org Thu Jul 3 22:26:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) (f895f33) Message-ID: <20140703222616.105DE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f895f334d117b8295471897c527dd57335e75eb7/ghc >--------------------------------------------------------------- commit f895f334d117b8295471897c527dd57335e75eb7 Author: Simon Peyton Jones Date: Thu Jun 5 11:03:45 2014 +0100 Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) We simply weren't giving anything like the right instantiating types to patSynInstArgTys in matchOneConLike. To get these instantiating types would have involved matching the result type of the pattern synonym with the pattern type, which is tiresome. So instead I changed ConPatOut so that instead of recording the type of the *whole* pattern (in old field pat_ty), it not records the *instantiating* types (in new field pat_arg_tys). Then we canuse TcHsSyn.conLikeResTy to get the pattern type when needed. There are lots of knock-on incidental effects, but they mostly made the code simpler, so I'm happy. (cherry picked from commit 0a55a3cada2fea37586b1a270c1511ed9957dbd4) >--------------------------------------------------------------- f895f334d117b8295471897c527dd57335e75eb7 compiler/basicTypes/PatSyn.lhs | 25 +++++++++++++++++++++++-- compiler/deSugar/Check.lhs | 32 +++++++++++++++----------------- compiler/deSugar/DsExpr.lhs | 2 +- compiler/deSugar/DsUtils.lhs | 3 +-- compiler/deSugar/Match.lhs | 11 +++++------ compiler/deSugar/MatchCon.lhs | 33 +++++++++++++++------------------ compiler/deSugar/MatchLit.lhs | 6 +++--- compiler/hsSyn/Convert.lhs | 4 ++-- compiler/hsSyn/HsPat.lhs | 31 ++++++++++++++++++++----------- compiler/hsSyn/HsUtils.lhs | 2 +- compiler/parser/RdrHsSyn.lhs | 2 +- compiler/rename/RnPat.lhs | 2 +- compiler/typecheck/TcHsSyn.lhs | 24 ++++++++++++++++-------- compiler/typecheck/TcPat.lhs | 18 +++++++++--------- 14 files changed, 113 insertions(+), 82 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f895f334d117b8295471897c527dd57335e75eb7 From git at git.haskell.org Thu Jul 3 22:26:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:18 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Print for-alls more often (Trac #9018) (175791f) Message-ID: <20140703222618.73CCA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/175791f98e8f009f4c68441e3411673bbb454871/ghc >--------------------------------------------------------------- commit 175791f98e8f009f4c68441e3411673bbb454871 Author: Simon Peyton Jones Date: Mon Apr 28 14:49:21 2014 +0100 Print for-alls more often (Trac #9018) We now display the foralls of a type if any of the type variables is polykinded. This put kind polymorphism "in your face" a bit more often, but eliminates a lot of head scratching. The user manual reflects the new behaviour. (cherry picked from commit 2f3ea95285d0cccc2a999e7572d8fb78dc2ea441) Conflicts: testsuite/tests/ghci/scripts/ghci059.stdout testsuite/tests/polykinds/T7438.stderr >--------------------------------------------------------------- 175791f98e8f009f4c68441e3411673bbb454871 compiler/main/PprTyThing.hs | 11 +++---- compiler/typecheck/TcRnTypes.lhs | 7 +++-- compiler/types/TypeRep.lhs | 36 ++++++++++++++++------ docs/users_guide/using.xml | 29 +++++++++++++---- testsuite/tests/ghci/scripts/T7873.stdout | 3 +- .../tests/indexed-types/should_fail/T7786.stderr | 2 +- testsuite/tests/polykinds/T7230.stderr | 4 +-- testsuite/tests/polykinds/T8566.stderr | 3 +- testsuite/tests/roles/should_compile/Roles1.stderr | 6 ++-- testsuite/tests/th/TH_Roles2.stderr | 2 +- 10 files changed, 70 insertions(+), 33 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 175791f98e8f009f4c68441e3411673bbb454871 From git at git.haskell.org Thu Jul 3 22:26:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:21 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds (abb884f) Message-ID: <20140703222621.E574A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/abb884fba135b8f0e002ef9cd78311ed9afe521c/ghc >--------------------------------------------------------------- commit abb884fba135b8f0e002ef9cd78311ed9afe521c Author: Simon Peyton Jones Date: Fri Jun 6 11:39:41 2014 +0100 Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds This was a serious bug, exposed by Trac #9175. The matcher and wrapper must be LocalIds, like record selectors and dictionary functions, for the reasons now documented in Note [Exported LocalIds] in Id.lhs In fixing this I found - PatSyn should have an Id inside it (apart from the wrapper and matcher) It should be a Name. Hence psId --> psName, with knock-on consequences - Tidying of PatSyns in TidyPgm was wrong - The keep-alive set in Desugar.deSugar (now) doesn't need pattern synonyms in it I also cleaned up the interface to PatSyn a little, so there's a tiny knock-on effect in Haddock; hence the haddock submodule update. It's very hard to make a test for this bug, so I haven't. (cherry picked from commit 7ac600d5fcd74db1f991555de6e415030970d5f3) Conflicts: utils/haddock >--------------------------------------------------------------- abb884fba135b8f0e002ef9cd78311ed9afe521c compiler/basicTypes/Id.lhs | 39 +++++++++++++- compiler/basicTypes/MkId.lhs | 31 +++-------- compiler/basicTypes/PatSyn.lhs | 77 +++++++++++++++++----------- compiler/deSugar/Desugar.lhs | 21 +++----- compiler/deSugar/MatchCon.lhs | 2 +- compiler/hsSyn/Convert.lhs | 2 +- compiler/iface/MkIface.lhs | 4 +- compiler/main/HscTypes.lhs | 20 ++------ compiler/main/TidyPgm.lhs | 52 +++++++++++-------- compiler/typecheck/TcEnv.lhs | 3 +- compiler/typecheck/TcPat.lhs | 4 +- compiler/typecheck/TcPatSyn.lhs | 5 +- compiler/typecheck/TcRnDriver.lhs | 5 +- compiler/typecheck/TcRnTypes.lhs | 4 +- compiler/typecheck/TcSplice.lhs | 4 +- compiler/typecheck/TcTyClsDecls.lhs | 7 ++- compiler/vectorise/Vectorise/Monad/Naming.hs | 5 +- 17 files changed, 153 insertions(+), 132 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc abb884fba135b8f0e002ef9cd78311ed9afe521c From git at git.haskell.org Thu Jul 3 22:26:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Test Trac #9023 (1a7c07b) Message-ID: <20140703222625.D73392406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/1a7c07b01e6d4ccb5987341f0bee3fbfbed0fb9b/ghc >--------------------------------------------------------------- commit 1a7c07b01e6d4ccb5987341f0bee3fbfbed0fb9b Author: Simon Peyton Jones Date: Thu Jun 5 12:26:24 2014 +0100 Test Trac #9023 (cherry picked from commit 616f54bdc28ad699f903248a5fb18dc0e5b52a52) >--------------------------------------------------------------- 1a7c07b01e6d4ccb5987341f0bee3fbfbed0fb9b testsuite/tests/patsyn/should_compile/T9023.hs | 6 ++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 2 files changed, 7 insertions(+) diff --git a/testsuite/tests/patsyn/should_compile/T9023.hs b/testsuite/tests/patsyn/should_compile/T9023.hs new file mode 100644 index 0000000..3a86140 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T9023.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T9023 where + +pattern P a b = Just (a, b) +foo P{} = True diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index ecc4701..d851bc3 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -9,3 +9,4 @@ test('num', normal, compile, ['']) test('incomplete', normal, compile, ['']) test('export', normal, compile, ['']) test('T8966', normal, compile, ['']) +test('T9023', normal, compile, ['']) From git at git.haskell.org Thu Jul 3 22:26:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:29 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add fake entries into the global kind environment for pattern synonyms. (c3bfc63) Message-ID: <20140703222629.A47E42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/c3bfc63d94272ba6be722c540d7c7f19f8bf5414/ghc >--------------------------------------------------------------- commit c3bfc63d94272ba6be722c540d7c7f19f8bf5414 Author: Dr. ERDI Gergo Date: Sat Jun 21 22:37:50 2014 +0800 Add fake entries into the global kind environment for pattern synonyms. This is needed to give meaningful error messages (instead of internal panics) when a program tries to lift a pattern synonym into a kind. (fixes T9161) (cherry picked from commit aa3166f42361cb605e046f4a063be3f9e1f48015) >--------------------------------------------------------------- c3bfc63d94272ba6be722c540d7c7f19f8bf5414 compiler/typecheck/TcBinds.lhs | 23 ++++++++++++++++------- compiler/typecheck/TcHsType.lhs | 1 - testsuite/tests/patsyn/should_fail/T9161-1.hs | 7 +++++++ testsuite/tests/patsyn/should_fail/T9161-1.stderr | 4 ++++ testsuite/tests/patsyn/should_fail/T9161-2.hs | 9 +++++++++ testsuite/tests/patsyn/should_fail/T9161-2.stderr | 5 +++++ testsuite/tests/patsyn/should_fail/all.T | 2 ++ 7 files changed, 43 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index a15d520..65ad001 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -277,19 +277,28 @@ tcValBinds :: TopLevelFlag -> TcM ([(RecFlag, LHsBinds TcId)], thing) tcValBinds top_lvl binds sigs thing_inside - = do { -- Typecheck the signature - (poly_ids, sig_fn) <- tcTySigs sigs + = do { -- Add fake entries for pattern synonyms so that + -- precise error messages can be generated when + -- trying to use a pattern synonym as a kind + traceTc "Fake lifted patsyns:" (vcat (map ppr patsyns)) + -- Typecheck the signature + ; (poly_ids, sig_fn) <- tcExtendKindEnv2 [(patsyn, fakePatSynCon) | patsyn <- patsyns] $ + tcTySigs sigs ; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds) -- Extend the envt right away with all -- the Ids declared with type signatures -- Use tcExtendIdEnv2 to avoid extending the TcIdBinder stack - ; (binds', thing) <- tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ - tcBindGroups top_lvl sig_fn prag_fn - binds thing_inside - - ; return (binds', thing) } + ; tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ + tcBindGroups top_lvl sig_fn prag_fn + binds thing_inside } + where + patsyns = [ name + | (_, lbinds) <- binds + , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds + ] + fakePatSynCon = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" ------------------------ tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index e4a34d9..8e1f361 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -618,7 +618,6 @@ tcTyVar :: Name -> TcM (TcType, TcKind) tcTyVar name -- Could be a tyvar, a tycon, or a datacon = do { traceTc "lk1" (ppr name) ; thing <- tcLookup name - ; traceTc "lk2" (ppr name <+> ppr thing) ; case thing of ATyVar _ tv | isKindVar tv diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.hs b/testsuite/tests/patsyn/should_fail/T9161-1.hs new file mode 100644 index 0000000..c14eb54 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds #-} + +pattern PATTERN = () + +wrongLift :: PATTERN +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.stderr b/testsuite/tests/patsyn/should_fail/T9161-1.stderr new file mode 100644 index 0000000..1f05196 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.stderr @@ -0,0 +1,4 @@ + +T9161-1.hs:6:14: + Pattern synonym ?PATTERN? used as a type + In the type signature for ?wrongLift?: wrongLift :: PATTERN diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.hs b/testsuite/tests/patsyn/should_fail/T9161-2.hs new file mode 100644 index 0000000..941d23e --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-} + +pattern PATTERN = () + +data Proxy (tag :: k) (a :: *) + +wrongLift :: Proxy PATTERN () +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.stderr b/testsuite/tests/patsyn/should_fail/T9161-2.stderr new file mode 100644 index 0000000..8d21be5 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.stderr @@ -0,0 +1,5 @@ + +T9161-2.hs:8:20: + Pattern synonym ?PATTERN? used as a type + In the type signature for ?wrongLift?: + wrongLift :: Proxy PATTERN () diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 897808e..bff6bdf 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -4,3 +4,5 @@ test('unidir', normal, compile_fail, ['']) test('local', normal, compile_fail, ['']) test('T8961', normal, multimod_compile_fail, ['T8961','']) test('as-pattern', normal, compile_fail, ['']) +test('T9161-1', normal, compile_fail, ['']) +test('T9161-2', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 3 22:26:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:32 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add Note [Placeholder PatSyn kinds] in TcBinds (161c73d) Message-ID: <20140703222632.A259A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/161c73d55de958d6371fcad08da0263e17bf9f5f/ghc >--------------------------------------------------------------- commit 161c73d55de958d6371fcad08da0263e17bf9f5f Author: Simon Peyton Jones Date: Tue Jun 24 13:24:36 2014 +0100 Add Note [Placeholder PatSyn kinds] in TcBinds This is just documentation for the fix to Trac #9161 (cherry picked from commit 0757831eaca96c8ebfd99fc51427560d3568cffa) >--------------------------------------------------------------- 161c73d55de958d6371fcad08da0263e17bf9f5f compiler/typecheck/TcBinds.lhs | 44 +++++++++++++++++++++++++++++++----------- compiler/typecheck/TcEnv.lhs | 3 +++ 2 files changed, 36 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 65ad001..f1c98d2 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -270,6 +270,30 @@ time by defaulting. No no no. However [Oct 10] this is all handled automatically by the untouchable-range idea. +Note [Placeholder PatSyn kinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (Trac #9161) + + {-# LANGUAGE PatternSynonyms, DataKinds #-} + pattern A = () + b :: A + b = undefined + +Here, the type signature for b mentions A. But A is a pattern +synonym, which is typechecked (for very good reasons; a view pattern +in the RHS may mention a value binding) as part of a group of +bindings. It is entirely resonable to reject this, but to do so +we need A to be in the kind environment when kind-checking the signature for B. + +Hence the tcExtendKindEnv2 patsyn_placeholder_kinds, which adds a binding + A -> AGlobal (AConLike (PatSynCon _|_)) +to the environment. Then TcHsType.tcTyVar will find A in the kind environment, +and will give a 'wrongThingErr' as a result. But the lookup of A won't fail. + +The _|_ (= panic "fakePatSynCon") works because the wrongThingErr call, in +tcTyVar, doesn't look inside the TcTyThing. + + \begin{code} tcValBinds :: TopLevelFlag -> [(RecFlag, LHsBinds Name)] -> [LSig Name] @@ -277,12 +301,9 @@ tcValBinds :: TopLevelFlag -> TcM ([(RecFlag, LHsBinds TcId)], thing) tcValBinds top_lvl binds sigs thing_inside - = do { -- Add fake entries for pattern synonyms so that - -- precise error messages can be generated when - -- trying to use a pattern synonym as a kind - traceTc "Fake lifted patsyns:" (vcat (map ppr patsyns)) - -- Typecheck the signature - ; (poly_ids, sig_fn) <- tcExtendKindEnv2 [(patsyn, fakePatSynCon) | patsyn <- patsyns] $ + = do { -- Typecheck the signature + ; (poly_ids, sig_fn) <- tcExtendKindEnv2 patsyn_placeholder_kinds $ + -- See Note [Placeholder PatSyn kinds] tcTySigs sigs ; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds) @@ -294,11 +315,12 @@ tcValBinds top_lvl binds sigs thing_inside tcBindGroups top_lvl sig_fn prag_fn binds thing_inside } where - patsyns = [ name - | (_, lbinds) <- binds - , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds - ] - fakePatSynCon = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" + patsyn_placeholder_kinds -- See Note [Placeholder PatSyn kinds] + = [ (name, placeholder_patsyn_tything) + | (_, lbinds) <- binds + , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds ] + placeholder_patsyn_tything + = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" ------------------------ tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index a077f5d..d9ce851 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -872,6 +872,9 @@ notFound name } wrongThingErr :: String -> TcTyThing -> Name -> TcM a +-- It's important that this only calls pprTcTyThingCategory, which in +-- turn does not look at the details of the TcTyThing. +-- See Note [Placeholder PatSyn kinds] in TcBinds wrongThingErr expected thing name = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> ptext (sLit "used as a") <+> text expected) From git at git.haskell.org Thu Jul 3 22:26:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Jul 2014 22:26:35 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix T7438 output (03e368e) Message-ID: <20140703222635.AA77C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/03e368e2daebeb7534fab8681a76068ede681913/ghc >--------------------------------------------------------------- commit 03e368e2daebeb7534fab8681a76068ede681913 Author: Austin Seipp Date: Thu Jul 3 16:35:21 2014 -0500 Fix T7438 output Signed-off-by: Austin Seipp >--------------------------------------------------------------- 03e368e2daebeb7534fab8681a76068ede681913 testsuite/tests/polykinds/T7438.stderr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/polykinds/T7438.stderr b/testsuite/tests/polykinds/T7438.stderr index 92e01e7..b20233c 100644 --- a/testsuite/tests/polykinds/T7438.stderr +++ b/testsuite/tests/polykinds/T7438.stderr @@ -4,7 +4,7 @@ T7438.hs:6:14: ?t? is untouchable inside the constraints (t2 ~ t3) bound by a pattern with constructor - Nil :: forall (a :: k). Thrist a a, + Nil :: forall (k :: BOX) (a :: k). Thrist a a, in an equation for ?go? at T7438.hs:6:4-6 ?t? is a rigid type variable bound by From git at git.haskell.org Fri Jul 4 00:05:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Jul 2014 00:05:33 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Partially fix #9003 by reverting bad numbering. (3f68d96) Message-ID: <20140704000534.49EA72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/3f68d967dba4d53068db9fca64808484ecafb52d/ghc >--------------------------------------------------------------- commit 3f68d967dba4d53068db9fca64808484ecafb52d Author: Edward Z. Yang Date: Tue Jul 1 14:43:50 2014 +0100 Partially fix #9003 by reverting bad numbering. Signed-off-by: Edward Z. Yang (cherry picked from commit 5f3c5384df59717ca8013c5df8d1f65692867825) >--------------------------------------------------------------- 3f68d967dba4d53068db9fca64808484ecafb52d includes/rts/Constants.h | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/includes/rts/Constants.h b/includes/rts/Constants.h index 842c37b..6fd0dc0 100644 --- a/includes/rts/Constants.h +++ b/includes/rts/Constants.h @@ -202,32 +202,34 @@ */ #define NotBlocked 0 #define BlockedOnMVar 1 -#define BlockedOnMVarRead 2 -#define BlockedOnBlackHole 3 -#define BlockedOnRead 4 -#define BlockedOnWrite 5 -#define BlockedOnDelay 6 -#define BlockedOnSTM 7 +#define BlockedOnMVarRead 14 /* TODO: renumber me, see #9003 */ +#define BlockedOnBlackHole 2 +#define BlockedOnRead 3 +#define BlockedOnWrite 4 +#define BlockedOnDelay 5 +#define BlockedOnSTM 6 /* Win32 only: */ -#define BlockedOnDoProc 8 +#define BlockedOnDoProc 7 /* Only relevant for PAR: */ /* blocked on a remote closure represented by a Global Address: */ -#define BlockedOnGA 9 +#define BlockedOnGA 8 /* same as above but without sending a Fetch message */ -#define BlockedOnGA_NoSend 10 +#define BlockedOnGA_NoSend 9 /* Only relevant for THREADED_RTS: */ -#define BlockedOnCCall 11 -#define BlockedOnCCall_Interruptible 12 +#define BlockedOnCCall 10 +#define BlockedOnCCall_Interruptible 11 /* same as above but permit killing the worker thread */ /* Involved in a message sent to tso->msg_cap */ -#define BlockedOnMsgThrowTo 13 +#define BlockedOnMsgThrowTo 12 /* The thread is not on any run queues, but can be woken up by tryWakeupThread() */ -#define ThreadMigrating 14 +#define ThreadMigrating 13 + +/* WARNING WARNING top number is BlockedOnMVarRead 14, not 13!! */ /* * These constants are returned to the scheduler by a thread that has From git at git.haskell.org Fri Jul 4 00:05:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Jul 2014 00:05:36 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Avoid NondecreasingIndentation syntax in ghc-pkg (2b854a1) Message-ID: <20140704000536.C35E82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/2b854a182be15387cf420e982bfb58957dd4e1d7/ghc >--------------------------------------------------------------- commit 2b854a182be15387cf420e982bfb58957dd4e1d7 Author: Herbert Valerio Riedel Date: Wed May 14 12:16:13 2014 +0200 Avoid NondecreasingIndentation syntax in ghc-pkg This also makes ghc-pkg.cabal `default-extensions`-free NB: Printing this commit via `git show --ignore-all-spaces` shows the only non-whitespaces changes are in `ghc-pkg.cabal` Signed-off-by: Herbert Valerio Riedel (cherry picked from commit 913b3146541e203b2524e756b047b7f90be849b7) Conflicts: utils/ghc-pkg/ghc-pkg.cabal >--------------------------------------------------------------- 2b854a182be15387cf420e982bfb58957dd4e1d7 utils/ghc-pkg/Main.hs | 60 ++++++++++++++++++++++----------------------- utils/ghc-pkg/ghc-pkg.cabal | 2 +- 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 30acbe2..8be752b 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -593,9 +593,9 @@ lookForPackageDBIn dir = do let path_dir = dir "package.conf.d" exists_dir <- doesDirectoryExist path_dir if exists_dir then return (Just path_dir) else do - let path_file = dir "package.conf" - exists_file <- doesFileExist path_file - if exists_file then return (Just path_file) else return Nothing + let path_file = dir "package.conf" + exists_file <- doesFileExist path_file + if exists_file then return (Just path_file) else return Nothing readParseDatabase :: Verbosity -> Maybe (FilePath,Bool) @@ -1035,34 +1035,34 @@ listPackages verbosity my_flags mPackageName mModuleName = do if simple_output then show_simple stack else do #if defined(mingw32_HOST_OS) || defined(BOOTSTRAPPING) - mapM_ show_normal stack + mapM_ show_normal stack #else - let - show_colour withF db = - mconcat $ map (<#> termText "\n") $ - (termText (location db) : - map (termText " " <#>) (map pp_pkg (packages db))) - where - pp_pkg p - | sourcePackageId p `elem` broken = withF Red doc - | exposed p = doc - | otherwise = withF Blue doc - where doc | verbosity >= Verbose - = termText (printf "%s (%s)" pkg ipid) - | otherwise - = termText pkg - where - InstalledPackageId ipid = installedPackageId p - pkg = display (sourcePackageId p) - - is_tty <- hIsTerminalDevice stdout - if not is_tty - then mapM_ show_normal stack - else do tty <- Terminfo.setupTermFromEnv - case Terminfo.getCapability tty withForegroundColor of - Nothing -> mapM_ show_normal stack - Just w -> runTermOutput tty $ mconcat $ - map (show_colour w) stack + let + show_colour withF db = + mconcat $ map (<#> termText "\n") $ + (termText (location db) : + map (termText " " <#>) (map pp_pkg (packages db))) + where + pp_pkg p + | sourcePackageId p `elem` broken = withF Red doc + | exposed p = doc + | otherwise = withF Blue doc + where doc | verbosity >= Verbose + = termText (printf "%s (%s)" pkg ipid) + | otherwise + = termText pkg + where + InstalledPackageId ipid = installedPackageId p + pkg = display (sourcePackageId p) + + is_tty <- hIsTerminalDevice stdout + if not is_tty + then mapM_ show_normal stack + else do tty <- Terminfo.setupTermFromEnv + case Terminfo.getCapability tty withForegroundColor of + Nothing -> mapM_ show_normal stack + Just w -> runTermOutput tty $ mconcat $ + map (show_colour w) stack #endif simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () diff --git a/utils/ghc-pkg/ghc-pkg.cabal b/utils/ghc-pkg/ghc-pkg.cabal index 2f42e31..7a44b57 100644 --- a/utils/ghc-pkg/ghc-pkg.cabal +++ b/utils/ghc-pkg/ghc-pkg.cabal @@ -16,7 +16,7 @@ cabal-version: >=1.4 Executable ghc-pkg Main-Is: Main.hs Other-Modules: Version - Extensions: CPP, ForeignFunctionInterface, NondecreasingIndentation + Extensions: CPP, ForeignFunctionInterface Build-Depends: base >= 4 && < 5, directory >= 1 && < 1.3, From git at git.haskell.org Fri Jul 4 01:36:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Jul 2014 01:36:12 +0000 (UTC) Subject: [commit: ghc] master: Update .gitignore (4b74f6c) Message-ID: <20140704013612.435F82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b74f6ca3fb962e9e9ccff1665f4d941763101e4/ghc >--------------------------------------------------------------- commit 4b74f6ca3fb962e9e9ccff1665f4d941763101e4 Author: Austin Seipp Date: Thu Jul 3 20:35:47 2014 -0500 Update .gitignore Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4b74f6ca3fb962e9e9ccff1665f4d941763101e4 .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index 99bf3a6..b71afec 100644 --- a/.gitignore +++ b/.gitignore @@ -150,3 +150,6 @@ _darcs/ .tm_properties VERSION + +/libraries/integer-gmp/gmp/gmp.h +/libraries/integer-gmp/gmp/gmpbuild/ From git at git.haskell.org Fri Jul 4 14:59:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Jul 2014 14:59:24 +0000 (UTC) Subject: [commit: ghc] master: Fix windows breakage (fallout from 34f7e9a3c998) (0567a31) Message-ID: <20140704145924.730532406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0567a3133bfd3f2085d2fc0211e91eaed96a3e83/ghc >--------------------------------------------------------------- commit 0567a3133bfd3f2085d2fc0211e91eaed96a3e83 Author: Austin Seipp Date: Fri Jul 4 09:40:25 2014 -0500 Fix windows breakage (fallout from 34f7e9a3c998) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 0567a3133bfd3f2085d2fc0211e91eaed96a3e83 aclocal.m4 | 1 + configure.ac | 3 --- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index 1a7872e..d857706 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -455,6 +455,7 @@ AC_DEFUN([FP_SETTINGS], mingw_bin_prefix=mingw/bin/ SettingsCCompilerCommand="\$topdir/../${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPCommand="\$topdir/../${mingw_bin_prefix}gcc.exe" + SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="\$topdir/../${mingw_bin_prefix}ld.exe" SettingsArCommand="\$topdir/../${mingw_bin_prefix}ar.exe" SettingsPerlCommand='$topdir/../perl/perl.exe' diff --git a/configure.ac b/configure.ac index 34cc02e..5fc5733 100644 --- a/configure.ac +++ b/configure.ac @@ -493,10 +493,7 @@ AC_ARG_WITH(hs-cpp, fi ], [ - if test "$HostOS" != "mingw32" - then HaskellCPPCmd=$WhatGccIsCalled - fi ] ) From git at git.haskell.org Fri Jul 4 14:59:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Jul 2014 14:59:49 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix windows breakage (fallout from 34f7e9a3c998) (8b5d262) Message-ID: <20140704145949.C67832406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/8b5d26208c80814afacb976a4ac22b5514b87aac/ghc >--------------------------------------------------------------- commit 8b5d26208c80814afacb976a4ac22b5514b87aac Author: Austin Seipp Date: Fri Jul 4 09:40:25 2014 -0500 Fix windows breakage (fallout from 34f7e9a3c998) Signed-off-by: Austin Seipp (cherry picked from commit 0567a3133bfd3f2085d2fc0211e91eaed96a3e83) >--------------------------------------------------------------- 8b5d26208c80814afacb976a4ac22b5514b87aac aclocal.m4 | 1 + configure.ac | 3 --- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index feb4f38..7224cd5 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -452,6 +452,7 @@ AC_DEFUN([FP_SETTINGS], mingw_bin_prefix=mingw/bin/ SettingsCCompilerCommand="\$topdir/../${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPCommand="\$topdir/../${mingw_bin_prefix}gcc.exe" + SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="\$topdir/../${mingw_bin_prefix}ld.exe" SettingsArCommand="\$topdir/../${mingw_bin_prefix}ar.exe" SettingsPerlCommand='$topdir/../perl/perl.exe' diff --git a/configure.ac b/configure.ac index 3ac1cbd..f1b949b 100644 --- a/configure.ac +++ b/configure.ac @@ -493,10 +493,7 @@ AC_ARG_WITH(hs-cpp, fi ], [ - if test "$HostOS" != "mingw32" - then HaskellCPPCmd=$WhatGccIsCalled - fi ] ) From git at git.haskell.org Fri Jul 4 15:13:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 4 Jul 2014 15:13:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Release note updates for 7.8.3 (e7d041b) Message-ID: <20140704151350.B739D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/e7d041be96b39de2a3c0ab8535a0757a2e1876de/ghc >--------------------------------------------------------------- commit e7d041be96b39de2a3c0ab8535a0757a2e1876de Author: Austin Seipp Date: Fri Jul 4 10:13:11 2014 -0500 Release note updates for 7.8.3 Signed-off-by: Austin Seipp >--------------------------------------------------------------- e7d041be96b39de2a3c0ab8535a0757a2e1876de docs/users_guide/7.8.3-notes.xml | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/docs/users_guide/7.8.3-notes.xml b/docs/users_guide/7.8.3-notes.xml index 1345e4e..197a932 100644 --- a/docs/users_guide/7.8.3-notes.xml +++ b/docs/users_guide/7.8.3-notes.xml @@ -19,6 +19,19 @@ + A handful of bugs in the pattern synonyms implementation + have been fixed (issues #9161, #8966, #9023, #9175). + + + + + A bug in runtime system which would cause + tryReadMVar to deadlock has been fixed + (issue #9148). + + + + A segmentation fault for compiled programs using makeStableName has been fixed (issue #9078). @@ -38,6 +51,12 @@ + A bug in the code generator that could cause segmentation + faults has been fixed (issue #9045). + + + + A bug which caused gcc to error when compiling large assembly source files has been fixed (issue #8768). @@ -45,6 +64,13 @@ + A bug which caused a performance regression in the new + `Typeable` implementation (due to recomputation of known + values) has been fixed (issue #9203). + + + + Several memory leaks and bugs in the runtime system and C libraries have been fixed. These issues were found using Coverity Scan. @@ -59,6 +85,14 @@ + A bug which could result in programs using all available + memory, due to a regression in the Read + instance for Data.Fixed.Pico has been + fixed (issue #9231). + + + + The libraries haskeline, xhtml, terminfo, transformers, and From git at git.haskell.org Sat Jul 5 19:54:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 5 Jul 2014 19:54:05 +0000 (UTC) Subject: [commit: ghc] master: Set mdo in typewriter face (7cf2589) Message-ID: <20140705195406.031C12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7cf25894678195fb9ffb7124afc066d91fdd363f/ghc >--------------------------------------------------------------- commit 7cf25894678195fb9ffb7124afc066d91fdd363f Author: Gabor Greif Date: Sat Jul 5 21:49:17 2014 +0200 Set mdo in typewriter face >--------------------------------------------------------------- 7cf25894678195fb9ffb7124afc066d91fdd363f docs/users_guide/glasgow_exts.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index e97d579..f1d7b94 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -1912,7 +1912,8 @@ the comprehension being over an arbitrary monad. functions (>>=), (>>), and fail, are in scope (not the Prelude - versions). List comprehensions, mdo (), and parallel array + versions). List comprehensions, mdo + (), and parallel array comprehensions, are unaffected. From git at git.haskell.org Sun Jul 6 09:38:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 6 Jul 2014 09:38:28 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: New parser for pattern synonym declarations: (007c39f) Message-ID: <20140706093829.CB1C52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/007c39f7b2749409af45b649a2906297a3be9c93/ghc >--------------------------------------------------------------- commit 007c39f7b2749409af45b649a2906297a3be9c93 Author: Dr. ERDI Gergo Date: Sun Jul 6 17:33:00 2014 +0800 New parser for pattern synonym declarations: Like splitCon for constructor definitions, the left-hand side of a pattern declaration is parsed as a single pattern which is then split into a ConName and argument variable names >--------------------------------------------------------------- 007c39f7b2749409af45b649a2906297a3be9c93 compiler/parser/Parser.y.pp | 14 ++++++++------ compiler/parser/RdrHsSyn.lhs | 21 ++++++++++++++++++++- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index a3c68c3..073afd8 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -821,17 +821,19 @@ role : VARID { L1 $ Just $ getVARID $1 } -- Glasgow extension: pattern synonyms pattern_synonym_decl :: { LHsDecl RdrName } - : 'pattern' con vars0 patsyn_token pat { LL . ValD $ mkPatSynBind $2 (PrefixPatSyn $3) $5 $4 } - | 'pattern' varid conop varid patsyn_token pat { LL . ValD $ mkPatSynBind $3 (InfixPatSyn $2 $4) $6 $5 } + : 'pattern' pat '=' pat + {% do { (name, args) <- splitPatSyn $2 + ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional + }} + | 'pattern' pat '<-' pat + {% do { (name, args) <- splitPatSyn $2 + ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional + }} vars0 :: { [Located RdrName] } : {- empty -} { [] } | varid vars0 { $1 : $2 } -patsyn_token :: { HsPatSynDir RdrName } - : '<-' { Unidirectional } - | '=' { ImplicitBidirectional } - ----------------------------------------------------------------------------- -- Nested declarations diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index af351b7..0536286 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -16,7 +16,7 @@ module RdrHsSyn ( mkTySynonym, mkTyFamInstEqn, mkTyFamInst, mkFamDecl, - splitCon, mkInlinePragma, + splitCon, splitPatSyn, mkInlinePragma, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -412,6 +412,25 @@ splitCon ty mk_rest [L _ (HsRecTy flds)] = RecCon flds mk_rest ts = PrefixCon ts +splitPatSyn :: LPat RdrName + -> P (Located RdrName, HsPatSynDetails (Located RdrName)) +splitPatSyn (L _ (ParPat pat)) = splitPatSyn pat +splitPatSyn pat@(L loc (ConPatIn con details)) = do + details' <- case details of + PrefixCon pats -> liftM PrefixPatSyn (mapM patVar pats) + InfixCon pat1 pat2 -> liftM2 InfixPatSyn (patVar pat1) (patVar pat2) + RecCon{} -> parseErrorSDoc loc $ + text "record syntax not supported for pattern synonym declarations:" $$ ppr pat + return (con, details') + where + patVar :: LPat RdrName -> P (Located RdrName) + patVar (L loc (VarPat v)) = return $ L loc v + patVar (L _ (ParPat pat)) = patVar pat + patVar pat@(L loc _) = parseErrorSDoc loc $ + text "Pattern synonym arguments must be variable names:" $$ ppr pat +splitPatSyn pat@(L loc _) = parseErrorSDoc loc $ + text "invalid pattern synonym declaration:" $$ ppr pat + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] From git at git.haskell.org Sun Jul 6 09:38:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 6 Jul 2014 09:38:32 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms's head updated: New parser for pattern synonym declarations: (007c39f) Message-ID: <20140706093832.1236A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/pattern-synonyms' now includes: b6352c9 Simplify package dump for -v4 b847481 Fix #9047 95f95ed Fix up b84748121e777d 446b0e1 arclint: disable Bad Charset lint rule 4612524 sync-all: cleanup bd07942 sync-all: delete dead code calling gitInitSubmodules 101c3f7 sync-all: die for real when required repo is missing bdb5809 sync-all: make --no-dph work for all subcommands 9a131dd sync-all: set and check variable $repo_is_submodule 72fe49d sync-all: infer remotepath from .gitmodules file 518ada5 Mark T9208 as broken when debugging is on 7a78374 More updates to Backpack impl docs. c1035d5 Fix regression in Data.Fixed Read instance (re #9231) 761c4b1 Minor refactoring of interface to extraTyVarInfo 8a0aa19 Comment the expect_broken for Trac #9208 0757831 Add Note [Placeholder PatSyn kinds] in TcBinds a4a79b5 Describe signature mini-backpack. d8abf85 Add more primops for atomic ops on byte arrays ec550e8 Fixup c1035d51e to behave more like in GHC 7.6 db19c66 Convert loose sub-repos into proper submodules (re #8545) 97ac32a Typos in comments 881be80 Fix anchors in Haddock 9833090 Fix few Haddock parser brainfarts d587ebd The linking restriction, no shaping necessary. c7dacdb sync-all: Allow - in submodule URLs c61260e Merge Thomas Miedema?s syn-all improvments 4bf3aa2 Fix sync-all get from a local working copy bcccadd Fix ?Checking for old .. repo? messages 04dd7cb Work around lack of __sync_fetch_and_nand in clang 84d7845 Lots of rewrites to further move toward new world order 950fcae Revert "Add more primops for atomic ops on byte arrays" 22c16eb Update parallel and stm submodules to have .gitignore 5bbbc7d arclint: update rules for xml files ab105f8 Add new flag -fwrite-interface for -fno-code. aa4c5e7 Add testsuite-related .gitignore files af913ad s/KnownLit/KnownSymbol/g and a typo fix 0451f91 More allDistinctTyVars from TcDeriv to Type 2be99d2 In TcValidity.checkAmbiguity, skolemise kind vars that appear free in the kinds of type variables fe0cbe4 Fix docs typo. b80d573 Refactor extension-bitmap in Lexer 05120ec Make -fno-write-interface to all modes of GHC, not just -fno-code. 5031772 Revert "Make -fno-write-interface to all modes of GHC, not just -fno-code." f4766c4 Comments only 1c0b5fd Add -XBinaryLiterals language extension (re #9224) ec38f4a Minor updates to Backpack docs. 713b271 Whitespace only 4144996 Untabify and M-x whitespace cleanup 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 007c39f New parser for pattern synonym declarations: From git at git.haskell.org Sun Jul 6 20:37:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 6 Jul 2014 20:37:19 +0000 (UTC) Subject: [commit: ghc] master: Fix imports in GHC.Event.Poll when not HAVE_POLL_H (#9275) (fa8553d) Message-ID: <20140706203719.1A56D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa8553de237a2f91f8551d69ef604c1d8a007b5f/ghc >--------------------------------------------------------------- commit fa8553de237a2f91f8551d69ef604c1d8a007b5f Author: Reid Barton Date: Sun Jul 6 16:34:32 2014 -0400 Fix imports in GHC.Event.Poll when not HAVE_POLL_H (#9275) Though as far as I can tell, we can never successfully build under this configuration anyways: GHC.Event.TimerManager requires the Poll backend to be functional. >--------------------------------------------------------------- fa8553de237a2f91f8551d69ef604c1d8a007b5f libraries/base/GHC/Event/Poll.hsc | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc index bb0b6e5..2ed25be 100644 --- a/libraries/base/GHC/Event/Poll.hsc +++ b/libraries/base/GHC/Event/Poll.hsc @@ -14,6 +14,7 @@ module GHC.Event.Poll #if !defined(HAVE_POLL_H) import GHC.Base +import qualified GHC.Event.Internal as E new :: IO E.Backend new = error "Poll back end not implemented for this platform" From git at git.haskell.org Mon Jul 7 07:53:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Jul 2014 07:53:23 +0000 (UTC) Subject: [commit: ghc] master: Do not print the result of 'main' after invoking ':main' (fixes #9086). (55e7ab1) Message-ID: <20140707075323.B38742406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/55e7ab1210975e6276f3cab3ac0e1f35bcd772f0/ghc >--------------------------------------------------------------- commit 55e7ab1210975e6276f3cab3ac0e1f35bcd772f0 Author: Gintautas Miliauskas Date: Sun Jun 8 11:49:29 2014 +0000 Do not print the result of 'main' after invoking ':main' (fixes #9086). >--------------------------------------------------------------- 55e7ab1210975e6276f3cab3ac0e1f35bcd772f0 ghc/InteractiveUI.hs | 7 ++++--- testsuite/tests/ghc-e/should_run/Makefile | 2 ++ testsuite/tests/ghc-e/should_run/T9086.hs | 1 + testsuite/tests/ghc-e/should_run/all.T | 1 + testsuite/tests/ghci/scripts/T9086b.script | 2 ++ .../{ffi/should_run/ffi021.stdout => ghci/scripts/T9086b.stdout} | 0 testsuite/tests/ghci/scripts/all.T | 1 + 7 files changed, 11 insertions(+), 3 deletions(-) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 0a56799..c3d9f25 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -1141,9 +1141,10 @@ runMain s = case toArgs s of Left err -> liftIO (hPutStrLn stderr err) Right args -> do dflags <- getDynFlags - case mainFunIs dflags of - Nothing -> doWithArgs args "main" - Just f -> doWithArgs args f + let main = fromMaybe "main" (mainFunIs dflags) + -- Wrap the main function in 'void' to discard its value instead + -- of printing it (#9086). See Haskell 2010 report Chapter 5. + doWithArgs args $ "Control.Monad.void (" ++ main ++ ")" ----------------------------------------------------------------------------- -- :run diff --git a/testsuite/tests/ghc-e/should_run/Makefile b/testsuite/tests/ghc-e/should_run/Makefile index 1971004..5ed1ec2 100644 --- a/testsuite/tests/ghc-e/should_run/Makefile +++ b/testsuite/tests/ghc-e/should_run/Makefile @@ -30,3 +30,5 @@ T3890: T7299: '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "Control.Concurrent.threadDelay (1000 * 1000)" +T9086: + '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":main" T9086.hs diff --git a/testsuite/tests/ghc-e/should_run/T9086.hs b/testsuite/tests/ghc-e/should_run/T9086.hs new file mode 100644 index 0000000..a2b4ace --- /dev/null +++ b/testsuite/tests/ghc-e/should_run/T9086.hs @@ -0,0 +1 @@ +main = return "this should not be printed" diff --git a/testsuite/tests/ghc-e/should_run/all.T b/testsuite/tests/ghc-e/should_run/all.T index 4ab7567..9f64918 100644 --- a/testsuite/tests/ghc-e/should_run/all.T +++ b/testsuite/tests/ghc-e/should_run/all.T @@ -14,3 +14,4 @@ test('T2228', test('T2636', req_interp, run_command, ['$MAKE --no-print-directory -s T2636']) test('T3890', req_interp, run_command, ['$MAKE --no-print-directory -s T3890']) test('T7299', req_interp, run_command, ['$MAKE --no-print-directory -s T7299']) +test('T9086', req_interp, run_command, ['$MAKE --no-print-directory -s T9086']) diff --git a/testsuite/tests/ghci/scripts/T9086b.script b/testsuite/tests/ghci/scripts/T9086b.script new file mode 100644 index 0000000..d60156a --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9086b.script @@ -0,0 +1,2 @@ +let main = do { putStrLn "hello"; return "discarded" } +:main diff --git a/testsuite/tests/ffi/should_run/ffi021.stdout b/testsuite/tests/ghci/scripts/T9086b.stdout similarity index 100% copy from testsuite/tests/ffi/should_run/ffi021.stdout copy to testsuite/tests/ghci/scripts/T9086b.stdout diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index b71dfd1..d1e67eb 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -175,3 +175,4 @@ test('T8931', normal, ghci_script, ['T8931.script']) test('T8959', normal, ghci_script, ['T8959.script']) test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script']) test('T9181', normal, ghci_script, ['T9181.script']) +test('T9086b', normal, ghci_script, ['T9086b.script']) From git at git.haskell.org Mon Jul 7 13:54:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Jul 2014 13:54:27 +0000 (UTC) Subject: [commit: ghc] master: Private axiom comment in Backpack (1d225d1) Message-ID: <20140707135428.131B72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1d225d1ec56624eb235fcc9d27e0d31ae30ed399/ghc >--------------------------------------------------------------- commit 1d225d1ec56624eb235fcc9d27e0d31ae30ed399 Author: Edward Z. Yang Date: Mon Jul 7 14:54:13 2014 +0100 Private axiom comment in Backpack Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 1d225d1ec56624eb235fcc9d27e0d31ae30ed399 docs/backpack/backpack-impl.tex | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index e45cead..66b62bb 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -1357,8 +1357,33 @@ Now it is illegal for \verb|A = B|, because when the type families are unified, the instances now fail the apartness check. However, if the second instance was \verb|F Int = Char|, the families would be able to link together. -It would be nice to solve this problem before getting to the linking phase. (But, -channeling SPJ for a moment, ``Why would anyone want to do that?!'') +To make matters worse, an implementation may define more axioms than are +visible in the signature: + +\begin{verbatim} +package a where + A :: [ + type family F a :: * + type instance F Int = Bool + ] +package b where + include a + B = [ + import A + type instance F Bool = Bool + ... + ] +package c where + A = [ + type family F a :: * + type instance F Int = Bool + type instance F Bool = Int + ] + include b +\end{verbatim} + +It would seem that private axioms cannot be naively supported. Is +there any way that thinning axioms could be made to work? \section{Open questions}\label{sec:open-questions} From git at git.haskell.org Mon Jul 7 13:58:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Jul 2014 13:58:14 +0000 (UTC) Subject: [commit: packages/unix] master: Ignore interp.stderr/stdout. (54fbbde) Message-ID: <20140707135814.3B76F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/54fbbdecb673705a67d5b9594503cf86d53265c9/unix >--------------------------------------------------------------- commit 54fbbdecb673705a67d5b9594503cf86d53265c9 Author: Edward Z. Yang Date: Mon Jul 7 14:58:08 2014 +0100 Ignore interp.stderr/stdout. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 54fbbdecb673705a67d5b9594503cf86d53265c9 tests/.gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/.gitignore b/tests/.gitignore index a6b0472..eefd6d4 100644 --- a/tests/.gitignore +++ b/tests/.gitignore @@ -6,6 +6,8 @@ *.eventlog *.genscript *.exe +*.interp.stderr +*.interp.stdout # specific files /T1185 From git at git.haskell.org Mon Jul 7 13:58:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Jul 2014 13:58:36 +0000 (UTC) Subject: [commit: ghc] master: Track gitignore update in submodule unix (74b6b04) Message-ID: <20140707135836.223AF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/74b6b04f64ed2489ec101407796e69c073fcf704/ghc >--------------------------------------------------------------- commit 74b6b04f64ed2489ec101407796e69c073fcf704 Author: Edward Z. Yang Date: Mon Jul 7 14:58:29 2014 +0100 Track gitignore update in submodule unix Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 74b6b04f64ed2489ec101407796e69c073fcf704 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index bc48ca8..54fbbde 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit bc48ca82deb23f6985579b7a50d205632cfd5d46 +Subproject commit 54fbbdecb673705a67d5b9594503cf86d53265c9 From git at git.haskell.org Mon Jul 7 14:14:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Jul 2014 14:14:22 +0000 (UTC) Subject: [commit: ghc] master: More testsuite ignores. (ff7aaf5) Message-ID: <20140707141422.60EBD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff7aaf508be46fc0b873faa0d3002203130f7737/ghc >--------------------------------------------------------------- commit ff7aaf508be46fc0b873faa0d3002203130f7737 Author: Edward Z. Yang Date: Mon Jul 7 15:14:12 2014 +0100 More testsuite ignores. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- ff7aaf508be46fc0b873faa0d3002203130f7737 testsuite/.gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 376318d..efb9c1c 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -275,6 +275,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/concurrent/should_run/T5611 /tests/concurrent/should_run/T5866 /tests/concurrent/should_run/T7970 +/tests/concurrent/should_run/AtomicPrimops /tests/concurrent/should_run/allowinterrupt001 /tests/concurrent/should_run/async001 /tests/concurrent/should_run/compareAndSwap @@ -1372,6 +1373,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/stranal/should_run/T2756b /tests/stranal/should_run/T7649 /tests/stranal/should_run/T8425/T8425 +/tests/stranal/should_run/T9254 /tests/stranal/should_run/strun001 /tests/stranal/should_run/strun002 /tests/stranal/should_run/strun003 From git at git.haskell.org Tue Jul 8 12:25:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Jul 2014 12:25:52 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add parser support for explicitly bidirectional pattern synonyms (4f08ba9) Message-ID: <20140708122552.64CB42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/4f08ba9600f29a8954b9d68aef7581dda502e909/ghc >--------------------------------------------------------------- commit 4f08ba9600f29a8954b9d68aef7581dda502e909 Author: Dr. ERDI Gergo Date: Sun Jul 6 22:13:50 2014 +0800 Add parser support for explicitly bidirectional pattern synonyms >--------------------------------------------------------------- 4f08ba9600f29a8954b9d68aef7581dda502e909 compiler/hsSyn/HsBinds.lhs | 18 ++++++++++-------- compiler/parser/Parser.y.pp | 10 ++++++++++ compiler/parser/RdrHsSyn.lhs | 42 +++++++++++++++++++++++++++++++++++++----- compiler/typecheck/TcHsSyn.lhs | 3 +++ 4 files changed, 60 insertions(+), 13 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 2261a89..54d5746 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -441,15 +441,18 @@ ppr_monobind (PatSynBind{ patsyn_id = L _ psyn, patsyn_args = details, patsyn_def = pat, patsyn_dir = dir }) = ppr_lhs <+> ppr_rhs where - ppr_lhs = ptext (sLit "pattern") <+> ppr_details details + ppr_lhs = ptext (sLit "pattern") <+> ppr_details ppr_simple syntax = syntax <+> ppr pat - ppr_details (InfixPatSyn v1 v2) = hsep [ppr v1, pprInfixOcc psyn, ppr v2] - ppr_details (PrefixPatSyn vs) = hsep (pprPrefixOcc psyn : map ppr vs) + (is_infix, ppr_details) = case details of + InfixPatSyn v1 v2 -> (True, hsep [ppr v1, pprInfixOcc psyn, ppr v2]) + PrefixPatSyn vs -> (False, hsep (pprPrefixOcc psyn : map ppr vs)) ppr_rhs = case dir of - Unidirectional -> ppr_simple (ptext (sLit "<-")) - ImplicitBidirectional -> ppr_simple equals + Unidirectional -> ppr_simple (ptext (sLit "<-")) + ImplicitBidirectional -> ppr_simple equals + ExplicitBidirectional mg -> ppr_simple (ptext (sLit "<-")) <+> ptext (sLit "where") $$ + (nest 2 $ pprFunBind psyn is_infix mg) ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars , abs_exports = exports, abs_binds = val_binds @@ -785,10 +788,9 @@ instance Traversable HsPatSynDetails where traverse f (InfixPatSyn left right) = InfixPatSyn <$> f left <*> f right traverse f (PrefixPatSyn args) = PrefixPatSyn <$> traverse f args -data HsPatSynDirLR idL idR +data HsPatSynDir id = Unidirectional | ImplicitBidirectional + | ExplicitBidirectional (MatchGroup id (LHsExpr id)) deriving (Data, Typeable) - -type HsPatSynDir id = HsPatSynDirLR id id \end{code} diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 073afd8..0913511 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -829,6 +829,16 @@ pattern_synonym_decl :: { LHsDecl RdrName } {% do { (name, args) <- splitPatSyn $2 ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional }} + | 'pattern' pat '<-' pat where_decls + {% do { (name, args) <- splitPatSyn $2 + ; mg <- toPatSynMatchGroup name $5 + ; return $ LL . ValD $ + mkPatSynBind name args $4 (ExplicitBidirectional mg) + }} + +where_decls :: { Located (OrdList (LHsDecl RdrName)) } + : 'where' '{' decls '}' { $3 } + | 'where' vocurly decls close { $3 } vars0 :: { [Located RdrName] } : {- empty -} { [] } diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 0536286..c04eef9 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -16,7 +16,8 @@ module RdrHsSyn ( mkTySynonym, mkTyFamInstEqn, mkTyFamInst, mkFamDecl, - splitCon, splitPatSyn, mkInlinePragma, + splitCon, mkInlinePragma, + splitPatSyn, toPatSynMatchGroup, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -419,18 +420,49 @@ splitPatSyn pat@(L loc (ConPatIn con details)) = do details' <- case details of PrefixCon pats -> liftM PrefixPatSyn (mapM patVar pats) InfixCon pat1 pat2 -> liftM2 InfixPatSyn (patVar pat1) (patVar pat2) - RecCon{} -> parseErrorSDoc loc $ - text "record syntax not supported for pattern synonym declarations:" $$ ppr pat + RecCon{} -> recordPatSynErr loc pat return (con, details') where patVar :: LPat RdrName -> P (Located RdrName) patVar (L loc (VarPat v)) = return $ L loc v patVar (L _ (ParPat pat)) = patVar pat - patVar pat@(L loc _) = parseErrorSDoc loc $ - text "Pattern synonym arguments must be variable names:" $$ ppr pat + patVar (L loc pat) = parseErrorSDoc loc $ + text "Pattern synonym arguments must be variable names:" $$ + ppr pat splitPatSyn pat@(L loc _) = parseErrorSDoc loc $ text "invalid pattern synonym declaration:" $$ ppr pat +recordPatSynErr :: SrcSpan -> LPat RdrName -> P a +recordPatSynErr loc pat = + parseErrorSDoc loc $ + text "record syntax not supported for pattern synonym declarations:" $$ + ppr pat + +toPatSynMatchGroup :: Located RdrName -> Located (OrdList (LHsDecl RdrName)) -> P (MatchGroup RdrName (LHsExpr RdrName)) +toPatSynMatchGroup (L _ patsyn_name) (L _ decls) = + do { matches <- mapM fromDecl (fromOL decls) + ; return $ mkMatchGroup FromSource matches } + where + fromDecl (L loc decl@(ValD (PatBind pat@(L _ (ConPatIn (L _ name) details)) rhs _ _ _))) = + do { unless (name == patsyn_name) $ + wrongNameBindingErr loc decl + ; match <- case details of + PrefixCon pats -> return $ Match pats Nothing rhs + InfixCon pat1 pat2 -> return $ Match [pat1, pat2] Nothing rhs + RecCon{} -> recordPatSynErr loc pat + ; return $ L loc match } + fromDecl (L loc decl) = extraDeclErr loc decl + + extraDeclErr loc decl = + parseErrorSDoc loc $ + text "pattern synonym 'where' clause must contain a single binding:" $$ + ppr decl + + wrongNameBindingErr loc decl = + parseErrorSDoc loc $ + text "pattern synonym 'where' clause must bind the pattern synonym's name" <+> + quotes (ppr patsyn_name) $$ ppr decl + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index f90cfca..1a48fe8 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -489,6 +489,9 @@ zonkPatSynDetails env = traverse (wrapLocM $ zonkIdBndr env) zonkPatSynDir :: ZonkEnv -> HsPatSynDir TcId -> TcM (ZonkEnv, HsPatSynDir Id) zonkPatSynDir env Unidirectional = return (env, Unidirectional) zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional) +zonkPatSynDir env (ExplicitBidirectional mg) = do + mg' <- zonkMatchGroup env zonkLExpr mg + return (env, ExplicitBidirectional mg') zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags zonkSpecPrags _ IsDefaultMethod = return IsDefaultMethod From git at git.haskell.org Tue Jul 8 12:25:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Jul 2014 12:25:54 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Typechecker support for explicitly-bidirectional pattern synonyms (e5dd0bf) Message-ID: <20140708122554.C267B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/e5dd0bf57be2ed630b102e5e34cbdf4fce964f11/ghc >--------------------------------------------------------------- commit e5dd0bf57be2ed630b102e5e34cbdf4fce964f11 Author: Dr. ERDI Gergo Date: Sun Jul 6 23:49:43 2014 +0800 Typechecker support for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- e5dd0bf57be2ed630b102e5e34cbdf4fce964f11 compiler/typecheck/TcPatSyn.lhs | 39 +++++++++++++++++++++++---------------- 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index 82fa999..d72acba 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -205,16 +205,27 @@ tcPatSynWrapper lname lpat dir args univ_tvs ex_tvs theta pat_ty (ImplicitBidirectional, Nothing) -> cannotInvertPatSynErr lpat (ImplicitBidirectional, Just lexpr) -> - fmap Just $ tc_pat_syn_wrapper_from_expr lname lexpr args univ_tvs ex_tvs theta pat_ty } - -tc_pat_syn_wrapper_from_expr :: Located Name - -> LHsExpr Name - -> [Var] - -> [TyVar] -> [TyVar] - -> ThetaType - -> Type - -> TcM (Id, LHsBinds Id) -tc_pat_syn_wrapper_from_expr (L loc name) lexpr args univ_tvs ex_tvs theta pat_ty + fmap Just $ mkWrapper $ \wrapper_lname args' -> + do { let wrapper_args = map (noLoc . VarPat . Var.varName) args' + wrapper_match = mkMatch wrapper_args lexpr EmptyLocalBinds + bind = mkTopFunBind Generated wrapper_lname [wrapper_match] + ; return bind } + (ExplicitBidirectional mg, _) -> + fmap Just $ mkWrapper $ \wrapper_lname _args' -> + return FunBind{ fun_id = wrapper_lname + , fun_infix = False + , fun_matches = mg + , fun_co_fn = idHsWrapper + , bind_fvs = placeHolderNames + , fun_tick = Nothing } } + where + mkWrapper = mkPatSynWrapper lname args univ_tvs ex_tvs theta pat_ty + +mkPatSynWrapper :: Located Name + -> [Var] -> [TyVar] -> [TyVar] -> ThetaType -> Type + -> (Located Name -> [Var] -> TcM (HsBind Name)) + -> TcM (Id, LHsBinds Id) +mkPatSynWrapper (L loc name) args univ_tvs ex_tvs theta pat_ty mk_bind = do { let qtvs = univ_tvs ++ ex_tvs ; (subst, wrapper_tvs) <- tcInstSkolTyVars qtvs ; let wrapper_theta = substTheta subst theta @@ -227,21 +238,17 @@ tc_pat_syn_wrapper_from_expr (L loc name) lexpr args univ_tvs ex_tvs theta pat_t ; let wrapper_lname = L loc wrapper_name wrapper_id = mkExportedLocalId VanillaId wrapper_name wrapper_sigma - ; let wrapper_args = map (noLoc . VarPat . Var.varName) args' - wrapper_match = mkMatch wrapper_args lexpr EmptyLocalBinds - bind = mkTopFunBind Generated wrapper_lname [wrapper_match] - lbind = noLoc bind + ; bind <- mk_bind wrapper_lname args' ; let sig = TcSigInfo{ sig_id = wrapper_id , sig_tvs = map (\tv -> (Nothing, tv)) wrapper_tvs , sig_theta = wrapper_theta , sig_tau = wrapper_tau , sig_loc = loc } - ; (wrapper_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig lbind + ; (wrapper_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (noLoc bind) ; traceTc "tcPatSynDecl wrapper" $ ppr wrapper_binds ; traceTc "tcPatSynDecl wrapper type" $ ppr (varType wrapper_id) ; return (wrapper_id, wrapper_binds) } - \end{code} Note [As-patterns in pattern synonym definitions] From git at git.haskell.org Tue Jul 8 12:25:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Jul 2014 12:25:57 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add renamer support for explicitly-bidirectional pattern synonyms (a61a5e0) Message-ID: <20140708122557.6CF2D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/a61a5e0034595038700bd42d648c1e67b0432bc1/ghc >--------------------------------------------------------------- commit a61a5e0034595038700bd42d648c1e67b0432bc1 Author: Dr. ERDI Gergo Date: Mon Jul 7 19:25:29 2014 +0800 Add renamer support for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- a61a5e0034595038700bd42d648c1e67b0432bc1 compiler/rename/RnBinds.lhs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index e65d317..b8887b0 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -523,7 +523,7 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name = do { pattern_synonym_ok <- xoptM Opt_PatternSynonyms ; unless pattern_synonym_ok (addErr patternSynonymErr) - ; ((pat', details'), fvs) <- rnPat PatSyn pat $ \pat' -> do + ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported -- from the left-hand side @@ -539,12 +539,16 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name -- ; checkPrecMatch -- TODO ; return (InfixPatSyn name1 name2, mkFVs (map unLoc [name1, name2])) } ; return ((pat', details'), fvs) } - ; dir' <- case dir of - Unidirectional -> return Unidirectional - ImplicitBidirectional -> return ImplicitBidirectional + ; (dir', fvs2) <- case dir of + Unidirectional -> return (Unidirectional, emptyFVs) + ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) + ExplicitBidirectional mg -> + do { (mg', fvs) <- rnMatchGroup PatSyn rnLExpr mg + ; return (ExplicitBidirectional mg', fvs) } ; mod <- getModule - ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs + ; let fvs = fvs1 `plusFV` fvs2 + fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs -- Keep locally-defined Names -- As well as dependency analysis, we need these for the -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan From git at git.haskell.org Tue Jul 8 12:26:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Jul 2014 12:26:00 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: When typechecking a pattern synonym, the typechecking the definition of the wrapper can be deferred until after everything else is checked (since the expression-type of the pattern synonym can be determined without looking at the wrapper). (fa3fc76) Message-ID: <20140708122600.62CB02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/fa3fc76ad77611091afeb4c017be932b908c1ee5/ghc >--------------------------------------------------------------- commit fa3fc76ad77611091afeb4c017be932b908c1ee5 Author: Dr. ERDI Gergo Date: Tue Jul 8 20:25:22 2014 +0800 When typechecking a pattern synonym, the typechecking the definition of the wrapper can be deferred until after everything else is checked (since the expression-type of the pattern synonym can be determined without looking at the wrapper). This is needed so that something like this typechecks, without regarding it as a recursive pattern synonym: pattern P x <- (x:_) where P x = foo [x] foo (P x) = [x, x] >--------------------------------------------------------------- fa3fc76ad77611091afeb4c017be932b908c1ee5 compiler/rename/RnBinds.lhs | 2 +- compiler/typecheck/TcBinds.lhs | 70 +++++++++++++++++------------- compiler/typecheck/TcPatSyn.lhs | 82 ++++++++++++++++++++---------------- compiler/typecheck/TcPatSyn.lhs-boot | 2 +- 4 files changed, 87 insertions(+), 69 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fa3fc76ad77611091afeb4c017be932b908c1ee5 From git at git.haskell.org Wed Jul 9 08:40:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Jul 2014 08:40:50 +0000 (UTC) Subject: [commit: ghc] master: Scott's updates to the impl paper. (7a15a68) Message-ID: <20140709084051.F14D32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a15a68d08cde4d8b5b4e53f0c887aeeae233536/ghc >--------------------------------------------------------------- commit 7a15a68d08cde4d8b5b4e53f0c887aeeae233536 Author: Edward Z. Yang Date: Wed Jul 9 09:40:42 2014 +0100 Scott's updates to the impl paper. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 7a15a68d08cde4d8b5b4e53f0c887aeeae233536 docs/backpack/backpack-impl.tex | 117 +++++++++++++++++++++++++++++++--------- 1 file changed, 92 insertions(+), 25 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index 66b62bb..9b5c450 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -480,8 +480,11 @@ but some global state in the module doesn't, the resulting behavior can be surprising. Perhaps the moral of the story really is, ``Don't do side effects in an applicative module system! No really!''} \\ -\noindent Flattening the package database may be too stiff a medicine for this -project. Here are two alternatives. +\subsection{Alternatives to flattening package DB} +Flattening can be seen as one of four different representations of packages +at the OS/library level. While it promotes maximal sharing of identical +modules, it is perhaps too fine-grained for most purposes. +\emph{TODO: Describe the alternatives.} \paragraph{Package slicing} Instead of changing the package database, we automatically @@ -913,6 +916,59 @@ but the ability to typecheck against holes, even with the linking restriction, is a very important part of modular separate development, so we will need to support it at some ponit. +\subsection{Efficient shaping} + +(These are Edward's opinion, he hasn't convinced other folks that this is +the right way to do it.) + +In this section, I want to argue that, although shaping constitutes +a pre-pass which must be run before compilation in earnest, it is only +about as bad as the dependency resolution analysis that GHC already does +in \verb|ghc -M| or \verb|ghc --make|. + +In Paper Backpack, what information does shaping compute? It looks at +exports, imports, data declarations and value declarations (but not the +actual expressions associated with these values.) As a matter of fact, +GHC already must look at the imports associated with a package in order +to determine the dependency graph, so that it can have some order to compile +modules in. There is a specialized parser which just parses these statements, +and then ignores the rest of the file. + +A bit of background: the \emph{renamer} is responsible for resolving +imports and figuring out where all of these entities actually come from. +SPJ would really like to avoid having to run the renamer in order to perform +a shaping pass. + +\paragraph{Is it necessary to run the Renamer to do shaping?} +Edward and Scott believe the answer is no, well, partially. +Shaping needs to know the original names of all entities exposed by a +module/signature. Then it needs to know (a) which entities a module/signature +defines/declares locally and (b) which entities that module/signature exports. +The former, (a), can be determined by a straightforward inspection of a parse +tree of the source file.\footnote{Note that no expression or type parsing +is necessary. We only need names of local values, data types, and data +constructors.} The latter, (b), is a bit trickier. Right now it's the Renamer +that interprets imports and exports into original names, so we would still +rely on that implementation. However, the Renamer does other, harder things +that we don't need, so ideally we could factor out the import/export +resolution from the Renamer for use in shaping. + +Unfortunately the Renamer's import resolution analyzes .hi files, but for +local modules, which haven't yet been typechecked, we don't have those. +Instead, we could use a new file format, .hsi files, to store the shape of +a locally defined module. (Defined packages are bundled with their shapes, +so included modules have .hsi files as well.) (What about the logical +vs.~physical distinction in file names?) If we refactor the import/export +resolution code, could we rewrite it to generically operate on both +.hi files and .hsi files? + +Alternatively, rather than storing shapes on a per-source basis, we could +store (in memory) the entire package shape. Similarly, included packages +could have a single shape file for the entire package. Although this approach +would make shaping non-incremental, since an entire package's shape would +be recomputed any time a constituent module's shape changes, we do not expect +shaping to be all that expensive. + \subsection{Typechecking of indefinite modules}\label{sec:typechecking-indefinite} Recall in our argument in the definite case, where we showed there are @@ -1026,30 +1082,41 @@ A\ldots but it will not be defined prior to package p. In any case, however, it would be good to emit a warning if a package cannot be compiled without mutual recursion. -\subsection{Efficient shaping} - -(These are Edward's opinion, he hasn't convinced other folks that this is -the right way to do it.) - -In this section, I want to argue that, although shaping constitutes -a pre-pass which must be run before compilation in earnest, it is only -about as bad as the dependency resolution analysis that GHC already does -in \verb|ghc -M| or \verb|ghc --make|. - -In Paper Backpack, what information does shaping compute? It looks at -exports, imports, data declarations and value declarations (but not the -actual expressions associated with these values.) As a matter of fact, -GHC already must look at the imports associated with a package in order -to determine the dependency graph, so that it can have some order to compile -modules in. There is a specialized parser which just parses these statements, -and then ignores the rest of the file. - -A bit of background: the \emph{renamer} is responsible for resolving -imports and figuring out where all of these entities actually come from. -SPJ would really like to avoid having to run the renamer in order to perform -a shaping pass. +\subsection{Incremental typechecking} +We want to typecheck modules incrementally, i.e., when something changes in +a package, we only want to re-typecheck the modules that care about that +change. GHC already does this today.% +\footnote{\url{https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance}} +Is the same mechanism sufficient for Backpack? Edward and Scott think that it +is, mostly. Our conjecture is that a module should be re-typechecked if the +existing mechanism says it should \emph{or} if the logical shape +context (which maps logical names to physical names) has changed. The latter +condition is due to aliases that affect typechecking of modules. + +Let's look again at an example from before: +\begin{verbatim} +package p where + A :: [ data A ] + B :: [ data A ] + M = [ import A; import B; ... ] +\end{verbatim} +Let's say that \verb|M| is typechecked successfully. Now we add an alias binding +at the end of the package, \verb|A = B|. Does \verb|M| need to be +re-typechecked? Yes! (Well, it seems so, but let's just assert ``yes'' for now. +Certainly in the reverse case---if we remove the alias and then ask---this +is true, since \verb|M| might have depended on the two \verb|A| types +being the same.) +The logical shape context changed to say that \verb|A| and +\verb|B| now map to the same physical module identity. But does the existing +recompilation avoidance mechanism say that \verb|M| should be re-typechecked? +It's unclear. The .hi file for \verb|M| records that it imported \verb|A| and +\verb|B| with particular ABIs, but does it also know about the physical module +identities (or rather, original module names) of these modules? + +Scott thinks this highlights the need for us to get our story straight about +the connection between logical names, physical module identities, and file +names! -XXX Primary open question here: is it possible to do shaping without renaming? \subsection{Installing indefinite packages}\label{sec:installing-indefinite} From git at git.haskell.org Wed Jul 9 08:50:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Jul 2014 08:50:35 +0000 (UTC) Subject: [commit: ghc] master: [docs/backpack] Get lint to stop complaining (d68c77b) Message-ID: <20140709085035.261A52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d68c77b514ebb987d618787f12840def66ec1c7e/ghc >--------------------------------------------------------------- commit d68c77b514ebb987d618787f12840def66ec1c7e Author: Edward Z. Yang Date: Wed Jul 9 09:50:27 2014 +0100 [docs/backpack] Get lint to stop complaining Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- d68c77b514ebb987d618787f12840def66ec1c7e docs/backpack/backpack-impl.tex | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index 9b5c450..46e397f 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -484,7 +484,7 @@ in an applicative module system! No really!''} \\ Flattening can be seen as one of four different representations of packages at the OS/library level. While it promotes maximal sharing of identical modules, it is perhaps too fine-grained for most purposes. -\emph{TODO: Describe the alternatives.} +\emph{ToDo: Describe the alternatives.} \paragraph{Package slicing} Instead of changing the package database, we automatically @@ -953,14 +953,14 @@ rely on that implementation. However, the Renamer does other, harder things that we don't need, so ideally we could factor out the import/export resolution from the Renamer for use in shaping. -Unfortunately the Renamer's import resolution analyzes .hi files, but for +Unfortunately the Renamer's import resolution analyzes \verb|.hi| files, but for local modules, which haven't yet been typechecked, we don't have those. -Instead, we could use a new file format, .hsi files, to store the shape of +Instead, we could use a new file format, \verb|.hsi| files, to store the shape of a locally defined module. (Defined packages are bundled with their shapes, -so included modules have .hsi files as well.) (What about the logical +so included modules have \verb|.hsi| files as well.) (What about the logical vs.~physical distinction in file names?) If we refactor the import/export resolution code, could we rewrite it to generically operate on both -.hi files and .hsi files? +\verb|.hi| files and \verb|.hsi| files? Alternatively, rather than storing shapes on a per-source basis, we could store (in memory) the entire package shape. Similarly, included packages @@ -1109,7 +1109,7 @@ being the same.) The logical shape context changed to say that \verb|A| and \verb|B| now map to the same physical module identity. But does the existing recompilation avoidance mechanism say that \verb|M| should be re-typechecked? -It's unclear. The .hi file for \verb|M| records that it imported \verb|A| and +It's unclear. The \verb|.hi| file for \verb|M| records that it imported \verb|A| and \verb|B| with particular ABIs, but does it also know about the physical module identities (or rather, original module names) of these modules? From git at git.haskell.org Wed Jul 9 08:53:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Jul 2014 08:53:51 +0000 (UTC) Subject: [commit: ghc] master: Add hyperref package. (afe7bc1) Message-ID: <20140709085351.863EE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/afe7bc188804dabf4c35c77e5442c0fe10b32afd/ghc >--------------------------------------------------------------- commit afe7bc188804dabf4c35c77e5442c0fe10b32afd Author: Edward Z. Yang Date: Wed Jul 9 09:53:43 2014 +0100 Add hyperref package. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- afe7bc188804dabf4c35c77e5442c0fe10b32afd docs/backpack/backpack-impl.tex | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index 46e397f..e7d32c3 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -4,6 +4,7 @@ \usepackage{fullpage} \usepackage{float} \usepackage{titling} +\usepackage{hyperref} \setlength{\droptitle}{-6em} \newcommand{\ghcfile}[1]{\textsl{#1}} From git at git.haskell.org Wed Jul 9 18:01:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Jul 2014 18:01:20 +0000 (UTC) Subject: [commit: ghc] master: Start expanding out linking text (a77e079) Message-ID: <20140709180120.899D02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a77e07970a89f2101e3c4f0429c6f426f06f1faf/ghc >--------------------------------------------------------------- commit a77e07970a89f2101e3c4f0429c6f426f06f1faf Author: Edward Z. Yang Date: Wed Jul 9 19:01:11 2014 +0100 Start expanding out linking text Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a77e07970a89f2101e3c4f0429c6f426f06f1faf docs/backpack/backpack-impl.tex | 331 +++++++++++++++++++++++++++++----------- 1 file changed, 239 insertions(+), 92 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a77e07970a89f2101e3c4f0429c6f426f06f1faf From git at git.haskell.org Thu Jul 10 00:20:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 00:20:58 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix #9003 with an annoying hack (bd5f3ef) Message-ID: <20140710002058.F3FD22406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd5f3ef6585640f762d96426bb041d79a5038e8e/ghc >--------------------------------------------------------------- commit bd5f3ef6585640f762d96426bb041d79a5038e8e Author: Austin Seipp Date: Wed Jul 9 19:08:26 2014 -0500 rts: Fix #9003 with an annoying hack The TL;DR is that by adding this, we can distinguish GHC 7.8.3 from 7.8.2, which had a buggy implementation. See the ticket for details. Signed-off-by: Austin Seipp >--------------------------------------------------------------- bd5f3ef6585640f762d96426bb041d79a5038e8e includes/rts/EventLogFormat.h | 4 +++- rts/eventlog/EventLog.c | 5 +++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h index e08a449..a1e038f 100644 --- a/includes/rts/EventLogFormat.h +++ b/includes/rts/EventLogFormat.h @@ -162,6 +162,8 @@ #define EVENT_TASK_MIGRATE 56 /* (taskID, cap, new_cap) */ #define EVENT_TASK_DELETE 57 /* (taskID) */ #define EVENT_USER_MARKER 58 /* (marker_name) */ +#define EVENT_HACK_BUG_T9003 59 /* Hack: see trac #9003 */ + /* Range 59 - 59 is available for new GHC and common events. */ /* Range 60 - 80 is used by eden for parallel tracing @@ -177,7 +179,7 @@ * ranges higher than this are reserved but not currently emitted by ghc. * This must match the size of the EventDesc[] array in EventLog.c */ -#define NUM_GHC_EVENT_TAGS 59 +#define NUM_GHC_EVENT_TAGS 60 #if 0 /* DEPRECATED EVENTS: */ /* we don't actually need to record the thread, it's implicit */ diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c index 2e0e9bb..4fd4b44 100644 --- a/rts/eventlog/EventLog.c +++ b/rts/eventlog/EventLog.c @@ -106,6 +106,7 @@ char *EventDesc[] = { [EVENT_TASK_CREATE] = "Task create", [EVENT_TASK_MIGRATE] = "Task migrate", [EVENT_TASK_DELETE] = "Task delete", + [EVENT_HACK_BUG_T9003] = "Empty event for bug #9003", }; // Event type. @@ -420,6 +421,10 @@ initEventLogging(void) sizeof(EventCapNo); break; + case EVENT_HACK_BUG_T9003: + eventTypes[t].size = 0; + break; + default: continue; /* ignore deprecated events */ } From git at git.haskell.org Thu Jul 10 00:22:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 00:22:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: rts: Fix #9003 with an annoying hack (b0d2c7f) Message-ID: <20140710002223.D01552406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/b0d2c7fff13a62487c01302520f0abbf6fc16ba3/ghc >--------------------------------------------------------------- commit b0d2c7fff13a62487c01302520f0abbf6fc16ba3 Author: Austin Seipp Date: Wed Jul 9 19:08:26 2014 -0500 rts: Fix #9003 with an annoying hack The TL;DR is that by adding this, we can distinguish GHC 7.8.3 from 7.8.2, which had a buggy implementation. See the ticket for details. Signed-off-by: Austin Seipp (cherry picked from commit bd5f3ef6585640f762d96426bb041d79a5038e8e) >--------------------------------------------------------------- b0d2c7fff13a62487c01302520f0abbf6fc16ba3 includes/rts/EventLogFormat.h | 4 +++- rts/eventlog/EventLog.c | 5 +++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h index e08a449..a1e038f 100644 --- a/includes/rts/EventLogFormat.h +++ b/includes/rts/EventLogFormat.h @@ -162,6 +162,8 @@ #define EVENT_TASK_MIGRATE 56 /* (taskID, cap, new_cap) */ #define EVENT_TASK_DELETE 57 /* (taskID) */ #define EVENT_USER_MARKER 58 /* (marker_name) */ +#define EVENT_HACK_BUG_T9003 59 /* Hack: see trac #9003 */ + /* Range 59 - 59 is available for new GHC and common events. */ /* Range 60 - 80 is used by eden for parallel tracing @@ -177,7 +179,7 @@ * ranges higher than this are reserved but not currently emitted by ghc. * This must match the size of the EventDesc[] array in EventLog.c */ -#define NUM_GHC_EVENT_TAGS 59 +#define NUM_GHC_EVENT_TAGS 60 #if 0 /* DEPRECATED EVENTS: */ /* we don't actually need to record the thread, it's implicit */ diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c index 2e0e9bb..4fd4b44 100644 --- a/rts/eventlog/EventLog.c +++ b/rts/eventlog/EventLog.c @@ -106,6 +106,7 @@ char *EventDesc[] = { [EVENT_TASK_CREATE] = "Task create", [EVENT_TASK_MIGRATE] = "Task migrate", [EVENT_TASK_DELETE] = "Task delete", + [EVENT_HACK_BUG_T9003] = "Empty event for bug #9003", }; // Event type. @@ -420,6 +421,10 @@ initEventLogging(void) sizeof(EventCapNo); break; + case EVENT_HACK_BUG_T9003: + eventTypes[t].size = 0; + break; + default: continue; /* ignore deprecated events */ } From git at git.haskell.org Thu Jul 10 02:54:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 02:54:57 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: When typechecking a pattern synonym, the typechecking the definition of the wrapper can be deferred until after everything else is checked (since the expression-type of the pattern synonym can be determined without looking at the wrapper). (6e7710f) Message-ID: <20140710025458.D05BB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/6e7710f4bd0ae3d7105fa9b026c4c422dca6cfc0/ghc >--------------------------------------------------------------- commit 6e7710f4bd0ae3d7105fa9b026c4c422dca6cfc0 Author: Dr. ERDI Gergo Date: Thu Jul 10 10:15:42 2014 +0800 When typechecking a pattern synonym, the typechecking the definition of the wrapper can be deferred until after everything else is checked (since the expression-type of the pattern synonym can be determined without looking at the wrapper). This is needed so that something like this typechecks, without regarding it as a recursive pattern synonym: pattern P x <- (x:_) where P x = foo [x] foo (P x) = [x, x] >--------------------------------------------------------------- 6e7710f4bd0ae3d7105fa9b026c4c422dca6cfc0 compiler/rename/RnBinds.lhs | 2 +- compiler/typecheck/TcBinds.lhs | 70 +++++++++++++++++------------- compiler/typecheck/TcPatSyn.lhs | 82 ++++++++++++++++++++---------------- compiler/typecheck/TcPatSyn.lhs-boot | 2 +- 4 files changed, 87 insertions(+), 69 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6e7710f4bd0ae3d7105fa9b026c4c422dca6cfc0 From git at git.haskell.org Thu Jul 10 02:55:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 02:55:00 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add test case for explicitly-bidirectional pattern synonym (576f461) Message-ID: <20140710025500.A4F602406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/576f461a12b64b5540d9b88b08c8635dfa510b22/ghc >--------------------------------------------------------------- commit 576f461a12b64b5540d9b88b08c8635dfa510b22 Author: Dr. ERDI Gergo Date: Thu Jul 10 10:13:14 2014 +0800 Add test case for explicitly-bidirectional pattern synonym >--------------------------------------------------------------- 576f461a12b64b5540d9b88b08c8635dfa510b22 testsuite/.gitignore | 1 + testsuite/tests/patsyn/should_run/all.T | 1 + testsuite/tests/patsyn/should_run/bidir-explicit.hs | 16 ++++++++++++++++ .../should_run/bidir-explicit.stdout} | 2 ++ 4 files changed, 20 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 376318d..ae004e9 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1058,6 +1058,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/parser/unicode/1744 /tests/parser/unicode/T1744 /tests/parser/unicode/utf8_024 +/tests/patsyn/should_run/bidir-explicit /tests/patsyn/should_run/eval /tests/patsyn/should_run/ex-prov /tests/patsyn/should_run/ex-prov-run diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T index f5936c6..f551da5 100644 --- a/testsuite/tests/patsyn/should_run/all.T +++ b/testsuite/tests/patsyn/should_run/all.T @@ -1,3 +1,4 @@ test('eval', normal, compile_and_run, ['']) test('match', normal, compile_and_run, ['']) test('ex-prov-run', normal, compile_and_run, ['']) +test('bidir-explicit', normal, compile_and_run, ['']) diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.hs b/testsuite/tests/patsyn/should_run/bidir-explicit.hs new file mode 100644 index 0000000..c5de877 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +module Main where + +pattern First x <- x:_ where + First x = [x] + +pattern First' x <- x:_ where + First' x = foo [x, x, x] + +foo :: [a] -> [a] +foo xs@(First x) = replicate (length xs + 1) x + +main = do + mapM_ print $ First () + putStrLn "" + mapM_ print $ First' () diff --git a/testsuite/tests/deriving/should_run/T3087.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout similarity index 75% copy from testsuite/tests/deriving/should_run/T3087.stdout copy to testsuite/tests/patsyn/should_run/bidir-explicit.stdout index 35735b4..4625e61 100644 --- a/testsuite/tests/deriving/should_run/T3087.stdout +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout @@ -1,4 +1,6 @@ () + +() () () () From git at git.haskell.org Thu Jul 10 06:38:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 06:38:53 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Set VERSION=7.8.3, RELEASE=YES (cd35d3a) Message-ID: <20140710063853.C44CF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/cd35d3a15b67b109a835f8e6e4ee25f9509757aa/ghc >--------------------------------------------------------------- commit cd35d3a15b67b109a835f8e6e4ee25f9509757aa Author: Austin Seipp Date: Wed Jul 9 19:25:13 2014 -0500 Set VERSION=7.8.3, RELEASE=YES Signed-off-by: Austin Seipp >--------------------------------------------------------------- cd35d3a15b67b109a835f8e6e4ee25f9509757aa configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index f1b949b..f3ae26e 100644 --- a/configure.ac +++ b/configure.ac @@ -13,10 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.2], [glasgow-haskell-bugs at haskell.org], [ghc]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.3], [glasgow-haskell-bugs at haskell.org], [ghc]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the From git at git.haskell.org Thu Jul 10 14:28:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 14:28:51 +0000 (UTC) Subject: [commit: ghc] master: Make the example a little more complex (77ecb7b) Message-ID: <20140710142852.A1F802406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/77ecb7bfae57d26ff8ca6ff2868827fbca1c04b8/ghc >--------------------------------------------------------------- commit 77ecb7bfae57d26ff8ca6ff2868827fbca1c04b8 Author: Edward Z. Yang Date: Thu Jul 10 15:28:23 2014 +0100 Make the example a little more complex Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 77ecb7bfae57d26ff8ca6ff2868827fbca1c04b8 docs/backpack/backpack-impl.tex | 350 ++++++++++++++++++++++++---------------- 1 file changed, 208 insertions(+), 142 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 77ecb7bfae57d26ff8ca6ff2868827fbca1c04b8 From git at git.haskell.org Thu Jul 10 16:07:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 16:07:40 +0000 (UTC) Subject: [commit: ghc] master: [backpack] Rework definite package compilation (61cce91) Message-ID: <20140710160740.531082406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/61cce9116ac1a927632979e56dfa9754c69d2441/ghc >--------------------------------------------------------------- commit 61cce9116ac1a927632979e56dfa9754c69d2441 Author: Edward Z. Yang Date: Thu Jul 10 17:07:18 2014 +0100 [backpack] Rework definite package compilation Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 61cce9116ac1a927632979e56dfa9754c69d2441 docs/backpack/backpack-impl.tex | 208 ++++++++++++++++++++-------------------- 1 file changed, 103 insertions(+), 105 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 61cce9116ac1a927632979e56dfa9754c69d2441 From git at git.haskell.org Thu Jul 10 16:21:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 16:21:40 +0000 (UTC) Subject: [commit: ghc] master: Avoid unnecessary clock_gettime() syscalls in GC stats. (3c9fc10) Message-ID: <20140710162140.8D7262406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c9fc104337a142fe4f375d30d7a6b81d55a70c1/ghc >--------------------------------------------------------------- commit 3c9fc104337a142fe4f375d30d7a6b81d55a70c1 Author: Brian Brooks Date: Thu Jul 10 02:55:33 2014 -0500 Avoid unnecessary clock_gettime() syscalls in GC stats. Summary: Avoid unnecessary clock_gettime() syscalls in GC stats. Test Plan: Use strace. Reviewers: simonmar, austin Reviewed By: simonmar, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D39 >--------------------------------------------------------------- 3c9fc104337a142fe4f375d30d7a6b81d55a70c1 rts/Stats.c | 45 ++------------------------------------------- rts/Stats.h | 3 --- rts/sm/GC.c | 5 ----- rts/sm/GCThread.h | 3 +-- 4 files changed, 3 insertions(+), 53 deletions(-) diff --git a/rts/Stats.c b/rts/Stats.c index 48c320c..c3d963c 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -173,8 +173,8 @@ initStats1 (void) nat i; if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) { - statsPrintf(" Alloc Copied Live GC GC TOT TOT Page Flts\n"); - statsPrintf(" bytes bytes bytes user elap user elap\n"); + statsPrintf(" Alloc Copied Live GC GC TOT TOT Page Flts\n"); + statsPrintf(" bytes bytes bytes user elap user elap\n"); } GC_coll_cpu = (Time *)stgMallocBytes( @@ -287,53 +287,12 @@ stat_startGC (Capability *cap, gc_thread *gct) traceEventGcStartAtT(cap, TimeToNS(gct->gc_start_elapsed - start_init_elapsed)); - gct->gc_start_thread_cpu = getThreadCPUTime(); - if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) { gct->gc_start_faults = getPageFaults(); } } -void -stat_gcWorkerThreadStart (gc_thread *gct STG_UNUSED) -{ -#if 0 - /* - * We dont' collect per-thread GC stats any more, but this code - * could be used to do that if we want to in the future: - */ - if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) - { - getProcessTimes(&gct->gc_start_cpu, &gct->gc_start_elapsed); - gct->gc_start_thread_cpu = getThreadCPUTime(); - } -#endif -} - -void -stat_gcWorkerThreadDone (gc_thread *gct STG_UNUSED) -{ -#if 0 - /* - * We dont' collect per-thread GC stats any more, but this code - * could be used to do that if we want to in the future: - */ - Time thread_cpu, elapsed, gc_cpu, gc_elapsed; - - if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) - { - elapsed = getProcessElapsedTime(); - thread_cpu = getThreadCPUTime(); - - gc_cpu = thread_cpu - gct->gc_start_thread_cpu; - gc_elapsed = elapsed - gct->gc_start_elapsed; - - taskDoneGC(gct->cap->running_task, gc_cpu, gc_elapsed); - } -#endif -} - /* ----------------------------------------------------------------------------- * Calculate the total allocated memory since the start of the * program. Also emits events reporting the per-cap allocation diff --git a/rts/Stats.h b/rts/Stats.h index 9839e5c..925920f 100644 --- a/rts/Stats.h +++ b/rts/Stats.h @@ -32,9 +32,6 @@ void stat_endGC (Capability *cap, struct gc_thread_ *_gct, W_ live, W_ copied, W_ slop, nat gen, nat n_gc_threads, W_ par_max_copied, W_ par_tot_copied); -void stat_gcWorkerThreadStart (struct gc_thread_ *_gct); -void stat_gcWorkerThreadDone (struct gc_thread_ *_gct); - #ifdef PROFILING void stat_startRP(void); void stat_endRP(nat, diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 61432ea..dabcd72 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -1041,8 +1041,6 @@ gcWorkerThread (Capability *cap) SET_GCT(gc_threads[cap->no]); gct->id = osThreadId(); - stat_gcWorkerThreadStart(gct); - // Wait until we're told to wake up RELEASE_SPIN_LOCK(&gct->mut_spin); // yieldThread(); @@ -1100,9 +1098,6 @@ gcWorkerThread (Capability *cap) ACQUIRE_SPIN_LOCK(&gct->mut_spin); debugTrace(DEBUG_gc, "GC thread %d on my way...", gct->thread_index); - // record the time spent doing GC in the Task structure - stat_gcWorkerThreadDone(gct); - SET_GCT(saved_gct); } diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h index 12ef999..84ce3f0 100644 --- a/rts/sm/GCThread.h +++ b/rts/sm/GCThread.h @@ -77,7 +77,7 @@ ------------------------------------------------------------------------- */ typedef struct gen_workspace_ { - generation * gen; // the gen for this workspace + generation * gen; // the gen for this workspace struct gc_thread_ * my_gct; // the gc_thread that contains this workspace // where objects to be scavenged go @@ -184,7 +184,6 @@ typedef struct gc_thread_ { Time gc_start_cpu; // process CPU time Time gc_start_elapsed; // process elapsed time - Time gc_start_thread_cpu; // thread CPU time W_ gc_start_faults; // ------------------- From git at git.haskell.org Thu Jul 10 16:21:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 16:21:43 +0000 (UTC) Subject: [commit: ghc] master: GHC.Conc: clarify that 'forkOn' binds to capability, not a 'CPU' or 'Task' (e148d7d) Message-ID: <20140710162143.4CF582406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e148d7d1c0d5db39cd494c4a9b6860cd0f0bf852/ghc >--------------------------------------------------------------- commit e148d7d1c0d5db39cd494c4a9b6860cd0f0bf852 Author: Sergei Trofimovich Date: Thu Jul 10 02:56:23 2014 -0500 GHC.Conc: clarify that 'forkOn' binds to capability, not a 'CPU' or 'Task' Summary: Capability (HEC) can migrate to other Task (thus switch CPU) unless capability was created as a bound haskell thread. Task also can migrate to other CPU due to OS scheduler (unless '-qa' RTS option is set). Signed-off-by: Sergei Trofimovich Test Plan: proofread for typos Reviewers: simonmar, austin Reviewed By: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D52 >--------------------------------------------------------------- e148d7d1c0d5db39cd494c4a9b6860cd0f0bf852 libraries/base/GHC/Conc/Sync.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/Conc/Sync.lhs b/libraries/base/GHC/Conc/Sync.lhs index ebb7226..713e0b5 100644 --- a/libraries/base/GHC/Conc/Sync.lhs +++ b/libraries/base/GHC/Conc/Sync.lhs @@ -219,10 +219,10 @@ forkIOWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId forkIOWithUnmask io = forkIO (io unsafeUnmask) {- | -Like 'forkIO', but lets you specify on which processor the thread +Like 'forkIO', but lets you specify on which capability the thread should run. Unlike a `forkIO` thread, a thread created by `forkOn` -will stay on the same processor for its entire lifetime (`forkIO` -threads can migrate between processors according to the scheduling +will stay on the same capability for its entire lifetime (`forkIO` +threads can migrate between capabilities according to the scheduling policy). `forkOn` is useful for overriding the scheduling policy when you know in advance how best to distribute the threads. From git at git.haskell.org Thu Jul 10 16:21:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Jul 2014 16:21:45 +0000 (UTC) Subject: [commit: ghc] master: remove SPARC related comment in PPC code generator (c80c574) Message-ID: <20140710162145.BCBE62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c80c574fe53c76122b0e950fd88022ecc41f3a10/ghc >--------------------------------------------------------------- commit c80c574fe53c76122b0e950fd88022ecc41f3a10 Author: Peter Trommler Date: Thu Jul 10 02:55:51 2014 -0500 remove SPARC related comment in PPC code generator Summary: PowerPC does not do delay slots and there is also no requirement to put extra instructions between FP operations and branches. Test Plan: None. Comment change only. Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D40 >--------------------------------------------------------------- c80c574fe53c76122b0e950fd88022ecc41f3a10 compiler/nativeGen/PPC/CodeGen.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 22a2c7c..014117d 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -813,15 +813,6 @@ genBranch = return . toOL . mkJumpInstr Conditional jumps are always to local labels, so we can use branch instructions. We peek at the arguments to decide what kind of comparison to do. - -SPARC: First, we have to ensure that the condition codes are set -according to the supplied comparison operation. We generate slightly -different code for floating point comparisons, because a floating -point operation cannot directly precede a @BF at . We assume the worst -and fill that slot with a @NOP at . - -SPARC: Do not fill the delay slots here; you will confuse the register -allocator. -} From git at git.haskell.org Fri Jul 11 04:57:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 04:57:33 +0000 (UTC) Subject: [commit: ghc] master: Fix typos in base documentation. (2f8d5e2) Message-ID: <20140711045733.482D42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f8d5e28929649c0c4fb0e48c78ec63a7ae625ab/ghc >--------------------------------------------------------------- commit 2f8d5e28929649c0c4fb0e48c78ec63a7ae625ab Author: Shachaf Ben-Kiki Date: Thu Jul 10 23:55:53 2014 -0500 Fix typos in base documentation. Summary: Signed-off-by: Shachaf Ben-Kiki Test Plan: n/a Reviewers: austin Reviewed By: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D57 >--------------------------------------------------------------- 2f8d5e28929649c0c4fb0e48c78ec63a7ae625ab libraries/base/Control/Concurrent.hs | 4 ++-- libraries/base/Data/Data.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs index c487190..e5a0ebf 100644 --- a/libraries/base/Control/Concurrent.hs +++ b/libraries/base/Control/Concurrent.hs @@ -361,8 +361,8 @@ is /bound/, an unbound thread is created temporarily using 'forkIO'. Use this function /only/ in the rare case that you have actually observed a performance loss due to the use of bound threads. A program that -doesn't need it's main thread to be bound and makes /heavy/ use of concurrency -(e.g. a web server), might want to wrap it's @main@ action in +doesn't need its main thread to be bound and makes /heavy/ use of concurrency +(e.g. a web server), might want to wrap its @main@ action in @runInUnboundThread at . Note that exceptions which are thrown to the current thread are thrown in turn diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 25f2875..49407fa 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -777,12 +777,12 @@ mkCharConstr dt c = case datarep dt of ------------------------------------------------------------------------------ -- --- Non-representations for non-presentable types +-- Non-representations for non-representable types -- ------------------------------------------------------------------------------ --- | Constructs a non-representation for a non-presentable type +-- | Constructs a non-representation for a non-representable type mkNoRepType :: String -> DataType mkNoRepType str = DataType { tycon = str From git at git.haskell.org Fri Jul 11 11:55:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 11:55:58 +0000 (UTC) Subject: [commit: ghc] master: Integrate changelog entries from base-4.7.0.1 rel (dbbc1e8) Message-ID: <20140711115558.DA6B42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbbc1e858de04dff7be800abd358fcce9e62f29f/ghc >--------------------------------------------------------------- commit dbbc1e858de04dff7be800abd358fcce9e62f29f Author: Herbert Valerio Riedel Date: Fri Jul 11 13:54:18 2014 +0200 Integrate changelog entries from base-4.7.0.1 rel >--------------------------------------------------------------- dbbc1e858de04dff7be800abd358fcce9e62f29f libraries/base/changelog.md | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 4efb121..46006b1 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -14,6 +14,19 @@ * Add `Control.Monad.(<$!>)` as a strict version of `(<$>)` +## 4.7.0.1 *Jul 2014* + + * Bundled with GHC 7.8.3 + + * Unhide `Foreign.ForeignPtr` in Haddock (#8475) + + * Fix recomputation of `TypeRep` in `Typeable` type-application instance + (#9203) + + * Fix regression in Data.Fixed Read instance (#9231) + + * Fix `fdReady` to honor `FD_SETSIZE` (#9168) + ## 4.7.0.0 *Apr 2014* * Bundled with GHC 7.8.1 From git at git.haskell.org Fri Jul 11 11:59:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 11:59:15 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Update changelog.md (d762c0c) Message-ID: <20140711115916.0D26C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/d762c0c11b3e9b3031c76caaa895202d1b81acdf/base >--------------------------------------------------------------- commit d762c0c11b3e9b3031c76caaa895202d1b81acdf Author: Herbert Valerio Riedel Date: Fri Jul 11 13:58:41 2014 +0200 Update changelog.md >--------------------------------------------------------------- d762c0c11b3e9b3031c76caaa895202d1b81acdf changelog.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/changelog.md b/changelog.md index 5eef01f..bb42c1e 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,6 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## 4.7.0.1 *Jun 2014* +## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 @@ -11,6 +11,8 @@ * Fix regression in Data.Fixed Read instance (#9231) + * Fix `fdReady` to honor `FD_SETSIZE` (#9168) + ## 4.7.0.0 *Mar 2014* * Bundled with GHC 7.8.1 From git at git.haskell.org Fri Jul 11 11:59:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 11:59:26 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' created Message-ID: <20140711115927.064832406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/travis Referencing: 4495d2836af4bb2f2da1d8884a47e7494b331034 From git at git.haskell.org Fri Jul 11 11:59:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 11:59:30 +0000 (UTC) Subject: [commit: ghc] wip/travis: Add travis script (4495d28) Message-ID: <20140711115930.E002E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/4495d2836af4bb2f2da1d8884a47e7494b331034/ghc >--------------------------------------------------------------- commit 4495d2836af4bb2f2da1d8884a47e7494b331034 Author: Joachim Breitner Date: Fri Jul 11 13:58:46 2014 +0200 Add travis script in contrast to ghc-complete, which uses a custom script, let's try to use "validate --fast" here, and maybe evolve into a "validate --fastest" mode. >--------------------------------------------------------------- 4495d2836af4bb2f2da1d8884a47e7494b331034 .travis.yml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..b58f7c7 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,16 @@ +notifications: + email: + - mail at joachim-breitner.de + - ghc-builds at haskell.org + +env: + - DEBUG_STAGE2=YES + - DEBUG_STAGE2=NO + +install: + - sudo apt-get update + - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils + - cabal update + - cabal install happy alex +script: + - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Fri Jul 11 13:42:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 13:42:05 +0000 (UTC) Subject: [commit: ghc] master: Remove unused parameter in rnHsTyVar (8e396b0) Message-ID: <20140711134205.D87752406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e396b08e4e095ded8f6ff93f5b265a03015717e/ghc >--------------------------------------------------------------- commit 8e396b08e4e095ded8f6ff93f5b265a03015717e Author: Jan Stolarek Date: Fri Jul 11 14:25:27 2014 +0200 Remove unused parameter in rnHsTyVar >--------------------------------------------------------------- 8e396b08e4e095ded8f6ff93f5b265a03015717e compiler/rename/RnSource.lhs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index c6646ad..dae9d81 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -970,7 +970,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls, <- bindHsTyVars cls_doc Nothing kvs tyvars $ \ tyvars' -> do -- Checks for distinct tyvars { (context', cxt_fvs) <- rnContext cls_doc context - ; fds' <- rnFds (docOfHsDocContext cls_doc) fds + ; fds' <- rnFds fds -- The fundeps have no free variables ; (ats', fv_ats) <- rnATDecls cls' ats ; (at_defs', fv_at_defs) <- rnATInstDecls rnTyFamInstDecl cls' tyvars' at_defs @@ -1409,21 +1409,20 @@ extendRecordFieldEnv tycl_decls inst_decls %********************************************************* \begin{code} -rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)] - -rnFds doc fds +rnFds :: [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)] +rnFds fds = mapM (wrapLocM rn_fds) fds where rn_fds (tys1, tys2) - = do { tys1' <- rnHsTyVars doc tys1 - ; tys2' <- rnHsTyVars doc tys2 + = do { tys1' <- rnHsTyVars tys1 + ; tys2' <- rnHsTyVars tys2 ; return (tys1', tys2') } -rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name] -rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs +rnHsTyVars :: [RdrName] -> RnM [Name] +rnHsTyVars tvs = mapM rnHsTyVar tvs -rnHsTyVar :: SDoc -> RdrName -> RnM Name -rnHsTyVar _doc tyvar = lookupOccRn tyvar +rnHsTyVar :: RdrName -> RnM Name +rnHsTyVar tyvar = lookupOccRn tyvar \end{code} From git at git.haskell.org Fri Jul 11 13:42:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 13:42:08 +0000 (UTC) Subject: [commit: ghc] master: Comments only (edae31a) Message-ID: <20140711134208.418EE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/edae31ab65718f57a3f326175a9320dc456f30cf/ghc >--------------------------------------------------------------- commit edae31ab65718f57a3f326175a9320dc456f30cf Author: Jan Stolarek Date: Fri Jul 11 14:33:38 2014 +0200 Comments only >--------------------------------------------------------------- edae31ab65718f57a3f326175a9320dc456f30cf compiler/types/TyCon.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index d57ce12..c39f9d1 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -1210,7 +1210,7 @@ isDecomposableTyCon :: TyCon -> Bool -- Ultimately we may have injective associated types -- in which case this test will become more interesting -- --- It'd be unusual to call isInjectiveTyCon on a regular H98 +-- It'd be unusual to call isDecomposableTyCon on a regular H98 -- type synonym, because you should probably have expanded it first -- But regardless, it's not decomposable isDecomposableTyCon (SynTyCon {}) = False From git at git.haskell.org Fri Jul 11 13:54:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 13:54:30 +0000 (UTC) Subject: [commit: ghc] wip/travis: Fix submodule paths (9a9c97a) Message-ID: <20140711135430.56F042406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/9a9c97a8e3a05701be0d6355d61fcf0fa303bbdf/ghc >--------------------------------------------------------------- commit 9a9c97a8e3a05701be0d6355d61fcf0fa303bbdf Author: Joachim Breitner Date: Fri Jul 11 15:52:09 2014 +0200 Fix submodule paths >--------------------------------------------------------------- 9a9c97a8e3a05701be0d6355d61fcf0fa303bbdf .travis.yml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/.travis.yml b/.travis.yml index b58f7c7..58e0c1a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,3 +1,6 @@ +git: + submodules: false + notifications: email: - mail at joachim-breitner.de @@ -7,6 +10,13 @@ env: - DEBUG_STAGE2=YES - DEBUG_STAGE2=NO +before_install: + - 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/ + - git config --global url."ssh://git at github.com/ghc/packages-".insteadOf ssh://git at github.com/ghc/packages/ + - git config --global url."git at github.com:/ghc/packages-".insteadOf git at github.com:/ghc/packages/ + - git submodule update --init --recursive install: - sudo apt-get update - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils From git at git.haskell.org Fri Jul 11 14:34:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 14:34:12 +0000 (UTC) Subject: [commit: ghc] wip/travis: Build less verbosely (340d647) Message-ID: <20140711143412.BF3602406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/340d64739297eb3303dd4178392119a063ef071e/ghc >--------------------------------------------------------------- commit 340d64739297eb3303dd4178392119a063ef071e Author: Joachim Breitner Date: Fri Jul 11 16:34:08 2014 +0200 Build less verbosely >--------------------------------------------------------------- 340d64739297eb3303dd4178392119a063ef071e .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 58e0c1a..854c9ab 100644 --- a/.travis.yml +++ b/.travis.yml @@ -23,4 +23,5 @@ install: - cabal update - cabal install happy alex script: + - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Fri Jul 11 14:44:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 14:44:24 +0000 (UTC) Subject: [commit: ghc] wip/travis: Pass -DDEBUG when requested (c86cd1a) Message-ID: <20140711144424.418A12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/c86cd1a8d49711189ff834e425b73d3f6369523c/ghc >--------------------------------------------------------------- commit c86cd1a8d49711189ff834e425b73d3f6369523c Author: Joachim Breitner Date: Fri Jul 11 16:44:20 2014 +0200 Pass -DDEBUG when requested >--------------------------------------------------------------- c86cd1a8d49711189ff834e425b73d3f6369523c .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 854c9ab..a74795c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,4 +24,5 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. + - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Fri Jul 11 15:35:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 15:35:38 +0000 (UTC) Subject: [commit: ghc] wip/travis: Do not build dynamic libraries (2c2fab7) Message-ID: <20140711153539.84DAF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/2c2fab74bedd771314de5cd74f03a62958c782cf/ghc >--------------------------------------------------------------- commit 2c2fab74bedd771314de5cd74f03a62958c782cf Author: Joachim Breitner Date: Fri Jul 11 17:35:02 2014 +0200 Do not build dynamic libraries >--------------------------------------------------------------- 2c2fab74bedd771314de5cd74f03a62958c782cf .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index a74795c..e3d5f9a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,5 +24,8 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. + # do not build dynamic libraries + - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk + - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Fri Jul 11 17:41:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 17:41:27 +0000 (UTC) Subject: [commit: ghc] master: Declare official github home of libraries/unix (441d1b9) Message-ID: <20140711174127.494412406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/441d1b995fd269d39b40845b6904ecc0c5aac844/ghc >--------------------------------------------------------------- commit 441d1b995fd269d39b40845b6904ecc0c5aac844 Author: Herbert Valerio Riedel Date: Fri Jul 11 19:36:26 2014 +0200 Declare official github home of libraries/unix Effective immediately, pushing to libraries/unix requires pushing to ssh://git at github.com/haskell/unix.git. This done now even though there's no scripted tooling yet as the GitHub repo is already receiving pull requests (which are getting merged) >--------------------------------------------------------------- 441d1b995fd269d39b40845b6904ecc0c5aac844 packages | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages b/packages index f52fc73..faf8c5d 100644 --- a/packages +++ b/packages @@ -71,7 +71,7 @@ libraries/process - - - libraries/terminfo - - https://github.com/judah/terminfo.git libraries/time - - http://git.haskell.org/darcs-mirrors/time.git libraries/transformers - - http://git.haskell.org/darcs-mirrors/transformers.git -libraries/unix - - - +libraries/unix - - ssh://git at github.com/haskell/unix.git libraries/Win32 - - https://github.com/haskell/win32.git libraries/xhtml - - https://github.com/haskell/xhtml.git nofib nofib - - From git at git.haskell.org Fri Jul 11 22:40:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 22:40:53 +0000 (UTC) Subject: [commit: ghc] wip/travis: Skip building haddock and docs (d350c9a) Message-ID: <20140711224053.F08CD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/d350c9a3b178d8e0dc1ca688827219d70c1be9a6/ghc >--------------------------------------------------------------- commit d350c9a3b178d8e0dc1ca688827219d70c1be9a6 Author: Joachim Breitner Date: Sat Jul 12 00:40:37 2014 +0200 Skip building haddock and docs >--------------------------------------------------------------- d350c9a3b178d8e0dc1ca688827219d70c1be9a6 .travis.yml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index e3d5f9a..f9f7218 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,8 +24,13 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. + # do not build docs + - echo 'HADDOCK_DOCS = NO' >> mk/build.mk + - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/build.mk + - echo 'BUILD_DOCBOOK_PS = NO' >> mk/build.mk + - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/build.mk # do not build dynamic libraries - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph --no-clean From git at git.haskell.org Fri Jul 11 22:54:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 22:54:04 +0000 (UTC) Subject: [commit: ghc] wip/travis: Fix syntax (5f8761c) Message-ID: <20140711225404.8E5D82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/5f8761c425fa88713a1c19ac1240bd5f357e18d5/ghc >--------------------------------------------------------------- commit 5f8761c425fa88713a1c19ac1240bd5f357e18d5 Author: Joachim Breitner Date: Sat Jul 12 00:54:01 2014 +0200 Fix syntax >--------------------------------------------------------------- 5f8761c425fa88713a1c19ac1240bd5f357e18d5 .travis.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index f9f7218..765abd2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -25,12 +25,12 @@ install: script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs - - echo 'HADDOCK_DOCS = NO' >> mk/build.mk - - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/build.mk - - echo 'BUILD_DOCBOOK_PS = NO' >> mk/build.mk - - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/build.mk + - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_PS = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/validate.mk # do not build dynamic libraries - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi + - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph --no-clean From git at git.haskell.org Fri Jul 11 22:54:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 11 Jul 2014 22:54:25 +0000 (UTC) Subject: [commit: ghc] wip/travis: no --no-clean (32984bc) Message-ID: <20140711225425.382E52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/32984bc8b76383f5b4c5fdf9d1e8795e33872845/ghc >--------------------------------------------------------------- commit 32984bc8b76383f5b4c5fdf9d1e8795e33872845 Author: Joachim Breitner Date: Sat Jul 12 00:54:19 2014 +0200 no --no-clean >--------------------------------------------------------------- 32984bc8b76383f5b4c5fdf9d1e8795e33872845 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 765abd2..c9fdf67 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph --no-clean + - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 09:49:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 09:49:35 +0000 (UTC) Subject: [commit: ghc] wip/travis: Skip performance tests (b1b315f) Message-ID: <20140712094936.632F82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/b1b315f8724955ca39eee1b85024c6bc30922aae/ghc >--------------------------------------------------------------- commit b1b315f8724955ca39eee1b85024c6bc30922aae Author: Joachim Breitner Date: Sat Jul 12 11:49:23 2014 +0200 Skip performance tests >--------------------------------------------------------------- b1b315f8724955ca39eee1b85024c6bc30922aae .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index c9fdf67..0e6143a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 09:49:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 09:49:55 +0000 (UTC) Subject: [commit: ghc] wip/travis: Try with 3 cpus (1b42800) Message-ID: <20140712094956.0685E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/1b42800985e41aa7dbe6a715c4ec9704ae8b57a7/ghc >--------------------------------------------------------------- commit 1b42800985e41aa7dbe6a715c4ec9704ae8b57a7 Author: Joachim Breitner Date: Sat Jul 12 11:49:49 2014 +0200 Try with 3 cpus >--------------------------------------------------------------- 1b42800985e41aa7dbe6a715c4ec9704ae8b57a7 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 0e6143a..5dc1e53 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:15 +0000 (UTC) Subject: [commit: ghc] wip/travis: Add travis script (c46d1bc) Message-ID: <20140712111215.23D542406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/c46d1bce8373684fa8d0d9816c8aeda4d1acbf6a/ghc >--------------------------------------------------------------- commit c46d1bce8373684fa8d0d9816c8aeda4d1acbf6a Author: Joachim Breitner Date: Fri Jul 11 13:58:46 2014 +0200 Add travis script in contrast to ghc-complete, which uses a custom script, let's try to use "validate --fast" here, and maybe evolve into a "validate --fastest" mode. >--------------------------------------------------------------- c46d1bce8373684fa8d0d9816c8aeda4d1acbf6a .travis.yml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..b58f7c7 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,16 @@ +notifications: + email: + - mail at joachim-breitner.de + - ghc-builds at haskell.org + +env: + - DEBUG_STAGE2=YES + - DEBUG_STAGE2=NO + +install: + - sudo apt-get update + - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils + - cabal update + - cabal install happy alex +script: + - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:17 +0000 (UTC) Subject: [commit: ghc] wip/travis: Build less verbosely (e16bff0) Message-ID: <20140712111217.A78452406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/e16bff03ad667ddb078eb148008002deb0eec4f0/ghc >--------------------------------------------------------------- commit e16bff03ad667ddb078eb148008002deb0eec4f0 Author: Joachim Breitner Date: Fri Jul 11 16:34:08 2014 +0200 Build less verbosely >--------------------------------------------------------------- e16bff03ad667ddb078eb148008002deb0eec4f0 .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 58e0c1a..854c9ab 100644 --- a/.travis.yml +++ b/.travis.yml @@ -23,4 +23,5 @@ install: - cabal update - cabal install happy alex script: + - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:20 +0000 (UTC) Subject: [commit: ghc] wip/travis: Do not build dynamic libraries (9b0d221) Message-ID: <20140712111220.2B9EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/9b0d221f211b7ad6c2bd8f34860484dda630186d/ghc >--------------------------------------------------------------- commit 9b0d221f211b7ad6c2bd8f34860484dda630186d Author: Joachim Breitner Date: Fri Jul 11 17:35:02 2014 +0200 Do not build dynamic libraries >--------------------------------------------------------------- 9b0d221f211b7ad6c2bd8f34860484dda630186d .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index a74795c..e3d5f9a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,5 +24,8 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. + # do not build dynamic libraries + - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk + - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:22 +0000 (UTC) Subject: [commit: ghc] wip/travis: Try with 3 cpus (a076fc0) Message-ID: <20140712111222.78B882406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/a076fc03a09dbbeabe0b3715fad04f8235c7d7c3/ghc >--------------------------------------------------------------- commit a076fc03a09dbbeabe0b3715fad04f8235c7d7c3 Author: Joachim Breitner Date: Sat Jul 12 11:49:49 2014 +0200 Try with 3 cpus >--------------------------------------------------------------- a076fc03a09dbbeabe0b3715fad04f8235c7d7c3 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 0e6143a..5dc1e53 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:24 +0000 (UTC) Subject: [commit: ghc] wip/travis: Skip performance tests (d03b4b8) Message-ID: <20140712111224.EA7172406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/d03b4b8fcd5b9d25b616a1dc50fec0184ed458c0/ghc >--------------------------------------------------------------- commit d03b4b8fcd5b9d25b616a1dc50fec0184ed458c0 Author: Joachim Breitner Date: Sat Jul 12 11:49:23 2014 +0200 Skip performance tests >--------------------------------------------------------------- d03b4b8fcd5b9d25b616a1dc50fec0184ed458c0 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index c9fdf67..0e6143a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:27 +0000 (UTC) Subject: [commit: ghc] wip/travis: Fix submodule paths (39cbaf3) Message-ID: <20140712111227.41B652406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/39cbaf30c2eeb53b962656a9801f7ff145b577f2/ghc >--------------------------------------------------------------- commit 39cbaf30c2eeb53b962656a9801f7ff145b577f2 Author: Joachim Breitner Date: Fri Jul 11 15:52:09 2014 +0200 Fix submodule paths >--------------------------------------------------------------- 39cbaf30c2eeb53b962656a9801f7ff145b577f2 .travis.yml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/.travis.yml b/.travis.yml index b58f7c7..58e0c1a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,3 +1,6 @@ +git: + submodules: false + notifications: email: - mail at joachim-breitner.de @@ -7,6 +10,13 @@ env: - DEBUG_STAGE2=YES - DEBUG_STAGE2=NO +before_install: + - 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/ + - git config --global url."ssh://git at github.com/ghc/packages-".insteadOf ssh://git at github.com/ghc/packages/ + - git config --global url."git at github.com:/ghc/packages-".insteadOf git at github.com:/ghc/packages/ + - git submodule update --init --recursive install: - sudo apt-get update - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils From git at git.haskell.org Sat Jul 12 11:12:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:29 +0000 (UTC) Subject: [commit: ghc] wip/travis: Pass -DDEBUG when requested (5b65b90) Message-ID: <20140712111229.9F3BF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/5b65b907b086bf7c9609bd0f514c494c694d41be/ghc >--------------------------------------------------------------- commit 5b65b907b086bf7c9609bd0f514c494c694d41be Author: Joachim Breitner Date: Fri Jul 11 16:44:20 2014 +0200 Pass -DDEBUG when requested >--------------------------------------------------------------- 5b65b907b086bf7c9609bd0f514c494c694d41be .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 854c9ab..a74795c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,4 +24,5 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. + - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:32 +0000 (UTC) Subject: [commit: ghc] wip/travis: no --no-clean (9dd4de2) Message-ID: <20140712111232.47B282406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/9dd4de26404c4bb842161f149b7e339d92e2029a/ghc >--------------------------------------------------------------- commit 9dd4de26404c4bb842161f149b7e339d92e2029a Author: Joachim Breitner Date: Sat Jul 12 00:54:19 2014 +0200 no --no-clean >--------------------------------------------------------------- 9dd4de26404c4bb842161f149b7e339d92e2029a .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 765abd2..c9fdf67 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph --no-clean + - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 11:12:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:34 +0000 (UTC) Subject: [commit: ghc] wip/travis: Skip building haddock and docs (96fed81) Message-ID: <20140712111235.BF0CA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/96fed81009332c9a4969b30b51eca94150b18a5d/ghc >--------------------------------------------------------------- commit 96fed81009332c9a4969b30b51eca94150b18a5d Author: Joachim Breitner Date: Sat Jul 12 00:40:37 2014 +0200 Skip building haddock and docs >--------------------------------------------------------------- 96fed81009332c9a4969b30b51eca94150b18a5d .travis.yml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index e3d5f9a..f9f7218 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,8 +24,13 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. + # do not build docs + - echo 'HADDOCK_DOCS = NO' >> mk/build.mk + - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/build.mk + - echo 'BUILD_DOCBOOK_PS = NO' >> mk/build.mk + - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/build.mk # do not build dynamic libraries - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph --no-clean From git at git.haskell.org Sat Jul 12 11:12:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:37 +0000 (UTC) Subject: [commit: ghc] wip/travis: Fix syntax (5f5bdec) Message-ID: <20140712111237.2B2622406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/5f5bdecf1d0e2e0e93965a1ef0698702aca0647b/ghc >--------------------------------------------------------------- commit 5f5bdecf1d0e2e0e93965a1ef0698702aca0647b Author: Joachim Breitner Date: Sat Jul 12 00:54:01 2014 +0200 Fix syntax >--------------------------------------------------------------- 5f5bdecf1d0e2e0e93965a1ef0698702aca0647b .travis.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index f9f7218..765abd2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -25,12 +25,12 @@ install: script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs - - echo 'HADDOCK_DOCS = NO' >> mk/build.mk - - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/build.mk - - echo 'BUILD_DOCBOOK_PS = NO' >> mk/build.mk - - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/build.mk + - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_PS = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/validate.mk # do not build dynamic libraries - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - - if [ "$DEBUG_STAGE" = "YES"]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi + - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph --no-clean From git at git.haskell.org Sat Jul 12 11:12:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:12:39 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: Try with 3 cpus (a076fc0) Message-ID: <20140712111242.066312406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: 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 c46d1bc Add travis script 39cbaf3 Fix submodule paths e16bff0 Build less verbosely 5b65b90 Pass -DDEBUG when requested 9b0d221 Do not build dynamic libraries 96fed81 Skip building haddock and docs 5f5bdec Fix syntax 9dd4de2 no --no-clean d03b4b8 Skip performance tests a076fc0 Try with 3 cpus From git at git.haskell.org Sat Jul 12 11:59:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 11:59:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' deleted Message-ID: <20140712115942.EE65A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/travis From git at git.haskell.org Sat Jul 12 12:00:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 12:00:24 +0000 (UTC) Subject: [commit: ghc] master: Add a .travis.yml file (30518f0) Message-ID: <20140712120024.0EF552406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30518f0d7f1c040fae16003794b2e5e873850c0e/ghc >--------------------------------------------------------------- commit 30518f0d7f1c040fae16003794b2e5e873850c0e Author: Joachim Breitner Date: Sat Jul 12 13:58:09 2014 +0200 Add a .travis.yml file This is a reduced build that should finish within the 50 minute time limit most of the time. In particular, * it skips DPH * it does not build dynamic libraries and no dynamic executables * does not build haddock or generate documentation * only runs fast tests, and no performance tests You can see its results at https://travis-ci.org/ghc/ghc/builds >--------------------------------------------------------------- 30518f0d7f1c040fae16003794b2e5e873850c0e .travis.yml | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..5dc1e53 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,36 @@ +git: + submodules: false + +notifications: + email: + - mail at joachim-breitner.de + - ghc-builds at haskell.org + +env: + - DEBUG_STAGE2=YES + - DEBUG_STAGE2=NO + +before_install: + - 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/ + - git config --global url."ssh://git at github.com/ghc/packages-".insteadOf ssh://git at github.com/ghc/packages/ + - git config --global url."git at github.com:/ghc/packages-".insteadOf git at github.com:/ghc/packages/ + - git submodule update --init --recursive +install: + - sudo apt-get update + - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils + - cabal update + - cabal install happy alex +script: + - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. + # do not build docs + - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_PS = NO' >> mk/validate.mk + - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/validate.mk + # do not build dynamic libraries + - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk + - echo 'GhcLibWays = v' >> mk/validate.mk + - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi + - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Sat Jul 12 16:00:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 16:00:25 +0000 (UTC) Subject: [commit: ghc] master: M-x untabify (6a75bcd) Message-ID: <20140712160025.AB5922406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6a75bcd0725c3e569b5e9b9d3f254a3c4745989c/ghc >--------------------------------------------------------------- commit 6a75bcd0725c3e569b5e9b9d3f254a3c4745989c Author: Gabor Greif Date: Sat Jul 12 11:19:58 2014 +0200 M-x untabify >--------------------------------------------------------------- 6a75bcd0725c3e569b5e9b9d3f254a3c4745989c compiler/typecheck/TcArrows.lhs | 220 ++++++++++++++++++++-------------------- 1 file changed, 110 insertions(+), 110 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6a75bcd0725c3e569b5e9b9d3f254a3c4745989c From git at git.haskell.org Sat Jul 12 16:00:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 16:00:28 +0000 (UTC) Subject: [commit: ghc] master: Rectify some panic messages (d591b19) Message-ID: <20140712160028.988062406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d591b19beb55698f429a2c8074e432e4fcde3379/ghc >--------------------------------------------------------------- commit d591b19beb55698f429a2c8074e432e4fcde3379 Author: Gabor Greif Date: Sat Jul 12 17:12:10 2014 +0200 Rectify some panic messages >--------------------------------------------------------------- d591b19beb55698f429a2c8074e432e4fcde3379 compiler/typecheck/TcSMonad.lhs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index e01b2fe..898e2b8 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1147,8 +1147,8 @@ nestImplicTcS ref inner_untch inerts (TcS thing_inside) , tcs_ty_binds = ty_binds , tcs_count = count , tcs_inerts = new_inert_var - , tcs_worklist = panic "nextImplicTcS: worklist" - , tcs_implics = panic "nextImplicTcS: implics" + , tcs_worklist = panic "nestImplicTcS: worklist" + , tcs_implics = panic "nestImplicTcS: implics" -- NB: Both these are initialised by withWorkList } ; res <- TcM.setUntouchables inner_untch $ @@ -1176,8 +1176,8 @@ nestTcS (TcS thing_inside) do { inerts <- TcM.readTcRef inerts_var ; new_inert_var <- TcM.newTcRef inerts ; let nest_env = env { tcs_inerts = new_inert_var - , tcs_worklist = panic "nextImplicTcS: worklist" - , tcs_implics = panic "nextImplicTcS: implics" } + , tcs_worklist = panic "nestTcS: worklist" + , tcs_implics = panic "nestTcS: implics" } ; thing_inside nest_env } tryTcS :: TcS a -> TcS a @@ -1195,8 +1195,8 @@ tryTcS (TcS thing_inside) ; let nest_env = env { tcs_ev_binds = ev_binds_var , tcs_ty_binds = ty_binds_var , tcs_inerts = is_var - , tcs_worklist = panic "nextImplicTcS: worklist" - , tcs_implics = panic "nextImplicTcS: implics" } + , tcs_worklist = panic "tryTcS: worklist" + , tcs_implics = panic "tryTcS: implics" } ; thing_inside nest_env } -- Getters and setters of TcEnv fields From git at git.haskell.org Sat Jul 12 16:00:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 16:00:31 +0000 (UTC) Subject: [commit: ghc] master: Typoes in comments (c70a720) Message-ID: <20140712160031.B2E642406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c70a720104cb91799b4a938e598ec8ed92a265e1/ghc >--------------------------------------------------------------- commit c70a720104cb91799b4a938e598ec8ed92a265e1 Author: Gabor Greif Date: Sat Jul 12 11:36:02 2014 +0200 Typoes in comments >--------------------------------------------------------------- c70a720104cb91799b4a938e598ec8ed92a265e1 compiler/typecheck/TcExpr.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 48c4cbf..36276e5 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -202,7 +202,7 @@ tcExpr (HsIPVar x) res_ty ; ip_var <- emitWanted origin (mkClassPred ipClass [ip_name, ip_ty]) ; tcWrapResult (fromDict ipClass ip_name ip_ty (HsVar ip_var)) ip_ty res_ty } where - -- Coerces a dictionry for `IP "x" t` into `t`. + -- Coerces a dictionary for `IP "x" t` into `t`. fromDict ipClass x ty = case unwrapNewTyCon_maybe (classTyCon ipClass) of Just (_,_,ax) -> HsWrap $ mkWpCast $ mkTcUnbranchedAxInstCo Representational ax [x,ty] @@ -807,7 +807,7 @@ tcExpr (PArrSeq _ _) _ \begin{code} tcExpr (HsSpliceE is_ty splice) res_ty - = ASSERT( is_ty ) -- Untyped splices are expanced by the renamer + = ASSERT( is_ty ) -- Untyped splices are expanded by the renamer tcSpliceExpr splice res_ty tcExpr (HsBracket brack) res_ty = tcTypedBracket brack res_ty @@ -966,7 +966,7 @@ tcInferFun fun -- Zonk the function type carefully, to expose any polymorphism -- E.g. (( \(x::forall a. a->a). blah ) e) - -- We can see the rank-2 type of the lambda in time to genrealise e + -- We can see the rank-2 type of the lambda in time to generalise e ; fun_ty' <- zonkTcType fun_ty ; (wrap, rho) <- deeplyInstantiate AppOrigin fun_ty' From git at git.haskell.org Sat Jul 12 16:00:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 16:00:34 +0000 (UTC) Subject: [commit: ghc] master: Activate tab checks (b8b8d19) Message-ID: <20140712160034.A69DF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b8b8d190525b073aa44f7a5bda555e25ea7ef5d6/ghc >--------------------------------------------------------------- commit b8b8d190525b073aa44f7a5bda555e25ea7ef5d6 Author: Gabor Greif Date: Sat Jul 12 11:20:31 2014 +0200 Activate tab checks >--------------------------------------------------------------- b8b8d190525b073aa44f7a5bda555e25ea7ef5d6 compiler/typecheck/TcArrows.lhs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/compiler/typecheck/TcArrows.lhs b/compiler/typecheck/TcArrows.lhs index 6cea892..eab8941 100644 --- a/compiler/typecheck/TcArrows.lhs +++ b/compiler/typecheck/TcArrows.lhs @@ -6,12 +6,6 @@ Typecheck arrow notation \begin{code} {-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details module TcArrows ( tcProc ) where From git at git.haskell.org Sat Jul 12 16:00:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 16:00:37 +0000 (UTC) Subject: [commit: ghc] master: Fix comment (b7b3f01) Message-ID: <20140712160037.1C2412406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7b3f017d3224e0ba960e9ba89cd885d9843fdef/ghc >--------------------------------------------------------------- commit b7b3f017d3224e0ba960e9ba89cd885d9843fdef Author: Gabor Greif Date: Sat Jul 12 11:21:47 2014 +0200 Fix comment >--------------------------------------------------------------- b7b3f017d3224e0ba960e9ba89cd885d9843fdef compiler/typecheck/TcTyDecls.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index 31d522f..fcb8c03 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -264,7 +264,7 @@ this for all newtypes, we'd get infinite types. So we figure out for each newtype whether it is "recursive", and add a coercion if so. In effect, we are trying to "cut the loops" by identifying a loop-breaker. -2. Avoid infinite unboxing. This is nothing to do with newtypes. +2. Avoid infinite unboxing. This has nothing to do with newtypes. Suppose we have data T = MkT Int T f (MkT x t) = f t From git at git.haskell.org Sat Jul 12 18:01:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 18:01:22 +0000 (UTC) Subject: [commit: ghc] master: Add travis-ci badge (73bb054) Message-ID: <20140712180122.E03FC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/73bb054de9a173a4e33f63ad4f5e88237a32e94c/ghc >--------------------------------------------------------------- commit 73bb054de9a173a4e33f63ad4f5e88237a32e94c Author: Gabor Greif Date: Sat Jul 12 19:59:37 2014 +0200 Add travis-ci badge >--------------------------------------------------------------- 73bb054de9a173a4e33f63ad4f5e88237a32e94c README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index c9c38f1..f35df72 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ The Glasgow Haskell Compiler ============================ +[![Build Status](https://api.travis-ci.org/ghc/ghc.svg?branch=master)](http://travis-ci.org/ghc/ghc) + This is the source tree for [GHC][1], a compiler and interactive environment for the Haskell functional programming language. From git at git.haskell.org Sat Jul 12 18:01:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 18:01:20 +0000 (UTC) Subject: [commit: ghc] master: Fix note spelling (31cde29) Message-ID: <20140712180122.A12E92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31cde297617369486e49d741ae9251969826917c/ghc >--------------------------------------------------------------- commit 31cde297617369486e49d741ae9251969826917c Author: Gabor Greif Date: Sat Jul 12 17:15:38 2014 +0200 Fix note spelling >--------------------------------------------------------------- 31cde297617369486e49d741ae9251969826917c compiler/typecheck/TcExpr.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 36276e5..d4120d0 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -565,7 +565,7 @@ Note that because MkT3 doesn't contain all the fields being updated, its RHS is simply an error, so it doesn't impose any type constraints. Hence the use of 'relevant_cont'. -Note [Implict type sharing] +Note [Implicit type sharing] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ We also take into account any "implicit" non-update fields. For example data T a b where { MkT { f::a } :: T a a; ... } @@ -751,7 +751,7 @@ tcExpr (RecordUpd record_expr rbinds _ _ _) res_ty -- Universally-quantified tyvars that -- appear in any of the *implicit* -- arguments to the constructor are fixed - -- See Note [Implict type sharing] + -- See Note [Implicit type sharing] fixed_tys = [ty | (fld,ty) <- zip flds arg_tys , not (fld `elem` upd_fld_names)] From git at git.haskell.org Sat Jul 12 20:14:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 20:14:18 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Tweak T6048 bounds (ce4477f) Message-ID: <20140712201418.2C68C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce4477fd0150389d2a184c2dee9819118de450e2/ghc >--------------------------------------------------------------- commit ce4477fd0150389d2a184c2dee9819118de450e2 Author: Austin Seipp Date: Sat Jul 12 15:13:59 2014 -0500 testsuite: Tweak T6048 bounds Summary: This should fix the Harbormaster builds; the bounds are just a little too narrow. Signed-off-by: Austin Seipp Test Plan: Harbormaster should build successfully. Reviewers: simonmar Subscribers: phaskell, simonmar, relrod, carter Projects: #ghc Differential Revision: https://phabricator.haskell.org/D65 >--------------------------------------------------------------- ce4477fd0150389d2a184c2dee9819118de450e2 testsuite/tests/perf/compiler/all.T | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 060d8ca..3851eef 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -235,7 +235,7 @@ test('T3064', # (amd64/Linux) (02/08/2013): 236404384, increase from roles # (amd64/Linux) (11/09/2013): 290165632, increase from AMP warnings # (amd64/Linux) (22/11/2013): 308300448, GND via Coercible and counters for constraints solving - # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor + # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor # (amd64/Linux) (11/02/2014): 308422280, optimize Coercions in simpleOptExpr # (amd64/Linux) (23/05/2014): 324022680, unknown cause @@ -392,8 +392,8 @@ test('T5837', # 2012-10-02 81879216 # 2012-09-20 87254264 amd64/Linux # 2013-09-18 90587232 amd64/Linux - # 2013-11-21 86795752 amd64/Linux, GND via Coercible and counters - # for constraints solving + # 2013-11-21 86795752 amd64/Linux, GND via Coercible and counters + # for constraints solving ], compile_fail,['-ftype-function-depth=50']) @@ -404,7 +404,7 @@ test('T6048', # prev: 38000000 (x86/Linux) # 2012-10-08: 48887164 (x86/Linux) # 2014-04-04: 62618072 (x86 Windows, 64 bit machine) - (wordsize(64), 110646312, 10)]) + (wordsize(64), 110646312, 12)]) # 18/09/2012 97247032 amd64/Linux # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr) # 18/01/2014 95960720 amd64/Linux Call Arity improvements From git at git.haskell.org Sat Jul 12 21:18:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 21:18:30 +0000 (UTC) Subject: [commit: ghc] master: integer-gmp: tweak gitignore. (708062b) Message-ID: <20140712211831.2604E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/708062b54d85163410a48e80ebb863be4fe21854/ghc >--------------------------------------------------------------- commit 708062b54d85163410a48e80ebb863be4fe21854 Author: Austin Seipp Date: Sat Jul 12 16:18:03 2014 -0500 integer-gmp: tweak gitignore. Auditors: hvr Signed-off-by: Austin Seipp >--------------------------------------------------------------- 708062b54d85163410a48e80ebb863be4fe21854 .gitignore | 3 --- libraries/integer-gmp/.gitignore | 3 +++ 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index b71afec..99bf3a6 100644 --- a/.gitignore +++ b/.gitignore @@ -150,6 +150,3 @@ _darcs/ .tm_properties VERSION - -/libraries/integer-gmp/gmp/gmp.h -/libraries/integer-gmp/gmp/gmpbuild/ diff --git a/libraries/integer-gmp/.gitignore b/libraries/integer-gmp/.gitignore index 295f5b2..4e7da36 100644 --- a/libraries/integer-gmp/.gitignore +++ b/libraries/integer-gmp/.gitignore @@ -11,3 +11,6 @@ /include/HsIntegerGmp.h /integer-gmp.buildinfo /mkGmpDerivedConstants/dist/ + +/gmp/gmp.h +/gmp/gmpbuild From git at git.haskell.org Sat Jul 12 22:28:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Jul 2014 22:28:04 +0000 (UTC) Subject: [commit: ghc] master: Test case for #9305 (47640ca) Message-ID: <20140712222804.7DA712406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47640ca4e5cdb2882f0b30dec7b34f8c5c734171/ghc >--------------------------------------------------------------- commit 47640ca4e5cdb2882f0b30dec7b34f8c5c734171 Author: Joachim Breitner Date: Sun Jul 13 00:27:54 2014 +0200 Test case for #9305 >--------------------------------------------------------------- 47640ca4e5cdb2882f0b30dec7b34f8c5c734171 testsuite/tests/typecheck/should_fail/T9305.hs | 8 ++++++++ testsuite/tests/typecheck/should_fail/T9305.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 2 +- 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_fail/T9305.hs b/testsuite/tests/typecheck/should_fail/T9305.hs new file mode 100644 index 0000000..b6ad3b7 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9305.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DeriveFunctor#-} +module Main where + +data Event a b = Event a deriving (Functor) + +newtype F f = F (f (F f)) + +data EventF a = EventF (F (Event a)) deriving (Functor) diff --git a/testsuite/tests/typecheck/should_fail/T9305.stderr b/testsuite/tests/typecheck/should_fail/T9305.stderr new file mode 100644 index 0000000..1610423 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9305.stderr @@ -0,0 +1,8 @@ + +T9305.hs:8:48: + No instance for (Functor Event) + arising from the first field of ?EventF? (type ?F (Event a)?) + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Functor EventF) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index a1dab9d..c1dbd58 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -334,4 +334,4 @@ test('T8912', normal, compile_fail, ['']) test('T9033', normal, compile_fail, ['']) test('T8883', normal, compile_fail, ['']) test('T9196', normal, compile_fail, ['']) - +test('T9305', normal, compile_fail, ['']) From git at git.haskell.org Sun Jul 13 11:35:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 13 Jul 2014 11:35:01 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment (8af2f70) Message-ID: <20140713113501.CF19F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8af2f702210b359dad1e65fb029ddf934b967edc/ghc >--------------------------------------------------------------- commit 8af2f702210b359dad1e65fb029ddf934b967edc Author: Gabor Greif Date: Sun Jul 13 11:52:17 2014 +0200 Typo in comment >--------------------------------------------------------------- 8af2f702210b359dad1e65fb029ddf934b967edc compiler/typecheck/TcExpr.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index d4120d0..7e6c495 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -76,7 +76,7 @@ import qualified Data.Set as Set \begin{code} tcPolyExpr, tcPolyExprNC :: LHsExpr Name -- Expression to type check - -> TcSigmaType -- Expected type (could be a polytpye) + -> TcSigmaType -- Expected type (could be a polytype) -> TcM (LHsExpr TcId) -- Generalised expr with expected type -- tcPolyExpr is a convenient place (frequent but not too frequent) From git at git.haskell.org Mon Jul 14 02:39:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 02:39:39 +0000 (UTC) Subject: [commit: ghc] master: Fix ghci tab completion of duplicate identifiers. (1d71e96) Message-ID: <20140714023939.61A782406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1d71e96958cb4374b383e2f254b5358386bf835c/ghc >--------------------------------------------------------------- commit 1d71e96958cb4374b383e2f254b5358386bf835c Author: Shachaf Ben-Kiki Date: Sun Jul 13 15:19:33 2014 -0500 Fix ghci tab completion of duplicate identifiers. Summary: Currently, if the same identifier is imported via multiple modules, ghci shows multiple completions for it. Use the nub of the completions instead so that it only shows up once. Signed-off-by: Shachaf Ben-Kiki Test Plan: by hand Reviewers: simonmar, austin, hvr Reviewed By: austin, hvr Subscribers: hvr, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D58 >--------------------------------------------------------------- 1d71e96958cb4374b383e2f254b5358386bf835c compiler/utils/Util.lhs | 6 +++++- ghc/InteractiveUI.hs | 4 ++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 0274c59..2dcc73f 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -47,7 +47,7 @@ module Util ( nTimes, -- * Sorting - sortWith, minWith, + sortWith, minWith, nubSort, -- * Comparisons isEqual, eqListBy, eqMaybeBy, @@ -126,6 +126,7 @@ import Data.Ord ( comparing ) import Data.Bits import Data.Word import qualified Data.IntMap as IM +import qualified Data.Set as Set import Data.Time #if __GLASGOW_HASKELL__ < 705 @@ -490,6 +491,9 @@ sortWith get_key xs = sortBy (comparing get_key) xs minWith :: Ord b => (a -> b) -> [a] -> a minWith get_key xs = ASSERT( not (null xs) ) head (sortWith get_key xs) + +nubSort :: Ord a => [a] -> [a] +nubSort = Set.toAscList . Set.fromList \end{code} %************************************************************************ diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index c3d9f25..ef48c34 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -2536,14 +2536,14 @@ unionComplete f1 f2 line = do wrapCompleter :: String -> (String -> GHCi [String]) -> CompletionFunc GHCi wrapCompleter breakChars fun = completeWord Nothing breakChars - $ fmap (map simpleCompletion) . fmap sort . fun + $ fmap (map simpleCompletion . nubSort) . fun wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi wrapIdentCompleter = wrapCompleter word_break_chars wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars - $ \rest -> fmap (map simpleCompletion) . fmap sort . fun (getModifier rest) + $ \rest -> fmap (map simpleCompletion . nubSort) . fun (getModifier rest) where getModifier = find (`elem` modifChars) From git at git.haskell.org Mon Jul 14 02:39:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 02:39:41 +0000 (UTC) Subject: [commit: ghc] master: Avoid deadlock in freeTask (called by forkProcess) (39630ab) Message-ID: <20140714023942.0247A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/39630ab15cc0607103dc4ef3d9089de44ef17c2d/ghc >--------------------------------------------------------------- commit 39630ab15cc0607103dc4ef3d9089de44ef17c2d Author: Edsko de Vries Date: Sun Jul 13 15:19:39 2014 -0500 Avoid deadlock in freeTask (called by forkProcess) Summary: Documented in more detail inline with the change. Test Plan: validate Reviewers: austin, simonmar, duncan Reviewed By: austin, simonmar, duncan Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D59 >--------------------------------------------------------------- 39630ab15cc0607103dc4ef3d9089de44ef17c2d rts/Task.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/rts/Task.c b/rts/Task.c index 12c22c4..e191bd0 100644 --- a/rts/Task.c +++ b/rts/Task.c @@ -350,6 +350,20 @@ discardTasksExcept (Task *keep) next = task->all_next; if (task != keep) { debugTrace(DEBUG_sched, "discarding task %" FMT_SizeT "", (size_t)TASK_ID(task)); +#if defined(THREADED_RTS) + // It is possible that some of these tasks are currently blocked + // (in the parent process) either on their condition variable + // `cond` or on their mutex `lock`. If they are we may deadlock + // when `freeTask` attempts to call `closeCondition` or + // `closeMutex` (the behaviour of these functions is documented to + // be undefined in the case that there are threads blocked on + // them). To avoid this, we re-initialize both the condition + // variable and the mutex before calling `freeTask` (we do + // precisely the same for all global locks in `forkProcess`). + initCondition(&task->cond); + initMutex(&task->lock); +#endif + // Note that we do not traceTaskDelete here because // we are not really deleting a task. // The OS threads for all these tasks do not exist in From git at git.haskell.org Mon Jul 14 02:39:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 02:39:44 +0000 (UTC) Subject: [commit: ghc] master: Acquire all_tasks_mutex in forkProcess (16403f0) Message-ID: <20140714023944.577652406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/16403f0d182d2d3d0b1fbe5ad778ead4bfcb7e16/ghc >--------------------------------------------------------------- commit 16403f0d182d2d3d0b1fbe5ad778ead4bfcb7e16 Author: Edsko de Vries Date: Sun Jul 13 15:19:45 2014 -0500 Acquire all_tasks_mutex in forkProcess Summary: (for the same reason that we acquire all the other mutexes) Test Plan: validate Reviewers: simonmar, austin, duncan Reviewed By: simonmar, austin, duncan Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D60 >--------------------------------------------------------------- 16403f0d182d2d3d0b1fbe5ad778ead4bfcb7e16 rts/Schedule.c | 11 +++++++++++ rts/Task.c | 2 +- rts/Task.h | 5 +++++ 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index adf2b5c..7f8ced6 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1802,6 +1802,10 @@ forkProcess(HsStablePtr *entry ACQUIRE_LOCK(&capabilities[i]->lock); } +#ifdef THREADED_RTS + ACQUIRE_LOCK(&all_tasks_mutex); +#endif + stopTimer(); // See #4074 #if defined(TRACING) @@ -1823,6 +1827,11 @@ forkProcess(HsStablePtr *entry releaseCapability_(capabilities[i],rtsFalse); RELEASE_LOCK(&capabilities[i]->lock); } + +#ifdef THREADED_RTS + RELEASE_LOCK(&all_tasks_mutex); +#endif + boundTaskExiting(task); // just return the pid @@ -1839,6 +1848,8 @@ forkProcess(HsStablePtr *entry for (i=0; i < n_capabilities; i++) { initMutex(&capabilities[i]->lock); } + + initMutex(&all_tasks_mutex); #endif #ifdef TRACING diff --git a/rts/Task.c b/rts/Task.c index e191bd0..842ad84 100644 --- a/rts/Task.c +++ b/rts/Task.c @@ -39,7 +39,7 @@ static Task * allocTask (void); static Task * newTask (rtsBool); #if defined(THREADED_RTS) -static Mutex all_tasks_mutex; +Mutex all_tasks_mutex; #endif /* ----------------------------------------------------------------------------- diff --git a/rts/Task.h b/rts/Task.h index cf70256..8dab0a2 100644 --- a/rts/Task.h +++ b/rts/Task.h @@ -171,6 +171,11 @@ isBoundTask (Task *task) // extern Task *all_tasks; +// The all_tasks list is protected by the all_tasks_mutex +#if defined(THREADED_RTS) +extern Mutex all_tasks_mutex; +#endif + // Start and stop the task manager. // Requires: sched_mutex. // From git at git.haskell.org Mon Jul 14 02:43:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 02:43:36 +0000 (UTC) Subject: [commit: ghc] master: add support for x86_64-solaris2 platform (6da6032) Message-ID: <20140714024336.66F8E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6da603213b097a267418d8c14cbfaf0021ac2b2c/ghc >--------------------------------------------------------------- commit 6da603213b097a267418d8c14cbfaf0021ac2b2c Author: Karel Gardas Date: Sun Jul 13 21:43:20 2014 -0500 add support for x86_64-solaris2 platform Summary: this set of patches adds support for x86_64-solaris2 platform Solaris is multi-lib platform which means it provides 32bit user-land together with 32bit and 64bit libraries. The 32bit libraries are located in /lib directories while 64bit libraries are located in /lib/64 directories. This is why GHCi required the fix since otherwise it'll attempt to load /usr/lib/libgmp.so which is 32bit library into 64bit binary process space (GHCi). This of course fails with wrong ELFCLASS32 error message. Another issue was that by default GNU C distributed with Solaris compiles into 32bit binary. We need to enforce compilation to 64bit binary by adding appropriate -m64 option. Test Plan: already built on x86_64-solaris2 Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D68 >--------------------------------------------------------------- 6da603213b097a267418d8c14cbfaf0021ac2b2c aclocal.m4 | 6 ++++++ compiler/ghci/Linker.lhs | 6 +++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index d857706..782cae5 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -538,6 +538,12 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], $4="$$4 -arch x86_64" $5="$$5 -m64" ;; + x86_64-unknown-solaris2) + $2="$$2 -m64" + $3="$$3 -m64" + $4="$$4 -m64" + $5="$$5 -m64" + ;; alpha-*) # For now, to suppress the gcc warning "call-clobbered # register used for global register variable", we simply diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 0b23985..0dbab24 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -1209,7 +1209,9 @@ locateLib dflags is_hs dirs lib mk_hs_dyn_lib_path dir = dir mkHsSOName platform hs_dyn_lib_name so_name = mkSOName platform lib - mk_dyn_lib_path dir = dir so_name + mk_dyn_lib_path dir = case (arch, os) of + (ArchX86_64, OSSolaris2) -> dir ("64/" ++ so_name) + _ -> dir so_name findObject = liftM (fmap Object) $ findFile mk_obj_path dirs findDynObject = liftM (fmap Object) $ findFile mk_dyn_obj_path dirs @@ -1226,6 +1228,8 @@ locateLib dflags is_hs dirs lib Nothing -> g platform = targetPlatform dflags + arch = platformArch platform + os = platformOS platform searchForLibUsingGcc :: DynFlags -> String -> [FilePath] -> IO (Maybe FilePath) searchForLibUsingGcc dflags so dirs = do From git at git.haskell.org Mon Jul 14 10:00:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:00:06 +0000 (UTC) Subject: [commit: ghc] master: Type classes (22e992e) Message-ID: <20140714100006.285AF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22e992e24abc5690d794a1b1a913511845c61046/ghc >--------------------------------------------------------------- commit 22e992e24abc5690d794a1b1a913511845c61046 Author: Edward Z. Yang Date: Fri Jul 11 17:13:12 2014 +0100 Type classes Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 22e992e24abc5690d794a1b1a913511845c61046 docs/backpack/backpack-impl.tex | 279 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 268 insertions(+), 11 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 22e992e24abc5690d794a1b1a913511845c61046 From git at git.haskell.org Mon Jul 14 10:00:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:00:08 +0000 (UTC) Subject: [commit: ghc] master: Finish TCs section (c85a3b0) Message-ID: <20140714100010.957DC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c85a3b0bc190fb065be92357b264e932a8423388/ghc >--------------------------------------------------------------- commit c85a3b0bc190fb065be92357b264e932a8423388 Author: Edward Z. Yang Date: Mon Jul 14 10:59:47 2014 +0100 Finish TCs section Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- c85a3b0bc190fb065be92357b264e932a8423388 docs/backpack/backpack-impl.tex | 323 +++++++++++++++++++++++++++++----------- 1 file changed, 238 insertions(+), 85 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c85a3b0bc190fb065be92357b264e932a8423388 From git at git.haskell.org Mon Jul 14 10:20:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:20:32 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Update baseline shift/reduce conflict number (105f16f) Message-ID: <20140714102032.2C7672406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/105f16f1862eee9c3dd2f8eda2947552f8e570f2/ghc >--------------------------------------------------------------- commit 105f16f1862eee9c3dd2f8eda2947552f8e570f2 Author: Dr. ERDI Gergo Date: Wed Jul 2 19:18:43 2014 +0800 Update baseline shift/reduce conflict number >--------------------------------------------------------------- 105f16f1862eee9c3dd2f8eda2947552f8e570f2 compiler/parser/Parser.y.pp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 073afd8..45b0a2b 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -55,6 +55,12 @@ import Control.Monad ( mplus ) {- ----------------------------------------------------------------------------- +25 June 2014 + +Conflicts: 47 shift/reduce + 1 reduce/reduce + +----------------------------------------------------------------------------- 12 October 2012 Conflicts: 43 shift/reduce From git at git.haskell.org Mon Jul 14 10:20:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:20:35 +0000 (UTC) Subject: [commit: ghc] wip/T9023: Add parser for pattern synonym type signatures. Syntax is of the form (6986976) Message-ID: <20140714102035.4D27A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9023 Link : http://ghc.haskell.org/trac/ghc/changeset/698697656bb0501df40713aff847555e61b9411c/ghc >--------------------------------------------------------------- commit 698697656bb0501df40713aff847555e61b9411c Author: Dr. ERDI Gergo Date: Mon Jul 14 18:18:44 2014 +0800 Add parser for pattern synonym type signatures. Syntax is of the form pattern type Eq a => P a T b :: Num b => R a b which declares a pattern synonym called P, with argument types a, T, and b. >--------------------------------------------------------------- 698697656bb0501df40713aff847555e61b9411c compiler/hsSyn/HsBinds.lhs | 1 + compiler/hsSyn/HsTypes.lhs | 2 +- compiler/parser/Parser.y.pp | 12 ++++++++---- compiler/parser/RdrHsSyn.lhs | 29 ++++++++++++++++++++++++++++- 4 files changed, 38 insertions(+), 6 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 2261a89..3b3f3f8 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -717,6 +717,7 @@ pprPatSynSig :: (OutputableBndr a) => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> Maybe SDoc -> Maybe SDoc -> SDoc pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta = sep [ ptext (sLit "pattern") + , ptext (sLit "type") , thetaOpt prov_theta, name_and_args , colon , thetaOpt req_theta, rhs_ty diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 08a0eef..52b919e 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -31,7 +31,7 @@ module HsTypes ( hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, - splitHsFunType, + splitHsFunType, splitLHsForAllTy, splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy, -- Printing diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 45b0a2b..4773e9b 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -829,12 +829,15 @@ role : VARID { L1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl RdrName } : 'pattern' pat '=' pat {% do { (name, args) <- splitPatSyn $2 - ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional - }} + ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional }} | 'pattern' pat '<-' pat {% do { (name, args) <- splitPatSyn $2 - ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional - }} + ; return . LL $ ValD $ mkPatSynBind name args $4 Unidirectional }} + +pattern_synonym_sig :: { LSig RdrName } + : 'pattern' 'type' ctype '::' ctype + {% do { (name, details, ty, prov, req) <- splitPatSynSig $3 $5 + ; return . LL $ PatSynSig name details ty prov req }} vars0 :: { [Located RdrName] } : {- empty -} { [] } @@ -1445,6 +1448,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } { LL $ toOL [ LL $ SigD (TypeSig ($1 : reverse (unLoc $3)) $5) ] } | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | n <- unLoc $3 ] } + | pattern_synonym_sig { LL . unitOL $ LL . SigD . unLoc $ $1 } | '{-# INLINE' activation qvar '#-}' { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) } | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}' diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 0536286..cd025a7 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -16,7 +16,7 @@ module RdrHsSyn ( mkTySynonym, mkTyFamInstEqn, mkTyFamInst, mkFamDecl, - splitCon, splitPatSyn, mkInlinePragma, + splitCon, splitPatSyn, splitPatSynSig, mkInlinePragma, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -431,6 +431,33 @@ splitPatSyn pat@(L loc (ConPatIn con details)) = do splitPatSyn pat@(L loc _) = parseErrorSDoc loc $ text "invalid pattern synonym declaration:" $$ ppr pat +-- Given two types like +-- Eq a => P a T b +-- and +-- Num b => R a b +-- +-- This returns +-- P as the name, +-- PrefixPatSyn [a, T, b] as the details, +-- R a b as the result type, +-- and (Eq a) and (Num b) as the provided and required thetas (respectively) +splitPatSynSig :: LHsType RdrName + -> LHsType RdrName + -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, LHsContext RdrName, LHsContext RdrName) +splitPatSynSig lty1 lty2 = do + (name, details) <- splitCon pat_ty + details' <- case details of + PrefixCon tys -> return $ PrefixPatSyn tys + InfixCon ty1 ty2 -> return $ InfixPatSyn ty1 ty2 + RecCon{} -> parseErrorSDoc (getLoc lty1) $ + text "record syntax not supported for pattern synonym declarations:" $$ ppr lty1 + return (name, details', res_ty, prov', req') + where + (_, prov, pat_ty) = splitLHsForAllTy lty1 + (_, req, res_ty) = splitLHsForAllTy lty2 + prov' = L (getLoc lty1) prov + req' = L (getLoc lty2) req + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] From git at git.haskell.org Mon Jul 14 10:20:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:20:51 +0000 (UTC) Subject: [commit: ghc] wip/T9023's head updated: Add parser for pattern synonym type signatures. Syntax is of the form (6986976) Message-ID: <20140714102051.DD3B32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9023' now includes: 4fb94ae [project @ 2001-06-28 14:15:04 by simonmar] First cut of the Haskell Core Libraries ======================================= d4514dc [project @ 2001-06-29 09:41:37 by simonmar] merge fptools/hslibs/lang/ST.lhs rev. 1.4 dfbab25 [project @ 2001-06-29 09:44:03 by simonmar] merge ghc/lib/std/CPUTime.hsc rev. 1.7 d5fe1da [project @ 2001-07-03 09:02:05 by simonmar] add paragraph about capitalisation of module names b5925b0 [project @ 2001-07-03 09:21:46 by simonmar] Add a paragraph on when to pluralize(*) a module name b4358ba [project @ 2001-07-03 11:37:49 by simonmar] Latest round of changes, incorporating: 900b4a1 [project @ 2001-07-03 11:38:07 by simonmar] add new file 020857d [project @ 2001-07-03 14:13:32 by simonmar] Move generic Maybe and Either definitions from GHC.Maybe to Data.Maybe and Data.Either, and remove GHC.Maybe. a335549 [project @ 2001-07-03 14:17:23 by simonmar] GHC.Maybe isn't used any more (contents moved to Data.Maybe and Data.Either). 5760684 [project @ 2001-07-04 10:48:16 by simonmar] bugfix in yesterday's changes. 38cfe4f [project @ 2001-07-04 10:48:39 by simonmar] Add 4 new libraries b7dc61f [project @ 2001-07-04 10:51:09 by simonmar] oops, better import Prelude bca479a [project @ 2001-07-04 11:06:39 by simonmar] Add Generics library 4fd8a5f [project @ 2001-07-04 11:29:26 by simonmar] need to import Data.Tuple explicitly to get dependencies right. 5743073 [project @ 2001-07-04 11:30:52 by simonmar] Add Prelude imports. eb7eff6 [project @ 2001-07-04 12:06:33 by simonmar] Add showListWith :: (a -> ShowS) -> [a] -> ShowS d69a177 [project @ 2001-07-04 12:07:27 by simonmar] Add Numeric library here for the time being. This is a combination of the H98 Numeric library and a few functions from GHC's NumExts. f9dc6de [project @ 2001-07-05 10:38:33 by simonmar] Makefile for the document. c5175d4 [project @ 2001-07-05 13:52:49 by simonmar] Latest revisions: 6d51c89 [project @ 2001-07-31 11:51:09 by simonmar] Catch up with changes in the main tree. ba4d349 [project @ 2001-07-31 11:59:08 by simonmar] merge fptools/ghc/lib/std/PrelHandle.hsc rev. 1.11 a9a4106 [project @ 2001-07-31 12:46:17 by simonmar] merge fptools/ghc/lib/std/IO.hsc rev. 1.6 60ca3a6 [project @ 2001-07-31 12:47:13 by simonmar] merge fptools/ghc/lib/std/PrelHandle.hsc rev. 1.12 6b8b2ca [project @ 2001-07-31 12:48:13 by simonmar] merge fptools/ghc/lib/std/PrelPosix.hsc rev. 1.8 c165440 [project @ 2001-07-31 12:48:55 by simonmar] merge fptools/ghc/lib/std/PrelHandle.hsc rev. 1.13 2c885c9 [project @ 2001-07-31 12:50:18 by simonmar] merge fptools/ghc/lib/std/CPUTime.hsc rev. 1.8 f33325e [project @ 2001-07-31 12:51:37 by simonmar] merge ghc/lib/std/PrelTopHandler.lhs rev. 1.3 447dad3 [project @ 2001-07-31 12:52:37 by simonmar] add file from main tree. d6acc44 [project @ 2001-07-31 12:58:00 by simonmar] merge ghc/lib/std/PrelInt.lhs rev. 1.16-1.18 5224e42 [project @ 2001-07-31 12:59:30 by simonmar] merge ghc/lib/std/PrelCError.lhs rev. 1.10 79d5bed [project @ 2001-07-31 13:00:26 by simonmar] merge ghc/lib/std/PrelGHC.hi-boot rev. 1.57 2935d84 [project @ 2001-07-31 13:03:28 by simonmar] merge ghc/lib/std/PrelHandle.hsc rev. 1.15 123fb75 [project @ 2001-07-31 13:05:02 by simonmar] merge ghc/lib/std/Time.hsc rev. 1.17 a177664 [project @ 2001-07-31 13:05:33 by simonmar] merge ghc/lib/std/Time.hsc rev. 1.18 5800c82 [project @ 2001-07-31 13:06:09 by simonmar] merge ghc/lib/std/Time.hsc rev. 1.19 a5c9e37 [project @ 2001-07-31 13:06:51 by simonmar] merge ghc/lib/std/PrelEnum.lhs rev. 1.14 fbabc47 [project @ 2001-07-31 13:09:11 by simonmar] merge ghc/lib/std/Num.lhs rev. 1.40 82840a5 [project @ 2001-07-31 13:10:01 by simonmar] merge ghc/lib/std/PrelStorable.lhs rev. 1.8 018bd0f [project @ 2001-07-31 13:11:07 by simonmar] merge ghc/lib/std/PrelErr.lhs rev. 1.20 8448667 [project @ 2001-07-31 13:11:40 by simonmar] merge ghc/lib/std/PrelErr.lhs rev. 1.21 354e601 [project @ 2001-07-31 13:14:01 by simonmar] merge ghc/lib/std/PrelList.lhs rev. 1.25 1e81784 [project @ 2001-07-31 13:28:58 by simonmar] merge hslibs/lang/ArrayBase.lhs rev. 1.17-1.18 7c9589c [project @ 2001-07-31 13:31:44 by simonmar] merge hslibs/lang/ST.lhs rev. 1.14 911ea3e [project @ 2001-07-31 13:38:10 by simonmar] merge hslibs/lang/ArrayBase.lhs rev. 1.19 17f3053 [project @ 2001-07-31 14:34:23 by simonmar] add a couple of useful variants of catch & catchJust: 4528993 [project @ 2001-07-31 14:36:19 by simonmar] add missing #include 250b405 [project @ 2001-07-31 16:35:29 by simonmar] use the eqForeignPtr primop cd9ef85 [project @ 2001-07-31 16:41:32 by simonmar] Add the template package config, and move some of the makefile code out into ../mk/target.mk. 316a7d2 [project @ 2001-08-01 13:53:07 by simonmar] Add Andy Gill's HTML combinator library. d65df60 [project @ 2001-08-02 11:20:50 by simonmar] Add a POSIX regular expression binding as Text/Regex/Posix. POSIX regexps are provided virtually everywhere (except Windows, but there's always pcre), and this means we won't have to ship the a copy of GNU regex.c, which is GPL'ed. 45c5a17 [project @ 2001-08-02 13:30:36 by simonmar] Don't export non-H98 functions 6906afe [project @ 2001-08-07 15:25:04 by simonmar] Remove 'fork' (unsafe, and not used), and don't export 'seq' and 'par'. d1ddd69 [project @ 2001-08-17 12:44:54 by simonmar] Add FiniteMap from package data. 2be6368 [project @ 2001-08-17 12:45:27 by simonmar] Move System.IO.Directory to System.Directory c4ed33b [project @ 2001-08-17 12:46:16 by simonmar] Add default pretty printing library (Text.PrettyPrint.HughesPJ). da7d6b7 [project @ 2001-08-17 12:46:40 by simonmar] Add default pretty printing library. da8fe7b [project @ 2001-08-17 12:47:10 by simonmar] Copy from ghc/lib/std/cbits 8adea3a [project @ 2001-08-17 12:47:47 by simonmar] Add a Makefile (for installing the includes) 0f54f44 [project @ 2001-08-17 12:48:38 by simonmar] Add QuickCheck from package util. a0aef53 [project @ 2001-08-17 12:50:34 by simonmar] Track updates to ghc/lib/std and hslibs. 3cc3816 [project @ 2001-08-30 13:36:00 by simonmar] fix a few typos and add some clarifications d06189a [project @ 2001-09-13 11:35:09 by simonmar] Add System.Mem directory 2194ef4 [project @ 2001-09-13 11:36:52 by simonmar] make this compile 10fd991 [project @ 2001-09-13 11:37:08 by simonmar] add missing import; make it compile fd2801a [project @ 2001-09-13 11:37:43 by simonmar] remove a couple of unused imports 3f12694 [project @ 2001-09-13 11:38:54 by simonmar] cosmetic only: separate the IOErrorType declaration into Haskell 98 and non-Haskell 98 sections. da78e1e [project @ 2001-09-13 11:39:14 by simonmar] Fix the module header 81d1634 [project @ 2001-09-13 11:39:58 by simonmar] Use withForeignPtr rather than passing ForeignPtrs directly to foreign imported functions. 078953f [project @ 2001-09-13 11:40:28 by simonmar] remove get_prog_arg{c,v} prototypes bdbc6e0 [project @ 2001-09-13 11:50:35 by simonmar] Add Set (from package data) 09c1852 [project @ 2001-09-13 15:34:17 by simonmar] remove unused import 9866830 [project @ 2001-09-14 11:25:23 by simonmar] - replace PackedString implementation with one based on UArray. It hasn't been tuned for performance yet, and it seems that not enough fusion is happening yet, but in theory it should be nearly as fast as the old implementation (modulo the fact that the new packed string representation used 32-bit chars vs. 8-bit chars in the old implementation). 0bdbe8b [project @ 2001-09-14 11:25:57 by simonmar] Remove inline functions from GHC.Handle and GHC.IO, and declare them as 'extern inline' in HsCore.h. 4cb5bac [project @ 2001-10-18 11:10:19 by rrt] Remove STGHUGSery. b83cfb9 [project @ 2001-10-18 11:14:17 by rrt] Remove comment that was for STGHUGS. ceb68b9 [project @ 2001-12-21 15:07:20 by simonmar] Merge up to the ghc/lib/std on the HEAD (tagged as new-libraries-last-merged). 56d4524 [project @ 2002-01-02 14:40:09 by simonmar] Make this compile again, and update with latest changes from hslibs/lang. 2a42c35 [project @ 2002-01-02 15:01:27 by simonmar] import Prelude explicitly (this is necessary in libraries/core so that ghc --make can infer correct dependencies). 19bf2f2 [project @ 2002-01-02 15:01:44 by simonmar] Fix the names of some foreign imports. ec3d22d [project @ 2002-01-02 15:13:23 by simonmar] We need GHC/Prim.hi for when the package is built, although we only use GHC/Prim.hi-boot during building. aadbf09 [project @ 2002-02-05 17:32:24 by simonmar] - Merging from ghc/lib/std - Add System.IO.Error - Now builds without --make, so we can do -split-objs c89b528 [project @ 2002-02-06 10:14:26 by simonmar] There's no need for this to be a .hsc file. I'm moving towards libraries/core being .hsc-free, so eventually this can be used for bootstrapping. 8fbb1c4 [project @ 2002-02-06 10:40:26 by simonmar] Building the cbits library is simpler with UseGhcForCC=YES. 14bd795 [project @ 2002-02-06 11:49:32 by simonmar] #include 9b7636b [project @ 2002-02-06 11:50:31 by simonmar] Back off: don't use UseGhcForCc as a magic way to get the right include paths, because we still need to tell mkdependC about them. c42e3e7 [project @ 2002-02-06 11:51:12 by simonmar] - change package name to "base" - make GHC/PrimopWrappers work. 91890c6 [project @ 2002-02-07 11:13:29 by simonmar] Various updates after rearranging the directory structure in the repository (there wasn't any history worth keeping, and it's better to do this now before we go 'live'). 91ceefe [project @ 2002-02-11 12:27:34 by simonmar] These files aren't necessary any more. 81759ad [project @ 2002-02-11 12:28:04 by simonmar] Final part of QuickCheck from hslibs/utils. 8294089 [project @ 2002-02-11 12:28:31 by simonmar] Export the various memcpy functions (following ghc/lib/std/PrelIO.hs) 812e0e5 [project @ 2002-02-11 12:28:57 by simonmar] Export runMain (following ghc/lib/std/PrelTopHandler.lhs) 82009cd [project @ 2002-02-11 12:29:13 by simonmar] HsCore ==> HsBase 2e98b12 [project @ 2002-02-11 12:31:30 by simonmar] - Don't forget System/Console - Add -fglasgow-exts and -cpp here rather than mk/target.mk 2b944de [project @ 2002-02-11 16:11:38 by simonmar] Add missing Show instance for Ptr. 3be5332 [project @ 2002-02-11 17:10:56 by simonmar] don't forget -funbox-strict-fields for GHC.IOBase 1d2fd05 [project @ 2002-02-11 17:11:12 by simonmar] New module from ghc/lib/std. 4a8a7df [project @ 2002-02-11 17:30:57 by simonmar] Add code to build/install the split version of this library on Windows (untested). It may be that the base library has grown sufficiently to warrant being split into 3 now, or we may need to orgnise the splitting criteria a little better. Feedback from someone with a Win32 build would be welcome (once I've checked the rest of the changes in). 93c7ce3 [project @ 2002-02-12 09:39:19 by simonmar] Merge rev. 1.61 of ghc/lib/std/PrelBase.lhs 30f1170 [project @ 2002-02-12 10:50:03 by simonmar] The new home for performGC. 0280956 [project @ 2002-02-12 10:50:37 by simonmar] Make this build: OPTIONS -fparr and place it above the Prelude in the dependency tree. 4ab1eb1 [project @ 2002-02-12 10:51:06 by simonmar] Export h{Get,Set}Echo, and hIsTerminalDevice 7dca863 [project @ 2002-02-12 10:52:18 by simonmar] Place this below the Prelude in the dependency tree, so we can import it in Foreign.Ptr without creating a loop. 2eb8067 [project @ 2002-02-12 10:52:47 by simonmar] wibbles d6db874 [project @ 2002-02-12 15:17:34 by simonmar] Switch over to the new hierarchical libraries --------------------------------------------- a5aeb37 [project @ 2002-02-12 15:51:26 by simonmar] Remove fromInt/toInt 6a5400d [project @ 2002-02-13 10:17:29 by simonmar] include to get PATH_MAX aadca45 [project @ 2002-02-13 10:43:15 by simonpj] Use C comments not Haskell comments; ghc-pkg doesnt understand the latter a06ba1a [project @ 2002-02-13 11:51:40 by simonmar] - Detect presence of a POSIX-compatible regex interface in configure, and omit Text.Regex.Posix (and hence Text.Regex) if it is missing. ToDo: pull in a suitably-licensed implementation of POSIX regex to be used in the event that the system doesn't supply one. 3807ed7 [project @ 2002-02-13 11:52:42 by simonmar] Remove a ToDo 462a416 [project @ 2002-02-13 12:12:08 by simonmar] Make this build on mingw32 (hopefully) 6fba759 [project @ 2002-02-13 12:17:14 by simonmar] import Prelude 940f32e [project @ 2002-02-13 12:21:21 by simonmar] Merge inputReady.c from ghc/lib/std 14e3ec8 [project @ 2002-02-13 14:26:01 by simonmar] Move c_unlink foreign import outside #ifdef mingw32_TARGET_OS d171497 [project @ 2002-02-14 07:31:03 by sof] Time stubs (for mingw) 2623394 [project @ 2002-02-14 07:31:34 by sof] hook in timeUtils.h fb2142f [project @ 2002-02-14 07:32:17 by sof] mingw: support timezone and tzname (as before) 53fee2b [project @ 2002-02-14 07:33:09 by sof] move half a dozen non-mingw f-imports into approp. ifdef section 284990d [project @ 2002-02-14 13:59:20 by simonmar] Import FreeBSD's regex library 097df6a [project @ 2002-02-14 13:59:21 by simonmar] Initial revision 1315c81 [project @ 2002-02-14 14:01:38 by simonmar] ==> "regex.h" dd0df11 [project @ 2002-02-14 14:03:25 by simonmar] Remove support for "collate" which appears to be a locale-independent way of interpreting character ranges like [a-z]. Anyway it relies on stuff internal to FreeBSD's libc which doesn't appear to be easy to extract, so just disable it. a64abb7 [project @ 2002-02-14 14:05:12 by simonmar] FreeBSD regex library requires reallocf(), a FreeBSD-specific flavour of realloc(), so include it here. 653ce69 [project @ 2002-02-14 14:05:48 by simonmar] Include regex stuff if $(HavePosixRegex) == "NO" cf20c1f [project @ 2002-02-14 14:07:16 by simonmar] Also import FreeBSD's regex.h 29f017b [project @ 2002-02-14 14:08:25 by simonmar] Use cbits/regex if the system doesn't have a POSIX-compatible regular expression library. 94f887f [project @ 2002-02-14 14:08:50 by simonmar] Catch up with changes to the foreign import syntax. 96e0216 [project @ 2002-02-14 15:14:02 by simonmar] Fixes to 'make install' in fptools/libraries. We have to maintain the directory structure when installing the .hi files, rather than just dumping them in a single directory as we do for packages in fptools/hslibs. 9668657 [project @ 2002-02-15 11:26:02 by simonpj] mingw32 doesn't define _POSIX2_RE_DUP_MAX, it seems d3e0af2 [project @ 2002-02-15 11:27:03 by simonpj] - include rather than non-std - remove use of __P-style prototypes a6c2f10 [project @ 2002-02-15 11:28:47 by simonpj] Remove __P from prototypes 2f68fca [project @ 2002-02-16 18:04:28 by simonmar] Must #include before regex.h ac8a1df [project @ 2002-02-17 15:22:11 by panne] Synch import_dirs with the result of "make install". It could have been fixed the other way round, but fixing the config files makes more sense to me. Furthermore, I've got a 50% chance of taking the correct route by pure accident... ;-) fc84d36 [project @ 2002-02-17 20:05:35 by panne] Install GHC.Prim interface file, too... *sigh* 3d4cbc2 [project @ 2002-02-17 20:08:56 by panne] Add missing commas... >:-( 73fd86e [project @ 2002-02-26 18:19:17 by ross] New Control.Arrow module, plus Arrow stub (in lang) for compatability. 850446d [project @ 2002-02-27 14:31:44 by simonmar] remove unnecessary import of GHC.Prim de74d2e [project @ 2002-02-27 14:32:23 by simonmar] Define hTell in GHC.Handle, and export it from System.IO 8dc326e [project @ 2002-02-27 14:33:09 by simonmar] Move the Float/Double constant folding rules from GHC.Float to GHC.Base, thus returning GHC.Float to its non-orphan status. a88f4e3 [project @ 2002-03-04 17:02:43 by simonmar] - generate GHC/Prim.hi from GHC/Prim.hi-boot using ghc --compile-iface - compile the whole lot with -funbox-strict-fields fc033a9 [project @ 2002-03-04 17:25:36 by panne] Export modifySTRef, too b05d975 [project @ 2002-03-05 14:31:47 by simonmar] The interface file for GHC.Prim is now built-in to the compiler, and mostly automatically generated. aa8f96f [project @ 2002-03-11 14:53:51 by simonmar] Use updated FFI syntax 9cd0f82 [project @ 2002-03-14 12:09:49 by simonmar] Eliminate some orphan-instance modules to speed up compilation. 9295636 [project @ 2002-03-14 16:26:40 by simonmar] Add class Splittable that accidentally got dropped on the floor when we moved over to the new libraries. 3b376f0 [project @ 2002-03-15 12:42:39 by simonmar] Convert to new syntax 25f91cb [project @ 2002-03-15 12:45:12 by simonmar] This doesn't appear to be used 6141dee [project @ 2002-03-18 14:03:20 by simonmar] Fix silly bug I noticed unpackAcc, which apparently is not triggered. 079e705 [project @ 2002-03-19 10:59:01 by simonmar] Use new form of FFI declarations 4a7079b [project @ 2002-03-19 11:24:51 by simonmar] Fix 64-bit shift operations. 1fc6ee2 [project @ 2002-03-20 15:38:36 by simonmar] convert to new-style FFI declarations 531934f [project @ 2002-03-22 10:20:24 by simonmar] This module now lives above the Prelude in the dependency tree. 9e18cb4 [project @ 2002-03-25 05:23:53 by sof] provide isblank() for Win32 282a245 [project @ 2002-03-25 05:25:27 by sof] make splitting of HSbase.o work (mingw only) ddce1d0 [project @ 2002-03-25 15:49:26 by sof] make HSbase splitting a mingw-only affair (and a sorry one, at that.) 9b78160 [project @ 2002-03-26 10:44:32 by simonmar] sigaddset returns a CInt, not () b7db2ac [project @ 2002-03-26 10:53:03 by simonmar] sigaddset() can be a macro, so add an wrapper around it (inlined in via-C mode). I didn't bother with the #ifdef darwin_TARGET_OS around this change since it doesn't hurt on other architectures. 7751d5d [project @ 2002-03-26 17:03:08 by simonmar] Add type signatures for isAlreadyExistsErrorType & friends 3294e5f [project @ 2002-03-26 17:06:32 by simonmar] Add some missing type signatures 0c19e67 [project @ 2002-03-26 17:09:52 by simonmar] Update foreign import declaration to new syntax 517c086 [project @ 2002-03-26 17:11:15 by simonmar] Update to new FFI syntax 8babd81 [project @ 2002-03-26 20:18:28 by sof] mingw32: drop msvcrt from extra_libraries list 77f9723 [project @ 2002-03-26 21:02:19 by sof] cygwin: stick with system() bd0e9f9 [project @ 2002-03-26 21:07:06 by sof] make it work with cygwin again e580c66 [project @ 2002-03-26 23:50:56 by sof] To make cygwin/mingw interworking a little bit simpler, use the __MINGW32__ define rather than config.h's mingw32_TARGET_OS d5cce22 [project @ 2002-03-27 17:55:26 by simonmar] Fix cut-n-pasto (the testsuite actually showed up something useful!) a133f05 [project @ 2002-04-01 09:19:18 by simonpj] Remove Ix context from STArray data type. Data type contexts are evil. H98 says they even apply for pattern matching, which GHC didn't implement till now --- and that forces Ix even on equality of STArrays. No, no, no. 85e5a42 [project @ 2002-04-02 10:19:21 by simonmar] Add foldl', the strict version of foldl. 6ba6fe1 [project @ 2002-04-02 15:33:34 by sof] don't bother defining __hscore_sigaddset() on mingw b77afa8 [project @ 2002-04-10 11:43:49 by stolz] Two new scheduler-API primops: 36d4430 [project @ 2002-04-10 15:57:16 by simonmar] Update to newer FFI definition style 76a82fd [project @ 2002-04-11 12:03:43 by simonpj] ------------------- Mainly derived Read ------------------- 16bc668 [project @ 2002-04-13 05:08:55 by sof] readIEEENumber: support reading IEEE-754 'special' values (NaN,Inf) 6d3da36 [project @ 2002-04-13 14:59:06 by panne] Ugly hack to make `lex' H98-compliant again: lex "" should return [("","")], not []. This should probably be fixed elsewhere... 0549a06 [project @ 2002-04-18 23:32:56 by sof] re-added Show instance for ThreadId 8421673 [project @ 2002-04-24 11:17:53 by simonpj] "\Oxxx" and "\Xyyy" are not octal or hexadecimal escapes in Haskell 98, and should not be lexed as such. 27c5dda [project @ 2002-04-24 15:47:10 by sof] Directory.Permissions.searchable: True iff S_ISDIR() and X bit set (was : !S_ISREG() and X) -- falls into line with what nhc98 and Hugs does c1253ce [project @ 2002-04-24 15:47:34 by simonmar] Update foreign import syntax bd0c347 [project @ 2002-04-24 16:01:51 by simonmar] Update foreign import syntax ea1718d [project @ 2002-04-24 16:09:12 by simonmar] Update foreign import syntax 0183707 [project @ 2002-04-24 16:10:21 by simonmar] Omit the generic declarations when processing with Haddock, since the Haddock parser doesn't understand them (yet). 13a593f [project @ 2002-04-24 16:13:26 by simonmar] Makefile rules for building HTML documentation using Haddock. It's a bit rough around the edges so far, and I haven't added any actual documentation yet, but you can build Haddock (in fptools/haddock) and then say f014372 [project @ 2002-04-24 16:31:37 by simonmar] Add the single character '|' to the header comment of each module so that Haddock will parse it as the module documentation. 63a85e7 [project @ 2002-04-24 17:57:55 by ross] haddock food. cf1acc8 [project @ 2002-04-26 12:31:06 by simonmar] Add a LICENSE f478c5a [project @ 2002-04-26 12:48:16 by simonmar] - Add proper module headers to these guys - Remove \$Id\$ - Update copyrights - Int.lhs and Word.lhs were just wrapped in \begin{code}..\end{code}, so make them .hs files instead. 1d53e7e [project @ 2002-04-26 12:58:45 by simonmar] doc string wibble 8b348ed [project @ 2002-04-26 13:26:39 by simonmar] We can cope with Control.Monad.Reader & friends now (Haddock can parse fundeps). 6aa094d [project @ 2002-04-26 13:33:10 by simonmar] - Remove \$Id\$ - Fix comments that confuse Haddock 1eb49e8 [project @ 2002-04-26 13:34:05 by simonmar] Remove \$Id\$ from all files: it isn't particularly useful (see previous discussion on cvs-ghc at haskell.org), and it confuses Haddock. c38c0d0 [project @ 2002-04-26 15:39:50 by lewie] Fix broken def of fixST. 0fe6b08 [project @ 2002-04-28 02:01:00 by sof] \\begin{code} prefix missing ea54d6c [project @ 2002-05-02 15:20:02 by sof] extra_libraries(mingw): The Return of MSVCRT d33f77b [project @ 2002-05-03 08:39:17 by simonmar] Fix the build on Sparc-Solaris, hopefully without breaking it on Windows. 5af37c0 [project @ 2002-05-06 06:51:00 by sof] timezone mingw fix, making this module resemble even more of a dog's dinner 246a1e7 [project @ 2002-05-09 10:43:26 by simonmar] Omit the imports in Haddock, to avoid module recursion e9a4da6 [project @ 2002-05-09 10:43:42 by simonmar] We can process GHC.Err with Haddock now c427a78 [project @ 2002-05-09 13:05:46 by simonmar] Fix comments that are misinterpreted by Haddock f9efc41 [project @ 2002-05-09 13:09:30 by simonmar] singletonSet has been deprecated for a while; remove it now d66534a [project @ 2002-05-09 13:13:28 by simonmar] Add documentation Haddock-style 6c9f614 [project @ 2002-05-09 13:14:42 by simonmar] tweak the module comment 961034a [project @ 2002-05-09 13:15:07 by simonmar] Various tweaks needed to get the source processed cleanly with Haddock. cbe4350 [project @ 2002-05-09 13:16:29 by simonmar] Rename libraries/core to libraries/base in the module headers. 95b47f8 [project @ 2002-05-09 13:28:30 by simonmar] Add a type signature for getClockTime ba4af98 [project @ 2002-05-10 08:35:05 by simonmar] import GHC.Ptr instead of Foreign.Ptr (I fixed the latter to export Ptr abstractly yesterday). b647b00 [project @ 2002-05-10 08:38:53 by simonmar] import GHC.Ptr to get the representation of Ptr. This module should really be split into compiler-dep and indep. parts. 8678a54 [project @ 2002-05-10 08:58:34 by simonmar] Convert these files from .lhs to .hs, and give them proper headers to match the style used in the rest of the libraries. d4fdc8b [project @ 2002-05-10 13:16:55 by simonmar] Add GHC/PrimopWrappers to EXTRA_SRCS 6d89b63 [project @ 2002-05-10 13:17:27 by simonmar] - Add documentation to Control.Concurrent and friends - Other documentation tweaks 6f9702f [project @ 2002-05-10 13:42:07 by simonmar] Add documentation 17d7506 [project @ 2002-05-10 14:51:14 by simonmar] Add some documentation for IORef 329155d [project @ 2002-05-10 14:52:00 by simonmar] give slurpFile, hGetBuf and hPutBuf reasonable behaviour for zero-sized files 75f4492 [project @ 2002-05-10 15:41:33 by simonmar] More documentation bcb5a52 [project @ 2002-05-10 16:18:28 by simonmar] More documentation d84005c [project @ 2002-05-11 08:59:08 by panne] Now that Int is exported, it might be a good idea to import it first... 88915b4 [project @ 2002-05-14 13:22:37 by simonmar] Replace qsort by mergesort, which is more reliable performance-wise. From: Ian Lynagh 3a440b1 [project @ 2002-05-14 21:08:59 by sof] lexNumberBase: support negative exponents f9650ca [project @ 2002-05-15 09:00:00 by chak] * Added the options `-ffi' and `-fffi', which switch on FFI support (`-fglasgow-exts' implies `-fffi'). 1b5a6b0 [project @ 2002-05-15 12:16:11 by simonmar] Fix non-Haddockish comments 1d0511c [project @ 2002-05-15 12:17:18 by simonmar] Fix comment to avoid confusing Haddock 1ce999f [project @ 2002-05-16 11:39:36 by simonmar] Happy -g currently requires GlaExts, which means it can't be used inside fptools/libraries (GlaExts comes from lang, and lang isn't built yet). So, until I've fixed Happy and everyone has built & installed the vnew version... e1e5818 [project @ 2002-05-27 14:30:49 by simonmar] Define __HADDOCK__ for .hs files as well as .lhs files. 7801cb1 [project @ 2002-05-27 14:31:06 by simonmar] Document Control.Exception and Data.Dynamic 4529737 [project @ 2002-05-27 14:36:51 by simonmar] Documentation 45c786b [project @ 2002-05-27 14:54:27 by simonmar] Add documentation af9b642 [project @ 2002-05-27 15:43:44 by simonmar] Documentation for System.Mem.Weak 8b2db71 [project @ 2002-05-27 15:57:01 by simonmar] Documentation, such as it is aedfb63 [project @ 2002-05-28 10:38:50 by simonmar] Document Text.Regex.Posix and Text.Regex 464de01 [project @ 2002-05-28 11:21:03 by simonmar] Add documentation 1b8ad7d [project @ 2002-05-28 11:21:56 by simonmar] tweak documentationa 119d39f [project @ 2002-05-28 11:41:29 by simonmar] Documentation tweaks cfd85d6 [project @ 2002-05-28 11:43:59 by simonmar] Export list tweak ca58f27 [project @ 2002-05-28 12:00:17 by simonmar] typo 59d3cc6 [project @ 2002-05-28 12:03:06 by simonmar] Document d5f23e5 [project @ 2002-05-28 14:04:18 by simonmar] Fix mistake in 'evaluate'. 47351d7 [project @ 2002-05-28 14:06:01 by simonmar] Add (minimal) documentation d9e75d6 [project @ 2002-05-28 15:04:54 by simonmar] Documentation b7e39d2 [project @ 2002-05-28 16:32:45 by simonmar] Documentation 34352f3 [project @ 2002-05-28 16:33:46 by simonmar] Documentation for the overloaded array interfaces (currently a bit flaky due to a couple of shortcomings in Haddock). a155a4f [project @ 2002-05-28 19:22:04 by sof] make it compile edd63fd [project @ 2002-05-29 13:22:10 by simonmar] Don't need to escape single quotes 99fb1fd [project @ 2002-05-29 13:27:04 by simonmar] fix case of markup inside bird tracks. 79f4ce8 [project @ 2002-05-29 13:28:36 by simonmar] doc fixes 6e681bc [project @ 2002-05-31 09:43:04 by panne] Added Show instance for FunPtr a85886b [project @ 2002-05-31 12:22:33 by panne] Moved Parsec to its new home 13a70d1 [project @ 2002-06-03 13:19:37 by simonmar] IO.hGetContents ==> System.IO.hGetContents (in docs) 7fa4fa4 [project @ 2002-06-04 19:12:53 by sof] PEi(x86) backends: The addition of Parsec to libraries/ put us over the limit for splitting HSbase into two parts (at least I couldn't find a good paritioning), we now need three. Fun and games. 2bf1f14 [project @ 2002-06-04 19:13:31 by sof] Adjust to three-way split of HSbase + accommodate cygwin. a734568 [project @ 2002-06-05 11:30:38 by ross] documentation adjustments. 62cf41f [project @ 2002-06-05 14:08:24 by simonpj] ------------------------------------------------ Fix the (new) lexer, and make the derived read and show code work according to the new H98 report ------------------------------------------------ 704ce13 [project @ 2002-06-06 16:01:37 by simonpj] Win32 comment c2841cb [project @ 2002-06-06 16:03:16 by simonpj] Read instance for Array, plus some documentation 72104bf [project @ 2002-06-08 13:11:27 by panne] Install HSbase3.o, too. NOTE: This is untested, but probably corrects the previous commit. 27473ce [project @ 2002-06-08 14:14:08 by panne] Minor doc formatting improvement 85947b6 [project @ 2002-06-09 14:20:06 by panne] Use :%, not % for Inf/NaN, the latter would immediately lead to a runtime error. Note that 6a18f39 [project @ 2002-06-11 10:53:03 by simonmar] typo in email address (noticed by J?n Fairbairn, thanks J?n). 37e6bac [project @ 2002-06-13 10:41:31 by simonmar] Some extra docs, from Jon Fairbairn 326ca1a [project @ 2002-06-13 23:26:55 by sof] Provide STRefs over both lazy and strict ST monads as, 38ef02a [project @ 2002-06-14 08:17:08 by simonpj] Add comment 85e48ad [project @ 2002-06-18 09:31:05 by simonpj] -------------------------- Deal with NaN and Infinity -------------------------- 23e923d [project @ 2002-06-18 13:01:43 by simonmar] Fix bug in the implementation of hGetLine: on finding the EOF when we have a partial line in our hands, we weren't resetting the state of the buffer to empty, so the same partial line would be returned for each subsequent call to hGetLine. 301802f [project @ 2002-06-18 13:58:22 by simonpj] --------------------------------------- Rehash the handling of SeqOp --------------------------------------- 238e58e [project @ 2002-06-19 14:33:24 by simonmar] Remove this hack. Happy 1.13 is now required to build GHC. b3f7a16 [project @ 2002-06-20 13:54:40 by simonmar] Add license from Andy Gill's HTML library 26b212c [project @ 2002-06-20 14:56:11 by malcolm] Remove spurious comma in export list. b32e15d [project @ 2002-06-20 16:11:45 by simonmar] use $(includedir) and INSTALL_INCLUDES rather than overriding $(datadir) 73210e5 [project @ 2002-06-20 16:12:58 by simonmar] Haddock stuff has moved to ../../mk/package.mk 0da7603 [project @ 2002-06-21 09:12:37 by simonmar] Andy Gill asked me to remove his license to keep things simple. 555ccfc [project @ 2002-06-21 14:00:32 by simonmar] Mention the package name in the Haddock title ea25fea [project @ 2002-06-24 14:40:02 by simonmar] Makefile updates for generating docs with Haddock: 56b5187 [project @ 2002-06-26 08:18:45 by stolz] - Make TSO "stable" again: The thread label was changing the size of the TSO if you were building a debugging-RTS, leading to binary incompatibility. Now we map TSOs to strings using Hash.c. 7158d54 [project @ 2002-06-27 13:40:37 by stolz] - forkProcess[Prim] wrapper - document forkProcess[Prim] & labelThread 4e7a0c7 [project @ 2002-06-27 15:38:58 by simonmar] Finally fix foreign export and foreign import "wrapper" so that exceptions raised during the call are handled properly rather than causing the RTS to bomb out. 92b386e [project @ 2002-06-27 17:19:01 by sof] theStdGen: initialise it via mkStdRNG (as was done in <= 5.02) 0ca4afd [project @ 2002-07-01 11:37:35 by simonmar] Replace divInt# with a version which doesn't suffer from overflow problems (thanks to Dylan Thurston for the code). 8a59647 [project @ 2002-07-01 18:50:54 by sof] closesocket() is stdcall-based b86afd9 [project @ 2002-07-02 10:28:54 by simonmar] Documentation for hSetBinaryMode 8ea1560 [project @ 2002-07-02 10:31:35 by simonmar] Documentation for system 42df532 [project @ 2002-07-02 10:33:23 by simonmar] Documentation for getProgName. eb74c19 [project @ 2002-07-02 10:34:52 by simonmar] Point the punters to the online report at haskell.org until the documentation for the Prelude is up to scratch. 3f4ad5d [project @ 2002-07-02 13:13:36 by simonmar] Add descriptions to the top level of each package documentation be5e68d [project @ 2002-07-03 13:05:28 by simonmar] Export dynApply and dynApp a79716a [project @ 2002-07-04 10:42:32 by simonmar] Explicitly import the Prelude, and add a few types signatures to make these modules produce better documentation. ab6d22d [project @ 2002-07-04 12:57:39 by simonmar] We have to define _POSIX_PTHREAD_SEMANTICS on Solaris in order to get the right versions of the _r functions. Otherwise we get Solaris-specific versions of these, which puts a spanner in the works. 2b24ca8 [project @ 2002-07-04 13:33:24 by simonmar] Sigh, enabling _POSIX_PTHREAD_SEMANTICS causes the Solaris header files to drop several silly little C functions into the source code. We don't want these duplicated in every Haskell-compiled object. 99abeb9 [project @ 2002-07-04 16:22:02 by simonmar] Flesh out the documentation a bit. cbfc311 [project @ 2002-07-08 10:43:10 by simonmar] Fix a bug in getDirectoryEntries where the directory stream wasn't always being closed. This one shows up on Solaris as a "too many open files" failure when trying to run the test suite. 21101cc [project @ 2002-07-15 12:25:24 by simonmar] Remove duplication in the extra_libraries list for mingw32 54be0e0 [project @ 2002-07-15 16:02:11 by simonmar] Remove for extra commas in export lists (GHC is a little too lenient). Patch from Ross Paterson. 2726d8d [project @ 2002-07-15 16:15:14 by simonmar] extra comma in export list 2fc64f6 [project @ 2002-07-16 15:47:25 by ross] First stage of making the new libraries work with Hugs: 62fbfbb [project @ 2002-07-16 16:08:58 by ross] Add imports of Hugs.* modules (wrapped in #ifdef __HUGS__) to make these modules work with Hugs. 1c817f8 [project @ 2002-07-16 22:42:28 by sof] handleFinalizer: (also) use the handle's type/state to decide whether or not go ahead with close()ing. 3440daa [project @ 2002-07-17 09:22:20 by simonmar] Need to #include now that Stg.h doesn't. f471318 [project @ 2002-07-17 10:47:01 by ross] Make the libraries' Numeric module usable by Hugs. Also deleted a chunk of code inside #ifdef __HUGS__ -- this was unused, and the copy in Hugs (now Hugs.Numeric) has since been improved. (Since these functions are portable, ideally they would be merged with the versions in GHC.Float) f9b1dab [project @ 2002-07-18 22:01:07 by sof] helper functions for mucking about with Win32 consoles 7c948d6 [project @ 2002-07-18 22:01:50 by sof] win32 console-based implementations of setCooked, {get,set}Echo 674f4cc [project @ 2002-07-22 11:37:38 by ross] Make Data.Array.{IArray,MArray,IO,ST} work with Hugs, splitting off the IOArray part of Hugs.IOExts into Hugs.IOArray and (sadly) adding Hugs.Array.Base, a cut-down version of Data.Array.Base. c22589f [project @ 2002-07-22 13:30:43 by simonmar] Make the new mergesort stable. 4edbab6 [project @ 2002-07-23 10:46:27 by ross] Make Data.Unique work with Hugs. 5e3b441 [project @ 2002-07-23 14:52:46 by simonpj] Various precedence errors in the code for read and show. A couple (the show instances for Ratio and Array) were actually errors in the Library Report. A couple more were to do with whether the precedence of application is 9 (wrong) or 10 (right). f212d46 [project @ 2002-07-23 18:50:54 by sof] gmtoff: MS CRT implementation of _tzset() (and _timezone) assumes that >0 represent positions west of the Prime Meridian. This module assumes the opposite, so flip the sign of 'timezone' when compiling for mingw. 1089f6c [project @ 2002-07-23 22:04:36 by sof] inputReady(): using MsgWaitForMultipleObjects() instead of WaitForMultipleObjects() on file handles is nicer from within a message pump, but here it is less confusing to use the latter (and simply just block message delivery for its duration.) edb47ef [project @ 2002-07-24 09:57:21 by simonmar] tiny doc fixes 244cd16 [project @ 2002-07-25 14:14:36 by simonmar] Fix comment typos, from Reuben Thomas. f4692eb [project @ 2002-07-26 02:36:57 by sof] gmtoff: according to the (POSIX / Single Unix and MSVC) documentation of tzset(), 'timezone' is > 0 west of the Prime Meridian, so extend prev. commit to apply to all platforms, not just Win32. 0f3b6b1 [project @ 2002-07-26 10:05:04 by stolz] Add some references. Requires upgrade to current haddock version (>2002-7-25)! e75e1bb [project @ 2002-07-26 12:12:33 by stolz] Fix typo. 35d3afc [project @ 2002-07-26 13:23:38 by malcolm] Must start tweaking the libraries for NHC soon. 74bb702 [project @ 2002-07-29 09:54:40 by ross] Tweaked imports and includes for compatibility. 8a3d33f [project @ 2002-07-29 09:57:17 by simonmar] Remove non-existent and empty dirs from $(ALL_DIRS) 3be2ff0 [project @ 2002-08-01 12:50:31 by simonpj] Add parens to make precence clear 92a3d30 [project @ 2002-08-02 12:24:36 by simonmar] I can get away without -monly-3-regs for this file, now that GHC is passing -fno-builtin to gcc. 45e4c5f [project @ 2002-08-02 12:25:30 by simonmar] Don't need -monly-3-regs now. 7b56e9f [project @ 2002-08-02 12:26:36 by simonmar] Don't need -monly-3-regs now 1d084ab [project @ 2002-08-03 19:32:16 by reid] Changes to make libs work with Hugs/FFI. 823938f [project @ 2002-08-03 19:32:49 by reid] Oops f8650f2 [project @ 2002-08-03 20:14:23 by reid] oops again 71c1629 [project @ 2002-08-03 21:01:26 by reid] Final bout of changes to make things work with Hugs. a62c4c6 [project @ 2002-08-03 21:33:15 by reid] Directives like this a312934 [project @ 2002-08-05 08:29:17 by simonmar] Add missing GHC imports c49948b [project @ 2002-08-05 08:44:53 by simonmar] Move the import of System.IO.Unsafe into the #else part of #ifdef __GLASGOW_HASKELL__, because it was causing an import loop. (Alastair: that #else should probably be #elif __HUGS__, right?) 61b9f39 [project @ 2002-08-05 08:48:07 by simonmar] Remove the literate bits from this file: I'm trying to keep .lhs out of the non-GHC parts of the libraries tree, we don't use it any more and it clutters up the code. 56800ce [project @ 2002-08-07 12:17:59 by ross] Renamed HugsStorable -> Hugs.Storable (copy of lib/exts/HugsStorable.hs) b271ab1 [project @ 2002-08-08 06:25:05 by ross] Add hTell to Hugs. 535df85 [project @ 2002-08-08 22:29:28 by reid] Hugs provides makeForeignPtr instead of newForeignPtr. f379522 [project @ 2002-08-16 11:38:04 by simonmar] Data.Array.IArray should export Array too 70c3686 [project @ 2002-08-16 11:38:57 by simonmar] Some extra docs for addFinalizer, describing why using addFinalizer on a ForeignPtr isn't the same as using addForeignPtrFinalizer. 166a9e1 [project @ 2002-08-20 10:03:05 by simonmar] The Typeable instances were missing in the __GLASGOW_HASKELL__ case; add them. 0d287e0 [project @ 2002-08-21 10:43:22 by simonmar] Oops, unpackCStringUtf8# had rotted at some point, and no-one noticed. Some parentheses are required because the relative precedences of uncheckIShiftL# and +# (the default precedences, AFAICT) give the wrong meaning to some expressions. 8479863 [project @ 2002-08-23 22:10:43 by sof] ioeGetErrorString: don't "show" the string from a user error. 80972f6 [project @ 2002-08-25 09:16:07 by panne] Fixed bug in documentation introduced by "Mr. Haddock" himself. :-) 5c3189f [project @ 2002-08-27 14:44:31 by simonmar] We really should export the representations of Ptr and FunPtr from here. 1d36d59 [project @ 2002-08-28 13:59:19 by simonmar] - Move rawSystem from SystemExts to System.Cmd. - Move withArgv and withProgName from SystemExts to System.Environment 9efe433 [project @ 2002-08-28 14:30:12 by simonpj] Fix a lexing bug: "\SOH" could mean "\SO" followed by "H" or "\SOH". The Report specifies the latter. 5634a8a [project @ 2002-08-29 05:11:41 by ross] The functions rawSystem, withArgs and withProgName aren't supported by Hugs yet. 3250e7a [project @ 2002-08-29 09:24:21 by simonmar] Move library-project documentation to a better place, and add the current hierarchy spec. c50828c [project @ 2002-08-29 11:29:40 by simonmar] Foreign.C.TypesISO has been merged into Foreign.C.Types now. a0dfc75 [project @ 2002-08-29 11:49:10 by simonmar] Make the readline binding into a hierarchical library and put it in its own package (for licensing reasons). f5515f7 [project @ 2002-08-29 16:03:57 by stolz] Add replicateM[_] and foldM_ e2e8a57 [project @ 2002-08-29 16:05:59 by stolz] Haddock-ise with comments from library report 88a5df2 [project @ 2002-08-29 16:39:42 by stolz] - Haddock-ise with comments from library report - The chapter "Deriving Instances of Ix" doesn't end up in the "Contents" section (yet), although it should. 24a67b4 [project @ 2002-08-30 07:56:48 by stolz] Fix sample way of expressing 'killThread' in docs. 4471d43 [project @ 2002-08-30 10:46:10 by stolz] Haddock-ised. The previous version already did contain a lot of documentation which just wasn't in the right shape. The current documentation diverges slightly from the Library Report. 51cf67a [project @ 2002-08-30 12:25:15 by stolz] Express 'killThread' in terms of 'throwTo' 5988a17 [project @ 2002-08-30 12:32:44 by stolz] - Haddock-ise with comments from library report - FIXME: Haddock doesn't support nested enumerations. 5e2bb8f [project @ 2002-08-30 13:00:31 by simonpj] Remove bogus parError; MERGE TO STABLE e9e064d [project @ 2002-08-30 13:27:42 by stolz] Haddock-ise. a11109e [project @ 2002-08-30 13:43:57 by stolz] Haddock-ise with comments from library report cd4a2f2 [project @ 2002-08-30 14:19:18 by simonpj] Extra space after $ to avoid conflict with Template Haskell 45d3a3a [project @ 2002-08-30 14:29:51 by simonpj] * Do not export built-in syntax (H98 conformance) * Add 'assert' to GHC.Base a0e9e3e [project @ 2002-08-30 14:54:58 by simonpj] Move defn of hs_fileno inside ifdef ca2e48f [project @ 2002-08-31 08:37:56 by simonpj] Remove GHC.Base.assert until I can figure out what happened 2e44135 [project @ 2002-09-02 11:20:50 by ross] Minor rearrangement: the implementation of System.Exit.exitWith is GHC-specific, while exitFailure is portable. 44aa638 [project @ 2002-09-02 16:33:31 by ross] non-GHC compilers should also import Numeric. e7478d9 [project @ 2002-09-02 16:40:55 by simonpj] Un-break head build due to (:) export 5f7d567 [project @ 2002-09-03 00:15:45 by mthomas] Mingw32 has no fcntl() - use _setmode() (twice) instead. 2ba2065 [project @ 2002-09-03 09:40:51 by simonmar] (%) should be infixl 7 (thanks to Jon Fairbairn for pointing out the omission) 465fec0 [project @ 2002-09-04 15:52:20 by simonmar] Remove some unnecessary imports db34f07 [project @ 2002-09-04 16:05:29 by simonmar] GHC can derive arbitrary instances for newtypes, so derive Storable for the types in Foreign.C.Types, rather than using CPP trickery to define the instances. 03d4d61 [project @ 2002-09-04 16:46:40 by ross] Fix typo. 054a65b [project @ 2002-09-04 16:51:33 by ross] Foreign.C.TypesISO needs to import Foreign.Storable. Also added some imports for non-GHC platforms. 6bcd915 [project @ 2002-09-06 14:08:45 by simonmar] Implement 700db30 [project @ 2002-09-06 14:34:15 by simonmar] Partial rewrite of the POSIX library. aaa77a2 [project @ 2002-09-06 14:38:15 by simonmar] Make it build on mingw32, with a cut-down set of types 8fb5d72 [project @ 2002-09-06 15:00:04 by simonmar] Disable the whole contents on mingw32. At some point we might be able to provide cut-down signal support, but I'll leave that for later. 049c328 [project @ 2002-09-08 02:35:33 by sof] Hugs updates + fixes eea0c94 [project @ 2002-09-09 03:50:38 by sof] (hugs only): PrelImpl -> Hugs.Prelude 0a678e9 [project @ 2002-09-09 15:13:47 by simonmar] Comments only a97b83b [project @ 2002-09-09 15:30:58 by ross] Hugs-only changes: explicit imports + use approxRational. 39e7414 [project @ 2002-09-09 16:04:10 by ross] More imports for non-GHC platforms. 2d8cdf6 [project @ 2002-09-10 09:06:07 by simonmar] Remove CBlkCnt and add it to the ToDo list; it clearly isn't present on several systems yet. Fortunately we weren't using it. c7f1b29 [project @ 2002-09-10 09:13:52 by ross] H98 conformance: fill out (..)'s, and make the [] export GHC-only. bd2c070 [project @ 2002-09-10 10:50:28 by malcolm] Export the builtin syntax for []((:),[]), ()(()), and (->) in nhc98 as well as ghc. bf8e196 [project @ 2002-09-10 11:07:23 by ross] #ifdef's for Hugs, which only allows one import in the Prelude at the moment. 6fb52f7 [project @ 2002-09-10 11:36:04 by ross] non-GHC: import Control.Monad (needed by INSTANCE_STORABLE). d0b54cd [project @ 2002-09-10 20:45:50 by panne] Fixed slashification in Haddock comment 9f63d16 [project @ 2002-09-11 11:06:05 by simonpj] Add documentation about unsafePerformIO d7fd415 [project @ 2002-09-13 18:21:46 by panne] It looks like we need assert again...?! f8df252 [project @ 2002-09-13 18:25:07 by panne] Not quite sure about this one: Export builtin stuff like [], (), and (->) only for NHC, not for GHC anymore. e90d876 [project @ 2002-09-14 09:27:21 by panne] Make Haddock happy 976f582 [project @ 2002-09-16 11:24:20 by simonpj] Comments only d7827d3 [project @ 2002-09-16 11:24:36 by simonpj] Fix bug in Read instance for Maybe 9415bd4 [project @ 2002-09-16 11:29:39 by ross] Moved some stuff from Hugs.Prelude to Hugs.Char. a938d52 [project @ 2002-09-18 11:32:43 by simonmar] Sort out the divide-by-zero situation. c4f6fb9 [project @ 2002-09-19 10:47:21 by simonmar] re-export unsafePerformIO c43c694 [project @ 2002-09-19 13:24:52 by simonmar] Put this below the Prelude in the dependency tree. I accidentally created a loop with the latest change to Foreign.hs; this fixes it. 4e07ae0 [project @ 2002-09-20 13:15:07 by ross] Make Data.Array.Base more portable (no semantic changes, I hope) by f50294a [project @ 2002-09-23 09:19:53 by ross] remove unnecessary #ifndef __HUGS__ 05b3352 [project @ 2002-09-24 16:07:50 by sof] ioeGetErrorType(error case): don't pose as ioeGetHandle. 5d5f213 [project @ 2002-09-24 19:01:55 by sof] userErrors: don't barf on non-IOExceptions. 835f33e [project @ 2002-09-25 15:16:30 by simonpj] Remove readList__ 06f1b3b [project @ 2002-09-25 15:24:07 by simonmar] Re-instate the checking for the values of errno constants at configure time. The problem with doing it using foreign calls is simply that this tickles a bad case in the code gen machinery, which in this case results in an extra 10-20k of goop ending up in pretty much every binary, and it impacts GC performance too. 466552f [project @ 2002-09-25 22:49:17 by ross] Hugs only (but being considered for the ffi spec): added finalizerFree, a pointer to a foreign function equivalent to free, for use as a finalizer. e31ee99 [project @ 2002-09-25 22:55:41 by ross] Switch to mallocForeignPtr. 205cbfc [project @ 2002-09-25 23:01:11 by ross] (Hugs only) conform to the current FFI spec. This code makes the additional assumption that a finalizer added with addForeignPtrFinalizer runs before any existing finalizers on the same object. dee5fa3 [project @ 2002-09-25 23:06:30 by ross] (Hugs only) use StorableArray as a poor man's IOUArray. 22c5ce6 [project @ 2002-09-26 09:16:33 by simonpj] Comments 888c28e [project @ 2002-09-27 23:10:23 by erkok] The MonadRec.hs library, stolen from the Hugs release. 718505a [project @ 2002-09-29 20:24:00 by panne] Warning police #1: Nuke duplicate export of CSsize(..) f41af17 [project @ 2002-09-30 10:27:49 by simonmar] s/rm -f/$(RM)/ 51f335d [project @ 2002-09-30 14:31:02 by ross] Portability tweak. 911cbab [project @ 2002-10-01 10:32:11 by ross] Hugs only: reinstate infix declarations. It seems the Hugs limitation this was working around no longer exists. aee388f [project @ 2002-10-01 15:58:11 by erkok] Merge Fix.hs with MonadRec.hs, and remove the latter. ae10d00 [project @ 2002-10-01 16:29:47 by ross] Removed the strict ST instance (already in Control.Monad.ST) and moved the lazy ST instance to Control.Monad.ST.Lazy, so Control.Monad.Fix contains only instances for Prelude types, and is portable. cef863d [project @ 2002-10-03 12:43:50 by panne] Warning police #4: To use uname, we should try to #include . f511a7a [project @ 2002-10-03 12:57:42 by panne] Warning police #5: Nuked duplicate exports, simplifying (i.e. nuking :-) the export list on the way. The deep and arcane reasons for the strange #ifdef-ery in this module are not clear to me, so I hope no damage is done by this commit. :-} 5b0420b [project @ 2002-10-03 13:04:58 by panne] Warning police #6: Add prototype for writeErrString__, which is used by GHC.TopHandler. 849b1ed [project @ 2002-10-03 13:29:07 by panne] Warning police #7: Improved typing of TSOs a bit, getting rid of a bunch of C compiler warnings. 0ea562e [project @ 2002-10-03 13:41:35 by panne] Warning police #8: Exporting Foo(..) exports Foo's field selector functions, too, so let's nuke the latter from the export list. e9443b3 [project @ 2002-10-03 13:56:12 by panne] Warning police #9: Nuked modules from the export list which are already implied by other exported modules. Still quite a few warnings left here, though... >:-( ea49782 [project @ 2002-10-03 15:19:15 by ross] Reinstate the exports of the function names, because the module must export them, even though Hugs doesn't define them here. The old module export they overlapped with was there to pick up the tuple definitions for GHC, but that probably isn't necessary with the recent GHC changes. 4f5dbdf [project @ 2002-10-08 08:03:01 by wolfgang] Make the new Posix bindings compile on Mac OS X. Most notable, Mac OS X lacks *) lchown *) SIGPOLL I don't know of a replacement of either, so they are just left out when they are not detected by configure. 325f7ec [project @ 2002-10-09 16:55:30 by malcolm] Add a little infrastructure for building the hierarchical libraries with nhc98. 5704a5d [project @ 2002-10-09 17:08:18 by malcolm] Add #ifdefs for nhc98. e3dec53 [project @ 2002-10-09 17:24:12 by malcolm] Add #ifdefs for nhc98. 3d893a1 [project @ 2002-10-11 11:05:20 by malcolm] Make some more libraries buildable with nhc98. b8d2aa7 [project @ 2002-10-11 12:23:41 by stolz] Add even more #ifdefs for nhc98. 1d28f2f [project @ 2002-10-11 14:33:58 by simonpj] Fix cpp syntax 461576b [project @ 2002-10-14 10:06:28 by ross] #ifdef tweaks a9a5413 [project @ 2002-10-16 13:48:24 by ross] Remove special treatment of Hugs. 490c1b8 [project @ 2002-10-18 09:51:04 by simonmar] Add atomicModifyIORef, as discussed on the FFI list. 52b26ba [project @ 2002-10-18 12:28:38 by ross] Hugs only: simple version of atomicModifyIORef, relying on the absence of preemption from Hugs. If Hugs gets Haskell finalizers, they'll have to be blocked during this operation. a1a1efb [project @ 2002-10-18 13:32:56 by simonpj] Move Typable IORef instance to Dynamic; stops IORef.hs being an oprhan module 8995f70 [project @ 2002-10-18 16:29:18 by malcolm] Implement atomicModifyIORef for nhc98. 3bdd406 [project @ 2002-10-22 10:59:40 by simonmar] Don't bogusly cast ThreadId# to Ptr (). The right way to fix these warnings is to change the type signatures of cmp_thread and rts_getThreadId to take StgPtr rather than StgTSO *, since the compiler now has no internal distinction between the two in the backend (it used to, but recent simplifications removed the distinction). cae97a5 [project @ 2002-10-24 07:49:40 by mthomas] Unchecked quick fix. Hope to test tonight after getting home. 2819cfe [project @ 2002-10-25 13:07:41 by sof] Only interested in a subset when used in w/ Hugs eaceaff [project @ 2002-10-30 14:53:39 by ross] #ifdef's for Hugs 95bf297 [project @ 2002-10-30 18:21:25 by ross] (Hugs only) fix silly slip in last commit. ca950ea [project @ 2002-11-02 11:56:30 by ross] Hugs only: export throwIO :: Exception -> IO a instead of a generalized ioError. This is an interim measure to keep Hugs working until it's decided what to do about IOError. ad6af6a [project @ 2002-11-06 10:38:16 by simonmar] - Add a Show instance for ForeignPtr 546ca2b [project @ 2002-11-06 20:30:26 by ross] Hugs only: move the dummy implementation of evaluate here, to avoid ambiguity. 508314c [project @ 2002-11-06 23:47:16 by ross] Minor #elif adjustment (__HUGS__ vs __NHC__). 2ca778b [project @ 2002-11-07 10:41:59 by stolz] - Explicitely document order of parameters in addToFM_C. fe0bb42 [project @ 2002-11-08 09:04:35 by simonpj] --------------------------------- Tiny H98 fix to numericEnumFromThenTo --------------------------------- b57bb87 [project @ 2002-11-13 10:35:18 by simonmar] Remove superfluous escaping of quotation marks in the example code (Haddock interprets bird-tracked code literally). 6952eca [project @ 2002-11-19 11:28:51 by simonmar] Doc fix for unsafeInterleaveIO 28d31e7 [project @ 2002-11-20 13:44:41 by simonmar] Allow opening a character special device; we treat it as a stream, even though it might be seekable. This allows opening /dev/stdin, /dev/null, etc. 5d7f1de [project @ 2002-11-20 13:45:20 by simonmar] Add experimental hDuplicate and hDuplicateTo. 8e0ccdb [project @ 2002-11-22 10:52:23 by stolz] Add 'mapException' as proposed in "A semantics for imprecise exceptions" 2d18757 [project @ 2002-11-26 17:32:33 by ross] added missing _ == _ = False to Eq Exception. 0f9d7cc [project @ 2002-12-03 14:30:12 by simonmar] Eeek! A nasty bug has been lurking in waitQSemN, which as far as I can make out has been there for ever. Presumably no-one uses this abstraction... a277cae [project @ 2002-12-05 09:49:38 by simonmar] annotateIOError was somehow missing from the export list... 69ee5e6 [project @ 2002-12-05 14:20:56 by stolz] Add SA_RESETHAND (aka SA_ONESHOT) support. Requested by: John Meacham 92aa54d [project @ 2002-12-05 14:44:02 by stolz] Don't forget peeking signal handlers (nothing to see here, please move along) 731590a [project @ 2002-12-11 15:55:17 by simonmar] Obj type must be forall a.a now, to avoid confusing GHC's new tail-calling scheme. 166bb30 [project @ 2002-12-11 16:12:22 by ross] non-GHC: keep the old definition of Obj. 8a2c46b [project @ 2002-12-12 13:29:07 by ross] Hugs only: add an import. 052e3a7 [project @ 2002-12-12 13:32:06 by ross] Add an import for Hugs, and change some #ifdef __GLASGOW_HASKELL__ to #ifndef __NHC__ 455d1bb [project @ 2002-12-12 13:42:46 by ross] Changes to the exception interface, as discussed on the libraries list. 20d5d21 [project @ 2002-12-13 13:36:36 by malcolm] Add #ifdef around import Control.Exception, which does not exist in nhc98. f757f3c [project @ 2002-12-13 14:23:42 by simonmar] Fix bugs caused by missing casts in arithmetic expressions in stg_integerToInt64 and stg_integerToWord64. 308112b [project @ 2002-12-16 11:00:53 by malcolm] Un-break for nhc98. `bracket' now comes from IO, not System.IO. 74357f5 [project @ 2002-12-18 10:34:28 by malcolm] Add a bunch more libraries to the nhc98 build. ec173cb [project @ 2002-12-18 10:42:09 by malcolm] Make it work with nhc98. 8f36daa [project @ 2002-12-18 10:42:54 by malcolm] With nhc98, avoid overlap between Prelude defns and Control.Monad defns. 215aa25 [project @ 2002-12-18 10:43:38 by malcolm] Make it compilable with nhc98, although for now it omits all instances. b7a79db [project @ 2002-12-18 10:45:31 by malcolm] Now compiles with nhc98. 233ac57 [project @ 2002-12-18 16:29:25 by simonmar] "Auto" packages. 661c373 [project @ 2002-12-19 15:23:29 by ross] #ifdef's for Hugs. 538a7bc [project @ 2002-12-19 22:04:41 by malcolm] Make it work with nhc98. 962cbf5 [project @ 2002-12-19 22:06:20 by malcolm] Add a couple more libraries for nhc98. 86c6983 [project @ 2002-12-20 09:31:11 by simonmar] Oops, forgot to commit this with the "auto packages" changes. We now have to -#include "HsBase.h" explicitly. As far as I can tell it was happening by accident before, as a result of the base package being enabled by default. dda6705 [project @ 2002-12-20 09:41:20 by simonmar] Remove c_uname from here, it isn't required in the base package baf09e2 [project @ 2002-12-20 17:56:21 by ross] Make Hugs use all of System.IO.Error. e05ec88 [project @ 2002-12-20 18:43:53 by ross] Hugs only: use new version of evaluate. b5d7f55 [project @ 2002-12-23 13:33:16 by malcolm] Ensure all the Storable instances are available in nhc98. 15abba8 [project @ 2003-01-02 23:49:32 by ross] Hugs only: #ifndef out the bits Hugs can't do. a9b8e21 [project @ 2003-01-06 14:30:12 by ross] Consolidate to a single version of trace (except that GHC has the post-hook). This version adds a newline, which the old Hugs and NHC versions didn't. da0b599 [project @ 2003-01-08 13:06:30 by simonmar] Alter the order of the argument to annotateIOError to match mkIOError and the FFI spec. 69c7fbf [project @ 2003-01-08 14:08:29 by simonmar] Fix annotateIOError (bug noticed by Ross Paterson). 7b028df [project @ 2003-01-13 11:32:00 by simonmar] Fix off-by-one in splitWithPS. 9a0eab7 [project @ 2003-01-13 11:42:16 by simonmar] UArrays should always be initialized with known elements, otherwise we can lose referential transparency: ad1956e [project @ 2003-01-16 14:38:40 by ross] remove spurious #ifdef __HUGS__ 68ca3cb [project @ 2003-01-17 14:52:17 by ross] Exchange some functions between System.Mem.Weak (portable) and GHC.Weak (not). 481069c [project @ 2003-01-21 16:33:20 by ross] add local definitions of unsafeIOToST and stToIO 7d7ea76 [project @ 2003-01-22 10:55:56 by ross] add mallocForeignPtrArray and mallocForeignPtrArray0 as per latest FFI draft. 82c232f [project @ 2003-01-22 10:56:27 by ross] use mallocForeignPtrArray from Foreign.ForeignPtr 35cb996 [project @ 2003-01-22 14:44:50 by ross] simpler swapMVar (like readMVar): no need to unblock for a return. 64d3b39 [project @ 2003-01-23 11:46:57 by ross] add Ord instance, as per FFI spec 8e100c7 [project @ 2003-01-23 17:45:40 by ross] Hugs now uses most of Control.Exception. 746c210 [project @ 2003-01-23 18:06:01 by panne] Added (not-so-standard ;-) support for pooled memory management. No GHC-specifics like the use of arenas yet... 91b17a6 [project @ 2003-01-24 14:04:41 by simonmar] - Generalise seq to allow an unlifted type in its second argument. This works because seq is *always* inlined and replaced by a case. af7bb6a [project @ 2003-01-24 15:18:46 by malcolm] Move the 'shiftL/R' and 'rotateL/R' variants to become methods of the Bits class. This gives an instance the choice of which methods (directional, or unified) to implement directly. (This change was agreed in Sept 2002, but is only being committed now.) 0c37c76 [project @ 2003-01-25 15:54:51 by wolfgang] This commit fixes many bugs and limitations in the threaded RTS. There are still some issues remaining, though. f37e84a [project @ 2003-01-28 11:07:39 by simonmar] Hand-optimised versions of pokeArray and pokeArray0 (selected via #ifdef __GLASGOW_HASKELL__). 69a9b1f [project @ 2003-01-28 11:09:41 by simonmar] Provide hand-optimised versions of all the functions herein, protected by #ifdef __GLASGOW_HASKELL__. 2d32e3a [project @ 2003-01-28 21:38:30 by panne] After trying out re-exporting Foreign.Marshal.Pool from Marshal, it became obvious that -fno-implicit-prelude would be a good idea. :-} Otherwise one gets cirular dependencies to the Prelude. Alas, fixing this resulted in some uglification of the code in some places... e9eab4b [project @ 2003-01-28 21:48:23 by panne] As agreed (= no riots after the proposal :-) on the FFI list, introduce a re-exporting module Foreign.Marshal 129756c [project @ 2003-01-29 07:54:46 by panne] Ooops, unbreak non-GHC targets... 79c99f2 [project @ 2003-01-29 14:28:47 by ross] fix typo that broke non-GHC impls. ee0c867 [project @ 2003-01-30 12:51:05 by ross] fix for non-GHC 5d6dd6b [project @ 2003-01-30 20:41:10 by panne] * Fixed the comment breakage of the previous commit (Haddock failure) * Synched signature comments in header with reality * Added default implementation of 'rotate' in terms of 'rotateL'/'rotateR' * Removed spurios "signed": What's a signed rotate or a signed left shift?? 7c070f2 [project @ 2003-02-04 11:55:54 by simonmar] Add support for using vfork, which I apparently removed when this file was moved over from ghc/lib/std/cbits. Using vfork on Linux makes quite a big difference - eg. when building GHC.Base with -split-objs , I saw a 2.5s reduction in system time. 36f5c2d [project @ 2003-02-06 10:41:10 by ross] Hugs-only: special definitions of fromInt & fromDouble. df20eb8 [project @ 2003-02-06 10:41:13 by simonmar] Aargh! We were setting the VMIN and VTIME values in the termios structure when the terminal is in non-raw mode, rather than raw mode, because I had a test round the wrong way. cd2140e [project @ 2003-02-14 13:01:32 by simonpj] Fix for deriving of records with leading underscore, and corresponding lex e561eac [project @ 2003-02-14 17:11:59 by sof] - add missing config.h include to Handle.hs - Handle.hSetBuffering: don't bother putting the handle's FD into 'raw' mode under Win32. 'raw' mode is just too specialised and potentially confusing (see comments.) 399d175 [project @ 2003-02-17 11:43:21 by simonmar] Comment wibble 7634c8a [project @ 2003-02-17 15:13:09 by simonpj] Type sig for getTag 0ea018d [project @ 2003-02-17 15:13:56 by simonpj] Wibbles to ST Monad methods; I forget why 73bcd44 [project @ 2003-02-18 20:15:15 by panne] * Fixed bug #687034 (GetOpt overly ambiguous) * Reformatted comment * Synch example with reality 341b99a [project @ 2003-02-18 20:39:56 by panne] Guerrilla tactics: Re-export Foreign.Marshal.Pool >:-) 418d748 [project @ 2003-02-19 13:54:19 by malcolm] Oops, the "directory-collecting" modules Foreign and Foreign.Marshal were accidentally omitted from the nhc98 build. 2b90d5e [project @ 2003-02-20 09:36:40 by malcolm] Add Foreign.Marshal.Pool to the nhc98 build. cb266c1 [project @ 2003-02-21 05:34:12 by sof] Asynchronous / non-blocking I/O for Win32 platforms. 08e5613 [project @ 2003-02-26 10:22:14 by simonmar] Add a note about the problem with forkProcess, for the time being. a3d4b34 [project @ 2003-02-28 12:34:43 by stolz] - Rename System.Posix.Process.forkProcess to forkProcessAll - Move GHC.Conc.forkProcess to System.Posix with type 'Maybe ProcessID' 6005584 [project @ 2003-03-04 11:09:15 by simonmar] Split Data.Array.IO into Data.Array.IO.Internals (which defines and exports the concrete representations of IOArray and IOUArray) and Data.Array.IO which exports the user-visible API. 49bd7a3 [project @ 2003-03-04 13:36:39 by ross] add an #ifdef __GLASGOW_HASKELL__ 5b12681 [project @ 2003-03-05 15:53:10 by malcolm] Build the hierarchical libraries from .hc files when building nhc98 from .hc's. 46738fd [project @ 2003-03-05 15:54:59 by malcolm] For nhc98, use nullPtr rather than 0 as the argument to time(). 05657aa [project @ 2003-03-06 09:51:03 by simonmar] Add Data/Array/IO to list of directories f3fdb22 [project @ 2003-03-08 19:02:39 by panne] Fixed some broken/redirected/canonicalized links found by a very picky link checker. 6690828 [project @ 2003-03-08 23:03:47 by panne] More markup fixes... a04d391 [project @ 2003-03-09 20:19:27 by panne] Fixed markup confusion ("" vs. '') 73e53bb [project @ 2003-03-11 18:41:43 by panne] Fixed link to getArgs c486ae0 [project @ 2003-03-12 16:42:27 by ijones] * Added more Haddock documentation to functions / classes / types * Added section headings for classes / types * Added an Examples section 2f9a2ea [project @ 2003-03-14 13:08:04 by simonmar] Attach the finalizer to the write side of a duplex handle, where it should have been. Otherwise finalization of duplex handles doesn't work properly. daf54e0 [project @ 2003-03-26 12:35:34 by simonmar] Add getrlimit()/setrlimit() suppport 640bba6 [project @ 2003-03-26 15:25:46 by simonmar] Change our ForeignPtr implementation to match the spec: finalizers must now be foreign functions. b5a75c9 [project @ 2003-03-27 10:24:43 by simonmar] [ oops, forgot to commit this with the rest of the changes yesterday... ] 7fdfbbd [project @ 2003-03-30 12:20:16 by ross] withForeignPtr is portable. So is some other stuff, though only Hugs uses the portable versions at present. b08edd6 [project @ 2003-03-31 13:58:03 by simonmar] - Add ioeSet{ErrorType,ErrorString,Handle,FileName} to match the existing ioeGet* functions. 789daa6 [project @ 2003-03-31 13:58:43 by simonmar] Get the filename right in IOErrors generated by several functions in here. 2bb2c9c [project @ 2003-03-31 15:36:24 by ross] remove a GHC-ism 26d6e1e [project @ 2003-04-01 16:30:37 by simonpj] Use INLINE rather than SPECIALISE for ceiling, floor, truncate c44d034 [project @ 2003-04-01 16:32:04 by simonpj] Fix bogus implementation of readLitChar, lexLitChar fb462ef [project @ 2003-04-03 16:46:59 by ross] Graph and Tree modules, from GHC's Digraph (actually the Haddock version, which looks more recent). 0c03a60 [project @ 2003-04-04 14:36:31 by simonpj] lexChar wibblifications 6af0d63 [project @ 2003-04-04 16:12:01 by ross] Added a list of the modules in the package that don't work with Hugs. Such modules are skipped by the conversion script. Packages in which everything works with Hugs don't need such a file. d436ec4 [project @ 2003-04-08 14:52:26 by ross] import tweak da40a2b [project @ 2003-04-08 16:02:05 by simonpj] New ReadP module from Koen, featuring <++ combinator b5a2ffd [project @ 2003-04-08 16:14:29 by simonpj] add fixity for +++, <++ f5331a7 [project @ 2003-04-09 08:17:39 by simonpj] Remove redundant Prelude import a7eeab6 [project @ 2003-04-09 08:18:13 by simonpj] ------------------------------------- Fix the lexer so that it does the right thing for floating point and hexadecimal numbers ------------------------------------- 1d9d3df [project @ 2003-04-09 10:21:09 by simonpj] Typo baa562c [project @ 2003-04-11 10:11:24 by ross] rename GHC.Posix as System.Posix.Internals 7572369 [project @ 2003-04-11 10:41:23 by ross] move #hide to where it works f191210 [project @ 2003-04-11 11:10:57 by ross] rename Control.Monad.Monoid as Data.Monoid cfd486f [project @ 2003-04-11 11:43:09 by ross] Hugs only: use the whole thing now e1e8556 [project @ 2003-04-11 14:24:07 by simonmar] Plug a file descriptor leak: when finalizing a handle, we should ignore errors in the flushing operation and go ahead and close the handle anyway. 8612742 [project @ 2003-04-11 23:39:43 by ross] Hugs only: add a CBITS "pragma" to tell the Hugs conversion script which files from /cbits should be linked with the module by ffihugs, e.g. {-# CBITS HsNet.c initWinSock.c ancilData.c #-} cd9fc2f [project @ 2003-04-15 10:41:14 by simonmar] Re-instate joinPS which appears to have been accidentally left out of this revised version of PackedString, and add unlinesPS and unwordsPS which are the analogs of Data.List.unlines and Data.List.unwords respectively. c5fba01 [project @ 2003-04-15 12:42:13 by malcolm] Add unlinesPS, unwordsPS, joinPS, and splitWithPS, to the nhc98 version of the code. b4d32d3 [project @ 2003-04-16 15:12:02 by sof] hGetArray: wrong result length returned. b3e4120 [project @ 2003-04-17 07:01:27 by simonpj] Start on better Typeable aa5e82f [project @ 2003-04-17 07:26:12 by simonpj] Better Haddock documentation 709486e [project @ 2003-04-17 10:44:59 by simonmar] Add a hash table implementation. This is an implementation of Dynamic Hash Tables, transliterated from the code in GHC's RTS into Haskell. I'd like to say it looks nicer, and well, maybe it does a little. a650a9f [project @ 2003-04-17 12:58:14 by mthomas] Fix "System/Posix/Internals.hs:273: Malformed entity string". cc08a0a [project @ 2003-04-17 13:26:59 by simonmar] Doc wibbles c6e4ceb [project @ 2003-04-17 15:17:07 by simonpj] Comments and imports 7e51e8b [project @ 2003-04-17 15:23:37 by simonpj] ---------------------------------- Implement Typeable properly ---------------------------------- 230207a [project @ 2003-04-17 16:51:43 by simonpj] Add lots of new generics stuff ba88be2 [project @ 2003-04-21 16:32:05 by ross] Hugs only: Key is defined in Hugs.Prelude (because it needs Dynamic) e9526a4 [project @ 2003-04-21 16:32:39 by ross] adjust imports for Hugs's benefit. 534944a [project @ 2003-04-22 09:19:24 by ross] remove an ifdef'd out commented out import. 2cccdd0 [project @ 2003-04-22 09:21:34 by ross] Hugs only: minor re-arrangement of ifdefs. 19d4641 [project @ 2003-04-22 10:20:30 by malcolm] Exclude Data.Dynamic from the nhc98 build now that it no longer compiles. (Need to investigate getting Data.HashTable to work.) 0782b94 [project @ 2003-04-23 10:27:53 by simonmar] hGetArray/hPutArray with a count argument of zero now just return doing nothing. This brings them into line with hGetBuf/hPutBuf and fixes a bug in Data.PackedString.hPutPS which fails on an empty string. 1276f4a [project @ 2003-04-23 13:22:16 by simonmar] Doc wibble. 5af9479 [project @ 2003-04-23 14:29:51 by malcolm] Tweak #ifdefs to make it compile with nhc98. 4bae1fc [project @ 2003-04-23 14:36:26 by malcolm] Add Data.HashTable, Data.Monoid, and Data.Tree to the nhc98 build, and re-instate Data.Dynamic, which now uses Data.HashTable. 9ac18b6 [project @ 2003-04-24 12:25:26 by malcolm] Add instances of Data.Bits.Bits for Int/Word[8,16,32,64] in a different way. The module Data.Bits is only available from the base package, which is normally added to the link line *before* the standard libraries, hence if the instances are in the latter, you get link errors. So move the instances into the base package where they belong, in NHC.SizedTypes. 062c551 [project @ 2003-04-25 10:23:29 by simonmar] doc fixes 304f7fe [project @ 2003-04-25 10:24:20 by ross] non-GHC: remove instances for Word ceed85a [project @ 2003-04-25 10:24:58 by ross] add Data.Array.Diff to Hugs d270f3d [project @ 2003-04-25 17:42:26 by ross] add System.Info to Hugs 492be53 [project @ 2003-04-25 17:43:06 by ross] tiny haddock fix 9d76081 [project @ 2003-04-28 09:16:47 by ross] portability fixes, plus marking these as non-portable (uses forall). 63c961b [project @ 2003-04-28 09:18:29 by ross] add Text.ParserCombinators.ReadP, Text.ParserCombinators.ReadPrec and Text.Read.Lex to Hugs. (But they're not used by Read, because that would make the Prelude non-H98). 27242f9 [project @ 2003-04-30 08:36:21 by simonmar] When doing hGetChar on a block-buffered handle, don't wait for the buffer to be completely full before returning a character. This behaviour seems more useful, and matches what hGetLine and hGetContents do. 11a8412 [project @ 2003-05-05 19:44:28 by ross] non-GHC: fill out the Bits instances for Int and Integer, and make them work with Hugs. c212e87 [project @ 2003-05-08 16:06:41 by ross] avoid a C compiler warning about arithmetic with void * 0327389 [project @ 2003-05-12 08:48:09 by ross] some re-arrangement for the benefit of Hugs. 01f10fd [project @ 2003-05-12 08:54:21 by ross] add Haddock markers e36cd23 [project @ 2003-05-12 08:55:53 by ross] remove #ifndef __HUGS__ f443dbb [project @ 2003-05-12 08:57:55 by ross] cosmetic change 0d3f287 [project @ 2003-05-12 10:12:52 by ross] Hugs only (I hope): add unboxed arrays to Hugs 165eca2 [project @ 2003-05-12 10:15:00 by ross] mark Text.Read as non-portable, and make a bit more available in Hugs. f93d66f [project @ 2003-05-12 10:16:22 by ross] documentation only: tag some things as "GHC only". 996fa5f [project @ 2003-05-13 11:42:47 by simonpj] Generalise the type of listens slightly; a suggestion from Tom Pledger 7af82b0 [project @ 2003-05-14 09:11:43 by ross] hide Foreign.Concurrent from Hugs a67cd92 [project @ 2003-05-14 09:12:27 by ross] comments 8210474 [project @ 2003-05-14 17:31:47 by ross] doc tweaks b2d709a [project @ 2003-05-16 10:14:22 by simonmar] Now that we have auto packages, it makes sense to keep all the interfaces for hierarchical libraries in the same directory tree. So now, instead of putting interfaces for package P in $libdir/imports/P, we put them all in $libdir/imports. af8613c [project @ 2003-05-17 00:11:29 by ross] Rename per-package configuration files from $(PACKAGE).conf.* to package.conf.*, making them easier to find (since each package is in a separate directory anyway). b839129 [project @ 2003-05-19 16:48:18 by ross] non-GHC (and non-NHC): simplistic implementation of byte array I/O. cf6f87d [project @ 2003-05-20 09:44:08 by stolz] Add missing 'Constr' for conOf/consOf in examples 78cf79f [project @ 2003-05-21 16:31:59 by ross] add finalizerFree :: FunPtr (Ptr a -> IO ()) ef702f5 [project @ 2003-05-22 06:37:08 by chak] The FFI Addendum requires `Foreign' to re-export `Data.Bits'. 66d09d1 [project @ 2003-05-22 08:20:38 by ross] trim import fa38f9c [project @ 2003-05-22 08:21:49 by ross] add Eq instance (explicit, so Haddock won't be confused) 69c5373 [project @ 2003-05-22 08:24:32 by chak] Added a `FinalizerPtr' synonym as in the FFI Addendum (RC 10). f597503 [project @ 2003-05-22 09:40:04 by ross] export architecture-dependent types opaquely. 5d58c57 [project @ 2003-05-22 09:55:56 by simonmar] Commit an off-by-one fix that I forgot about. bef202f [project @ 2003-05-22 10:59:47 by ross] unbreak for Hugs 7bbc1da [project @ 2003-05-23 08:59:46 by simonmar] Remove the words "A cool hack..." from the documentation of this module, since they refer to the implementation, not the API :-) 4a7c3de [project @ 2003-05-23 10:12:28 by ross] hide GHC.PrimopWrappers from Haddock. a24461b [project @ 2003-05-23 10:13:33 by ross] fix header comment 1bf8174 [project @ 2003-05-23 10:21:27 by simonmar] Hide this module in the Haddock docs. 5561861 [project @ 2003-05-23 10:48:55 by ross] replace deriving Eq with explicit instance (twice) because Haddock's limited understanding of derived instances can't figure out these two. 3f88528 [project @ 2003-05-27 08:03:46 by stolz] GCC 3.3 cpp wibbles fdabd46 [project @ 2003-05-27 08:46:38 by malcolm] For nhc98, like hugs, re-export sum and product from the Prelude. e18c72b [project @ 2003-05-27 09:48:13 by ralf] Simplified type of gunfold (removed last arg.) And cosmetics. 9ab599d [project @ 2003-05-27 16:57:09 by malcolm] Unbreak for nhc98, after the addition of FinalizerPtr as a type synonym, and the change of Foreign.C.Types to export all newtypes abstract. 252a50d [project @ 2003-05-29 14:39:31 by sof] Support for interop'ing with .NET via FFI declarations along the lines of what Hugs98.NET offers, see 1f36871 [project @ 2003-05-29 17:37:17 by malcolm] For nhc98 only, export the basic C types non-abstractly. This is due to a deficiency in the way newtypes are handled in interface files - the compiler needs full information about the newtype in order to pass values across the FFI. 0a86d61 [project @ 2003-05-30 09:19:39 by simonpj] Stop omitting Data.Generics from Haddockising, now that suitable #ifdefs make it go through. 100b8c8 [project @ 2003-05-30 21:59:44 by ralf] Major clean-up; would have been nice in GHC 6.00 86d21b4 [project @ 2003-06-01 17:20:02 by ralf] Minor revision; extension. (customised gread/gshow for String; add a generic count to be used in the definition gtypecount, gnodecount; added a mkF to use const mzero as default and not as in the case of mkM; added a gmapF which is monadic but tries to recover from failure while stile insisting on at least one successful immediate subterm; cosmetics) b75c2ff [project @ 2003-06-02 14:32:14 by simonpj] Add (<++) 1d32e8c [project @ 2003-06-03 22:26:44 by diatchki] Added a first version of the new monad library (experimental). Hopefully one day the "X" will disappear. 4b4a82f [project @ 2003-06-04 14:52:09 by ralf] Made gread a bit more robust; some renaming of new stuff; add more comments to implementations; added a bit more illustration of gunfold; added or/choice operators 0ed1528 [project @ 2003-06-05 00:49:31 by diatchki] a huge commit. 47dbfb0 [project @ 2003-06-05 13:42:51 by ralf] Add listify; other minor revisions. d5f6e0d [project @ 2003-06-12 10:31:29 by malcolm] For nhc98, temporarily make foreignPtrToPtr an alias for unsafeForeignPtrToPtr until ghc and hugs catch up. 86380ee [project @ 2003-06-12 10:53:15 by simonmar] Update to latest revision of the FFI spec: 3a3ce8e [project @ 2003-06-12 10:55:57 by malcolm] For nhc98, define mallocForeignPtr and friends. 3e0b191 [project @ 2003-06-12 10:59:00 by malcolm] ... and add newForeignPtr_ for nhc98. 5220c9a [project @ 2003-06-12 12:55:27 by ross] move portable newForeignPtr from GHC.ForeignPtr to Foreign.ForeignPtr a997117 [project @ 2003-06-12 15:15:23 by simonmar] exitWith should be using throwIO not throw. b915bd0 [project @ 2003-06-12 16:06:06 by simonmar] Change the type of System.Cmd.rawSystem: 31a8fed [project @ 2003-06-16 08:02:09 by simonpj] Add Haddock docs, courtesy of Hal Daume 5ab0e8f [project @ 2003-06-18 08:06:00 by stolz] fork() never returns with EINTR 35e9537 [project @ 2003-06-19 09:32:04 by wolfgang] fix misleading typo in comment 7b825a4 [project @ 2003-06-19 10:38:15 by simonmar] Fix Windows build 074974b [project @ 2003-06-19 10:42:26 by simonmar] Add raiseIO# primop. 172fb88 [project @ 2003-06-19 12:55:09 by simonmar] Fix typo in doc string c566c0a [project @ 2003-06-19 13:04:49 by simonmar] Following near-silence on the libraries list, add 586cebc [project @ 2003-06-19 13:20:37 by simonmar] Fix reallocBytes: when size is zero, it is supposed to act like free. Which it did, except that we were complaining about the NULL return value from C's realloc and reporting it as an error. 8fc7c0a [project @ 2003-06-20 14:42:03 by ross] Hugs only: no hSetBinaryMode 305fb87 [project @ 2003-06-21 20:21:04 by malcolm] Exclude openBinaryFile etc from nhc98 build until we implement it. b233cd1 [project @ 2003-06-22 09:24:23 by ross] Hugs only: import throwIO 722b66b [project @ 2003-06-24 09:40:51 by stolz] Pick up openFileEx/openBinaryFile change in error message 48b38fa [project @ 2003-06-30 14:08:24 by stolz] Duplex Handles are writeable. 6994bc1 [project @ 2003-07-02 13:27:35 by stolz] fork() never returns with EINTR 7c521d9 [project @ 2003-07-03 15:22:04 by sof] [mingw only] asyncDoProc :: FunPtr (Ptr a -> IO ()) -> Ptr a -> IO () cfe0bae [project @ 2003-07-08 15:46:40 by panne] Fixed some Haddock links. f09bc1c [project @ 2003-07-08 16:04:54 by panne] Export TestResult, too 022b889 [project @ 2003-07-08 16:22:52 by panne] Fixed some more Haddock links. 75131ee [project @ 2003-07-10 19:25:58 by sof] For System.Directory.renameFile on Win32 platforms, implement the Haskell98 semantics of replacing the target file if it already exists (i.e., file/directory renaming is now done by dirUtils.c:__hscore_renameFile().) 897b35b [project @ 2003-07-16 10:46:29 by panne] Build Control.Monad before Data.HashTable, the latter depends on the former. Shouldn't the build system know about that automatically? 78662c8 [project @ 2003-07-16 10:55:20 by simonmar] - Make showHex and showOct match the report (don't add leading "Ox" or "Oo"). 1825139 [project @ 2003-07-16 17:46:52 by sof] [win32]asyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int cafacc0 [project @ 2003-07-21 09:26:23 by simonmar] Fix showIntAtBase to match the report. Its signature was previously 24a1332 [project @ 2003-07-21 13:21:02 by malcolm] > Build Control.Monad before Data.HashTable, the latter depends on the > former. Shouldn't the build system know about that automatically? 5b50727 [project @ 2003-07-21 16:50:20 by simonmar] GHC's instance Show Handle is wrong, because it is impure. This commit makes the Show instance pure by restricting what it shows to just the filename. 989ce50 [project @ 2003-07-22 09:55:05 by ross] jiggle to make System.Posix.Directory work for Hugs 8bd5462 [project @ 2003-07-22 12:55:50 by simonmar] Export hShow (GHC only for now). c064f2f [project @ 2003-07-22 14:38:02 by simonpj] Remove out-of-date apology about mkTyConApp; merge to stable c625c89 [project @ 2003-07-23 10:27:49 by wolfgang] Fix regular expressions for Mac OS X. e8f520f [project @ 2003-07-23 15:39:54 by simonmar] GHC/PrimopWrappers.hs fix for BootingFromHc 94ddad9 [project @ 2003-07-24 07:49:33 by simonpj] A gross hack to stop the pretty-printer going into an infinite loop. What happens is that 'indent' is given a negative number, and that made it loop. This patch checks for the negative case, so at least it doesn't loop -- but I don't understand why the indent ever goes negative, so there's still something wrong here. 0c3ad5b [project @ 2003-07-24 10:41:38 by simonpj] Add more comments b0d6404 [project @ 2003-07-24 12:05:42 by panne] GCC 3.3 is a bit picky about macros with a varying number of arguments, even when they are skipped. Strange... 88738f0 [project @ 2003-07-24 12:19:57 by ralf] Major refactoring of Data/Generics. This also affects the compiler (because of deriving issues). This is an intermediate commit. The library is supposed to compile fine. But the deriving stuff for Data needs to be revised. The testsuite for Data/Generics will not pass. gread is broken at the moment. So it is strongly recommended not to cvs upd for a few hours or a day. 02c4a38 [project @ 2003-07-24 13:53:20 by simonmar] Make pre-processing primops.txt from this directory work properly. 97630a1 [project @ 2003-07-24 14:20:23 by panne] Quick fix from Ross to get the Hugs builds working again. I'm not sure what the right fix is, e.g. is moving sameType to Data.Types enough? f08ff98 [project @ 2003-07-24 15:13:44 by ross] exclude Data.Generics.* from Hugs 0e0f869 [project @ 2003-07-24 15:28:06 by simonpj] Minor bugs in generics 10e9834 [project @ 2003-07-24 16:24:21 by ralf] Addressed Ross' concerns as follows: Included all of Data/Types.hs into Data/Typeable.hs. It really makes sense there anyway. 4a111aa [project @ 2003-07-25 10:03:51 by simonmar] regcomp: don't attach the regfree finalizer if c_regcomp failed. 4d056a8 [project @ 2003-07-25 14:36:38 by ralf] Data.Generics is up and running again! 0ee5e70 [project @ 2003-07-25 15:03:38 by simonpj] Wibbles to gread; Ralf to check d10c94c [project @ 2003-07-26 12:43:58 by ralf] Renamed Data/Generics/Strings to .../Text. Implemented generic read by using Text/ParserCombinators/ReadP. This is now how it really should look like. Did some more refactoring in the modules of Data/Generics. I consider the library relatively stable by now. Very experimental stuff is only in Data/Generics/Reify.hs 4ce37be [project @ 2003-07-28 12:11:46 by malcolm] Use new Data.Dynamic/Data.Typeable story in nhc98. e7a4f9e [project @ 2003-07-28 15:03:05 by panne] Markup fixes 9b454a7 [project @ 2003-07-29 12:03:13 by ross] trim imports e6b1378 [project @ 2003-07-29 12:36:52 by ross] exclude Data.Generics.* 6d7174b [project @ 2003-07-30 08:13:16 by ralf] Rolled back to newtype now that the compiler does not panic anymore for the module Data/Generics/Text.hs. 62ae5db [project @ 2003-07-31 09:28:47 by ralf] Cosmetic changes. Documentation of Data.Generics at http://www.cs.vu.nl/boilerplate/ is now also again well in line with the major revision of Data.Generics from last week. 593d4c8 [project @ 2003-07-31 10:48:50 by panne] Merge Foreign.C.TypesISO into Foreign.C.Types 4621466 [project @ 2003-07-31 17:45:22 by ross] move Parsec out of base into a package parsec (no code changes) a846994 [project @ 2003-08-01 09:59:04 by ross] tiny doc fix 4aa9bf5 [project @ 2003-08-01 10:00:48 by ross] Swapped argument order of `newForeignPtr' and `addForeignPtrFinalizer' to track FFI spec. (Maybe the Conc ones should do the same?) c8c0f59 [project @ 2003-08-01 15:56:11 by panne] Warning police 601e1a8 [project @ 2003-08-04 10:05:32 by ross] docs copied from the report 2cbd887 [project @ 2003-08-04 13:49:28 by panne] Fixed hyperlink for exitWith a66e620 [project @ 2003-08-04 14:41:55 by simonmar] Make a bunch of foreign imports "unsafe". f8581c1 [project @ 2003-08-04 14:47:37 by panne] Fixed hyperlink 7d58a6f [project @ 2003-08-04 17:30:53 by panne] Fixed hyperlink (at least for GHC docs :-) a8f1379 [project @ 2003-08-04 17:52:33 by panne] Synched comments with reality dcf4c0d [project @ 2003-08-04 18:07:49 by panne] Export ReadS from Text.ParserCombinators.ReadP, curing CPP trickery a bit 624f829 [project @ 2003-08-04 18:20:44 by panne] Ooops, forgot one link in the last commit... eddc275 [project @ 2003-08-04 18:40:47 by panne] Export HandlePosition 2526ab0 [project @ 2003-08-05 12:13:29 by panne] Moved QuickCheck into separate package 0d10d74 [project @ 2003-08-05 17:16:16 by ross] adjust exclusions for Hugs bdf2b17 [project @ 2003-08-05 17:24:40 by ross] add type signatures for Haddock's benefit 8c6764c [project @ 2003-08-05 17:25:30 by ross] fix some identifier links 9233f90 [project @ 2003-08-08 10:55:22 by malcolm] Adjust the default search path for building library packages with nhc98. 748af71 [project @ 2003-08-11 13:18:22 by ross] expose unsafeInterleaveIO to Hugs 73e2796 [project @ 2003-08-11 18:39:56 by ross] rename the cute presentations and use derived instances of Read and Show, as suggested by Tomasz Zielonka. d052d71 [project @ 2003-08-18 12:46:21 by panne] Revamped altzone detection. Note that we test only for successful compilation now, not for successful linking, but this is what most autoconf macros do. 49cf969 [project @ 2003-08-19 16:33:03 by simonmar] Fix incorrect Haddock syntax 70cce88 [project @ 2003-08-19 16:34:11 by simonmar] Fix reversed flag in mkRegexWithOpts fbf9b82 [project @ 2003-08-19 16:39:13 by simonmar] Use the wide-char classifications from the C library if available. This gives us Unicode-aware isLower, isUpper, isAlpha etc. 7c64b6c [project @ 2003-08-20 10:22:44 by simonmar] Use the wide-char classifications from the C library if available. This gives us Unicode-aware isLower, isUpper, isAlpha etc. 7c8d57b [project @ 2003-08-20 15:44:19 by panne] * Cleaned up FP_CHECK_ALIGNMENT test a bit. d054690 [project @ 2003-08-20 15:54:45 by panne] Nuked FPTOOLS_O_BINARY test and use FP_CHECK_CONST instead, which is shorter and better (e.g. cross compilation). 217cc5b [project @ 2003-08-22 08:58:30 by panne] Added a workaround for the Haddock problems introduced by the circular module dependencies regarding Unicode handling. cb45254 [project @ 2003-08-22 22:11:03 by sof] [GHC only]: Added missing 'config.h' #include ; needed by getProgName dae31cb [project @ 2003-08-22 23:44:40 by sof] pin better location info on IOErrors 3848b26 [project @ 2003-08-23 00:08:02 by sof] [win32]renameFile: Try bridging between GetLastError() error values and the errno-based error handling code in System.Directory. As was, errors ended up being reported as 'no errors'. 63c2b2f [project @ 2003-08-23 10:25:52 by ross] non-GHC only: hide functions defined in the Prelude f14d763 [project @ 2003-08-26 10:39:55 by ross] Document Data.Char from the H98 Report. 11d035d [project @ 2003-08-26 20:41:46 by ross] Hugs only: remove unused argument from toClockTimePrim ab2c656 [project @ 2003-08-27 08:41:07 by simonmar] Remove duplicate type signature d25661c [project @ 2003-08-27 11:03:44 by simonmar] isSpace should only recognise Latin-1 whitespace characters, according to the report. 59ad9e9 [project @ 2003-08-30 12:26:56 by ross] docs for System.IO.Error 0522e14 [project @ 2003-08-30 22:55:42 by ross] docs for System.Environment & System.Exit 785b037 [project @ 2003-08-30 23:01:48 by ross] minor haddock fixes e72a1e9 [project @ 2003-08-31 18:41:28 by ross] doc tweaks cb41e77 [project @ 2003-09-01 09:12:02 by ross] H98 docs for Data.List f0be11e [project @ 2003-09-02 15:31:02 by malcolm] For nhc98, take the corrected (thanks to Ross Paterson) version of fixIO from NHC.IOExtras. 03bef66 [project @ 2003-09-02 16:07:08 by ross] Deal with systems on which PATH_MAX is undefined, e.g. systems with unlimited path length, like the Hurd (also faulty installations of gcc on Solaris). In fact getCurrentDirectory only needs a long path size to use as a first approximation, so give it that. c4723c7 [project @ 2003-09-03 10:49:19 by simonmar] inputReady(): the time calculation for select() was wrong, forgetting to multiply the milliseconds value by 1000 to get microseconds. da79ff3 [project @ 2003-09-05 15:06:48 by ross] doc tweaks cd0aded [project @ 2003-09-05 17:36:40 by ross] minimal docs 82ea78e [project @ 2003-09-08 14:14:37 by simonmar] Doc wibbles 1a92b1b [project @ 2003-09-08 16:23:57 by ross] ST doc adjustments 012b14c [project @ 2003-09-10 11:46:58 by simonmar] The finalizer for a ForeignPtr created with mallocForeignPtr better "touch#" the MutableByteArray# after running the other finalizers, otherwise the memory might be garbage collected before we've finished running the finalizers. d223107 [project @ 2003-09-10 14:45:24 by simonmar] Quick hack to work around the dynamic exception crashes in GHCi. The problem is this: the Data.Typeable library (Data.Dymamic in previous versions of GHC) maintains an internal cache mapping type names to unique numbers, and this cache is used for fast comparisons on TypeReps. In GHCi, there are actually two versions of the Data.Typeable library loaded: one linked to GHCi itself, and the other dynamically loaded, so there are two copies of the hash tables. 5d16c9d [project @ 2003-09-12 12:29:43 by simonmar] Move setChildStopFlag and queryChildStopFlag to System.Posix.Signals. a6d8ea6 [project @ 2003-09-12 13:05:19 by simonmar] Implement pathconf()/fpathconf() wrappers. e62ca65 [project @ 2003-09-16 13:03:37 by simonmar] Legacy Removal ~~~~~~~~~~~~~~ aabd697 [project @ 2003-09-16 13:46:36 by simonmar] Don't strip the trailing slash from the filename '/'. 5aef5c6 [project @ 2003-09-21 22:20:57 by wolfgang] Bound Threads ============= f1e5fdd [project @ 2003-09-22 10:20:06 by wolfgang] fix some embarassing typos in the previous commit 5515cef [project @ 2003-09-22 11:11:54 by ross] cosmetic: move comments inside #ifdefs to avoid confusing people (like Hugs users) who look at the preprocessed output. 0e2b2bf [project @ 2003-09-22 13:27:19 by wolfgang] Really make the bound threads stuff compile this time (sorry). 8b0d04d [project @ 2003-09-23 10:09:17 by panne] Unbreak Show instance for Ptr caused by the changes to showHex d06f918 [project @ 2003-09-23 13:23:58 by simonmar] micro-optimisation 506eb20 [project @ 2003-09-23 13:26:30 by simonmar] - Add h{Get,Put}BufNonBlocking a02e72d [project @ 2003-09-23 16:13:59 by simonmar] Haddock fix. 354c8c0 [project @ 2003-09-23 16:18:03 by sof] [win32]: make it compile 140476b [project @ 2003-09-23 17:33:12 by sof] createPipe, createPipeEx: commented out exports (doesn't appear to be defined anywhere) de444f6 [project @ 2003-09-23 18:59:43 by sof] h{Get,Put}NonBlocking: win32 impl 82fbd98 [project @ 2003-09-24 10:32:12 by simonmar] If we change the terminal settings as a result of hSetBuffering or hSetEcho, then restore them again in hs_exit(). This is just good citizenship on Unixy platforms. 706c3d6 [project @ 2003-09-24 10:41:11 by simonmar] Add non-blocking versions of hGetBuf, hPutBuf. 65b1bac [project @ 2003-09-24 11:06:54 by simonmar] Move forkOS_createThread into the RTS so its implementation can be dependent on RTS_SUPPORTS_THREADS, which means we can provide a stub implementation in the !RTS_SUPPORTS_THREADS case, and hence not depend on pthread_create, which requires -lpthread. The upshot is that GHCi now works again when !RTS_SUPPORTS_THREADS. d25f4b7 [project @ 2003-09-24 11:36:24 by simonmar] Add some realToFrac rules for CFloat,CDouble and CLDouble, so that eg. realToFrac :: CDouble -> Double turns into a no-op. cb04045 [project @ 2003-09-24 13:26:08 by malcolm] Missing dependency. 0f9f2a0 [project @ 2003-09-24 14:01:18 by simonmar] Add foldFM_GE, fmToList_GE, keysFM_GE, eltsFM_GE. (contributed by Tomasz Zielonka via George Russell). 37335cc [project @ 2003-09-25 14:44:36 by sof] [win32]getCPUTime: comments + reduce fromIntegral use. No change in functionality. 01bb943 [project @ 2003-09-25 15:14:44 by panne] To fix dynamic linking issues with Hugs, access saved_termios via getter/setter. 08ef45e [project @ 2003-09-26 09:26:13 by panne] Saving/restoring termios is only done for GHC a6ae0a4 [project @ 2003-10-01 10:57:44 by wolfgang] New implementation & changed type signature of forkProcess fb390bd [project @ 2003-10-01 11:00:20 by wolfgang] Add runInUnboundThread to the export list 922351c [project @ 2003-10-06 13:14:36 by simonpj] MERGE TO STABLE bc90621 [project @ 2003-10-07 16:56:33 by sof] peekCString{Len}: tweak GHC impls (why are these provided anyway?) - Do as for Foreign.Marshal.Array.peekArray and read in length-bounded string back-to-front. - force evaluation of CChar->Char conversions. 3f6e3e9 [project @ 2003-10-09 13:59:33 by stolz] FreeBSD 4.X has an emtpy wctype.h, so test one of the affected functions in Unicode.hsc if it's really there. dfe9aca [project @ 2003-10-09 14:01:46 by stolz] Fix flipped arguments to sigprocmask in getSignalMask. b124662 [project @ 2003-10-13 03:19:48 by sof] make it useable with msvc + gcc-mingw 1562165 [project @ 2003-10-13 03:21:20 by sof] cope if regex.h isn't supported by target 1d94a68 [project @ 2003-10-13 05:09:40 by sof] prev commit too strict wrt mingw 871d9d9 [project @ 2003-10-13 05:20:37 by sof] extra_libraries: win32 CPP tweak d082af5 [project @ 2003-10-13 05:21:37 by sof] more mind-numbing CPP tweaking 98ca2df [project @ 2003-10-13 05:22:59 by sof] support CFoo iff HTYPE_FOO_T is defined 123b517 [project @ 2003-10-13 05:23:53 by sof] mingw tweaks + add cbits/consUtils.c to CBITS 9f1f843 [project @ 2003-10-16 00:18:34 by ross] add withArgs and withProgName to Hugs. 84f7e2f [project @ 2003-10-16 16:26:43 by ross] fix a couple of id references in haddock docs ef02902 [project @ 2003-10-17 16:48:43 by ross] Hugs only: add most of the rest of System.Posix e3abc99 [project @ 2003-10-20 12:31:00 by ross] add System.Posix.Signals to Hugs 7219399 [project @ 2003-10-20 13:16:58 by simonmar] Comment use of $(HavePosixRegex) 427485c [project @ 2003-10-20 15:56:52 by simonmar] Convert Unicode.hsc to a plain .hs file to fix bootstrapping problems. 2f1b654 [project @ 2003-10-20 20:00:25 by panne] Again: Fixed previous commit. Our QA department must really be on an extended vacation... :-] 41e6e6f [project @ 2003-10-21 13:24:31 by simonmar] Make the GHC implementation of peekCString run in constant stack-space by checking the length of the array first and then working backwards from the end. Interestingly, this version is faster than the original. e2b681a [project @ 2003-10-21 13:27:13 by simonmar] Make peekArray0 run in constant stack-space by testing the length of the array first, then calling peekArray (which works backwards from the end so it can be tail-recursive). ece4fc6 [project @ 2003-10-21 13:31:44 by simonmar] - Add _LE duals of the _GE functions - Add minFM and maxFM 05292e1 [project @ 2003-10-21 13:57:39 by simonmar] Fix bug in hGetBufNonBlocking that meant it would sometimes block. 381defa [project @ 2003-10-21 14:00:20 by simonmar] oops, revert parts of previous commit that weren't supposed to be included. c6a32b7 [project @ 2003-10-21 14:32:43 by sof] appease the GHC bigwigs 9d6a771 [project @ 2003-10-27 09:56:11 by ross] unswap UNBLOCK/SETMASK (merge to STABLE) b3911da [project @ 2003-10-27 12:09:44 by stolz] Avoid setting O_NONBLOCK when already set. e75b200 [project @ 2003-10-30 18:51:26 by sof] drop uses of __MINGW32__, no longer needed 4838ceb [project @ 2003-11-02 00:06:23 by panne] Added an extremely ugly workaround for the broken sigfillset macro on OpenBSD, which misses a cast. Is there a better way? 65b7479 [project @ 2003-11-02 16:30:16 by panne] * Added workaround for broken sigemptyset * Use #if, not #ifdef for feature tests * Nuked CVS keyword e0aa14e [project @ 2003-11-02 17:52:09 by ralf] Minor extension to enable rebuild of Strafunski. 93cbc6e [project @ 2003-11-04 21:59:23 by ross] Hugs only: add finalizers with environments, as per the latest FFI draft. 1c3d0af [project @ 2003-11-05 09:58:01 by simonmar] Fix a memory leak in __hscore_readdir() which meant that one struct dirent was leaked at the end of each directory read. c469c2c [project @ 2003-11-05 10:43:10 by simonmar] Better documentation for unsafeThaw, unsafeFreeze. cfa3827 [project @ 2003-11-05 15:05:12 by ross] doc updates for mallocForeignPtr and friends d93c042 [project @ 2003-11-06 12:50:22 by ross] import Prelude if haddocking bf6cd58 [project @ 2003-11-06 17:34:00 by simonmar] Doc wibbles 1cdfc00 [project @ 2003-11-10 15:32:43 by simonmar] Change the documentation title from "Haskell Core Libraries" to "Haskell Hierarchical Libraries". 1f7f519 [project @ 2003-11-10 15:54:55 by sof] brought into the hier-lib world; stripped away outdated code & comments c121d9e [project @ 2003-11-10 15:55:13 by sof] ALL_DIRS: added Control/Parallel 530afa3 [project @ 2003-11-11 11:50:52 by simonmar] Convert to use Haddock 0.6's combined contents/index functionality for the hierarchical library docs. 1422071 [project @ 2003-11-13 14:43:58 by ross] Hugs-only tweak 2657bd7 [project @ 2003-11-13 19:23:12 by panne] Markup fix 135ae7e [project @ 2003-11-15 22:31:16 by panne] Decouple packages a bit more again: The prologue of the combined index is now generated via shell magic from the package prologues. As a nice side effect, some autoconf magic is gone, so configure.ac is effectively empty now (but not for long... :-) eb4afe3 [project @ 2003-11-21 16:24:44 by sof] code tidyup d8b08f3 [project @ 2003-11-23 12:23:49 by ralf] Added some trivial observers for type representations. 51e8c92 [project @ 2003-11-23 12:25:02 by ralf] Refactored some alias for generic builders and readers. Worked out some interested stuff for reification of type structures. 60d0e4a [project @ 2003-11-23 22:19:35 by ralf] Added the missing Data instance for Either. 6721ead [project @ 2003-11-26 09:55:22 by simonmar] Declare some libraries to be "stable". 9129371 [project @ 2003-11-26 10:00:09 by simonmar] oops, revert accidental commit fb0fe86 [project @ 2003-11-28 11:08:54 by simonmar] Doc wibble ed3a760 [project @ 2003-12-04 18:25:51 by panne] Synched #ifdefs, but only 90% sure if I got it right... fa71932 [project @ 2003-12-06 17:48:49 by ralf] Added Data instances for triples and quadruples. f85e43a [project @ 2003-12-12 18:29:26 by sof] showIntAtBase: - implementation uses quotRem [where the remainder isn't always non-negative -- ditto for divMod, so there's no trivial fix], negative bases aren't supported; catch this. - separate argument validity checking from actual digitisation. e37f296 [project @ 2003-12-15 17:59:05 by panne] Fixed #ifdefs for Cygwin e8c6784 [project @ 2003-12-16 16:54:12 by simonmar] Add Show instance for FiniteMap ba05fd2 [project @ 2003-12-16 16:54:42 by simonmar] Add Show instance for Set d93ccac [project @ 2003-12-17 17:13:47 by sof] merge rev 1.48.2.4 ab2349b [project @ 2003-12-17 17:15:12 by sof] merge rev. 1.13.2.1 123af63 [project @ 2003-12-22 10:56:42 by simonmar] performGC should really do a major GC - this was broken at some point. f8c15cf [project @ 2003-12-22 12:23:35 by simonmar] - Fix hGetBuf & hGetBufNonBlocking. There were various bugs in these two functions, so I did a complete rewrite (again). They are quite hard to get right it seems, so I've put together a test case (shortly to be added to the test suite). c71586a [project @ 2003-12-22 12:41:52 by simonmar] add fillReadBufferWithoutBlocking (required for fixed hGetBufNonBlocking implementation in IO.hs rev. 1.20) 3e2fc9a [project @ 2003-12-23 12:35:34 by simonmar] Fix yet another bug in hGetBuf/hGetBufNonBlocking 546370a [project @ 2003-12-23 13:58:17 by simonmar] - Fix up mingw build after changes to hGetBuf etc. I don't think that hGetBufNonBlocking works correctly on Windows, because there doesn't seem to be a non-blocking read primitive. I haven't tested it, however. 43683aa [project @ 2003-12-29 17:16:42 by panne] Updated my email address b7d62ed [project @ 2004-01-02 19:03:14 by panne] Annual copyright update a5c83b2 [project @ 2004-01-05 10:07:25 by ross] doc tweak ab631b3 [project @ 2004-01-05 10:07:52 by ross] doc tidy-ups a585b70 [project @ 2004-01-05 16:03:34 by simonmar] Add runSTArray and runSTUArray, as suggested by John Meacham. runSTUArray showed up an interesting deficiency in the type system (see comments for details). 44f2077 [project @ 2004-01-05 16:47:09 by ross] Change the drawing of trees so that long labels work better. The new drawings are narrower but a little longer than before. e010c70 [project @ 2004-01-05 17:44:30 by ross] Make runST(U)Array work with Hugs. This includes explicitly using unsafeFreezeSTArray rather than unsafeFreeze, to avoid relying on rules. de519dc [project @ 2004-01-06 10:31:05 by ross] new Queue type, using Chris Okasaki's cute 3-list implementation. fb577d2 [project @ 2004-01-06 12:40:00 by simonmar] Fix, and simplify, the getting/setting of errno in Foreign.C.Error. 2a7b95f [project @ 2004-01-06 14:01:52 by ross] fix for Hugs d0241bc [project @ 2004-01-07 12:43:50 by simonmar] Mention that threadDelay rounds its argument down to a multiple of 0.02s. 575f0f2 [project @ 2004-01-08 15:27:29 by simonmar] update threadDelay docs: delay is rounded up. 6fb1d48 [project @ 2004-01-10 12:53:42 by panne] Haddock fixes e3ffd04 [project @ 2004-01-14 11:16:10 by malcolm] Unbreak for nhc98 after recent errno changes. f23b2ec [project @ 2004-01-14 14:19:41 by ross] (Hugs only) add hIsTerminalDevice, hGetEcho and hSetEcho. aa8a901 [project @ 2004-01-14 14:58:57 by ralf] Added gdepth to determine depth of a term. edcb5e4 [project @ 2004-01-15 14:43:24 by igloo] Split Template Haskell out to its own package and update docs and tests. 08f5dc7 [project @ 2004-01-20 13:57:25 by ross] use fields in Node 9889459 [project @ 2004-01-21 17:28:47 by simonmar] __hscore_set_errno() should return void, not int. a6cb0ec [project @ 2004-01-23 13:35:16 by ross] add a Functor instance for FiniteMap 35adccc [project @ 2004-01-26 11:24:54 by simonmar] - fix bug(s) in emptySampleVar - add isEmptySampleVar, with similar caveats on its use as isEmptyMVar ebe4fa4 [project @ 2004-01-27 09:52:37 by ross] generalize the type of minusFM 3d08503 [project @ 2004-01-28 10:04:25 by simonpj] --------------------------------------- Fix the WinME/98/95 double-backslash bug --------------------------------------- 26a0d9e [project @ 2004-02-02 11:54:32 by ross] add some unfolds (pure, monadic depth-first and monadic breadth-first) 2d9095f [project @ 2004-02-04 10:51:18 by malcolm] Exclude functions 'unfoldTreeM' and 'unfoldForestM' in nhc98. For some unknown reason they result in a type inference error: "No default for Prelude.Monad" b1f75e3 [project @ 2004-02-04 10:52:28 by malcolm] Plumb in Data.Queue for nhc98. 71bad3c [project @ 2004-02-04 17:00:00 by malcolm] Excluding 'unfoldTreeM' and 'unfoldForestM' is overkill for nhc98. A simpler workaround for the type inference bug is just to omit one type signature from the mutually recursive pair. edac88b [project @ 2004-02-04 17:13:53 by ross] plug a warning 55b084e [project @ 2004-02-05 11:45:59 by ross] Hugs only: use the configure-set variable INLINE_ONLY instead of `extern inline' (which works for gcc but not C99 compilers). 5e1b65f [project @ 2004-02-05 11:58:21 by malcolm] Fix definition of 'partition' to match the (non-)strictness mandated by the Haskell'98 Libraries Report version. a107e3d [project @ 2004-02-05 16:46:32 by igloo] Typo (Frue instead of False for falseName) found during discussion with Duncan. dfe7719 [project @ 2004-02-05 18:55:47 by ross] moved the monad transformer libraries into a separate mtl package. de871d5 [project @ 2004-02-11 14:01:06 by simonmar] Put double quotes around the -#include flag, so that command-lines can be cut-n-pasted. 6c4bbb5 [project @ 2004-02-12 14:54:19 by simonpj] Document non-std behaviour of array 87e3aab [project @ 2004-02-12 14:55:05 by simonpj] Explicit for-alls for Monad (so desugaring knows which order to give type args) 4daa9de [project @ 2004-02-12 14:55:31 by simonpj] Documentation for floatToDigits dd30d01 [project @ 2004-02-12 14:55:55 by simonpj] Comments f2c753f [project @ 2004-02-12 21:23:48 by krasimir] Added interface to set/get handler for uncatched exceptions. The handler is invoked from the GHC.TopHandler.topHandler or Control.Concurrent.childHandler when an exception is catched. 015ffda [project @ 2004-02-12 22:35:25 by krasimir] The UncatchedExceptionHandler is defined only for GHC a8be691 [project @ 2004-02-13 12:13:00 by simonmar] uncatched -> uncaught 8dc1e1a [project @ 2004-02-13 15:17:38 by ross] array doc updates 252660f [project @ 2004-02-13 17:46:32 by ross] make import Foreign.C.String GHC-only to unbreak Hugs build 7e9db43 [project @ 2004-02-14 18:18:46 by ralf] Refactored the approach to Twin Traversal. Added some illustrative treatment of polymorphic lists. aa52e1c [project @ 2004-02-15 13:04:47 by krasimir] Added support for tracers b03b6c5 [project @ 2004-02-15 13:24:42 by ralf] Another commit of boilerplate refactoring related to twin traversal and type introspection. Clean-up. After some reflection the list processing module was not regarded suitable for the library (see List.hs removed). 8b90cd0 [project @ 2004-02-16 11:08:58 by ross] adjust imports for portability 08df762 [project @ 2004-02-17 11:16:36 by malcolm] Exclude "config.h" inclusion for nhc98 as well as Hugs. 84d748e [project @ 2004-02-17 11:21:04 by simonmar] Remove unused argument from commitBuffer e4fa830 [project @ 2004-02-17 11:22:22 by simonmar] Use C wrappers for lseek() and open(). On Linux, these functions are macro'd to different versions when large file support is on, so to make the libraries compilable with the NCG we need to use C wrappers for these functions. 00734d0 [project @ 2004-02-17 11:59:16 by simonmar] Also need to wrap fstat(). 1782c4a [project @ 2004-02-18 15:07:03 by simonmar] stat() needs to be wrapped too 1afa490 [project @ 2004-02-19 10:42:50 by stolz] Preserve group/other bits in setPermissions. bb53111 [project @ 2004-02-20 10:55:09 by stolz] wibble (replace helper function with fromEnum) faf38bc [project @ 2004-02-20 17:46:38 by panne] Hugs has hSetBinaryMode, hPutBuf, and hGetBuf now. 74ddd4c [project @ 2004-02-24 12:39:12 by simonmar] New version of translate for mingw32, which correctly (allegedly) reverses the command-line translation done by the standard C runtime on Windows. e439a05 [project @ 2004-02-24 19:49:58 by ralf] Proliferation of unsafeCoerce in Data.Typeable stopped. (There is now just one cast0 which generalises on all previous forms: cast, castss, castarr.) Started classes Typeable1/2 for unary/binary type constructors. Added instances for lists, products, sums, functions, maybies. 20120b6 [project @ 2004-02-24 19:51:11 by ralf] Twin traversal is now based on accumulating maps. Added polymorphic type extension for type constructors. 9dbea19 [project @ 2004-02-25 19:21:20 by krasimir] Added finalizeForeignPtr function 5b4e35c [project @ 2004-02-25 20:10:18 by ralf] Thanks to Sven Panne. The module should be back to Haskell 98 or at least should not break hugs anymore. cafe1fc [project @ 2004-02-25 21:20:04 by ralf] Follow-up fix triggered by yesterday's major scrap your boilerplate commit. 519ca93 [project @ 2004-02-26 18:06:51 by ralf] Simplified kind-polymorphic boilerplate stuff. 6cab28c [project @ 2004-02-26 18:34:14 by ross] instances for Ordering and tuples (up to 5) a18a6fb [project @ 2004-02-27 10:27:41 by simonmar] Update the comments in here after changes in rev. 1.17. 89a8f1b [project @ 2004-02-27 14:48:16 by malcolm] To make it compile with nhc98, #ifdef out the Typeable[12] instances. d6f122d [project @ 2004-02-28 15:35:28 by ralf] Code that uses deriving (... Data ...) will require an updated *compiler* to be in line with these new boilerplate modules. d13284e [project @ 2004-03-01 14:47:30 by simonmar] small improvements from Ian Lynagh c54909e [project @ 2004-03-01 17:25:46 by malcolm] nhc98: ensure the Either type is identical with Prelude.Either. 53297f9 [project @ 2004-03-02 22:23:59 by ralf] Once more revised the Data class. You will need to cvs upd the compiler as well. 54b9d86 [project @ 2004-03-03 11:47:42 by ross] withObject -> with 960c6ae [project @ 2004-03-03 19:25:41 by malcolm] #ifdefs for nhc98. ce6a3ec [project @ 2004-03-04 17:48:27 by igloo] Add missing punctuate definition from Duncan Coutts. 040d7a9 [project @ 2004-03-05 18:00:35 by malcolm] Plumb System.Time and System.CPUTime into nhc98 libraries build. 537197d [project @ 2004-03-08 10:22:09 by malcolm] nhc98 (built by ghc/solaris) needs more stack to make System.Time. 5f93cd4 [project @ 2004-03-16 10:04:17 by ross] comment typo f1c55a9 [project @ 2004-03-16 13:46:07 by ralf] Some more refactoring and renaming to be aligned with the boilerplate II paper. Removed the weird module Generics.Reify, the code of which still lives in testsuite (see example reify.hs). One will also need to cvs upd the compiler which again changed slightly with regard to deriving Data. 16ac5f5 [project @ 2004-03-16 15:19:36 by ralf] I thought that I removed that one. 35eb22e [project @ 2004-03-17 23:22:51 by ralf] Installed genneric instances for Typeable1, ..., Typeable7. Updated Data/Generics/Instances.hs accordingly. 08bb853 [project @ 2004-03-19 10:45:42 by simonmar] Bugfix for insert (from the missing-prime class of bugs) f8e2916 [project @ 2004-03-19 11:00:02 by simonmar] - fix one performance bug: we weren't updating the bucket count when expanding the hash table, so too many expansions were happening. ca93edc [project @ 2004-03-19 20:31:50 by panne] HACK: Unbreak the Hugs build again, Typeable left the realm of Haskell98 one more time. I slowly doubt if this module belongs to the "base" package at all... If it stays there, things should better be tested with Hugs and nh98 before committing, the latter build probably breaks, too. 327619b [project @ 2004-03-20 02:37:18 by ross] clean up the TypeableN stuff a bit: GHC uses overlapping instances; everyone else uses explicit instances using provided defaults. Macros paper over the difference. c20a754 [project @ 2004-03-20 12:42:27 by ross] Comments (and deleted some of the blank lines Ralf is so fond of). 8ac0150 [project @ 2004-03-20 13:31:06 by ross] revert a couple of tcnames for greater consistency (fixes dynamic001). bb1bb04 [project @ 2004-03-20 18:26:40 by ross] change instances of Typeable to macros e367013 [project @ 2004-03-21 19:07:00 by ralf] Implemented renaming for Data.Typeable according to http://www.haskell.org//pipermail/libraries/2004-March/001846.html 0dd193b [project @ 2004-03-22 14:48:56 by malcolm] For nhc98, at last include the Typeable macros which define the instance decls. 58a05f6 [project @ 2004-03-24 16:59:51 by simonmar] Add caveat about finalizers (don't refer to Handles from finalizers). 4941f98 [project @ 2004-03-27 13:18:12 by panne] * Merged Martin Sj-A?gren's patch for multiline descriptions-b * Nuked some TABs in favour of space + some small reformatting * Updated copyright edde716 [project @ 2004-03-27 14:15:24 by panne] This package is named "base", not "core". d12525b [project @ 2004-03-30 07:05:46 by panne] Added withArrayLen and withArrayLen0 d69bb11 [project @ 2004-03-30 15:31:35 by ralf] We decided that we want the gunfold primitive back. This avoids some hassle with bottoms and strict datatypes. The compiler now also derives gunfold. 24646d8 [project @ 2004-03-30 17:02:59 by ross] track Data/Generics/* twists 7a1aff6 [project @ 2004-03-30 17:54:28 by ross] fix a warning 8b9443c [project @ 2004-04-02 02:39:29 by igloo] Add support for foreign imports inside quasi-quotes. Gave TH a few more uniques to play with and fixed a typo. 6cbff23 [project @ 2004-04-05 08:21:39 by simonpj] Use consistent capitalisation 6fc5861 [project @ 2004-04-06 08:54:02 by panne] Tiny fix in Haddock markup c6761cd [project @ 2004-04-06 12:03:05 by simonpj] * Add 'dyn' as an export of TH 73bf385 [project @ 2004-04-14 09:01:18 by simonmar] indent: don't use tab characters 5c92527 [project @ 2004-04-20 09:18:46 by simonmar] Fix a file descriptor leak in openFile: if openFd fails, then we weren't closing the newly created descriptor. a5b43a2 [project @ 2004-04-20 15:49:58 by simonmar] - comments on INLINability of unsafePerformIO 63fecf0 [project @ 2004-04-20 15:52:18 by simonmar] New version of fixIO which does eager blackholing. 58eb623 [project @ 2004-04-23 18:13:07 by ross] Hugs: use the same version of fixIO as GHC 311dd3b [project @ 2004-05-06 08:44:52 by simonmar] Move the definition of rawSystem into a separate file which we #include in the places it is needed. This is slightly better than copying the code, since we now need it in three places (ghc/utils/runghc is the 3rd). ef5fe77 [project @ 2004-05-06 12:27:47 by wolfgang] Make the documentation and the error messages match the way the threaded RTS is used nowadays (the -threaded flag to ghc rather than ./configure --enable-threaded-rts) a4d8708 [project @ 2004-05-09 01:36:32 by dons] When .hc bootstrapping, don't build the Concurrent_stubs 07cfdb5 [project @ 2004-05-10 09:22:59 by malcolm] RawSystem inclusion belongs inside the __GLASGOW_HASKELL__ ifdef. e4e04b3 [project @ 2004-05-19 07:46:20 by simonpj] Print constructor arg types in parens 5c0be5d [project @ 2004-05-25 09:11:57 by simonpj] Remove spaces around the "%" when showing ratios. 98c0e98 [project @ 2004-05-25 09:12:29 by simonpj] Fix comment 9eef5c0 [project @ 2004-05-25 09:27:16 by simonmar] Small performance hack in maxBound::Word. 15532cb [project @ 2004-05-27 11:32:03 by simonpj] Inline the default method for newArray; big perf boost; comments with the pragma b2df702 [project @ 2004-06-01 23:22:32 by igloo] Add missing functions to TH export list (mostly spotted by Duncan Coutts). 08a11a7 [project @ 2004-06-02 08:23:46 by simonpj] ------------------------------- Fix a grevious bug in DsMeta which caused a seg fault ------------------------------- 40078de [project @ 2004-06-02 12:35:11 by simonmar] The lock arrays are too small on Windows, leading to buffer overruns and crashes when a program opens too many files. c8e1c7f [project @ 2004-06-02 16:00:02 by simonmar] Add __hscore_PrelHandle_{send,recv} 5d55d8f [project @ 2004-06-02 16:07:17 by simonmar] - Win32: when using the threaded RTS, bypass the Async IO stuff and just make blocking calls to read()/write(). 72c2269 [project @ 2004-06-02 16:09:58 by simonmar] __hscore_PrelHandle_{send,recv}: make these mingw32-only 06b8d04e [project @ 2004-06-02 16:17:20 by simonmar] Add a comment about fdGetMode, which doesn't work properly on Windows 2f6c4a3 [project @ 2004-06-12 12:13:12 by panne] timezone fix by Antony Courtney 463eed2 [project @ 2004-06-13 17:16:40 by panne] The FFI report does not mention that CClock and CTime have instances for Bounded, Real, Integral, and Bits. c4ed8d8 [project @ 2004-06-13 20:26:03 by panne] Added missing dependencies of Haskell files to header files they include 67a040b [project @ 2004-06-13 21:03:46 by panne] Changes related to arithmetic types: c0cc013 [project @ 2004-06-14 13:28:52 by malcolm] Solaris/nhc98 fixes: HAVE_TZNAME rather than HAVE_TM_ZONE, and need a "time.h" specification on every foreign import. d0e3c12 [project @ 2004-06-15 10:20:05 by malcolm] Add missing instances of Data.Bits.Bits for nhc98. 509e791 [project @ 2004-06-15 10:29:12 by malcolm] Note dependency of Foreign.C on Foreign.C.* e52eabe [project @ 2004-06-15 21:07:23 by panne] Yet another fix for the fact that CTime is not an instance of Integral anymore, f75fa29 [project @ 2004-06-16 09:50:25 by malcolm] Typo. fc865a7 [project @ 2004-06-22 12:45:55 by ross] Change the interface (but not the implementation) to match the FFI spec: 870d29d [project @ 2004-06-23 09:47:47 by simonmar] Add documentation from the FFI spec. 845cb18 [project @ 2004-06-25 10:42:48 by ross] more Ptr/FunPtr documentation 26197c8 [project @ 2004-06-29 19:10:47 by panne] Centralized compiler differences for requesting additional heap/stack in a single place. Only tested for bootstrapping via hbc, and this needs 170M heap for Language/Haskell/Parser.hs. There seems to be a "small" space leak here... :-] c647a31 [project @ 2004-07-01 13:25:09 by malcolm] Revert from common heap/stack options to per-package options. Since hbc's runtime requirements are on occasion so much larger ghc/nhc98, break out EXTRA_HBC_FLAGS as a separate variable. b4c1b8e [project @ 2004-07-01 14:49:11 by malcolm] Heap-profiling build bootstrapped with nhc98 requires more heap. 618f167 [project @ 2004-07-01 18:05:00 by panne] Increase heap size and stack size when building via hbc c4919d4 [project @ 2004-07-11 09:20:07 by panne] Use "flat" names for the type constructors of Ptr/StablePtr/IORef. This might be debatable, but at least it is consistent with the rest of the types. 94e9096 [project @ 2004-07-19 11:29:39 by simonpj] Template Haskell improvements 8d20bc3 [project @ 2004-07-23 11:34:31 by ross] docs only 07ed441 [project @ 2004-07-23 13:24:04 by ross] docs only 803fb54 [project @ 2004-07-23 15:26:06 by ross] tweak comment 02a07c4 [project @ 2004-07-23 15:31:59 by ross] To make Text.Regex.Posix work with Hugs, move cbits/regex/regex.h under include, where Hugs can find it. 74f1415 [project @ 2004-07-26 13:26:41 by ross] docs only 43cbf96 [project @ 2004-07-26 17:22:41 by ross] a few odd docs 0caf196 [project @ 2004-07-27 10:35:54 by ross] haddock fodder 7684c3d [project @ 2004-07-28 10:32:11 by ross] haddock food 0d080ea [project @ 2004-07-30 06:16:00 by krasimir] add copyFile function 117f7f3 [project @ 2004-07-30 20:33:54 by krasimir] add copyFile to the export list c289c80 [project @ 2004-07-30 22:17:44 by krasimir] fix 143c726 [project @ 2004-07-30 23:29:41 by ross] copyFile is GHC-only at the moment ded9c50 [project @ 2004-08-03 19:36:41 by panne] Fixed spelling of "http-equiv" attribute c61e042 [project @ 2004-08-09 10:04:33 by simonmar] quotes: use an appostrophe at both ends rather than a grave accent at the front and an apostrophe at the end. 3b49acc [project @ 2004-08-09 12:00:34 by simonmar] whitespace changes to the header only, for new compatibility with new Haddock 0037574 [project @ 2004-08-10 11:35:24 by simonpj] Add a Haddock note about dynamic linking c03df89 [project @ 2004-08-13 08:50:32 by simonmar] work around stricter CPP in GCC 3.4.1 8c7d098 [project @ 2004-08-13 10:54:15 by simonmar] Update copyright date d029634 [project @ 2004-08-13 10:55:06 by simonmar] Add a Todo 69eb297 [project @ 2004-08-13 13:29:00 by simonmar] Changes required be merge of backend-hacking-branch. Mostly config.h ==> ghcconfig.h. 5d8d941 [project @ 2004-08-13 13:29:11 by simonmar] Changes required be merge of backend-hacking-branch. Mostly config.h ==> ghcconfig.h. 8ed5e5b [project @ 2004-08-16 09:31:15 by simonmar] #ifdefery to work around change in name of config.h 4cf1f19 [project @ 2004-08-16 11:07:31 by simonmar] More ugly hacks related to the config.h change. I'm beginning to think maybe this wasn't such a great idea. c9e42a8 [project @ 2004-08-16 11:08:47 by simonmar] wibble 33a5b0b [project @ 2004-08-17 16:48:09 by krasimir] Add getHomeDirectory and getAppUserDataDirectory functions 5343b0b [project @ 2004-08-18 09:23:19 by malcolm] Add versions of getHomeDirectory and getAppUserDataDirectory for nhc98. (Note: implementation still missing for Hugs.) 4ed190b [project @ 2004-08-18 09:34:02 by simonmar] Add Haddock comments for getHomeDirectory/getAppUserDataDirectory b1825fc [project @ 2004-08-18 17:48:44 by krasimir] add getUserDocumentsDirectory function 4fd3f0b [project @ 2004-08-19 08:23:01 by simonmar] Add a new Haddock section "Pre-defined directories" 08ff349 [project @ 2004-08-19 10:54:34 by malcolm] Missing import for nhc98. f98834d [project @ 2004-08-20 08:45:52 by simonpj] Better handling of overflow conditions for Enum Int. 72a29d8 [project @ 2004-08-21 10:56:59 by panne] Haddock fix 92a4127 [project @ 2004-08-23 11:53:08 by simonmar] Fix deadlock problem when the difference list for \\ refers recursively to the array. 511830f [project @ 2004-08-25 16:20:13 by sof] Be resistant to missing CSIDL_* defines 4ff2edf [project @ 2004-08-25 18:35:29 by sof] extrs_libraries{mingw32}: replace 'shell32' with 'shfolder'; standard, and more version-proof ccf0ddb [project @ 2004-08-25 18:42:47 by sof] __hscore_d_name(), __hscore_end_of_dir(): de-platformify and use feature #defines instead. 5a77cb7 [project @ 2004-08-31 09:07:26 by ross] make the new directory queries available to all implementations, though the mingw versions only work for GHC. aca3bd8 [project @ 2004-09-01 09:47:31 by simonmar] Win32 rawSystem: set errno to EINVAL on error. This is a gross hack, but is slightly better than the existing situation (errno not set at all, caller tries to report errno and draws a blank). c120549 [project @ 2004-09-01 15:57:13 by ross] devolve the recently added dirent checks to a new libraries/base/configure.ac aebf6b5 [project @ 2004-09-02 05:57:41 by dons] Trying to closedir the wrong pointer in "readdir sets errno" test. This caused test to dump core, leading to 'bogus' value of test result, which breaks the build. 585004a [project @ 2004-09-06 09:07:45 by ross] Text.Regex.Posix is portable (because it includes an implementation) 8283965 [project @ 2004-09-06 17:20:02 by ross] add some RULES d47eab1 [project @ 2004-09-07 15:35:41 by stolz] Add cpp-protected signals sigINFO & sigWINCH if available. (An autoconf-wizard might want to look at the bottom of configure.ac, the similarities between HAVE_SIGPOLL, HAVE_SIGINFO & HAVE_SIGWINCH can surely be factored out) e1f293d [project @ 2004-09-08 11:10:08 by ross] typos in comments 2de5944 [project @ 2004-09-08 15:13:20 by ross] remove unneeded #includes of ghcconfig.h a05881c [project @ 2004-09-10 08:29:14 by stolz] Fix build on Solaris: CTime is no longer an instance of Integral, so do the realToInteger-dance. 8138525 [project @ 2004-09-10 20:38:53 by ross] docs 095ff7a [project @ 2004-09-10 22:43:20 by ross] doc tweaks c9a7587 [project @ 2004-09-15 13:51:00 by stolz] - Remove configure tests for SIG{POLL,INFO,WINCH}: Testing via #ifdef SIGFOO should be sufficient. - Change #if HAVE_SIGPOLL to #ifdef SIGPOLL - Remove SIGINFO/WINCH from package base: they'll reappear in package unix in System/Posix/Signals.Exts. 9ff25c7 [project @ 2004-09-18 12:49:59 by panne] Make autoupdate 2.52 happy, mainly by using the new formats of AC_INIT and AC_OUTPUT. This has the nice side effect that all "packages" have now a name, a version, a bug-report address, and a tar name, yielding better output with "configure --help=recursive". Nuked an unused AC_STRUCT_ST_BLKSIZE test on the way. a8ab7a3 [project @ 2004-09-20 16:35:12 by sof] openFile: have Haddock comments mention openBinaryFile 0b31efa [project @ 2004-09-22 08:37:01 by panne] * Replace obsolete macro AC_TRY_RUN with AC_RUN_IFELSE * Same for AC_TRY_LINK and AC_LINK_IFELSE * Minor cleanup 3cf8ba9 [project @ 2004-09-27 09:04:15 by ross] update documentation of memory allocation c346bd4 [project @ 2004-09-28 09:02:13 by simonmar] - Move foldl1 to Data.List - Provide a strict version of foldl1, namely foldl1' - Move minimum, maximum to Data.List - Provide specialised versions of minimum & maximum for Int, which use foldl1' e0ed007 [project @ 2004-09-28 11:29:29 by simonmar] - export foldl1' - specialise minimum/maximum for Integer too 7ba52e7 [project @ 2004-09-28 12:38:55 by simonmar] Add update, and improve documentation of insert. 7b11673 [project @ 2004-09-28 23:34:26 by ross] unbreak for non-GHC implementations ee2d0b9 [project @ 2004-09-29 10:29:13 by ross] haddock markup c590df4 [project @ 2004-09-29 15:46:53 by simonmar] Move this to the Attic 7d8c46b [project @ 2004-09-29 15:50:51 by simonmar] Process reorganisation: the System.Process library moves into base, and System.Cmd is re-implemented in terms of it. 56e8e42 [project @ 2004-09-29 22:48:06 by krasimir] compile execvpe only under Unix. The mingw's process.h header also contains definition for execvpe which conflicts with our definition. 42522f7 [project @ 2004-09-29 22:49:36 by krasimir] Change file extension. We don't need hsc2hs here. 9fee399 [project @ 2004-09-30 08:54:00 by simonmar] Update the signature of execvpe() to match the one in HsBase. 79d7b55 [project @ 2004-09-30 09:42:17 by simonmar] Haddock fixes 87cd92d [project @ 2004-09-30 10:01:46 by malcolm] Add a type signature to help nhc98 out. 1169da6 [project @ 2004-10-02 07:14:38 by dons] Undef PACKAGE_NAME PACKAGE_STRING PACKAGE_BUGREPORT PACKAGE_TARNAME coming in from ghcconfig.h, so that we can use HsBaseConfig.h versions without screenfulls of cpp warnings. f5768c7 [project @ 2004-10-02 07:34:38 by dons] Bind raiseSignal to genericRaise, on OpenBSD only, atm. 0c3fe86 [project @ 2004-10-05 07:43:07 by mthomas] Nonexistent file stopped entire install for libraries. bba137b [project @ 2004-10-05 12:51:33 by simonmar] inputReady foreign import should be "safe. a708d56 [project @ 2004-10-05 15:56:17 by simonmar] If we try to use a finalized handle, then throw a useful exception. Before, the thread would just block forever on the MVar or get a BlockedOnDeadMVar exception. 51fb2f8 [project @ 2004-10-06 10:13:07 by ross] make the evil PACKAGE_* hacks consistent a3f5ade [project @ 2004-10-06 11:11:34 by ross] Add getEnvironment from hslibs/lang/SystemExts. This differs from the System.Posix.Env version in not failing if an entry lacks an '=' sign. e144dab [project @ 2004-10-06 15:02:41 by malcolm] Dummy implementations of openBinaryFile and hSetBinaryMode for nhc98. b30fe6b [project @ 2004-10-06 23:45:37 by dons] Fix order of PACKAGE_* #undefs. They must appear before HsBaseConfig.h 898d6ce [project @ 2004-10-07 09:42:28 by malcolm] Oops, fix impdecl/fundecl ordering. 91e09c5 [project @ 2004-10-07 13:13:22 by stolz] Bring declaration of runProcess back in line with prototype: pid_t (ProcHandle) isn't compatible with int on SunOS. 5556c65 [project @ 2004-10-08 10:28:37 by simonmar] - make sure we don't overflow the table - use a checked array index just in case we *do* try to overflow - fix a harmless off-by-one 58056a8 [project @ 2004-10-08 12:04:48 by ross] revert previous change, so now these includes don't define PACKAGE_* 763b37c [project @ 2004-10-08 12:07:02 by ross] Hugs can't handle System.Process yet 8721065 [project @ 2004-10-08 21:21:08 by malcolm] Fix layout to Haskell'98. 791c906 [project @ 2004-10-09 07:51:06 by panne] Unbreak Hugs by moving pPrPr_disableITimers and execvpe to System.Posix.Internals (base package) and use it from System.Posix.Process (unix package). 246a7e6 [project @ 2004-10-11 10:54:57 by simonmar] genericRaise() hack needed on FreeBSD too. 038160e [project @ 2004-10-12 17:45:44 by ross] unused line e4069c6 [project @ 2004-10-13 10:24:16 by simonpj] c_execvpe & pPrPr_disableITimers: remove these in a Windows build. 386b65b [project @ 2004-10-14 14:58:50 by simonmar] Threaded RTS improvements: 1dd73bc [project @ 2004-10-17 00:08:08 by ross] markup ee9344e [project @ 2004-10-17 00:09:58 by ross] move some GHC-specific implementations into GHC.* 0ab9041 [project @ 2004-10-17 00:22:03 by ross] tighten imports 45140ff [project @ 2004-10-25 13:40:08 by simonmar] Doc update: notes on finalization of Handles 83bfac0 [project @ 2004-10-25 13:47:34 by simonmar] hDuplicate, hDuplicateTo: add finalizers 157f045 [project @ 2004-10-27 15:47:23 by ross] adjustments to doc comments 5857b7e [project @ 2004-11-03 01:10:59 by igloo] Implement TH ForallC constructor. 8c8be0a [project @ 2004-11-06 10:45:46 by panne] Push down the tests for errno values to the base package. There's really no need testing for this when e.g. building Happy. :-) c8098e6 [project @ 2004-11-06 11:10:18 by panne] Moved test for C/ISO types to base package, hopefully testing for all needed headers first. ba2b38a [project @ 2004-11-06 13:01:18 by panne] * Changed some '#include "ghcconfig.h"' to '#include "HsBaseConfig.h"' (or added the latter), tracking the recent autoconf-related changes. d3e0473 [project @ 2004-11-06 14:15:06 by panne] * Re-enable large file support * No need to test for lchown here 5c89384 [project @ 2004-11-06 16:34:25 by panne] 'd->d_name' (where d is of type 'struct dirent*') should always return a pointer to the directory entry's name, regardless if dirent is defined as 04b8c08 [project @ 2004-11-06 17:03:43 by panne] * Issue a warning when compilation/execution fails during FP_READDIR_EOF_ERRNO and assume a value of '0'. 00ab5a6 [project @ 2004-11-07 10:17:22 by ross] move CONST_O_BINARY detection down to libraries/base 1336b22 [project @ 2004-11-09 15:48:34 by simonmar] Adding Cabal to GHC, stage 1: 8224acf [project @ 2004-11-09 17:02:23 by simonmar] Make this compile with GHC < 6.3 351b987 [project @ 2004-11-10 11:27:54 by simonmar] Move the compatibility code for rawSystem from libraries/base into ghc/lib/compat. c04f2e1 [project @ 2004-11-11 17:17:30 by simonmar] remove unnecessary #ifdef 13fd5b4 [project @ 2004-11-11 17:48:49 by simonpj] Fix version skew 657eb83 [project @ 2004-11-12 12:34:52 by stolz] Push FreeBSD-unicode-detection into package 731ff7e [project @ 2004-11-12 15:14:17 by simonmar] Note Haskell 98 divergence in isAlpha. bcc5c31 [project @ 2004-11-12 17:07:54 by simonpj] Missing #include following per-package config changes 0d71238 [project @ 2004-11-13 08:21:32 by krasimir] Added the proposed System.FilePath. I also added to System.Directory the canonicalizePath and findExecutable functions. 0ede3d9 [project @ 2004-11-13 14:37:18 by panne] Get rid of those ugly WinDoze CR/LF 69695ec [project @ 2004-11-14 10:47:26 by malcolm] Allow new additions to build with nhc98 too. (I suspect more work is still needed to make them portable to Hugs as well.) c310125 [project @ 2004-11-14 10:48:23 by malcolm] Plumb in new addition System.FilePath. 605f8cb [project @ 2004-11-14 12:32:48 by ross] tweak imports for portability 128d075 [project @ 2004-11-14 20:25:54 by panne] Tiny refactoring, mostly used as a reminder that '#if blah_platform' tests are evil and should be replaced by feature-based test (autoconf!) and concentrated in few modules. System.FilePath is another great example for this, all #ifs should be replaced by a function handling a possible drive letter + a few separator constants. 3e32dec [project @ 2004-11-16 18:02:07 by ross] spelling in error message 92e474d [project @ 2004-11-16 23:36:36 by ross] drop with a negative length should yield the whole list, not [] f3f979a [project @ 2004-11-17 19:07:38 by sof] Expose Win32 console event handling to the user. 0b78351 [project @ 2004-11-18 00:56:24 by igloo] Implement FunDeps for TH. 86b86ee [project @ 2004-11-18 09:56:58 by tharris] Support for atomic memory transactions and associated regression tests conc041-048 16dfca6 [project @ 2004-11-18 16:39:54 by stolz] Push down more feature-tests 6cd05c9 [project @ 2004-11-19 12:54:12 by ross] make instance Enum () conform to the Report (though I doubt anyone will notice) 4f5cc6e [project @ 2004-11-22 10:16:42 by simonmar] Fix example code cb578df [project @ 2004-11-22 10:26:46 by simonmar] More fixes to the sample code (thanks to Satnam Singh for pointing out a problem). 31bcacc [project @ 2004-11-22 14:03:15 by simonmar] Plug a race condition in the IO manager 00fdbd9 [project @ 2004-11-25 15:01:24 by simonmar] Add explicit 'import Prelude' to fix dependencies (necessary for make -j) e8ac1c8 [project @ 2004-11-26 11:58:18 by simonmar] More 'import Prelude's to help make -j. 33af5e4 [project @ 2004-11-26 15:03:22 by ross] fix tycon name strings dc4805e [project @ 2004-11-26 16:00:06 by simonmar] more make -j fixing 3377074 [project @ 2004-11-26 16:22:09 by simonmar] Further integration with the new package story. GHC now supports pretty much everything in the package proposal. 3e3bb28 [project @ 2004-11-26 16:22:12 by simonmar] Further integration with the new package story. GHC now supports pretty much everything in the package proposal. 1665a23 [project @ 2004-11-30 10:04:31 by simonpj] Use C comment not Haskell comment in package.conf 604bd11 [project @ 2004-12-01 17:45:28 by ross] markup db861fd [project @ 2004-12-01 17:46:14 by ross] tweaks for portability 74d0298 [project @ 2004-12-02 14:52:30 by ross] add Henrik Nilsson's combinators for composing with pure functions 1be134c [project @ 2004-12-02 15:57:02 by ross] Hugs only: replace the CBITS pragma (files relative to cbits) with CFILES (files relative to the root of the package). ffe5660 [project @ 2004-12-03 12:19:51 by simonpj] Add nameModule; and PrimTyConI 961ba6f [project @ 2004-12-03 14:08:07 by ross] added a simple-minded implementation of rawSystem for non-GHC implementations. Also re-instated the doc comment that rawSystem lost in its travels. 937f8c0 [project @ 2004-12-08 11:05:31 by simonmar] - Update docs on finalizers: we don't guarantee to run finalizers at all, and you can't express finalizer ordering using touchForeignPtr. 0af150a [project @ 2004-12-09 09:45:39 by simonmar] Add subRegex & splitRegex 523390b [project @ 2004-12-09 17:25:15 by simonmar] Haddock only: import Data.Array.IArray, to avoid linking to hidden Data.Array.Base. c8292d2 [project @ 2004-12-14 12:37:28 by simonmar] Add Lennart's Printf module, extended by me to include hPrintf. 4cf1e85 [project @ 2004-12-14 12:44:52 by simonmar] Add instance Typeable MVar d62f2ba [project @ 2004-12-14 12:52:03 by simonmar] Some more Typeable instances, as requested on the ghc-users list a while back. c5d9bbb [project @ 2004-12-14 13:31:44 by malcolm] For nhc98, get entities from H'98 libraries, rather than redefine them here. 317468c [project @ 2004-12-14 13:32:38 by malcolm] Plumb in the new Text/Printf module. f6507c8 [project @ 2004-12-14 13:55:22 by simonmar] Add Text.Printf 9b65ef9 [project @ 2004-12-15 12:29:08 by simonpj] Pretty print PrimTyConI a95091a [project @ 2004-12-17 15:12:13 by simonmar] Add GHC.ConsoleHandler ba4fdad [project @ 2004-12-18 00:43:03 by ross] avoid a warning by defining getDrive only on Windows 057067e [project @ 2004-12-18 00:45:27 by ross] Add system-dependent filename extensions: exeExtension ("" or ".exe") objExtension (".o" or ".obj") dllExtension (".so" or ".dll") 14d7589 [project @ 2004-12-18 15:38:08 by panne] * Fixed Haddock comment. Please: Before committing, everybody should test with "make html" if the documentation is syntactically OK. It is quite frustrating to find a broken RPM build after several hours and 99% of the work done... >:-( 2132742 [project @ 2004-12-21 09:58:13 by simonpj] Comments only c257f43 [project @ 2004-12-21 12:12:40 by simonpj] Add GHC.Prim to base package modules 5f0ba68 [project @ 2004-12-21 14:00:12 by simonpj] Add an instance for Typeable RealWorld; and move the Typeable ST instance to Data.Typeable 554bbc1 [project @ 2004-12-21 16:42:06 by ross] Hugs only: move the Typeable instance for ST back to Control.Monad.ST. e6dc22c [project @ 2004-12-21 17:09:02 by simonpj] --------------------------------- Template Haskell: dynamically scoped qualified names --------------------------------- 097b243 [project @ 2004-12-23 00:02:41 by ralf] Resolved stage1 issues related SPJ's commit "Add more scoped type variables". Incidentally, this provides some input for the recent GHC list discussion on whether to provide lex. scope for function signatures. Not too many modules are affected! Good! 0043ea0 [project @ 2004-12-23 09:07:38 by simonpj] --------------------------------- Template Haskell: names again --------------------------------- 76672c6 [project @ 2004-12-24 12:12:28 by krasimir] minor performance update for withCAStringLen and newCAStringLen functions. We don't need to calculate the string length twice. d7445b6 [project @ 2004-12-24 12:20:18 by krasimir] revert the previous commit it was wrong b952ffb [project @ 2005-01-01 23:36:20 by krasimir] add getTemporaryDirectory to the collection of pre-defined directories. 04fd9bc [project @ 2005-01-01 23:59:58 by krasimir] According to the documentation, the Haskell implementation of Handle should implement single writer/multiple readers locking but the current implementation doesn't work under Windows. This commit fixes this using '_sopen' function instead of 'open'. The former allows to implement system level locking on Windows. The changes doesn't affect other platforms. 2bbab79 [project @ 2005-01-04 20:15:04 by krasimir] fix haddock comment f61189b [project @ 2005-01-05 21:30:05 by krasimir] Added implementation for hSetFileSize. The configure script checks for _chsize (usially Windows) and ftruncate (Linux) C functions and the package uses one of them to implement hSetFileSize. 72b83e6 [project @ 2005-01-06 16:35:04 by simonmar] Remove the leading '.' from exeExtension, objExtension and dllExtension. This is for consistency with joinFileExt, which does not expect to see a '.' in the extension. 8391324 [project @ 2005-01-06 16:37:36 by simonmar] Apply the previous change to the docs, too. b4fd512 [project @ 2005-01-06 18:14:40 by ross] extensions no longer include dots 36f7903 [project @ 2005-01-06 19:10:14 by krasimir] Reduce dependencies for GHC. This allows System.FilePath to be used in some low-level modules. 7446b65 [project @ 2005-01-06 19:35:05 by krasimir] add temporary files API 2f90d84 [project @ 2005-01-07 11:37:02 by simonmar] Add unsafeIOToSTM d55aeb8 [project @ 2005-01-07 12:22:18 by simonmar] oops, reinstate an import 3aa11fb [project @ 2005-01-07 13:31:07 by krasimir] fix for readFile001 d475b16 [project @ 2005-01-07 22:24:55 by krasimir] truncate the file only in WriteMode 9263e95 [project @ 2005-01-10 00:03:04 by krasimir] Add dropAbsolutePrefix function. (used in Cabal) 23e6371 [project @ 2005-01-10 23:25:04 by krasimir] move createIfNotExists and removeFileRecursive functions from Distribution.Simple.Utils to System.Directory. The functions are renamed to createDirectoryIfMissing and removeDirectoryRecursive. 7862413 [project @ 2005-01-11 12:12:36 by ross] haddock fix cf5744f [project @ 2005-01-11 12:14:00 by ross] tweak docs of name clashes ae91b1d [project @ 2005-01-11 13:20:22 by ross] doc fixes 5b9a3f1 [project @ 2005-01-11 13:29:34 by malcolm] Use ghc implementation of createDirectoryIfMissing and removeDirectoryRecursive for nhc98 and Hugs too. d23613d [project @ 2005-01-11 13:44:39 by malcolm] Hack around the non-portable ReadP library to allow nhc98 to use Data.Version. 8d142ee [project @ 2005-01-11 14:18:13 by ross] get IOError stuff from System.IO.Error instead of System.IO b5efe2a [project @ 2005-01-11 14:36:51 by ross] System.IO no longer re-exports System.IO.Error 0def01b [project @ 2005-01-11 14:49:07 by ross] untangle #if's a2302f6 [project @ 2005-01-11 16:04:08 by simonmar] Use OPTIONS_GHC instead of OPTIONS 3523844 [project @ 2005-01-11 16:04:32 by simonmar] Use OPTIONS_GHC instead of OPTIONS a4dd33a [project @ 2005-01-11 21:26:42 by krasimir] Use "o" extension everywere. Added haddock comment about the possible usage of "obj" for Hugs. 0498c99 [project @ 2005-01-13 10:23:07 by simonmar] import Prelude explicitly 8f500d7 [project @ 2005-01-13 10:37:35 by simonmar] Add Data.Map, Data.Set, Data.IntMap and Data.IntSet from Daan Leijen's DData library, with some modifications by JP Bernardy and others on the libraries at haskell.org list. Minor changes by me to remove the last references to DData, and add a DEPRECATED copy of the old Data.Set interface to the new Data.Set. 5e11a6a [project @ 2005-01-13 10:46:36 by ross] make comments ASCII 2d5d0a8 [project @ 2005-01-13 11:14:09 by ross] Hugs only: replace UserError with ResourceExhausted e5722b1 [project @ 2005-01-13 11:15:17 by ross] use ioError instead of the GHC-specific ioException 3d1901f [project @ 2005-01-13 12:09:55 by ross] kludge for cpp's that don't like \ at end of line b3a6694 [project @ 2005-01-13 12:26:50 by ross] another cpp hack (that infix declaration occurs 3 times!) 1ae033e [project @ 2005-01-13 13:31:09 by ross] adjust module header comments (the bit about imports still sounds wierd) ac8e3f2 [project @ 2005-01-14 00:00:22 by ross] make these work with Hugs (pending the possible return of Word) and simplify the #if's a bit. dfa72b3 [project @ 2005-01-14 12:06:51 by ross] Hugs: use Word like everyone else cc1301c [project @ 2005-01-14 12:18:00 by ross] Hugs: include instances for Word df1f5bb [project @ 2005-01-14 14:30:42 by malcolm] Minor tweaks to build with nhc98. d590170 [project @ 2005-01-14 14:31:58 by malcolm] Hook up the new Text.Map, Text.IntSet, and Text.IntMap modules, and the existing Text.Regex stuff. 7311bf6 [project @ 2005-01-14 17:01:02 by ross] non-GHC: import Word type be5f3d7 [project @ 2005-01-16 11:50:45 by panne] Improved DEPRECATED pragmas a bit 4edfa30 [project @ 2005-01-16 12:52:21 by ross] added runKleisli as suggested by David Menendez 7ae3093 [project @ 2005-01-17 11:08:52 by simonmar] Add Data.FunctorM ab986ec [project @ 2005-01-17 11:23:25 by ross] doc tweaks b6fdb43 [project @ 2005-01-17 13:23:43 by simonmar] Add Typeable instances for the new DData libraries 33197cc [project @ 2005-01-18 11:23:35 by ross] generalize the types of intersectionWith and intersectionWithKey 94fee9e [project @ 2005-01-18 15:08:39 by simonmar] Win32: attempt to make inputReady() work on pipes too. Fixes bug #995658. 7ec0d5b [project @ 2005-01-19 17:20:31 by ross] document the deprecated functions, and redirect mkSet to fromList 153e477 [project @ 2005-01-19 22:33:32 by ralf] Added quite a few more Data instances. 2580de4 [project @ 2005-01-19 23:32:04 by ross] fix name in Typeable instance eeb2216 [project @ 2005-01-19 23:33:25 by ross] Move comments inside #if's they refer to -- makes the cpp output, e.g. as seen by Hugs users, more sensible. 36622b8 [project @ 2005-01-20 10:36:43 by malcolm] Include Typeable instance for nhc98. 5728000 [project @ 2005-01-20 11:09:54 by malcolm] Hook up Data.FunctorM, and update dependencies from Data.Set, Data.IntMap, Data.Map etc, on Data.Typeable. d29794e [project @ 2005-01-20 14:22:26 by simonmar] Fill in the haddock-interfaces and haddock-html fields in the package.conf files. ddac311 [project @ 2005-01-20 14:39:09 by malcolm] Lots more new dependencies. 89eb503 [project @ 2005-01-20 19:00:26 by ross] cross-references and minor doc fixes a6c1afd [project @ 2005-01-21 09:55:52 by malcolm] Typo c9249be [project @ 2005-01-21 10:52:47 by ross] refine docs a bit 9d16745 [project @ 2005-01-21 11:44:08 by ross] alter the interface of splitLookup and splitMember, placing the match between the trees of smaller and larger elements in the returned triple. 565cbfe [project @ 2005-01-21 12:37:05 by simonmar] Update the haddock fields 2420bf2 [project @ 2005-01-21 15:12:21 by simonmar] hClose on stdin,stdout,stderr now actually closes the file descriptor. Before, there was no way to actually close these file descriptors, which might be necessary in some cases - especially when stdin/stdout are pipes and you need to indicate to the other end of the pipe that you've finished I/O, but without exiting the program. 47f3a57 [project @ 2005-01-21 16:02:47 by simonmar] Don't try to run finalizers at program exit. This turned out to be hard if not impossible to do in general, so now we don't attempt it at all. 732861d [project @ 2005-01-21 19:59:01 by sof] win32 only: Tidy up delivery and handling of console events by having the low-level console event handler signal the RTS thread blocked waiting for I/O. 865ce29 [project @ 2005-01-21 21:52:56 by panne] *sigh* Once again: Fixed a Haddock comment which broke "make html"... Why on earth do we have "make validate"?? :?-( I think we should introduce some kind of disciplinary punishment for checking in broken Haddock comments, like porting the mangler to a new platform or porting Adjustor.c to an ABI more irregular than the one on PowerPC... 73dc4c0 [project @ 2005-01-22 12:18:49 by panne] Doc change only: I don't think that toList should give the guarantee that the resulting list is in ascending order... 11ffbdf [project @ 2005-01-23 11:30:39 by panne] * Nuked one #ifdef in isPathSeparator, the generated code is the same * Added a ToDo for searchPathSeparator 23e414d [project @ 2005-01-23 13:12:52 by panne] Unify the base and Cabal versions of GetOpt a bit. 96d9fa6 [project @ 2005-01-23 13:48:19 by panne] Added Isaac's getOpt variant (named getOpt' now), so System.Console.GetOpt and Distribution.GetOpt are identical now. df028ab [project @ 2005-01-23 20:20:55 by wolfgang] Flush stdout and stderr also when exiting due to an ExitException. 44a3357 [project @ 2005-01-24 04:26:17 by wolfgang] Always flush stdout & stderr at exit, even when terminating abnormally due to an exception. d0497c6 [project @ 2005-01-25 17:06:39 by ross] add Cabal package descriptions 0aa48bd [project @ 2005-01-25 22:17:37 by krasimir] Fixed bug with splitFileExt "foo.bar." and splitFileName "foo:bar" e11ddba [project @ 2005-01-26 12:23:33 by simonmar] I think InvalidArgument is more useful than OtherError for EBADF. 3b4e02c [project @ 2005-01-26 13:27:44 by malcolm] Change stability notation from 'stable' to 'experimental', since many people seem to agree there are plenty of bugs here. 06fa805 [project @ 2005-01-26 14:33:29 by malcolm] Fix module name. 4608e3e [project @ 2005-01-26 14:36:42 by malcolm] Patch from John Meacham: Generalise a couple functions in Data.Map to be usable in an arbitrary monad (rather than being restricted to Maybe). 3cfdf74 [project @ 2005-01-26 14:55:41 by simonmar] Remove System.FilePath pending a redesign of the interface. Temporarily introduce System.Directory.Internals as a home for some of the bits of System.FilePath we were already using elsewhere. be80e49 [project @ 2005-01-26 15:19:19 by malcolm] Remove System.FilePath. 85bdaa2 [project @ 2005-01-26 15:40:37 by simonmar] remove System.FilePath; add System.Directory.Internals. a65cba7 [project @ 2005-01-26 15:41:01 by simonmar] Add System.Directory to $(ALL_DIRS) e27d450 [project @ 2005-01-27 10:45:47 by simonpj] -------------------------------------------- Replace hi-boot files with hs-boot files -------------------------------------------- 030644d [project @ 2005-01-27 10:46:19 by malcolm] Hook up System.Directory.Internals. fa67e70 [project @ 2005-01-27 14:19:50 by simonpj] Fix regex.h include stuff; Ross and Malcolm might want to look at the new comment c721dd8 [project @ 2005-01-27 14:38:05 by ross] doc tweaks 3a682aa [project @ 2005-01-28 10:15:44 by ross] fix foreign imports for non-GHC 2940ff3 [project @ 2005-01-28 13:36:25 by simonmar] Catch up with updates to platform #defines. a0808a9 [project @ 2005-01-28 13:54:56 by simonmar] System.Info now exports: 8013474 [project @ 2005-01-28 14:55:05 by simonmar] Remove unnecessary ghcconfig.h include f8249e4 [project @ 2005-01-28 15:03:06 by simonmar] Remove some unnecessary #includes of ghcconfig.h 3bfe0cc [project @ 2005-01-28 16:09:06 by malcolm] Add compilerVersion for nhc98. 5762f04 [project @ 2005-01-28 23:33:57 by krasimir] - The output from uncaught exceptions handler is redirected to RTS's errorBelch. - The output from Debug.Trace is redirected to RTS's debugBelch - Usually errorBelch and debugBelch messages go to stderr except for Windows GUI applications. For GUI applications the Debug.Trace output is redirected to debug console and the exceptions message is displayed in message box. dbc3cfe [project @ 2005-01-29 16:10:27 by wolfgang] import CString on non-windows platforms. 353ec34 [project @ 2005-01-31 12:57:26 by simonmar] Cleanup: convert System/Posix/Signals.hsc into a plain .hs file, and use the configure script to get the appropriate constants. 9f60683 [project @ 2005-01-31 13:45:50 by malcolm] Work around type-system bug (cxt in lhs pattern) in nhc98. dd2035f [project @ 2005-01-31 13:46:24 by simonmar] oops, remove debugging modification 40793bd [project @ 2005-01-31 13:51:22 by simonmar] Some improvements to System.Cmd.{system,rawSystem} on Un*x systems: these commands now do the appropriate signal handling, namely ignoring SIGINT/SIGQUIT in the parent but allowing these signals in the child. This behaviour matches the Un*x system(). c8d9c29 [project @ 2005-01-31 13:52:26 by malcolm] Make it compile for non-GHC. e5c232e [project @ 2005-01-31 15:48:21 by simonpj] --------------------------- Some Template Haskell fixes --------------------------- 7a2b4ed [project @ 2005-01-31 18:33:48 by ross] fix for non-GHC 0b45108 [project @ 2005-01-31 19:28:42 by panne] * Unbreak System.Info for Hugs, rearranging the whole module a bit. e5ccf95 [project @ 2005-01-31 19:54:22 by panne] Ooops, my evil XEmacs inserted an extraneous character... :-} a24f30e [project @ 2005-01-31 21:07:15 by panne] Documentation fix only ("in" is a keyword) a69fb32 [project @ 2005-02-01 00:52:20 by ross] more regex test down to libraries/base 0178a82 [project @ 2005-02-01 10:12:16 by krasimir] Fixes for Windows 4a660ce [project @ 2005-02-01 11:52:08 by malcolm] Record more dependencies. d00ccc5 [project @ 2005-02-01 13:02:37 by simonmar] Make hDuplicateTo actually use dup2() rather than dup(). The difference is noticeable if you want to eg. redirect stdout and then use executeFile or spawn sub-processes. 19097c4 [project @ 2005-02-01 13:41:41 by simonmar] Move #include of HsBaseConfig.h up 183400b [project @ 2005-02-01 16:47:27 by malcolm] Make the cpp directives in NHC.SizedTypes directly usable by nhc98 with internal cpphs, avoiding ANSI-only string-pasting. 48a0f00 [project @ 2005-02-01 17:32:19 by ross] docs 11e6a2f [project @ 2005-02-02 10:59:16 by malcolm] Build all package sources using hmake. The inaccurate and ever-changing Makefile dependencies can now all be thrown away, hurrah! 771e82b [project @ 2005-02-02 13:26:13 by simonpj] I've moved Typeable instances so that they are either in the module that defines the type or in the Typeable module (which defines the class) fc8e94f [project @ 2005-02-02 13:45:05 by malcolm] nhc98 has Data.Typeable. 4539e4a [project @ 2005-02-02 13:47:24 by simonpj] Generalise gfindtype to c3b4dd3 [project @ 2005-02-02 14:54:18 by ross] an instance for FunPtr, and minor Hugs fixes: dab859f [project @ 2005-02-02 15:20:11 by simonmar] tiny doc fix 7c6b74a [project @ 2005-02-02 15:21:02 by simonmar] doc fixes b83c9d3 [project @ 2005-02-02 15:22:19 by simonmar] Doc fixes 0eccfe4 [project @ 2005-02-02 15:22:54 by simonmar] Doc fix a257592 [project @ 2005-02-02 15:23:59 by simonmar] doc fixes de37eee [project @ 2005-02-02 15:28:49 by simonmar] doc fix c0c54c7 [project @ 2005-02-03 10:32:11 by ross] hide GHC internals from Haddock 8471d81 [project @ 2005-02-03 10:38:44 by simonmar] unhide a few modules 066eef3 [project @ 2005-02-04 14:20:57 by ross] if this can't be hidden, at least make it not-home 557cf09 [project @ 2005-02-04 14:36:52 by simonmar] Add a comment to Ross's previous commit (sorry, forgot to commit my version of that change earlier). 7470bd3 [project @ 2005-02-05 00:41:35 by ross] more Haddock fixes. c9aef57 [project @ 2005-02-07 09:56:42 by ross] a few docs (for STABLE) ac1f0f6 [project @ 2005-02-07 10:26:55 by simonpj] Documentation of flush behaviour of runIO 9333e0e [project @ 2005-02-07 12:21:29 by simonmar] After no response on libraries at haskell.org... John Meacham's Data.Graph patch, which returns an extra component from graphFromEdges. The old version of graphFromEdges is available as graphFromEdges'. b36d1d2 [project @ 2005-02-07 15:26:10 by malcolm] Place imports before #includes, just to reduce the number of 'file not found' warnings from hmake. da1b8a2 [project @ 2005-02-11 01:55:56 by ross] track syntax changes: 6e9b375 [project @ 2005-02-11 11:36:23 by simonmar] Add bracketOnError d0844e7 [project @ 2005-02-13 10:53:13 by malcolm] Eliminate more explicit dependencies in Makefiles: use hmake to create the bootstrapping .hc files, as well as the ordinary .o files. 03b44bc [project @ 2005-02-15 08:09:43 by ross] Hugs only: use binary handles for copyFile 018c1c2 [project @ 2005-02-15 21:06:31 by panne] For the 100th time: Fixed Haddock comment syntax. >:-( Perhaps we should really introduce a commit hook which verifies that "make html" works... 105f0e0 [project @ 2005-02-18 15:06:45 by simonmar] Rename fields in InstalledPackageInfo for consistency with PackageDescription & buildInfo: a914eed [project @ 2005-02-18 15:06:47 by simonmar] Rename fields in InstalledPackageInfo for consistency with PackageDescription & buildInfo: a65fe8b [project @ 2005-02-18 18:30:40 by ross] Rename package description fields as in InstalledPackageInfo: f2e87f7 [project @ 2005-02-21 11:36:07 by simonmar] docs only: clarify language in a couple of places. 3351d4b [project @ 2005-02-23 06:31:22 by dons] Typo in comment only. Spotted by sjanssen on #haskell. ab8e4ad [project @ 2005-02-24 09:58:23 by simonmar] nDoc fixes from Sven Panne. Generally fixing of Haddock links, adding some signatures, and in some cases exporting type constructors that are mentioned in the types of exported identifiers. e5bc0f2 [project @ 2005-02-24 09:58:26 by simonmar] nDoc fixes from Sven Panne. Generally fixing of Haddock links, adding some signatures, and in some cases exporting type constructors that are mentioned in the types of exported identifiers. 81e8f16 [project @ 2005-02-25 10:42:24 by simonmar] Add instance Typeable Queue 2d783d3 [project @ 2005-02-26 12:14:54 by panne] Moved Monoid instances of collection types to Data.Monoid, concentrating non-H98 stuff to a single place. 4d00bd6 [project @ 2005-03-02 13:11:00 by simonmar] We should not assume that the timeout parameter to select() is updated with the time left over after select() returns. Linux does this, but FreeBSD does not. 57c01ca [project @ 2005-03-02 14:46:14 by simonmar] distcleaning of things generated by configure e26da1d [project @ 2005-03-02 16:39:56 by ross] *Config.h files are in include/ (MERGE to STABLE) e7f3672 [project @ 2005-03-03 05:11:41 by chak] Merge to STABLE ad7c83f [project @ 2005-03-04 18:26:48 by sof] Temper 'libm' testing -- if 'atan' is available straight from libc, no need to include libm. 085be2d [project @ 2005-03-05 14:13:56 by panne] Use Data.Map instead of the deprecated Data.FiniteMap 12a28a1 [project @ 2005-03-05 15:13:01 by panne] Warning police again: Use the "official" hs_free_stable_ptr from HsFFI.h instead of the internal freeStablePtr, avoiding 02cf8b2 [project @ 2005-03-07 10:40:44 by simonmar] merge rev. 1.4.2.1 to HEAD 8a52d92 [project @ 2005-03-07 13:02:37 by simonmar] Add dynTypeRep, from John Meacham. 4a93ff0 [project @ 2005-03-09 17:47:50 by simonpj] Add instances for Bounded and Show up to 15-tuples 052a792 [project @ 2005-03-10 10:00:39 by simonpj] Read instances for tuples 9cc3315 [project @ 2005-03-10 17:23:06 by malcolm] Change configuration for nhc98 on Cygwin only. 2b179f0 [project @ 2005-03-14 12:18:05 by simonmar] Add Dimitry Golubovsky 's Unicode character class implementation. This will remove the dependency on libc's locale code and give us much more consistent support for Unicode across platforms. 74348f6 [project @ 2005-03-14 15:22:51 by simonmar] - isDigit only returns True for ASCII digits - Export the new predicates from Data.Char e5e2a19 [project @ 2005-03-14 15:46:12 by simonmar] Add Data.Ord and Data.Eq. Data.Ord also exports the new function 'comparing', as discussed on the libraries list a while back. 16246ff [project @ 2005-03-14 15:52:03 by simonmar] doc comparing 44c3027 [project @ 2005-03-14 15:57:04 by malcolm] Plumb in Data.Eq and Data.Ord. 976352f [project @ 2005-03-14 15:57:57 by simonmar] Add the script used to generate WCsubst.c 8f6b60a [project @ 2005-03-14 16:26:47 by simonmar] Fix export of Ordering b2d8004 [project @ 2005-03-14 17:23:22 by ross] Hugs only: don't import Data.{Eq,Ord} 1e09384 [project @ 2005-03-14 18:02:48 by ross] move general categories and derived predicates to Data.Char b7e91d4 [project @ 2005-03-15 12:15:15 by malcolm] nhc98 can use the WCsubst.c stuff for Unicode as well. 2173a4b [project @ 2005-03-15 13:38:27 by simonmar] patch for iswprint() from Dimitry. b683b7d [project @ 2005-03-15 17:18:24 by ross] remove unused WInt type 90b7403 [project @ 2005-03-15 17:19:09 by ross] Nhc: export the new names 77efda4 [project @ 2005-03-16 10:55:04 by simonmar] Back-port changes from WCsubst.c:iswprint() 56f0efe [project @ 2005-03-16 13:27:03 by ross] Data.Char docs, and hide GHC.Unicode 9e7c0b2 [project @ 2005-03-18 17:28:08 by krasimir] HACK: The redirection of standard handles under Windows is a little bit tricky because we have to take in account that the application can be GUI. The commit affects only Windows GUI applications. 7ac781d [project @ 2005-03-19 02:03:26 by sof] [Windows only] for System.Directory / Compat.Directory functionality that probes the OS for local details re: misc user directories, perform late binding of SHGetFolderPath() from shell32.dll, as it may not be present. (cf. ghc-6.4's failure to operate on Win9x / NT boxes.) If the API isn't there, fail with UnsupportedOperation. Packages.readPackageConfigs: gracefully handle excns from getAppUserDataDirectory. c0807fa [project @ 2005-03-21 18:04:48 by sof] __hscore_getFolderPath(): Don't limit ourselves to shell32.dll, look up shfolder.dll too. f2ab06e [project @ 2005-03-24 09:19:52 by simonmar] __hscore_getFolderPath is ccall, not stdcall. c77f5b4 [project @ 2005-03-27 13:41:19 by panne] * Some preprocessors don't like the C99/C++ '//' comments after a directive, so use '/* */' instead. For consistency, a lot of '//' in the include files were converted, too. a0f9b18 [project @ 2005-03-30 11:15:21 by simonmar] Ord instance: use toAscList instead of toList (doc change only; these functiosn are the same). f9aaf4e [project @ 2005-03-31 21:40:15 by wolfgang] Fix handling of end-of-options markers (--). getOpt would correctly return the non-options after the marker, but it would return errors for things after the marker that looked like options. b91764b [project @ 2005-04-02 04:39:35 by dons] Typo in comment only: "Causes a the finalizers associated with a foreign pointer..." to "Causes the finalizers associated with a foreign pointer..." 7847930 [project @ 2005-04-04 08:02:53 by simonmar] doc fix a0707a5 [project @ 2005-04-04 10:23:03 by simonpj] Indent where clauses 909df73 [project @ 2005-04-04 12:08:27 by simonpj] Match changes in DsMeta 58506e5 [project @ 2005-04-04 12:16:45 by simonpj] Default method for unsafeRangeSize should use unsafeIndex! 7e674ec [project @ 2005-04-05 08:38:24 by simonmar] Determine the location of CMD.EXE (or COMMAND.COM) using the same algorithm as system() from msvcrt. cf6ac4d [project @ 2005-04-06 22:05:58 by simonmar] Fix bug in hDuplicateTo 1d2fa28 [project @ 2005-04-07 14:33:31 by simonmar] Support handling signals in the threaded RTS by passing the signal number down the pipe to the IO manager. This avoids needing synchronisation in the signal handler. 0bf709e [project @ 2005-04-07 23:36:48 by sof] import reordering wibble to make it mingw-palatable. a7547ec [project @ 2005-04-12 12:57:49 by ross] clarify docs of insert and union. 8b9d1a1 [project @ 2005-04-17 10:06:16 by panne] Merged "unrecoginzed long opt" fix from Distribution.GetOpt 70c1fee [project @ 2005-04-21 09:40:41 by simonmar] Add unsafeForeignPtrToStorableArray 59e583d [project @ 2005-04-22 16:07:36 by sof] make DEBUG_DUMP-conditional code compile 21efff4 [project @ 2005-04-22 17:00:49 by sof] [mingw only] Better handling of I/O request abortions upon throwing an exception to a Haskell thread. As was, a thread blocked on an I/O request was simply unblocked, but its corresponding worker thread wasn't notified that the request had been abandoned. 6a56194 [project @ 2005-04-25 13:25:08 by simonmar] Only ftruncate() regular files. ae3215c [project @ 2005-05-04 15:07:47 by simonmar] Do *not* inline runSTRep now (see comments for details). 186152b [project @ 2005-05-06 00:30:56 by sof] [mingw only] Work around bug in win32 Console API which showed up in the GHCi UI: if the user typed in characters prior to the appearance of the prompt, the first of these characters always came out as a 'g'. The GHCi UI does for good reasons one-character reads from 'stdin', which causes the underlying APIs to become confused. A simple repro case is the following piece of C code: 000d5f5 [project @ 2005-05-13 16:58:02 by sof] flush_input_console__(): if the fd isn't connected to a console, treat flush as a NOP. Merge to STABLE. 77a3191 [project @ 2005-05-27 19:26:34 by simonmar] hLookAhead: don't wait for a completely full buffer e93177c [project @ 2005-06-10 13:19:41 by simonpj] Eta-contract foldr/app RULE to avoid overlap with foldr/id 8e91a49 [project @ 2005-06-10 13:21:52 by simonpj] Make toConstr strict for tuples, so that it's uniform with all other data types. 15a0ca0 [project @ 2005-06-27 13:56:32 by simonmar] Fix performance buglet: small Float literals weren't being simplified enough because the fromInteger method is defined in terms of encodeFloat, which itself is an FFI call. Double was already fixed, this change does the right thing for Float too. 4ff2fe3 [project @ 2005-06-27 22:31:41 by simonmar] As discussed on ghc-users some time ago, optimise the representation of ForeignPtr to make withForeignPtr more efficient. ForeignPtr is now represented by a pair of an Addr# and a ForeignPtrContents object. 084d417 [project @ 2005-07-04 10:22:17 by ross] add Typeable instance 47c5027 [project @ 2005-07-06 12:13:04 by simonmar] Close Handles passed to runProcess. Fixes #1187302 0c7e84a [project @ 2005-07-06 12:25:53 by simonmar] runProcess: allow duplicate Handles to be passed in without deadlock. Fixes #1187295. 858a97b [project @ 2005-07-06 16:17:36 by malcolm] Fix (from Scott Turner) for a broken implementation of 'split'. 0d0409f [project @ 2005-07-08 12:22:02 by simonmar] Fix instance Eq Version d389445 [project @ 2005-07-08 13:17:47 by simonmar] oops, fix imports 6d6efd8 [project @ 2005-07-08 17:17:31 by sof] - System.Posix.Internals.FDType.RawDevice: new constructor. - System.Posix.Internals.fdType: map block devices to RawDevice (but left character devices as still being Streams). - GHC.IOBase.isReadWriteHandleType: new HandleType predicate. - GHC.Handle.hIsSeekable: RawDevices are seekable. - GHC.Handle.openFd: handle RawDevices. => opening of block devices via std IO opening actions (open{Binary}File, openFd etc.) should now work better. 9f17e12 [project @ 2005-07-10 23:01:24 by ross] doc fix from Remi Turk 4316b2b [project @ 2005-07-14 11:57:09 by ross] Hugs only: more specific imports 170aa6c [project @ 2005-07-14 11:59:27 by ross] Data.Sequence: general purpose finite sequences (as discussed on the libraries list in May 2005). 0c691f5 [project @ 2005-07-14 15:36:31 by ross] remove redundant definitions of unsafeRangeSize (same as default) 48c53ef [project @ 2005-07-19 09:26:03 by ross] use $host instead of $target (mainly affects builds with cabal) dd5aff1 [project @ 2005-07-19 17:06:18 by ross] hook in Data.Sequence dc174ba [project @ 2005-07-19 17:33:23 by ross] improved definition of gfold for Seq a 550699d [project @ 2005-07-19 23:22:39 by ross] use feature tests instead of $host to locate socket library bce52f0 [project @ 2005-07-21 09:26:30 by simonmar] copyFile: copy the permissions properly (don't use getPermissions >>= setPermissions, which only copies the owner's permissions on Unix). 6f7a77e [project @ 2005-07-21 10:00:34 by simonmar] Further optimisations to ForeignPtr: now we don't allocate the IORef for a ForeignPtr without a finalizer. 5fabb36 [project @ 2005-07-21 10:59:27 by ross] more SPECIALIZE pragmas e2c3b39 [project @ 2005-07-21 11:00:17 by ross] revise Data instance again, making it like lists c7cf5ce [project @ 2005-07-21 11:08:51 by ross] specialize instances too efd2f2a [project @ 2005-07-21 12:54:33 by simonmar] Hack Makefiles so that 'make distclean' works even if the tree has not been configured, or 'make distclean' has already been run. 147c719 [project @ 2005-07-22 08:15:06 by ross] unbreak for non-GHC 7824273 [project @ 2005-07-22 10:18:51 by simonmar] check the return value of chdir() f0a1217 [project @ 2005-07-22 16:25:16 by ross] revert 1.17 6c85e7a [project @ 2005-07-23 13:28:24 by ross] Hugs: omit commandToProcess 02c7b60 [project @ 2005-07-23 17:08:03 by ross] non-GHC: implement rawSystem by translating the string for system. 20d9d69 [project @ 2005-07-26 09:37:27 by ross] PrelHandle functions are only needed by GHC 55872fc [project @ 2005-07-26 11:00:42 by ross] this version of closeFd is used by GHC only e6212d3 [project @ 2005-07-27 00:52:33 by ross] Hugs only: no longer need backslash fiddle now that Hugs leaves them alone. e06343d [project @ 2005-07-27 10:04:26 by simonmar] expand docs for touchForeignPtr and newConcForeignPtr 4bfe7c0 [project @ 2005-07-28 13:27:03 by ross] avoid warnings e63043f [project @ 2005-07-29 17:02:07 by ross] use Data.Sequence instead of Data.Queue b682cf9 [project @ 2005-07-29 17:03:37 by ross] deprecate in favour of Data.Sequence c21af11 [project @ 2005-07-29 17:17:22 by ross] document deprecation 751d276 [project @ 2005-08-01 13:23:22 by simonmar] Fix f51320c [project @ 2005-08-04 11:40:26 by simonmar] fix typo in subRegex (fixes subRegex breakage on Windows) 5c9f70d [project @ 2005-08-05 09:48:16 by ross] haddock stuff eb9ebee [project @ 2005-08-12 10:49:45 by dons] Typo in comment only 0b4e1f1 [project @ 2005-08-31 12:15:31 by ross] Hugs: use custom versioon of unsafeInterleaveIO 75e4c3e [project @ 2005-09-01 10:49:07 by ross] GHC only: define toList using build eb91a81 [project @ 2005-09-02 14:04:38 by simonmar] back out rev. 1.22; as pointed out by Krasimir Angelov, the optimisation doesn't work (sadly). cf2ac7d [project @ 2005-09-18 02:22:33 by dons] Typo in comment only. Spotted by heatsink on #haskell. ee014ae [project @ 2005-09-18 10:01:57 by panne] Fixed a few underquoted definitions. f547a0a [project @ 2005-09-19 23:24:31 by ross] For compilers other than MSVC and GCC, assume inline has the C99 semantics. a5c08f0 [project @ 2005-09-21 11:54:59 by simonmar] improve documentation for getProcessExitCode 959189a [project @ 2005-09-22 09:43:01 by ross] some docs 09a8784 [project @ 2005-09-24 15:07:49 by panne] Synched all FPTOOLS_CHECK_HTYPE definitions with the latest changes in libraries/OpenAL/aclocal.m4. Although it is not strictly necessary, keeping things identical is good for consistency. At some point in time we should really find a way to eliminate all this redundancy... *sigh* dd3c91d [project @ 2005-09-28 13:18:28 by malcolm] Add an instance of Read to correspond to the existing Show instance. (Implementation based on H'98 Report definition of 'readList'.) 536fe97 [project @ 2005-09-29 09:31:58 by ross] Tweak Read instance: allow optional parentheses around the outside (for consistency), and don't propagate precedence to elements. fcf6bc9 [project @ 2005-10-05 08:43:26 by ross] add Monad and MonadPlus instances 614127f [project @ 2005-10-05 13:15:44 by simonmar] mention that -O turns assertions off c787514 [project @ 2005-10-05 14:04:28 by simonmar] hPutChar should (probably) not be strict in its Char argument c149d13 [project @ 2005-10-10 23:32:51 by sof] CSsize fix: this Haskell type is defined iff HTYPE_SSIZE_T is. Merge to STABLE 145fc12 [project @ 2005-10-12 10:57:40 by simonpj] Comments 00178b8 [project @ 2005-10-13 10:35:49 by ross] comments re strict/lazy monads b1725c6 [project @ 2005-10-13 10:36:42 by ross] MArray instance for Lazy.ST df1dd98 [project @ 2005-10-13 11:09:50 by ross] update non-portability reasons c50cb4d [project @ 2005-10-18 11:36:25 by simonmar] Fixes to enable base to be compiled with -fasm on Windows: d3e1872 [project @ 2005-10-20 10:58:44 by malcolm] Instance of Read for Map, from Georg Martius. c5c9f61 [project @ 2005-10-20 15:08:35 by ross] Read instance ad514db [project @ 2005-10-20 15:14:22 by malcolm] Add spaces in Show instance, to avoid lexing problems e.g. Foo:=-0.9 in Read. 963fb60 [project @ 2005-10-20 17:12:28 by krasimir] from Neil Mitchell: 0c45859 [project @ 2005-10-20 18:07:53 by krasimir] The original version of @findExecutable@ was looking only in the $PATH but under Windows the executables are searched in the current directory, in $PATH and in some other places too. The new version is based on @SearchPath@ function from Win32 API. This is more consistent with @system@ and @rawSystem@ a50a2c7 [project @ 2005-10-20 23:28:42 by ross] revise Read instance to match < and > as chars rather than lexemes, as suggested by Georg Martius. 15d768a [project @ 2005-10-21 06:54:13 by ross] repair findExecutable 09106d4 [project @ 2005-10-21 10:24:58 by ross] export parens, which is useful for writing Read instances. 59d60fd [project @ 2005-10-21 10:26:57 by ross] conformant Show and Read instances 564bd0e [project @ 2005-10-21 10:39:56 by ross] conformant Show and Read instances b6a50ff [project @ 2005-10-21 10:47:25 by ross] conformant Show and Read instances. b585313 [project @ 2005-10-21 13:10:48 by simonmar] cmp_thread returns CInt, not Int b167a23 [project @ 2005-10-21 16:25:45 by ross] Data and FunctorM instances for View[LR]. 6925cf0 [project @ 2005-10-21 16:31:23 by ross] oops 8da605e [project @ 2005-10-22 00:28:21 by ross] define readListPrec too. 3e03f66 [project @ 2005-10-22 00:37:01 by ross] docs (readListDefault seems pretty useless) 86436c0 [project @ 2005-10-25 09:01:48 by simonmar] Note that throwTo blocks if the target thread is in a foreign call. 2cf6d82 [project @ 2005-10-25 09:11:25 by ross] Change the Monoid instance for functions (as proposed on the libraries list, and interpreting silence as assent) from composition to pointwise combination. ba5cc0b [project @ 2005-10-25 09:29:16 by ross] Now that Data.Monoid is portable, move Monoid instances for sets and maps back to where the data types are defined. a2138cd [project @ 2005-10-25 09:29:47 by ross] add Monoid instance b59789a [project @ 2005-10-25 11:13:53 by simonmar] forkIO the signal handlers directly from the IO manager thread, rather than calling an RTS function to do the same thing. 6f4bd87 [project @ 2005-10-25 12:01:11 by simonmar] fix findExecutable (I hope; don't have an up to date Windows build to test on). 823c0bc [project @ 2005-10-25 17:31:38 by sof] FPTOOLS_CHECK_HTYPE: correctly scope the resetting of CPPFLAGS; as was, it got blown away if the value was cached. 9a4eee8 [project @ 2005-10-26 22:52:58 by ross] missing part of rev. 1.13: in unfoldForestM_BF, the output sequence is now in the right order, so don't reverse it. 04179b4 [project @ 2005-10-27 01:39:40 by sof] [mingw/msys only] Undo long-standing workaround for buggy GNU ld's on mingw/msys; i.e., the linker wasn't correctly generating relocatable object files when the number of relocs exceeded 2^16. Worked around the issue by hackily splitting up the GHCi object file for the larger packages ('base', 'ObjectIO' and 'win32') into a handful of object files, each with a manageable number of relocs. Tiresome and error-prone (but the hack has served us well!) 0a1998c [project @ 2005-11-07 16:39:04 by simonmar] add GHC notes to mallocForeignPtr da71071 [project @ 2005-11-10 12:58:32 by simonmar] Some docs for System.Posix, from Bj?rn Bringert 2e0fce3 [project @ 2005-11-11 10:37:35 by simonmar] Fix bugs in new signal handling machinery a8973d9 [project @ 2005-11-11 12:01:58 by simonmar] On Windows, attach a finalizer to the ProcessHandle so that we can call CloseHandle() when the handle is no longer in use. Previously we were calling CloseHandle() in waitForProcess and terminateProcess, which prevented making multiple calls to these functions on the same handle. f5cf2d4 [project @ 2005-11-11 14:41:01 by simonmar] waitForProcess: if the process died with a signal, just return the exit status rather than EINTR. 1fd5b3a [project @ 2005-11-13 16:52:14 by jpbernardy] Correct handling of negative numbers in split and splitMember in IntMap and IntSet. Better documentation for insert and insertWith in Maps. c2922a3 [project @ 2005-11-17 11:28:43 by simonmar] ProcessHandle is now an MVar, in which we cache the ExitCode of the process when we know it. 01fe96a [project @ 2005-11-17 15:54:17 by ross] add a couple of Boolean instances c472d50 [project @ 2005-11-29 14:31:59 by ross] As foreshadowed on the libraries list, introduce new classes: 6615952 [project @ 2005-11-30 12:24:18 by simonmar] Add 7e724f3 [project @ 2005-11-30 16:56:24 by simonmar] - move forkIO into GHC.Conc, so that the I/O manager can use proper forkIO with an exception handler. This required TopHandler.lhs-boot. It's the right thing, though, since the forkIO implementation is GHC-specific. 15d096a [project @ 2005-12-01 12:32:24 by simonmar] export childHandler c2d0487 [project @ 2005-12-01 12:37:23 by simonmar] oops, forgot to remove forkIO from here 4a066b8 [project @ 2005-12-02 12:26:22 by simonmar] Apply rev 1.24 from FreeBSD's copy of this file. Commit message from FreeBSD: ce39b6e [project @ 2005-12-02 14:29:28 by simonmar] avoid recursive module trap with Haddock f8badeb [project @ 2005-12-03 17:32:01 by jpbernardy] Removed spurious constraint for Monoid (IntMap a) instance 712e319 [project @ 2005-12-05 11:42:47 by simonmar] Add IO versions of the STM primitives that allocate new transactional variables: f4a355a [project @ 2005-12-13 13:28:53 by simonmar] Only Streams can be DuplexHandles, not RawDevices. 8b4617a [project @ 2005-12-13 15:57:49 by simonmar] Raise the (new) exception NestedAtomically when atomically is nested (using unsafePerformIO). This is a small improvement over crashing. 636eb51 [project @ 2005-12-15 11:17:31 by simonmar] Add dataCast1/dataCast2 methods to Data class, as per ticket #633. c598bf9 [project @ 2005-12-30 00:18:59 by ross] deriving Data bf18366 [project @ 2006-01-02 19:38:01 by jpbernardy] * Left-bias restored * Minor documentation improvements d069840 [project @ 2006-01-06 15:46:09 by simonpj] Fix one-char typo in scanl1P ae57dba [project @ 2006-01-06 15:51:23 by simonpj] Eta-expand some higher-rank functions. GHC is about to move to *invariant* rather than *contra-variant* in function arguments, so far as type subsumption is concerned. These eta-expansions are simple, and allow type inference to go through with invariance. 7a04400 [project @ 2006-01-06 15:52:36 by simonpj] Use a type sig rather than a pattern signature, to avoid depending on GHC's precise impl of scoped type variables. (Which I'm about to change.) 0dc78a9 [project @ 2006-01-10 10:23:16 by simonmar] improve documentation for takeMVar/putMVar a2297e7 [project @ 2006-01-11 11:29:49 by simonmar] add some more warnings about unsafeThaw df9eb19 [project @ 2006-01-17 09:38:38 by ross] add Ix instance for GeneralCategory. 36d59c7 [project @ 2006-01-18 11:45:47 by malcolm] Fix import of Ix for nhc98. 8112cc1 [project @ 2006-01-19 14:47:15 by ross] backport warning avoidance from Haddock fe2c41b Generate PrimopWrappers.hs with Haddock docs Patch originally from Dinko Tenev , modified to add log message by me. 9f29faa add foldr/build optimisation for take and replicate This allows take to be deforested, and improves performance of replicate and replicateM/replicateM_. We have a separate problem that means expressions involving [n..m] aren't being completely optimised because eftIntFB isn't being inlined but otherwise the results look good. 72e08fb When splitting a bucket, keep the contents in the same order To retain the property that multiple inserts shadow each other (see ticket #661, test hash001) edd9a0f Add -fno-bang-patterns to modules using both bang and glasgow-exts ce3fd0e Give -foverlapping-instances to Data.Typeable 92e69c5 update ref in comment 0aaf0b9 simplify fmap 359978a typo in comment in Foldable class e9a5fe6 Drop dependency to haskell98 package 1a7dff0 declare blkcmp() static c592fc5 Years have 365 days, not 30*365 5e3514b Avoid overflow when normalising clock times e30e5f0 make head/build rule apply to all types, not just Bool. 9acdaa9 addToClockTime: handle picoseconds properly fixes #588 057d7ff add Data.Set.notMember and Data.Map.notMember e91e4ec Added notMember to Data.IntSet and Data.IntMap fa0b88a IntMap lookup now returns monad instead of Maybe. 907255a Oops typo in intSet notMember b3217ad Simplify Eq, Ord, and Show instances for UArray The Eq, Ord, and Show instances of UArray were written out longhand with one instance per element type. It is possible to condense these into a single instance for each class, at the expense of using more extensions (non-std context on instance declaration). 884e415 deprecate FunctorM in favour of Foldable and Traversable as discussed on the libraries list. be5f052 Added 'alter' Added 'alter :: (Maybe a -> Maybe a) -> k -> Map k a -> Map k a' to IntMap and Map This addresses ticket #665 b884ab3 Add unsafeSTToIO :: ST s a -> IO a Implementation for Hugs is missing, but should be easy. We need this for the forthcoming nested data parallelism implementation. 5b9df10 Fix a broken invariant Patch from #694, for the problem "empty is an identity for <> and $$" is currently broken by eg. isEmpty (empty<>empty)" d1372be add runIOFastExit :: IO a -> IO a Similar to runIO, but calls stg_exit() directly to exit, rather than shutdownHaskellAndExit(). Needed for running GHCi in the test suite. 56c2377 commit mysteriously missing parts of "runIOFastExit" patch 86dd67c work around a gcc 4.1.0 codegen bug in -O2 by forcing -O1 for GHC.Show See http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26824 30a4c1d Rework previous: not a gcc bug after all It turns out that we were relying on behaviour that is undefined in C, and undefined behaviour in C means "the compiler can do whatever the hell it likes with your entire program". So avoid that. ff829d7 add forkOnIO :: Int -> IO () -> IO ThreadId 3d44743 implement ForeignEnvPtr, newForeignPtrEnv, addForeignPtrEnv for GHC b17768e in the show instance for Exception, print the type of dynamic exceptions Unfortunately this requires some recursve module hackery to get at the show instance for Typeable. 968208c Track the GHC source tree reorganisation b2322c0 GHC.Base.breakpoint 209bf03 add Functor and Monad instances for Prelude types 38f343d add superclasses to Applicative and Traversable a23421f add instances 5ef3a87 add Data.Fixed module c5a59fc fix for Haddock 0.7 7ebcbea RequireOrder: do not collect unrecognised options after a non-opt The documentation for RequireOrder says "no option processing after first non-option", so it doesn't seem right that we should process the rest of the arguments to collect the unrecognised ones. Presumably the client wants to know about the unrecognised options up to the first non-option, and will be using a different option parser for the rest of the command line. d2944d7 fix imports for mingw32 && !GHC fc75004 fixes for non-GHC efceae6 fix previous patch 2d5b84e Import Data.ByteString from fps 0.5. Fast, packed byte vectors, providing a better PackedString. 57580d9 Merge in Data.ByteString head. Fixes ByteString+cbits in hugs a9c2fe4 Fix string truncating in hGetLine -- it was a pasto from Simon's code (from Don Stewart) 03aaf4d inline withMVar, modifyMVar, modifyMVar_ e7fdfc4 improve performance of Integer->String conversion See http://www.haskell.org//pipermail/libraries/2006-April/005227.html 6d442b3 Sync with FPS head 13ed689 writeFile: close the file on error Suggested by Ross Paterson, via Neil Mitchell 765afaa use bracket in appendFile (like writeFile) b6baa0a fix for non-GHC 5dc6d8a Add array fusion versions of map, filter and foldl 916d10f Sat May 6 13:01:34 EST 2006 Don Stewart * Do loopU realloc on the Haskell heap. And add a really tough stress test cf09e8b Merge "unrecognized long opt" fix from 6.4.2 5046116 Much faster find, findIndex. Hint from sjanssen 375fb0c Faster filterF, filterNotByte 55a6c08 Fixed import list syntax 0e20df1 Fix all uses for Int that should be CInt or CSize in ffi imports. Spotted by Duncan and Ian aea8eeb Sync with FPS head. e23efcf Make unsafePerformIO lazy 5643470 Trim imports 2f3d49f Make length a good consumer 7888b96 Two things. #if defined(__GLASGOW_HASKELL__) on INLINE [n] pragmas (for jhc). And careful use of INLINE on words/unwords halves runtime for those functions 69267ec add GHC.Dynamic a8e9e76 add CIntPtr, CUIntPtr, CIntMax, CUIntMax types aac3a2c add WordPtr and IntPtr types to Foreign.Ptr, with associated conversions 90b1678 portable implementation of WordPtr/IntPtr for non-GHC 26e52f4 Some small optimisations, generalise the type of unfold 3047c46 Last two CInt fixes for 64 bit, and bracket writeFile while we're here c90763d Use our own realloc. Thus reduction functions (like filter) allocate on the Haskell heap. Makes around 10% difference. 7033cd5 Fix negative index handling in splitAt, replicate and unfoldrN. Move mapF, filterF -> map', filter' while we're here 419c964 add import Prelude to get dependencies right for Data/Fixed.hs Hopefully this fixes parallel builds. 3afb16f copyCString* should be in IO. Spotted by Tomasz Zielonka 484919b #define _REENTRANT 1 (needed to get the right errno on some OSs) Part 2 of the fix for threaded RTS problems on Solaris and possibly *BSD (Part 1 was the same change in ghc/includes/Rts.h). 35c06b8 Better error handling in the IO manager thread In particular, handle EBADF just like rts/posix/Select.c, by waking up all the waiting threads. Other errors are thrown, instead of just being ignored. 787633b Move Eq, Ord, Show instances for ThreadId to GHC.Conc Eliminates orphans. ec985c1 simplify indexing in Data.Sequence f5453a0 haddock fix d0c25f9 Sync with FPS head, including the following patches: b9dd64f add a way to ask the IO manager thread to exit 3d0ff7d Merge in changes from fps head. Highlights: cf5ba6a export breakpoint 915608d small intro to exceptions c5abb27 Add the inline function, and many comments 25ffdea Optimised foreign pointer representation, for heap-allocated objects 27cc188 a few doc comments 5aa26c3 add signature for registerDelay 72dc76a Add minView and maxView to Map and Set 397210f clarify and expand docs 6861b99 remove dead code 0aac978 default to NoBuffering on Windows for a read/write text file Fixes (works around) #679 e5c1c21 comments for Applicative and Traversable 7aa1ae2 Wibble in docs for new ForeignPtr functionsn 3b80a6c Import Data.ByteString.Lazy, improve ByteString Fusion, and resync with FPS head 96040a0 Disable unpack/build fusion a2880cf Avoid strictness in accumulator for unpackFoldr 2d747fd UNDO: Merge "unrecognized long opt" fix from 6.4.2 This patch undid the previous patch, "RequireOrder: do not collect unrecognised options after a non-opt". I asked Sven to revert it, but didn't get an answer. 2bd9530 breakpointCond edc5299 make Control.Monad.Instances compilable by nhc98 1cebefa disambiguate uses of foldr for nhc98 to compile without errors 06f63fd Add missing method genRange for StdGen (fixes #794) 2b0673e Improve documentation of atomically 15ccf58 Fix unsafeIndex for large ranges f9a5721 remove spurious 'extern "C" {' 3612974 add traceShow (see #474) 7b0cffd deprecate this module. 784a581 Change the API of MArray to allow resizable arrays See #704 eef1ca7 remove unnecessary #include "ghcconfig.h" 970f880 move altzone test from ghc to base package 0bd0b8a Remove deprecated Data.FiniteMap and Data.Set interfaces d176439 bump version to 2.0 b6f1c8f move Text.Html to a separate package 57ea42b (non-GHC only) track MArray interface change 4275eb7 reduce dependency on ghcconfig.h e1d2ec1 Warning police: Removed useless catch-all clause 1c04b40 Warning police: Make some prototypes from the RTS known baf6864 Jan-Willem Maessen's improved implementation of Data.HashTable Rather than incrementally enlarging the hash table, this version just does it in one go when the table gets too full. 4264db2 remove deprecated 'withObject' 30e4620 fix Data.HashTable for non-GHC 8b90757 revert removal of ghcconfig.h from package.conf.in 33d6937 markup fix to Data.HashTable 878033a Hugs only: disable unused process primitives 3e3001b eliminate more HOST_OS tests 22e2f2c remove Text.Html from nhc98 build 424d170 add mapMaybe and mapEither, plus WithKey variants 9877f3a use correct names of IOArray operations for nhc98 3900e67 use Haskell'98 compliant indentation in do blocks c0c6e3f fix docs for withC(A)StringLen 16a9ba1 remove extra comma from import 03b3d01 generate Haddock docs on all platforms 2220a18 add alternative functors and extra instances 0236be1 copyFile: try removing the target file before opening it for writing f366c7e copyFile: try removing the target file before opening it for writing ff58206 add notes about why copyFile doesn't remove the target 19b0b8b Sync Data.ByteString with current stable branch, 0.7 e30f641 Add spec rules for sections in Data.ByteString c587da6 explicitly tag Data.ByteString rules with the FPS prefix. 817e4b1 remove Text.Regx & Text.Regex.Posix These are subsumed by the new regex-base, regex-posix and regex-compat packages. dfd5b77 this should have been removed with the previous patch 4af3f6a Add shared Typeable support (ghc only) c11b520 C regex library bits have moved to the regex-posix package 39c7df3 document minimal complete definition for Bits e2c372f add docs for par cdb49e2 Workaround for OSes that don't have intmax_t and uintmax_t OpenBSD (and possibly others) do not have intmax_t and uintmax_t types: http://www.mail-archive.com/haskell-prime at haskell.org/msg01548.html so substitute (unsigned) long long if we have them, otherwise (unsigned) long. 22ae6fa Clarify how one hides Prelude.catch 2dd6854 add Haddock marker f3789f0 expand advice on importing these modules f06cad5 add advice on avoiding import ambiguities 8e2de3a Hide internal module from haddock in Data.ByteString f61e591 Add Control.Monad.forM and forM_ cee3369 Make length a good consumer 44e60b1 Fix a bug in mkName; merge to STABLE ed03203 Add Show instances 06a394f Modifications required by the changes to package support in GHC A NameG now needs to store the package name, too. 8313186 add Data.Foldable.{for_,forM_} and Data.Traversable.{for,forM} 9b3b565 fix doc typo a5e46c7 add Data.Foldable.{msum,asum}, plus tweaks to comments d05b325 remove Text.Regex(.Posix) from nhc98 build f9ed538 import Control.Arrow.ArrowZero to help nhc98's type checker 46b8f57 remove some outdated comments 70cc949 mark nhc98 import hack ce524a6 fix hDuplicateTo on Windows deja vu - I'm sure I remember fixing this before... 7da77b4 Better doc on Data.Map.lookup: explain what the monad is for a08a636 New function isInfixOf that searches a list for a given sublist 08c9165 Cleaner isInfixOf suggestion from Ross Paterson bbd10f9 remove obsolete Hugs stuff 42bc89c Typeable1 instances for STM and TVar 27de16c Sync Data.ByteString with stable branch 962f7dd doc tweaks, including more precise equations for evaluate 2cf2fc3 Add strict versions of insertWith and insertWithKey (Data.Map) f40952a fix header comment 9e9cd6e add typeRepKey :: TypeRep -> IO Int See feature request #880 1785df7 make hGetBufNonBlocking do something on Windows w/ -threaded hGetBufNonBlocking will behave the same as hGetBuf on Windows now, which is better than just crashing (which it did previously). bb521d9 Hugs only: unbreak typeRepKey 03d0cfd Fix syntax error that prevents building Haddock documentation on Windows c38aadd Data.ByteString: fix lazyness of take, drop & splitAt f3ff0bf Don't create GHC.Prim when bootstrapping; we can't, and we don't need it b628859 Inline shift in GHC's Bits instances for {Int,Word}{,8,16,32,64} 872e851 STM invariants 034f0e0 Remove Data.FiniteMap, add Control.Applicative, Data.Traversable, and Data.Foldable to the nhc98 build. e99378b add Data.Sequence to nhc98 build bdaca42 Use the new Any type for dynamics (GHC only) 51e8938 fix example in comment 31a910c `par` should be infixr 0 Alas, I didn't spot this due to lack of testing, and the symptom is that an expression like x `par` y `seq z will have exactly the wrong parallelism properties. The workaround is to add parantheses. 485a4c9 Export pseq from Control.Parallel, and use it in Control.Parallel.Strategies e1da52d Add intercalate and split to Data.List 66e2685 rearrange docs a bit 77ae4e7 minor clarification of RandomGen doc 235e738 Add deriving Data to Complex 0472466 #ifdef around non-portable Data.Generics.Basics 9dcd804 Data.Generics.Basics is GHC-only 1d21645 Add intercalate and split to Data.List 53d7e21 fix example in docs 79c5c8d fix Haddock module headers 5624fae Use unchecked shifts to implement Data.Bits.rotate This should get rid of those cases, maybe lower the size enough that the inliner will like it? 5dfb83e Update documentation for hWaitForInput See #972 Merge to 6.6 branch. 6ad778f enable canonicalizePath for non-GHC platforms c12944f non-GHC: fix canonicalizeFilePath 742f987 Add intercalate to Data.List (ticket #971) 875a980 remove conflicting import for nhc98 44b2881 add withFile and withBinaryFile (#966) fba6785 redefine writeFile and appendFile using withFile c283e0f __hscore_long_path_size is not portable beyond GHC 24f8f5a Added Data.Function (Trac ticket #979). + A module with simple combinators working solely on and with functions. + The only new function is "on". + Some functions from the Prelude are re-exported. 853060d import Prelude 0ab34eb move fix to Data.Function c3a275e whitespace only 18acbc6 add Data.Function 528e40d add Data.Function 6103c6b hide Data.Array.IO.Internals 2f50f09 add doc link to bound threads section 87fad1c Fix broken pragmas; spotted by Bulat Ziganshin b3cfb51 Added and cleaned up Haddock comments in Control.Parallel.Strategies. Many of the definitions in Control.Parallel.Strategies had missing or unclear Haddock comments. I converted most of the existing plain code comments to haddock comments, added some missing documentation and cleaned up the existing Haddock mark-up. 5c0d819 Control.Parallel.Strategies: clarified documentation of parListChunk. 77b3487 add Control.Monad.Instances to nhc98 build a60bf5a Control.Parallel.Strategies: deprecate sPar, sSeq, Assoc, fstPairFstList, force and sforce. Code comments indicated that sPar and sSeq have been superceded by sparking and demanding, and that Assoc, fstPairFstList, force and sforce are examples and hacks needed by the Lolita system. 541ff14 Control.Parallel.Strategies: added NFData instances for Data.Int.*, Data.Word.*, Maybe, Either, Map, Set, Tree, IntMap, IntSet. 7a95457 Control.Parallel.Strategies clean-up: Added export list to avoid exporting seq, fixed import list strangeness that haddock choked on, and moved the deprecated functions to a separate section. 277e650 Update comments on Prelude organisation in GHC/Base.lhs 3b4ae5f LPS chunk sizes should be 16 bytes, not 17. 706b202 The wrong 'cycle' was exported from Data.ByteString.Lazy.Char8, spotted by sjanssen e7f9aae (nhc98) use new primitive implementations of h{Put,Get}Buf. 38d3dcf fix shift docs to match ffi spec 7b5235b typo in comment 8a3e83e One less unsafeCoerce# in the tree d65c1d2 make Data.Graph portable (no change to the interface) 795a06a remove Data.FunctorM and Data.Queue 18063ef Data.Graph is now portable (enable for nhc98) 9fd9913 trim imports 0c99253 Add an example of the use of unfoldr, following doc feedback from dozer e6c9171 Add type signatures d05d58b Move instance of Show Ptr to Ptr.hs (fewer orphans) 6b8688cd Hugs: add Control.Parallel.Strategies a2730b6 Add comments about argument order to the definitions of gmapQ and constrFields 126ec36 Make sure the threaded threadDelay sleeps at least as long as it is asked to 1143767 deriving (Eq, Ord, Enum, Show, Read, Typeab) for ConsoleEvent e0bfa41 Add support for the IO manager thread on Windows Fixes #637. The test program in that report now works for me with -threaded, but it doesn't work without -threaded (I don't know if that's new behaviour or not, though). aa6f4f5 Bump version number 3568a5d don't try to compile this on Unix 8c741ae dos2unix cf2d0bf documentation for installHandler merge to 6.6 2bc271d Add note about synhronous delivery of throwTo 2db4355 Mention that throwTo does not guarantee promptness of delivery 05fccf8 Fix missing comma in Fractional documentation 9b46e1e Introduce Unknowns for the closure viewer. Add breakpointCond which was missing 8b1678a Show instance for GHC.Base.Unknown 43ccc31 Improved the Show instance for Unknown 8d21eab Added Unknowns for higher kinds 569100a version of example using Tomasz Zielonka's technique bfe7806 Fix crash with (minBound :: Int*) `div (-1) as result is maxBound + 1. 66cb5d0 update section on "blocking" 7ba42a3 fix threadDelay In "Add support for the IO manager thread" I accidentally spammed part of "Make sure the threaded threadDelay sleeps at least as long as it is asked", which is why the ThreadDelay001 test has been failing. ff844b6 Added examples, more detailed documentation to Data.List Extracting sublists functions 7cf2924 Add IsString class for overloaded string literals. 7663ed1 Applicative and Monad instances for Tree cb089d8 IsString is GHC-only (so why is it in the Prelude?) 628e887 Add Kleisli composition fe68f08 Remove IsString(fromString) from the Prelude e745d6c Eliminate some warnings Eliminate warnings in the libraries caused by mixing pattern matching with numeric literal matching. b78b87f Improve pretty-printing for Template Haskell a52048c bump version to 2.0 a985f2c Omit package names when pretty-printing Names. 2eabf4a Add comments, re-order code (no functional effect) 7919110 Add Lift instances for Maybe and Either 5825786 Add instance Functor Q and make Quasi require Functor 117a9ce make Setup suitable for building the libraries with GHC de31008 add doc pointers to Foldable 676eede add derived instances for Dual monoid 66b09e0 Use static inline rather than extern inline/inline I understand this is more portable, and it also fixes warnings when C things we are wrapping are themselves static inlines (which FD_ISSET is on ppc OS X). 23d4259 Add some type sigs 038a87c Whitespace changes only 8cb0f00 wrapround of thread delays a245c49 The Windows counterpart to 'wrapround of thread delays' 2cd39a9 fix to getUSecOfDay(): arithmetic was overflowing 6541cb7 fix for hashString, from Jan-Willem Maessen (see #1137) 5a4614e Fix the types of minView/maxView (ticket #1134) 1b76e1d Consistently use CInt rather than Int for FDs f4c9f5a Fix FD changes on Windows c57ae3a Remove more redundant FD conversions e2880ed Keep the same FD in both halves of a duplex handle when dup'ing Otherwise we only close one of the FDs when closing the handle. Fixes trac #1149. 10c329e Fixed PArr.dropP - Thanks to Audrey Tang for the bug report 5764043 FDs are CInts now, fixing non-GHC builds 008e6d5 Bump nhc98 stack size for System/Time.hsc 10b8fa2 GHC.PArr: add bounds checking 6415e1c Add Data.String, containing IsString(fromString); trac proposal #1126 This is used by the overloaded strings extension (-foverloaded-strings in GHC). 96bb404 PArr: fixed permutations f86201f This patch adds a timeout function to the base libraries. Trac #980 is concerned with this issue. The design guideline for this implementation is that 'timeout N E' should behave exactly the same as E as long as E doesn't time out. In our implementation, this means that E has the same myThreadId it would have without the timeout wrapper. Any exception E might throw cancels the timeout and propagates further up. It also possible for E to receive exceptions thrown to it by another thread. e4323ea So many people were involved in the writing of this module that it feels unfair to single anyone out as the lone copyright holder. c0ab057 document timeout limitations 4cc5934 expand docs for forkOS ec836af Prevent duplication of unsafePerformIO on a multiprocessor Fixes #986. The idea is to add a new operation a8978ba fix race condition in prodServiceThread See #1187 44ab526 Add ioeGetLocation, ioeSetLocation to System/IO/Error.hs; trac #1191 59b427f copyBytes copies bytes, not elements; fixes trac #1203 6760c51 remove Makefile.inc (only affects nhc98) b6533af fix strictness of foldr/build rule for take, see #1219 a503ca1 Fix the type of wgencat 4701812 Monoid instance for Maybe and two wrappers: First and Last. trac proposal #1189 05ebb4b Add min/max handling operations for IntSet/IntMap f60d46b Function crossMapP for fixing desugaring of comprehensions 4b6a4eb fix for nhc98 build cedc8a4 put 'unsafeCoerce' in a standard location f60d1d7 Fix type mismatches between foreign imports and HsBase.h a37d25a add new module Unsafe.Coerce to build system 02d43d2 Fix C/Haskell type mismatches 0a39a51 Fix incorrect changes to C types in a foreign import for nhc98. If we use type CTime, it needs to be imported. Also, CTime is not an instance of Integral, so use some other mechanism to convert it. d786c4c Fix braino 227cf48 HsByteArray doesn't exist 0266d37 Don't use Fd/FD in foreign decls Using CInt makes it much easier to verify that it is right, and we won't get caught out by possible newtype switches between CInt/Int. 29d33b0 HsByteArray doesn't exist ae2d7c4 make Setup and base.cabal suitable for building the libraries with GHC 6480393 Unsafe.Coerce doesn't need Prelude 6bfb0f0 fix isPortableBuild test 65de149 Hugs only: fix location of unsafeCoerce 020e535 Allow additional options to pass on to ./configure to be given 11a95eb Add missing case in removePrefix ceef7da Fix -Wall warnings 2ac9133 Don't turn on -Werror in Data.Fixed This may be responsible for the x86_64/Linux nightly build failing. d652584 mark System.IO.openTempFile as non-portable in haddocks f7ecae4 add System.Posix.Types to default nhc98 build 3e534f1 Remove unnecesary SOURCE import of GHC.Err in GHC.Pack 799c7ed we need a makefileHook too e7e4438 For nhc98 only, use hsc2hs to determine System.Posix.Types. Avoids the existing autoconf stuff, by introducing an auxiliary module called NHC.PosixTypes that uses hsc2hs, which is then simply re-exported from System.Posix.Types. 6525735 MacOS 10.3 needs #include as well 20edb73 Fix configure with no --with-cc 65ca4e1 MERGE: fix ugly uses of memcpy foreign import inside ST fixes cg026 6afe94d inclusion of libc.h is conditional on __APPLE__ d961dd8 Follow Cabal changes in Setup.hs 98d48f5 Add extra libraries when compiling with GHC on Windows e457960 tweak documentation as per suggestion from Marc Weber on libraries at haskell.org aa97e0f Add IsString to exports of GHC.Exts 4d4bbe3 Remove Splittable class (a vestige of linear implicit parameters) ddf3e70 Create showName, which takes an additional prefix-context argument 5a9552b Thread prefix-context argument through pprName 9044ae2 Use pprName False in pretty printer 0c74dc0 Typo fixes, missing {in,ex}ports 5cbdc0d Properly handle tilde-patterns 65dd02d Fix precedence passing for patterns in LamE (fixes \((:) x xs) -> x misprinting) 1b71adb Pretty-print an empty list of fundeps without '|' (should fix #1260) de7bb87 parse (but don't pass on) options for ./configure d219695 Rejig name printing a bit 9e55b8f Another name printing tweak 59f1728 Add missing case in removePrefix 22d0fcd Fix -Wall warnings bbca21c Report fail string before passing control through to underlying fail in Q monad (otherwise it gets lost in GHC's IOEnv) for trac #1265 dcc8108 Follow Cabal changes in Setup.hs 279015b Be less quiet about building the base package ebde8c2 Trim imports, remove a cycle 73715a0 Make Control.Exception buildable by nhc98. The nhc98 does not have true exceptions, but these additions should be enough infrastructure to pretend that it does. Only IO exceptions will actually work. c12da1c the "unknown" types are no longer required d8f90d7 FIX: #724 (tee complains if used in a process started by ghc) aa73318 improve documentation for evaluate 94fd935 further clarify the docs for 'evaluate' 8e41494 Give an example of how intersection takes elements from the first set 698db81 fix imports for non-GHC 6c1f9ea Build GHC/Prim.hs and GHC/PrimopWrappers.hs from Cabal a5e5cd66 Use FilePath to make paths when building GHC/Prim.hs and GHC/PrimopWrappers.hs 2ce182e When doing safe writes, handle EAGAIN rather than raising an exception It might be that stdin was set to O_NONBLOCK by someone else, and we should handle this case. (this happens with GHCi, I'm not quite sure why) 3851b9a correct the documentation for newForeignPtr 51cdd8a add install-includes: field abcb831 Remove the pretty-printing modules (now in package pretty( d5ec800 We now depend on pretty 5d048b7 Remove Control.Parallel*, now in package parallel 60eef51 Split off directory, random and old-time packages 565675e System.Locale is now split out a77b423 Fix comment: maperrno is in Win32Utils.c, not runProcess.c 2ecf2cb Split off process package 9a7a022 Remove Makefile and package.conf.in (used in the old build system) f1a7942 Remove Makefile and package.conf.in (used in the old build system) 4c87ae5 remove directory, pretty, and random bits from base for nhc98 bbea32c nhc98 version of instance Show (a->b) copied from Prelude dbe5cf7 remove locale as well 995b9ff remove System.Cmd and System.Time too 9515bd4 delete unused constants d7ffcfa DIRS now lives in package Makefile, not script/pkgdirlist 1ab69f6 add module Data.Fixed to nhc98 build c193735 Add System.Timeout to base.cabal Filtered out for non-GHC by Setup.hs. 63d51d7 add a dummy implementation of System.Timeout.timeout for nhc98 0801066 add nhc98-options: field to .cabal file c72577d Control.Concurrent documentation fix 1be55ff Add Data instance for PackedString; patch from greenrd in trac #1263 1735728 Add Data and Typeable instances; patch from greenrd in trac #1263' 262f013 Data.PackedString: Data.Generics is GHC-only 4423efb --configure-option and --ghc-option are now provided by Cabal 5fedced Remove unsafeCoerce-importing kludgery in favor of Unsafe.Coerce ed5ac20 --configure-option and --ghc-option are now provided by Cabal 3b1e6cb fix description of CWStringLen 5b773cb FIX hGetBuf001: cut-and-pasto in readRawBufferNoBlock c9c7e2a update prototype following inputReady->fdReady change 0fbc000 install dependent include files and Typeable.h 67106d5 Typo (consUtils.hs -> consUtils.h) b16277b Hugs now gets MonadFix(mfix) from its prelude e1340db makefileHook needs to generate PrimopWrappers.hs too 4ddc6d9 Change C-style comments to Haskell-style. These two headers are only ever used for pre-processing Haskell code, and are never seen by any C tools except cpp. Using the Haskell comment convention means that cpphs no longer needs to be given the --strip option to remove C comments from open code. This is a Good Thing, because all of /* */ and // are valid Haskell operator names, and there is no compelling reason to forbid using them in files which also happen to have C-preprocessor directives. aa44db4 Use a combination of Haskell/C comments to ensure robustness. e.g. -- // ensures that _no_ preprocessor will try to tokenise the rest of the line. 2a9932d Use "-- //" (2 spaces) rather than "-- //" (1) to avoid tripping haddock up Are we nearly there yet? 4736c6e Speed up number printing and remove the need for Array by using the standard 'intToDigit' routine dfb3810 Modernize printf. 3deaeb1 fix bug in writes to blocking FDs in the non-threaded RTS 9143446 Word is a type synonym in nhc98 - so class instance not permitted. c9fc2b4 change nhc98 option from -prelude to --prelude 8b6d67e FIX #1131 (newArray_ allocates an array full of garbage) Now newArray_ returns a deterministic result in the ST monad, and behaves as before in other contexts. The current newArray_ is renamed to unsafeNewArray_; the MArray class therefore has one more method than before. d56c747 Remove include-dirs ../../includes and ../../rts We get these by virtue of depending on the rts package. 2f54eec Add a more efficient Data.List.foldl' for GHC (from GHC's utils/Util.lhs) f8099c8 no need to hide Maybe 105cdfb Define stripPrefix; fixes trac #1464 78e6aa0 Implement GHC.Environment.getFullArgs This returns all the arguments, including those normally eaten by the RTS (+RTS ... -RTS). This is mainly for ghc-inplace, where we need to pass /all/ the arguments on to the real ghc. e.g. ioref001(ghci) was failing because the +RTS -K32m -RTS wasn't getting passed on. 74859e7 in hClose, free the handle buffer by replacing it with an empty one This helps reduce the memory requirements for a closed but unfinalised Handle. d6b1060 fix Data.Map.updateAt See http://haskell.org/pipermail/libraries/2007-July/007785.html for a piece of code triggering the bug. updateAt threw away parts of the tree making up the map. 9e71989 Add a test for Data.Map, for a bug on the libraries@ list 9cb0c9e Rename openFd to fdToHandle' The name collision with System.Posix.IO.openFd made my brain hurt. fbe2f45 Move open(Binary)TempFile to System.IO 4c73274 Tweak temporary file filename chooser 39b65b1 open(Binary)TempFile is now portable 36d4917 Hugs only: avoid dependency cycle f0320cc fix Hugs implementation of openTempFile 3001ce0 Handle buffers should be allocated with newPinnedByteArray# always Not just on Windows. This change is required because we now use safe foreign calls for I/O on blocking file descriptors with the threaded RTS. Exposed by concio001.thr on MacOS X: MacOS apparently uses smaller buffers by default, so they weren't being allocated as large objects. 5637658 Use cabal configurations rather than Setup hacks c3eb383 Correct Windows OS name in cabal configuration 6259d85 Fix fdToHandle on Windows The old setmode code was throwing an exception, and I'm not sure it is meant to do what we need anyway. For now we assume that all FDs are both readable and writable. 645196f Generalise the type of synthesize, as suggested by Trac #1571 be395b7 Temporarily fix breakage for nhc98. A recent patch to System.IO introduced a cyclic dependency on Foreign.C.Error, and also inadvertently dragged along System.Posix.Internals which has non-H'98 layout, causing many build problems. The solution for now is to #ifndef __NHC__ all of the recent the openTempFile additions, and mark them non-portable once again. (I also took the opportunity to note a number of other non-portable functions in their Haddock comments.) 63544e5 fix Haddock markup 77d32a0 Clarify the swapMVar haddock doc 0fd4bea Move throwErrnoPath* functions from unix:System.Posix.Error 0e5ff9a Add simple haddock docs for throwErrnoPath* functions 0b9eebb Export throwErrnoPath* functions 78c8f42 bytestring is now in its own package d5b0bbb Remove System.Posix.Signals (moving to unix) c769383 Remove a number of modules now in a "containers" package 95a6179 Data.Array* and Data.PackedString have now moved to their own packages bf42b1a We now depend on the packedstring and containers packages 4f92628 Move the datamap001 (our only test) to the containers package 46341a1 Remove bits left over from the old build system 675a579 Move Data.{Foldable,Traversable} back to base The Array instances are now in Data.Array. b9bb2fc Don't try to build modules no longer living in base. a93b81c install Typeable.h for use by other packages ebd05cd Correct the swapMVar haddock doc 1df1a9b Don't import Distribution.Setup in Setup.hs as we no longer need it daf52ae include Win32 extra-libraries for non-GHC's too e3d4781 remove now-unused SIG constants 364214f fpstring.h has moved to bytestring c9a5285 test impl(ghc) instead of IsGHC 78d4976 Fix hashInt As pointed out in http://www.haskell.org/pipermail/glasgow-haskell-bugs/2007-August/009545.html the old behaviour was Prelude Data.HashTable> map hashInt [0..10] [0,-1,-1,-2,-2,-2,-3,-3,-4,-4,-4] 4fa06d9 FIX #1282: 64-bit unchecked shifts are not exported from base I've exported these functions from GHC.Exts. They are still implemented using the FFI underneath, though. 8a55cef delete configure droppings in setup clean 03ddae3 Make arrays safer (e.g. trac #1046) 6a9a2bf Added dummy license file Please fill in the correct license, no clue what it should be. Furthermore, a few licenses resulting from the "Big Base Split" (tm) should be reviewed, I guess. 113cd39 Put the correct license text in b2f00be Remove redundant include/Makefile cf6952e Better hash functions for Data.HashTable, from Jan-Willem Maessen 4af946a Fix building HashTable: Use ord rather than fromEnum e5954dc Fix haddock docs in Hashtable 11e8e5c make hWaitForInput/hReady not fail with "invalid argument" on Windows See #1198. This doesn't fully fix it, because hReady still always returns False on file handles. I'm not really sure how to fix that. 53a7a8a Suppress some warnings ff8b9d8 Remove some incorrect rules; fixes #1658: CSE [of Doubles] changes semantics 786638a FIX #1689 (openTempFile returns wrong filename) 043f2f2 Add a boring file adf2a96 Add a boring file 502c181 Add more entries to boring file e70b3ee put extra-tmp-files field in the right place 1fc47ca typo efdee48 expose the value of +RTS -N as GHC.Conc.numCapabilities (see #1733) a8ee502 clean up duplicate code ab8f5bb FIX #1652: openTempFile should accept an empty string for the directory b788063 base in 6.8 and head branch should be version 3.0 c17eadb Clean up .cabal file a bit specify build-type and cabal-version >= 1.2 put extra-tmp-files in the right place use os(windows) rather than os(mingw32) 9c374bf FIX #1258: document that openTempFile is secure(ish) Also change the mode from 0666 to 0600, which seems like a more sensible value and matches what C's mkstemp() does. 90af93e Fix doc building with Haddock 0.9 I was using a recent build here, which is more tolerant. 65fe3dc new Control.Compositor module 66ec326 Bump version number bf2a204 Copy description for the Cabal file from prologue.txt 6758b39 Specify build-type: Simple da44e83 new Control.Category, ghc ticket #1773 f9bc7b8 FIX BUILD: Haddock 1.x fails to parse (Prelude..) 8898b4b Fix performance regression: re-instate -funbox-strict-fields Yikes! While investigating the increase in code size with GHC 6.8 relative to 6.6, I noticed that in the transition to Cabal for the libraries we lost -funbox-strict-fields, which is more or less depended on by the IO library for performance. I'm astonished that we didn't notice this earlier! a4b128f fix nhc98 build: need a qualified Prelude import 6270bf0 add Control.Category to the nhc98 build 27fa0a4 Add module of special magic GHC desugaring helper functions Currently containing only one such helper: (>>>) for arrow desugaring 59b4958 Filter out GHC.Prim also for the Haddock step Please merge to the GHC 6.8.2 branch 2dc3c04 Fix ` characters in elem's haddock docs df97527 fix comment 530c5c7 Only overwrite GHC/Prim.hs and GHC/Primopwrappers.hs if they change This avoids make doing unnecessary work after 'setup makefile'. 5f59f65 Move file locking into the RTS, fixing #629, #1109 File locking (of the Haskell 98 variety) was previously done using a static table with linear search, which had two problems: the array had a fixed size and was sometimes too small (#1109), and performance of lockFile/unlockFile was suboptimal due to the linear search. Also the algorithm failed to count readers as required by Haskell 98 (#629). 460f368 Fix compilation with GHC 6.2.x 740bbc4 oops, we forgot to export traceShow 5a223d3 remove lockFile.h from install-includes 7bac83d FIX #1753 hClose should close the Handle and unlock the file even if calling close() fails for some reason. ea2fdf0 FIX BUILD: maybeUpdateFile: ignore failures when removing the target 94dbed6 Escape some special characters in haddock docs bc34b5f Don't try to make haddock links to the mtl package as we don't depend on it 49cc9d9 Fix some links in haddock docs 333440b Fix some URLs 69fc4b6 note about how to convert CTime (aka EpochTime) to UTCTime b3febff restore fdToHandle' to avoid breaking clients (#1109) c6f9dba protect against concurrent access to the signal handlers (#1922) 1030068 protect console handler against concurrent access (#1922) 34c69fd FIX #1621: bug in Windows code for getCPUTime We were reading the components of FILETIME as CLong, when they should be unsigned. Word32 seems to be the correct type here. c8a5524 Add singletonP to GHC.PArr a8897e2 doc only: use realToFrac instead of fromRational.toRational 0002e65 docs: describe the changes to forkIO, and document forkOnIO 5b4734c Implement 'openTempFile' for nhc98. fd205ff Simplify the GHC.Prim hack in base.cabal/Setup.hs 09f867c Add GHC.Prim to exposedModules in the Haddock 0.x hook 757c909 Add GHC.Prim to exposedModules in the Haddock 0.x hook 774beba Add groupWith, sortWith, the, to support generalised list comprehensions 045a52b Tuple tycons have parens around their names ca6fcaa Remove redundant imports of GHC.Err 8fb82f4 Fix comment on GHC.Ptr.minusPtr 485b60f Data.List.sort: force elements from start to end. this prevents a stack overflow on sort (take 10^6 [1..]) e37fa69 haddock attributes for haddock-2.0 33a93d5 Export topHandler, topHandlerFastExit from GHC.TopHandler We now use one of these in ghc when running with ghc -e e0fac59 Windows: large file support for hFileSize and hSeek (#1771) 087ccec add comment about lack of _chsize_s() 55b76a3 The default uncaught exception handler was adding an extra \n 7d4917a FIX #1936: hGetBufNonBlocking was blocking on stdin/stdout/stderr 7068e4c Generalise type of forever :: (Monad m) => m a -> m b f3f3903 deforestation rules for enumFromThenTo; based on a patch from Robin Houston 65a16b7 FIX dynamic001 dynamic002: isTupleTyCon had rotted In the patch "Tuple tycons have parens around their names", the names of the tuple tycons were changed to include parens, but isTupleTyCon was not updated to match, which made tuple types show as "(,) a b" rather than "(a,b)" 7382021 Whitespace only 7d1f993 whitespace only b667aa1 untabify only 499cb4f untabify 0077a5a FIX dynamic001, dynamic002: further fixes to tuple printing 18245aa untabify ae37bad untabify 9800d3d untabify 32af111 Add exitSuccess :: IO a. For symmetry with exitFailure f724cc9 untabify 6cab05d untabify e117955 untabify fc013dc untabify 01c9ee9 untabify 43f65bc mention explicitly that hIsEOF may block 58572f4 untabify 9cd506f untabify 6673102 Added Down class and improved groupWith fusion 4d73790 export MVar, TVar, and STM non-abstractly As requested by Sterling Clover on ghc-users 131f6db untabify 75d9ecb untabify dd53a79 untabify 64f46cc untabify ed725c0 untabify 0f41ab5 untabify 288d724 untabify 22ab7b5 untabify 1b8dcfa untabify 95d429d untabify 5492860 untabify f2ec55f untabify 8210c67 untabify e05218e untabify 4c61e6f untabify c0e1b8dd untabify f4275e0 untabify 93d0932 untabify 0b0b3ac untabify b7703a4 untabify 475e70a untabify d19e849 untabify 729ebf1 untabify 450f869 untabify 0363aee untabify 1a8a30e System.Console.GetOpt mistakenly rejects options as ambiguous. From "Eelis van der Weegen" . Testcase: 2a4ab8c Add partitionEithers, lefts, and rights. Patch from Russell O'Connor, trac proposal #974. e24f86f Replace (^) with a faster variant (from trac #1687) 13e57e9 An even better definition for (^) (trac #1687) 689ac05 Remove a gratuitous pattern type sig 6de7e26 List extensions used rather than using the -fglasgow-exts hammer 175e045 Move Integer out into its own package We now depend on the new integer package. We also depend on a new ghc-prim package, which has GHC.Prim, GHC.PrimopWrappers, and new modules GHC.Bool and GHC.Generics, containing Bool and Unit/Inl/Inr respectively. b7bd165 base now uses build-type: Configure c6b4079 Remove GHC.PrimopWrappers from base's exposed modules list 3f64040 Update .darcs-boring GHC/Prim.hs, GHC/PrimopWrappers.hs are no longer generated in this package 3aa968c Move Word64/Int64/Word32/Int32 primitives into ghc-prim feb58bb give an absolute path to 'harch' c211150 fix types for __hscore_st_dev() and __hscore_st_ino() 20faa40 Ordering has now moved to ghc-prim 45ba9b2 Turn off the gcd/lcm optimisations for Integer for now This makes it easier to experiment with other implementations 0ac84bf In docs for unsafeCoerce, point to unsafeCoerce# 2d817e6 Spelling only a83c996 Improve docs for unsafeCoerce Make it clear that compilers differ. Point to GHC docs in GHC.Base, and add a short description of nhc98's representation-safe conversions. 75a49cc don't set O_NONBLOCK on FDs passed to fdToHandle 7ae99bb Added emptyP def ad5ffc1 record libraries at haskell.org as maintainer 6e10abd Just (-0/1) is now printed as Just (-0.0), not Just -0.0; trac #2036 50058d5 Add RULES for realToFrac from Int. 9c6794a Add realToFrac RULE comments from patch message into the source code d0f3db8 Reexport (>>>) and (<<<) from Control.Arrow. Preserves API compatibility 0295b0c emptyP def to gHC.PArr d609d67 Moved def. of emptyP a5b73db Inline Data.Bits.rotate at Int, enables rotate to be constant folded e2294ec Add comments about why rotate has an INLINE e6a38b3 Avoid calling varargs functions using the FFI Calling varargs functions is explicitly deprecated according to the FFI specification. It used to work, just about, but it broke with the recent changes to the via-C backend to not use header files. 7d24980 Add a wrapper for mkstemp This is for #2038: macros are used in the Linux .h includes to redirect to a 64-bit version when large file support is enabled. f2e54f5 Add wrappers for [gs]etrlimit This is for #2038: macros are used in the Linux .h includes to redirect to a 64-bit version when large file support is enabled. 0706579 Fix the build on Windows 516e3c1 note about evaluation affecting StableNames 20fb7a8 Tweak the definition of (^) again This fixes trac #2306 (do the minimum number of (*)s), and also means that we don't use the value of (1 :: a) which causes problems if the Num a definition isn't complete. b2cc70e Add 'subsequences' and 'permutations' to Data.List b1a0c72 'subsequences' is now more lazy and also faster 02c91df 'permutations' is now more lazy and also faster 164d14e Support code for quasi-quotation feature 90726a0 Replace TH.Quasi by TH.Quote 11a293d Initial commit; code copied from the base package 2b1bd37 Initial commit of integer(-gmp) package; code copied from base 74e5de4 Fix parsing precedence problem 29c5f2e Add .darcs-boring file 89868b8 Define integerToWord64, word64ToInteger, integerToInt64, int64ToInteger if on a 32-bit machine db7460e Add GHC.IntWord32 and GHC.IntWord64 (from base) 18f5bf9 We can now use Ordering as it's in ghc-prim ae2efae Wibble && definition 5f6b44f Add GHC.Ordering 0f49db3 Add support for Word primitives 32## ec042d3 Initial commit 2f99971 Move the register-inplace special-case stuff into the ghc-prim package 1698be3 Avoid the need for infinite Integers when doing bitwise operations eebd9c7 Make the Integer type components strict a84ba0f Sprinkle on some strictness annotations e0bcb4a Fix ubconfc The current code doesn't seem to be what was used to generate WCsubst.c, so I'm not sure if it never worked, or if my tools work slightly differently to those of the previous user. e1c1482 Update WCsubst.c for Unicode 5.1.0, and add a README.Unicode README.Unicode describes how to do updates in the future. 24afeb6 Fix conversions between Float/Double and simple-integer 6e0d1f0 delete __hscore_{mkstemp,getrlimit,setrlimit} (moved to unix) 6b02395 Avoid using deprecated flags dfaf18f Avoid using deprecated flags 791ad9d Avoid using deprecated flags ee77cc8 Remove -fglasgow-exts from pragmas and comments c2986e0 List exact extensions used rather than using -fglasgow-exts 2533973 We only need -fno-warn-deprecations, not -w b2357b5 Make rename of a SigP fail properly, rather than just being an unhandled case a1a84a2 Make the StringConstr [] case of dataToQa fail rather than be an unhandled case 71da6cd Make the package -Wall clean 0eacb96 Fix #2363: getChar cannot be interrupted with -threaded Now in -threaded mode, instead of just making a blocking call to read(), we call select() first to make sure the read() won't block, and if it would block, then we use threadWaitRead. d27b23c Make the macros in Typeable.h add type signatures 6b5411e Remove code for older GHC versions 746ec49 Add GHC.Exts.maxTupleSize :: Int, the size of the largest tuple supported bfbfaf4 () has moved to ghc-prim:GHC.Unit, and the Eq and Ord instances to Data.Tuple d17038a FIX part of #2301 1b0906e FIX #1198: hWaitForInput on Windows Now we do the appropriate magic in fdReady() to detect when there is real input available, as opposed to uninteresting console events. 9f11776 Make threadWaitRead/threadWaitWrite partially useable on Windows 2a0267a check CONST_SIGINT ab5a660 FIX BUILD (on Windows) 40b8364 Add Control.Exception.blocked :: IO Bool Tells you whether async exceptions are currently blocked or not. 25614e1 forkOS: start the new thread in blocked mode iff the parent was (#1048) This matches the behaviour of forkIO 31c8495 Add threadStatus :: ThreadId -> IO ThreadStatus 23e579e Fix haddocking with older haddocks f185bc5 fix dummy async implementations for non-GHC 59af38f Extend nhc98's Exception type to resemble ghc's more closely c396535 Add instance Show Control.Exception.Exception for nhc98. f3b135c FIX #2376: inline shiftR Duplicating the default definition for shiftR doesn't seem quite right to me, but it gets the right results when compiling the example program, and I couldn't find a better way to do it. 282b3a9 add some big warnings to the docs for unsafeIOToSTM (#2401) a848c50 add comment 80bc85d Use extensible exceptions at the lowest level Everything above is largely unchanged; just the type of catch and throw. 6d87a36 Define nonTermination for the RTS to use We'll probably need to do the same for some other exceptions too 6a58c76 Fix warnings in ghc-prim modules 99ad336 Add GHC.Unit for the definition of the () type 4b835ac Use simpleUserHooks rather than defaultUserHooks in Setup.hs Cabal says that defaultUserHooks is deprecated. 0d62a23 Add a .darcs-boring file f2b1e35 Update .darcs-boring f64ea4a Follow Cabal changes 43e1c29 Follow flag name change 22c37b9 Rejig the extensible exceptions so there is less circular importing 20c837f Start to actually use extensible exceptions a322849 Re-add blocked; it got lost in the extensible exceptions patches c218e2a Fix whitespace The space after "\begin{code}" was confusing haddock 573beb4 Add onException 5a5cb88 Don't use "deriving Typeable" (for portability reasons) de13396 applied patches to make enumFrom and friends strict in arguments as per the Report; closes ticket #1997 514e5b2 Put in some parens to clarify how things parse 4d2b1ea Make numericEnumFrom more efficient b607bdb Comment wibble 87f7be5 TopHandler now uses the new extensible exceptions 3af5a2f Export assertError from Control.Exception to make GHC happy It's a wired-in name in GHC. We should possibly move it to another module. 98e13f5 Don't import Control.Concurrent.MVar in GHC.TopHandler 9bf4914 Reshuffle GHC.Conc/GHC.TopHandler a bit to remove a recursive import 0a713f6 Remove the now-unused GHC/TopHandler.lhs-boot 9753479 Rejig some code so Control.Exception and GHC.Conc don't need recursive imports f33f450 Make some more imports non-recursive e4bbe51 Remove the now-unused GHC/Conc.lhs-boot 81b785a Get rid of some duplicate imports afab0ec Remove unused imports in Control.Exception 3c08fdf Remove unused imports f2bd44a Remove an unused import ed6aac2 Remove the dangerous Exception functions Removed: catchAny, handleAny, ignoreExceptions These make it easy to eat /any/ exception, which is rarely what you want. Normally you either want to: * only catch exceptions in a certain part of the hierarchy, e.g. "file not found", in which case you should only catch exceptions of the appropriate type, or * you want to do some cleanup when an exception happens, and then rethrow the exception, in which case you should use onException, or one of the bracketing functions. 0525d37 Generalise the type of onException The type of the thing to do on an exception is now IO b rather than IO () which better matches functions like bracket. e7e051e Use onException rather than catchAny 8eb40cf Move assertError into GHC.IOBase 0912bae Remove the only import of GHC.Exts 6443137 Remove the duplicate definition of throwTo in Control.Exception It now imports GHC.Conc, so it is no longer necessary 8454033 Windows fixes 860c51c Change some imports and derive Show (Either a b) rather than writing it by hand in GHC.Show faf76d4 nhc98 needs the Prelude for this module d3bafd0 Fix nhc98 code variations to use the extensible exception API. There is still only one real exception type in nhc98, so it is not truly extensible. But this is enough to get the base package building again. f2fff63 zipWithM_ comes from Control.Monad f0e95df poke and peek come from Foreign.Storable c8ab434 make ExitCode an instance of Exception for nhc98 f2198b5 The tuple datatype definitions have moved to ghc-prim 4cf0bb2 Tuple datatypes are now in GHC.Tuple (they were in base:Data.Tuple before) 3ce8614 Remove some unnecessary Data.Tuple imports 1ea665e Generalise the type of mapException; pointed out by Isaac Dupree 7e87e49 Control.Exception doesn't need to export assertError 52a190c Hide standalone deriving clauses from haddock d4ece12 Remove GHC.Dotnet 350c446 Follow tuple datatype movements 4875183 Add a missing case to Show AsyncException 12a50ca Fix warnings 63c69e8 The [] definition has moved to ghc-prim 6588e16 Remove an unnecessary import a9bc61b Move the Char datatype into ghc-prim ad9140e Move some internals around to simplify the import graph a bit c99dd50 Remove the DynIOError constructor of IOErrorType As far as I can see it is never used or exported 13fb5c0 Tweak an import bc3938e Move some bits around to stop Data.Either being in the base import knot b33380b Swap imports around to get GHC.ForeignPtr out of the base knot c580fa7 Remove unused conditional import bc7c503 Fix a couple of imports 2937609 Put some explicit import lists in Data.Typeable a146ed9 Move Int, Float and Double into ghc-prim:GHC.Types d7141f7 Remove an unnecessary import e9ec30f Remove more redundant GHC.Float imports d0ea616 Remove unnecessary Data/Dynamic.hs-boot 8fe9ca2 Import wibbles b296beb Use the proper CInt type in GHC.Unicode d2f58eb Eq and Ord have moved into GHC.Classes 8ccf3c9 fix imports for non-GHC 3b66a65 threadDelay and friends are GHC-only 6579c41 remove kludges, now that Control.Exception is imported ec16083 split most of Control.Exception into new Control.Exception.Base 4474018 Hugs only: don't import exception types -- their instances are now in Control.Exception.Base 879807f bump to version 4.0 f072514 Move the [] definition from base into ghc-prim:GHC.Types 95f9739 Move the Char datatype into ghc-prim 44560f9 Add some GHC.Generics imports so we can find Inl etc where we need to 7faadaf Move Int, Float and Double into ghc-prim:GHC.Types f14420b add Control.Exception.Base to nhc98 build 3ae7e85 non-GHC: hide Prelude.catch 591b39f Hugs only: fix imports ebce15a use dummy implementation of timeout for all non-GHCs 569e88b export Control.Exception.Base f47de96 use the Haskell 98 module Control.Exception.Base in the Concurrent modules 2319319 use New.catch instead of catchException in OldException ea52fdb Must import ExitCode for its instance to be re-exported. The Cabal library depends on "instance Exception ExitCode", and expects to import it from Control.Exception, not Control.Exception.Base. 31215fe No reason for Handler and catches to exclude nhc98. 5ebd066 remove returns from void functions b8a8325 simplify definition of Prelude.catch 9b6b729 add Traversable generalizations of mapAccumL and mapAccumR (#2461) 8d771a4 Control.OldException: Map exceptions to old exceptions and back properly. * Control.OldException: Map exceptions to old exceptions and back properly. 5691448 Eliminate orphan rules and instances in the array package 4975be7 Fix oversight in Control.OldException The NonTermination constructor slipped through in the Exception instance. 9a7b324 Fix hReady (trac #1063) We now throw an EOF exception when appropriate a54da06 nhc only: expose Foldable and Traversable instances of Array a4088f2 Rewrite the documentation for forkOS again Try to make it clearer that forkOS is only necessary when calling foreing libraries that use thread-local state, and it has nothing to do with scheduling behaviour between Haskell threads. I also added something about the performance impact of forkOS, and mentioned that the main thread is a bound thread. f1f0f17 remove __hscore_renameFile, it is no longer uesd System.Directory implements renameFile using unix/Win32 now. e2a79c3 remove some functions that aren't used in base 48612e5 Ignore some orphan warnings cff5e3c Fix some more warnings 8c1cb53 Fix warnings in Data.Generics.* f9b2d39 Fix more warnings f050ec4 Suppress a couple of warnings in GHC.PArr The fix isn't immediately obvious to me 18328c7 Fix more warnings 094430f Provide blockedOnDeadMVar, blockedIndefinitely for the RTS 877f6ac Suppress some warnings that are hard to fix because of ifdefs 3968fbf Fix Windows-only warnings in GHC.Conc 7166d89 Fix Windows-only warnings 75097ac Remove ST stuff that is now in the new st package 1943bef Split getopt off into its own package 8beae42 Split off the concurrent hierarchy (concurrent, unique, timeout) 39711a3 Windows-only fixes for moving concurrent out of base dccaa13 Fix warnings in PrelIOUtils.c 70b971f add extra-source-files field 67dfc3e Split syb off into its own package I've also moved the Data (Complex a) instance into it, and made it portable rather than GHC-only in the process. 6085e27 getopt is no longer part of base 0af78f5 System.Timeout is no longer part of base 0ad9def #2528: reverse the order of args to (==) in nubBy to match nub This only makes a difference when the (==) definition is not reflexive, but strictly speaking it does violate the report definition of nubBy, so we should fix it. 83092ca docs: mention that killThread on a completed thread is a no-op 306b3f8 non-GHC: add Typeable instance for ForeignPtr ab3e00c non-GHC: leave out Belch functions 5994604 avoid relying on the implementation of SomeException a0bd245 add include/CTypes.h to extra-source-files a7b8c05 Don't look for actual OldException.Exception exceptions We don't actually throw them (we throw the new Exception equivalents instead), and looking for them was causing an infinite loop e8a0e61 make Typeable instances for larger tuples available to non-GHC 8d4f8b8 remove 'pure' method from Arrow class (#2517) 96c6210 Remerge concurrent,unique,timeout,st,getopt into base 672a5a9 Add missing files 2e383b7 Don't make S_ISSOCK use conditional We were conditionally defining the C wrapper, but unconditionally using it. So if it didn't exist then things would have broken anyway. 67a0e66 Unbreak the GHC build with older versions of gcc Patch from kili at outback.escape.de, who says: Stg.h must be included before HsBase.h, because the latter contains function definitions causing older versions of gcc (3.3.5 in my case) to bail out with "error: global register variable follows a function definition" on Regs.h, which is included by Stg.h. 51bd513 Don't define __hscore_s_issock on Windows ee17e68 Generic functions that take integral arguments should work the same way as their prelude counterparts b100e76 Add a dep on syb ba950c6 Help haddock find ghc-prim's types by explicitly exporting them f338f43 In Setup, tell haddock about GHC.Prim 73cec9f We should be including Rts.h here, not Stg.h Stg.h is for .hc files only, and it sets up various global register variables. 9ac2a78 Fix bugs in Text.Printf (#1548) e3a8052 Fix compilation of Setup.hs with GHC 6.9 4e430ea In nhc98, Word is a type synonym, so class instance is not possible. c70bcab Pad version number to 4.0.0.0 aafb9bb Pad version number to 0.1.0.0 bcd82a7 Pad version number to 0.1.0.0 0d05991 Bump version number to 2.3.0.0 e921297 Restore the Haskell 98 behaviour of Show Ratio (#1920) b130868 Move the Integer type definition into GHC.Integer.Internals This means that we can export the constructors, but still keep the GHC.Integer interface generic. 4ae7c07 Don't use ^(2::Int) in Data.Complex.magnitude; partially fixes trac #2450 We still might want to make a RULE for this, so the bug is not fully fixed. d2f13aa update Data.Generics import e2c964b restore Complex's derived Data instance 73c5dd0 add new Data.Data module 815cbac added new module Data.Data 86e089b Add build-depends: rts for correct dynamic library linking 4d07ded eliminate dependency on syb df6626f non-GHC: delete unnecessary imports ba37236 removed (->) instance from Data.Data 3a6ee49 add readTVarIO :: TVar a -> IO a 1040756 changing haddock links de659cd add link to the new syb wiki f2b608c Import n_capabilities via import symbol when linking dynamically 2f27767 docs about how exceptions are handled by forkIO'd threads (#2651) c42736c Fix Trac #2700: pretty-printing of types e38db62 Make NameFlavour have a full Data instance so annotations can deserialize it 1b1a4ac Add AnnotationWrapper type so GHC can capture annotation dictionaries during compilation 51ac30e FIX #2722: update RULES for the Category/Arrow split 80ce119 add GHC.Conc.runSparks (required by GHC patch "Run sparks in batches") 877f16b updating Haddock documentation 3a4810c Fix the definitions of trueName and falseName 8fc45a4 Change an "undefined" into a more informative error; trac #2782 134633c re-instate the gcd/Integer and lcm/Integer RULES Fixes a performance regression between 6.8.3 and 6.10.1 33ec542 Add more description of what "round" does, from the H98 report c05b2a3 Fix performance regression in quotRemInteger/divModInteger This fixes most of the performance regression in these functions between 6.8.3 and 6.10.1, it was due to a slight difference in the strictness between the old and new versions (see comments for details). There's still a few percent loss in performance in the div test in nofib/spectral/integer that I haven't tracked down as yet. c09e4ae Fix typo (or out of date reference) in throwTo documentation. 5591c2b Fix #2750: change Prelude.(,) to Prelude.(,,) 64d5fe1 Update INLINE pragmas for new INLINE story dc746ab Fix #2760: deprecate mkNorepType, add mkNoRepType 06e60f3 FIX #1364: added support for C finalizers that run as soon as the value is no longer reachable. 5a70e93 Rollback INLINE patches 6279bfa warning fix: don't use -XPatternSignatures in GHC >= 6.10 64bafed extra dependencies for the new build system f54b22b More compact error messages for record selectors a1ec510 Fix typo (reqwests -> requests); trac #2908, spotted by bancroft 8f32298 Add errno to the IOError type 2bd42c4 Fix the build on Windows c66815c Fix build when we have HTYPE_TCFLAG_T 1f1c03c #2699: exit silently for EPIPE on stdout 04770e8 Add NoImplicitPrelude to the extensions used when building with GHC 4808212 Move some catch definitions around to avoid an import loop As suggested by simonpj in trac #2822. 8e2a7b7 make the Monoid docs more self-contained d49ea2e Unbreak an import cycle caused by moving 'catch' definitions around. The new cycle was introduced for nhc98 only. ed1a8c2 add Monoid laws 09cc855 Make Data.Typeable imports and exports more explicit 7dd8652 avoid `mappend` in monoid laws, because it doesn't work with haddock 8224df6 Correct SYB's representation of Char f63fe36 optionally include GHC.Prim in exposed-modules (for the new GHC build system) 4940d17 Fix #2759: add mkRealConstr and mkIntegralConstr, deprecate mkFloatConstr and mkIntConstr f4fb75b Proposal #2875: remove StringRep and StringConstr 3f81b2d #2875: Correct SYB's representation of Char e21b1cc Add "bug-reports" and "source-repository" info to the Cabal file 99c71c3 Add "bug-reports" and "source-repository" info to the Cabal file 8cf662a Add "bug-reports" and "source-repository" info to the Cabal file fc6ae58 Add "bug-reports" and "source-repository" info to the Cabal file Also switched to the modern Cabal file format e3b05c3 Require Cabal version >= 1.6 c9dd0a0 get unsafePerformIO from a documented location 7850ab9 Require Cabal version >= 1.6 e910522 Require Cabal version >= 1.6 e941801 Require Cabal version >= 1.6 d4a67c3 Update the Exception docs 0be55bd OldException catches unknown exceptions as DynException It's important that we put all exceptions into the old Exception type somehow, or throwing a new exception wouldn't cause the cleanup code for bracket, finally etc to happen. ea0dd25 Fix #2903: ensure CWStringLen contains the length of the array rather than the String 261f56f Make System.Posix.Internals buildable by nhc98. 2fc5d82 implement System.IO.Error more fully for nhc98 4f1b447 add some rules of thumb for catching exceptions, restructure the docs a bit 6ae4c49 Fix #2971: we had lost the non-blocking flag on Handles created by openFile This code is a mess, fortunately the new IO library cleans it up. 1d266a9 Rewrite of signal-handling (base patch; see also ghc and unix patches) 3c642ac Set the IO manager pipe descriptors to FD_CLOEXEC This pipe is an internal implementation detail, we don't really want it to be exposed. 27df316 ifdef out the syncIOManager export on Windows; fixes the build eac3bc6 Fix warnings: put imports inside ifdefs 19b8cab ifdef out the definition of setCloseOnExec on Windows; fixes the build c15e830 #2759: Amend previous patch e86bc10 Rules to make genericLength strict for Int/Integer lengths, see #2962 68cf5b0 Don't hide GHC.Integer from haddock; fixes trac #2839 This works around haddock not exporting docs across package boundaries a1adf4c FIX #2189: re-enabled cooked mode for Console-connected Handles on Windows Patch from Sigbjorn Finne 258be3d add final newline; fix build (on Windows?) c751ba5 Add config.guess, config.sub and install-sh 7fc5bad Partial fix for #2917 97ca06f avoid a space leak building up in the "prodding" IORef (part of #2992) 40ad6ff FIX #2189: re-enabled cooked mode for Console-connected Handles on Windows Patch from Sigbjorn Finne 5b413a6 Don't set -Wall -Werror in the .cabal file db1fe7e Fix layout to comply with H'98. Also, configure correctly for nhc98, to avoid win32 code. 4715e3d ghcconfig.h is __GLASGOW_HASKELL__ only 2d75b36 Added type family declarations forms - Adds type family and instance declarations, both on the top level and as associated types - No equality constraints yet 36bf9a5 Adding equality constraints - This patch adds equality constraints - This requires an incompatible change of the type TH.Cxt - hence: 66d3f4c Add an import needed in the new build system 05ee08c Remove some redundant fromInteger's ce8f519 Added INLINE and SPECIALISE pragmas as declaration forms 4b84d6d Template Haskell: kind annotations - Kind annotations at variables in type declarations - Kind signatures in types 5429c33 Added bang patterns 8962241 Add another Data.List.intersect example from Christian Maeder cebb0b8 Avoid unnecessarily using Integer when decoding Floats 76fc3e3 be sure to install Nhc98BaseConfig.h 4ad4fcc Don't inline unpackCString e3abe55 Import GHC.Err so we see bottoming functions properly 59a4969 Don't inline enumDeltaToInteger until its rules have had a chance to fire b12c687 Fix QSem and QSemN: Initial amount must be non-negative 534875d FIX #3171: make sure we have only one table of signal handlers 3a8892c Use a bang pattern when we where/let-bind values with unlifted types eae9587 Use a bang pattern when we where/let-bind values with unlifted types 3050a63 Add more bang patterns, needed to fix the 32bit build 89f7400 Add wrappers around fcntl We need to do this as it has a (, ...) type, which we aren't allowed to directly call with the FFI. 925de5d remove msvcrt and kernel32 from extra-libraries 603dc2c add _O_NOINHERIT when opening files on Windows (see #2650) f7aba142 Document that the initial quantity for QSem and QSemN must be >= 0 3b73807 Fix warnings d93422a Increase the version number to that in the 6.10 branch b4a6381 Add liftString, to match the "improve lifting for strings" patch in the compiler c40a70c Fix #3257: document that exitWith in a forkIO'd thread does not exit the process ac45944 Make two type defaults explicit d7940ee Fix validate (on Windows) f06ff78 Add missing -XTypeOperators 84aff67 Remove the unused decodeFloatInteger 7892f2f Remove unnecessary parens 247de6b nhc98 must build dirUtils.c as well. Fixes this bootstrapping error: Undefined symbols: "___hscore_readdir", referenced from: _FR_System_46Posix_46Internals_46readdir_35 in libHSbase.a(Internals.o) ea7e893 Add __encodeDouble and __encodeFloat Moved here from the rts. 16f5710 Remove unused foreign imports of __encodeFloat/Double 10b4734 abstractify ModName, PkgName and OccName; drop dependency on packedstring 7b067f2 Rewrite of the IO library, including Unicode support 7834fd6 Add iconv as an extra library on platform that need to link with it For example, we need -liconv on OS X. 7f97d9d Allow System.Posix.Internals to compile with nhc98 again. Also affects GHC.IO.Device, which is not very GHC-specific at all. bbbf03e Fix #3128: file descriptor leak when hClose fails 1e74d27 Save and restore the codec state when re-decoding d273fbc Fix warnings in C programs generated by configure; fixes failures with -Werror 5abf6bc Fix warnings in configure script 0f859f0 The IO type has moved to GHC.Types in ghc-prim 86b3b70 Redefine gcdInt to use gcdInteger rather than gcdInt# primop The gcdInt# primop uses gmp internally, even though the interface is just Int#. Since we want to get gmp out of the rts we cannot keep gcdInt#, however it's also a bit odd for the integer package to export something that doesn't actually use Integer in its interface. Using gcdInteger is still not terribly satisfactory aesthetically. However in the short-term it works and it is no slower since gcdInteger calls gcdInt# for the special case of two small Integers. 68e2d96 Implement the gmp primops in the integer-gmp package using cmm 8294eb6 Tweak the small integer case of gcdInteger for better optimisation The gcdInt function in the base package now calls gcdInteger with two small integers. With this weak, the optimiser generates a base gcdInt that directly calls the gcdInt# primop from this package. This means there should be no additional overhead compared to when the base gcdInt called the gcdInt# primop directly. 116fd1f Add a configure script and rely on local definitions of derived constants 060251c Move gmp to here, from the GHC repo 64bcc31 Add a GHC.Debug module, with debugLn :: [Char] -> IO () 0c829ca The IO type has moved to GHC.Types in ghc-prim d8cc29c Remove the Integer functions; they're now in integer-gmp instead 819ff42 Move the int64 conversion functions here, from ghc-prim ce8b9e1 Fixes for building on machines that don't have gmp bba3952 Remove old Integer prototypes 81217a9 Don't put "extra-libraries: gmp" in the cabal file; it comes from the buildinfo file 28d1321 Remove AC_C_CONST It was breaking the build on Windows. The problem was that we included stdio.h which gave a prototype for some functions (e.g. remove), then the AC_C_CONST meant that we did /* Define to empty if `const' does not conform to ANSI C. */ #define const /**/ and then we included io.h which gave prototypes that, due to const being removed, conflicted with the earlier prototypes. 4a35e26 Improve the configure script 585f14e Make configure fail if deriving the constants fails ee93754 gmp build tweaks 82427f5 Unconditionally make a (Show Ptr) instance It used to only exist if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) 772a168 Add a comment to remind us that memcpy_src_off is used by dph 2e7e5a3 Windows: Unicode openFile and stat functions cfc1d39 Patch GMP to always use the GHC allocation functions This works around a crash (only on OS X for some reason?) where the GHCi GMP uses the systems memory allocator. We should fix this properly, by making ghci run constructor functions. 14a5ed1 Make this file independent of HsBase.h, use HsBaseConfig.h only 7f3e271 Tidy up use of read/write/recv/send; avoid unnecessary wrappers 331047f don't include config.mk if we're cleaning 5aa24b2 Make this package now really integer-gmp, rather than pretending it's integer 7975b3a fix bug in partial writes 82ea26e add hFlushAll, flushes both read and write buffers cdd8efa fix the dependencies on GmpDerivedConstants.h when HaveLibGmp==YES 77bdf4d Call nl_langinfo(CODESET) to get the name of the locale encoding on Unix fe11112 setNonBlockingMode now takes a flag, can turn blocking mode back on again 6664b78 Fix iconv detection on OpenBSD Matthias Kilian discovered that iconv_open is #define'd to something else on OpenBSD, so the test needs to include the iconv header. 6879b31 fix build failure on Windows 0c29bd3 not having iconv is not fatal on Windows 44f5e8e fix the windows build even more f1c161e Move directory-related stuff to the unix package now that it isn't used on Windows any more. e5c2417 Fix the case of HaveFrameworkGMP values 63b433a Check for whether we have gmp.h, as well as whether we have the gmp library a8da923 set binary mode for existing FDs on Windows (fixes some GHCi test failures) 9416fb7 #include if we have it (should fix build problems) c5692da Add a wrapper for libiconv. ff79ef5 avoid a warning 818e4ab a byte between 0x80 and 0xBF is illegal immediately (#3341) 63128a7 Don't export CLDouble for GHC; fixes trac #2793 We never really supported CLDouble (it was a plain old double underneath), and pretending that we do does more harm than good. 942281f Add 'eof' to Text.ParserCombinators.ReadP 63a241d Remove some cruft from Data.HashTable dbb6d84 Use the result of writeCharBuf c84bffd Remove unused imports from base 244350c fix mk/build.mk for HaveLibGmp/HaveFrameworkGMP Previously if you were to set HaveFrameworkGMP/HaveLibGmp in mk/build.mk (e.g. on mac os) the settings would be ignored, as gmp/config.mk is included late in GHC's ghc.mk, meaning autoconf overrides your settings. Now they ignore the values picked up by configure if you set these variables. 7c97c89 Remove unused imports 48ba358 Remove unused imports 201a288 Add back imports needed on Windows d521a6a Fix "warn-unused-do-bind" warnings where we really do want to ignore the result e6b1fc6 Fix "warn-unused-do-bind" warnings in System.Posix.Internals 3ef577a Fix "warn-unused-do-bind" warning in GHC.Conc If we fail to communicate with the IO manager then we print a warning using debugErrLn from the ghc-prim package. 95f71e7 Minor code tidyups in GHC.Conc 4f1f969 Use the result of writeCharBuf in GHC/IO/Encoding/Latin1.hs too f1c7f5b Fix some "warn-unused-do-bind" warnings where we just want to ignore the result 313263a Fix "warn-unused-do-bind" warnings in GHC/IO/Handle/Text.hs 5480a97 Minor SampleVar refactoring 1b12b2e Fix some "warn-unused-do-bind" warnings where we want to ignore the value 28056bd GHC.Conc.reportError now returns IO () It used to return IO a, by "return undefined". 63263ed reportStackOverflow now returns IO () It used to do "return undefined" to return IO a. fb13a2a Remove an unused import 1274496 Use throwErrnoIfMinus1_ when calling getrusage c23bcae Fix some "warn-unused-do-bind" warnings where we want to ignore the value c344229 Fix build on Windows 3d5794a add a comment about the non-workingness of CHARBUF_UTF16 43c7f11 Add a debugErrLn function, which is like debugLn except it prints to stderr 6bc00b2 Export Unicode and newline functionality from System.IO; update Haddock docs ecfac87 Add the utf8_bom codec as suggested during the discussion on the libraries list. 33209d5 Add more documentation to mkTextEncoding noting that "//IGNORE" and "//TRANSLIT" suffixes can be used with GNU iconv. 07c5532 Add hGetEncoding :: Handle -> IO (Maybe TextEncoding) as suggested during the discussion on the libraries list b6c2447 warning fix: -fno-implicit-prelude -> -XNoImplicitPrelude 9d3a7e4 remove unused warning f20d8c1 Add GmpDerivedConstants.h dependencies for all ways, not just vanilla 1ea44d1 Make chr say what its argument was, if it's a bad argument 5099abf Improve the index checking for array accesses; fixes #2120 #2669 As well as checking that offset we are reading is actually inside the array, we now also check that it is "in range" as defined by the Ix instance. This fixes confusing behaviour (#2120) and improves some error messages (#2669). c6214d4 move "instance Exception Dynamic" so it isn't an orphan fd5e28c Move the instances of Functor and Monad IO to GHC.Base, to avoid orphans f6a645e depend directly on integer-gmp, rather than indirecting through integer 7d28e54 Make integer-gmp suitable to be used directly, rather than via integer 6679d2c Whitespace only, in gmp-wrappers.cmm 3ee11c4 Remove unused stack variable 50d0195 Use shift[LR]Integer in the Bits Integer instance 14ca574 Add integer-simple as a build option 8325cd8 Add primops for shifting 12e1e1f Follow changes in GHC and the other libraries a63b16e () is now available, so use that instead of our own a7e4d79 Add an import so the deps get sorted out correctly cfe2b67 Add NoImplicitPrelude to the extensions used 44dc3ef Fix GC annotations in GMP_TAKE1_UL1_RET1() 65f42eb Update to follow RTS tidyp changes 47b0050 fix conditionals (prevents GMP always being built) 82b3b2a Update to follow RTS tidyp changes 5f54b85 Updates to follow the RTS tidyup C functions like isDoubleNaN moved here (primFloat.c) 356f414 Windows build fix, following RTS tidyup bcbe9e7 Deprecate Control.OldException ed6de50 Tweak the BufferedIO class to enable a memory-mapped file implementation We have to eliminate the assumption that an empty write buffer can be constructed by setting the buffer pointers to zero: this isn't necessarily the case when the buffer corresponds to a memory-mapped file, or other in-memory device implementation. cc81cb8 fix a copyright 32ed9c8 add INLINE toList 23a7746 Fixing configure for autoconf 2.64 2e1f145 Add some more C wrappers; patch from Krister Walfridsson Fixes 21 testsuite errors on NetBSD 5.99. 3744427 Apply proposal #3393 Add openTempFileWithDefaultPermissions and openBinaryTempFileWithDefaultPermissions. 57fea45 Add a GHC.Constants module; fixes trac #3094 97f3d01 Add a doc header to GHC.Types, and point at GHC.Exts 7a3b850 Fix "Cabal check" warnings 6401664 Fix "Cabal check" warnings 1d08e94 improvements to Data.Fixed: instances for Typeable and Data, more predefined types bf2f7ce Document 'CompE' better (see Trac #3395) 2da4486 Apply fix for #1548, from squadette at gmail.com 32f868b un-hide some modules from the Haddock docs 8537662 typo in comment a05ddfe Allow for configurable iconv include and library locations. This should help to fix the build on OpenBSD. 0bb639d fix debugging code bc41c09 Fix hWaitForInput It was erroneously waiting when there were bytes to decode waiting in the byte buffer. b98015a Fix #3441: detect errors in partial sequences 7ac406c Fix unicode conversion for MSB architectures This fixes the SPARC/Solaris build. a5e2fa9 Address #3310 92c7985 Bump base version to 4.2.0.0 bf7ad38 Fix "init" docs: the input list need not be finite. Fixes trac #3465 b63b596 On Windows, use the console code page for text file encoding/decoding. 9563eea make some Applicative functions into methods, and split off Data.Functor (proposal #3335) 970816a Use let !y = x in .. x .. instead of seq in $! and evaluate (#2273) 8dad51b Use CONF_CC_OPTS - Needed to get arch-dependent options, eg, on Snow Leopard 5b5e5b7 Fix #3534: No need to flush the byte buffer when setting binary mode 81c87ee Fix the error message when flushing the read buffer of a non-seekable Handle 612db02 Add traceEvent :: String -> IO () For emitting an event via the RTS tracing framework 3c87dfe Strip any Byte Order Mark (BOM) from the front of decoded streams. When decoding to UTF-32, Solaris iconv inserts a BOM at the front of the stream, but Linux iconv doesn't. ad96a22 use UTF32BE/UTF32LE instead of UCS-4/UCS-4LE 7f5e473 Strip any Byte Order Mark (BOM) from the front of decoded streams. When decoding to UTF-32, Solaris iconv inserts a BOM at the front of the stream, but Linux iconv doesn't. ef624c4 Use UTF-32LE instead of UTF32LE The latter is not recognised by some iconv implementations. 3951112 Fix gratuitous breakage for non-GHC in Data.Bits. 1748fa8 Fix gratuitous breakage of non-GHC in Data.Fixed. 1fcc5c8 Fix gratuitous breakage of nhc98 in Control.Exception.Base. 8a7745d Fix gratuitous breakage of nhc98 in System.IO. fdc271f Cope with nhc98's (occasionally-strange) import semantics. c3b8a74 Make Data.Functor compatible with non-GHC compilers. 9590147 Another instance of nhc98's strange import semantics. dfad393 It seems that nhc98 needs defaulting in Data.Fixed. 894d7fe Roll back "Cope with nhc98's (occasionally-strange) import semantics" Fri Oct 9 14:43:51 BST 2009 Malcolm.Wallace at cs.york.ac.uk GHC (correctly) warns about the unused import, which breaks the validate build. 2fa71f7 Roll back "Another instance of nhc98's strange import semantics." Fri Oct 9 14:50:51 BST 2009 Malcolm.Wallace at cs.york.ac.uk GHC (correctly) warns about the unused import, which breaks the validate build. 188bff7 Re-instate System.Console.Getopt for nhc98 builds. Although it was split out of base a while back, that change was reverted for ghc soon afterwards, but nhc98 never noticed. 23c183b Make hGetContents throw an exception if an error is encountered 1895485 dirUtils.c no longer available 381f8a8 Inline foldr and (.) when applied to two arguments not three 763bea6 Tidy up and comment imports 5a1ec04 Exploit now-working default-method INLINE pragmas for Data.Bits 1d6de5f Move error messages out of INLINEd default methods 00c66fe Inline more default methods 8d0eda2 Don't inline unpackFoldrCString ever 07bbc8c improve the documentation for throwErrnoIfRetry 23939c6 Fix #1185: restart the IO manager after fork() d9b3261 Fix the build on Windows 429156a Rollback #1185 fix e5b04f8 Second attempt to fix #1185 (forkProcess and -threaded) 23a2c67 Remove ffi warnings for nhc98. 99ead68 Move Eq/Ord Ordering instances to de-orphan them 08c5e81 De-orphan the Eq/Ord Bool instances b7d693c De-orphan the Eq/Ord Char instances 20d77cb De-orphan the Eq/Ord [a] instances c677ed0 Rearrange the contents of Control.Monad.ST; no functionality changes 606ef3a De-orphan the MonadFix ST instance for GHC 0739342 Control.Exception.Base no longer has any orphans b3a0d27 De-orphan tuple Eq/Ord instances d39fcd7 We can now derive Ord () 62e84a9 Derive some more instances, rather than writing them by hand 468595e Whitespace only d6f29a0 De-orphan the Eq/Ord Integer instances 78217b0 Remove an old comment 450bac6 Make sure zipWithFB has arity 2 c3f0928 Tweak layout to be accepted by the alternative layout rul b0b39d7 Tweak layout to work with alternative layout rule 07061cc Remove an unnecessary -fno-warn-orphans flag 46629f2 Fix arities of mapFB and zipFB f4b76d3 hGetContents: close the handle properly on error 524d844 check for size < 0 in mallocForeignPtrBytes and friends (#3514) 0e0130b x86_64 requires more stack 8c44eab fix the docs regarding finalizer guarantees 07f3840 Data.Either.partitionEithers was insufficiently lazy. Spotted by Daniel Fischer. 238b0d4 Add comments to "OPTIONS_GHC -fno-warn-orphans" pragmas 21b0ea0 De-orphan Eq/Ord Float/Double 8a4aa09 Comment the remaining orphan instance modules 6103a09 Mark 'index' as INLINE in GHC.Arr 0dd0cce Fix Trac #3245: memoising typeOf b6b3de1 Add comments about double bounds-checking, and fast paths for rectangular arrays 8b3a3db Restore previous Data.Typeable.typeOf*Default implementations for non-ghc. Not all compilers have ScopedTypeVariables. b48b19b Replace the implementation of mergesort with a 2x faster one. See ticket http://hackage.haskell.org/trac/ghc/ticket/2143. a8d9dc1 Control.Monad: +void :: f a -> f () See http://hackage.haskell.org/trac/ghc/ticket/3292 Turns m a -> m (). Lets one call functions for their side-effects without having to get rid of their return values with '>> return ()'. Very useful in many contexts (parsing, IO etc.); particularly good for 'forkIO' and 'forM_', as they demand return types of 'IO ()' though most interesting IO functions return non-(). c2507dd hIsEOF: don't do any decoding (#3808) 0dd5ade Fix the build: export void, so it doesn't give an unused binding warning a9db92b fix #3832: use the locale encoding in openTempFile Also while I was here fix an XXX: the Handle contained an uninformative string like for error messages rather than the real file path. c9de89a Stifle warning about unused return value 59252fb For nhc98, import unsafeInterleaveIO rather than defining it here. b7212fa Handle NaN, -Infinity and Infinity in the toRational for Float/Double (#3676) b166de1 Update the exitWith docs Error pointed out by Volker Wysk 8ff7031 nhc98 should build Data.Functor. 9699809 Put the complexity in the length docs. Fixes trac #3680 cba34d6 UNDO: Handle NaN, -Infinity and Infinity in the toRational for Float/Double (#3676) c77631a FIX #3866: improve documentation of Data.Data.Constr 4cd0295 Plug two race conditions that could lead to deadlocks in the IO manager da9c3f7 Documentation fixes in Control.Exception f73dee6 Fixed dead links in documentation of forkIO 522a41a Tweak docs 843fd34 change to use STM, fixing 4 things 1. there was no async exception protection 2. there was a space leak (now new value is strict) 3. using atomicModifyIORef would be slightly quicker, but can suffer from adverse scheduling issues (see #3838) 4. also, the STM version is faster. f513faee1 Write the thunk 'next' to the MVar 3a6a033 Fix bugs regarding asynchronous exceptions and laziness in Control.Concurrent.SampleVar - Block asynchronous exceptions at the right places - Force thunks before putting them in a MVar 05c9b24 Make SampleVar an abstract newtype fe89270 fix the deprecation message (GHC.IO.Handle.Base -> GHC.IO.Handle) 2f25bea runInUnboundThread: block asynchronous exceptions before installing exception handler 416bddb withThread: block asynchronous exceptions before installing exception handler. Note that I don't unblock the given io computation. Because AFAICS withThread is only called with 'waitFd' which only performs an FFI call which can't receive asynchronous exceptions anyway. cb1ec67 remove old/wrong comment d5dff95 Tiny code tidy-up a414415 Fix bitrot in IO debugging code Also switched to using Haskell Bools (rather than CPP) to en/disable it, so it shouldn't break again in the future. 6445963 Ignore the return code of c_fcntl_write again 8095608 Move comment closer to the offending line 98aeee2 INLINE alloca and malloc See discussion on glasgow-haskell-users: http://www.haskell.org/pipermail/glasgow-haskell-users/2010-April/018740.html bcf26f5 add NOINLINE pragmas for stdin/stdout/stderr 2ff3230 raise asynchronous exceptions asynchronously (#3997) 9a36403 inline allocaArray0, to fix withCString benchmark 092c0cf Add swap (#3298) 1428e6e Add hGetBufSome, like hGetBuf but can return short reads df963fc add Typeable instance fb2c023 elaborate the docs for unsafePerformIO a bit 4922f39 improve the documentation for throwTo and killThread (#3884) 77dcfa5 Fix for hGetBufSome 39aa14d Correct haddock formatting. 38e98e3 hSetEncoding: change the encoding on both read and write sides (#4066) 7eaf04a hWaitForInput: don't try to read from the device (#4078) readTextDeviceNonBlocking is not non-blocking on Windows bb6c2ee export hGetBufSome (#4046) 24265cd fix syntax in doc comments 3b4000f doc comment illustrating Foldable(foldr) 855b6c7 expand Foldable instance for Array ecff886 Added Applicative and Alternative instances for STM 74e75a2 Moved MonadPlus instance for STM from Control.Monad.STM to GHC.Conc to avoid an orphaned instance 808665a bump version to 4.3.0.0, added instance MonadPlus STM 2429795 Don't depend on Prelude (#4123) 7e991e1 don't depend on Prelude (#4122) f3bbb89 docs: note that hGetBufNonBlocking isn't non-blocking on Windows 0771aab Add a note about the interruptibility of throwTo. 264ffc7 Use libcharset instead of nl_langinfo(CODESET) if possible. c9bb622 add Applicative instance for Either (proposal #4095) 5dd5a90 Don't define the C localeEncoding on Windows (it causes warnings, and isn't used) 95ff509 add an INLINE to the list version of traverse, to enable fusion 37fa6df remove extraneous info from docs for Array bd2d802 add doc for the ExitCode type c4228db nit in docs for accumArray 2d6a2e0 make the hGetBuf/hPutBuf family work with non-FD Handles (#4144) fc5566b fix docs for isSpace 02d543a correct docs for exitWith: only stdout/stderr are flushed, not all Handles 039b6e1 Give nub's complexity in the haddock docs; fixes #4086 aeb0696 Fix haddock formatting 0506438 doc wibbles 035b627 doc wibble 23e8914 doc updates in System.IO 0d6d3b3 doc wibble da43f48 move the doc for 'Char' to its new home in ghc-prim:GHC.Types bdfebf2 doc whitespace f9a9ace doc wibble: nonstrict -> non-strict 8fb7b12 doc wibble: remove confusing mention of "Prelude" 56f36a9 use '==' consistently rather than '->' in examples 2c4faf5 Haddock hacks to fix whitespace consistency 8496a88 doc typo 97545f7 doc wibble: Haskell 98 I/O Error -> 'IOError' d4fc1d7 doc typo a879e42 doc typo 485a489 doc typo e88be24 peekArray docs: remove mentions of "this version" and "previous version" b6dca0e doc typo 207a6a6 extract information about Data.Time from docs for CTime 5f0bcba unqualify Float and Double d770bc0 docs: unqualify Prelude.IO 7cd4211 remove docs from Monad that belonged on the instance for MonadPlus IO fd70fba Fix a few places where we forgot to close the text codecs (#4029) Each time you invoke :load in GHCi it resets the CAFs, including stdin/stdout/stderr, and each of these was allocating a new iconv_t. 23d79ef Async-exception safety, and avoid space leaks Patch submitted by: Bas van Dijk Modified slightly by me to remove non-functional changes. 3ae2fa0 Async-exception safety, and avoid space leaks Patch submitted by: Bas van Dijk Modified slightly by me to remove non-functional changes. 7315707 New asynchronous exception control API (base parts) d328fb6 Allow nhc98 to cope with recent changes to Control.Exception. 4ed43d3 Remove duplicated word in documentation a2d8cd7 Fix typo in documentation 564d00c Partial fix for Trac #4136 2f788c9 mention that IntPtr and WordPtr can be marshalled to/from intptr_t and uintptr_t 5e2ec13 add cast{C,U}CharToChar and castCharTo{C,U}Char, from Haskell 2010 e4a66c6 note shortcutting behaviour of any/all/elem 90067a6 clarify meaning of bit e2fcaf0 doc: use "finalizer" consistently fac2960 document exception-overriding behaviour in withFile 941c197 add module intro from Haskell 2010 80d8b2f doc formatting fix 73bd02b docs: mention that Foreign.unsafePerformIO is deprecated We can't actually deprecate it without introducing a name clash between Foreign.unsafePerformIO and System.IO.Unsafe.unsafePerformIO 175e795 add unsafeLocalState from Haskell 2010, and docs 5a9bd2b add numSparks :: IO Int (#4167) 4c45d8f Remove egregious ghc-ish from Foreign.Marshal 6583bc7 move Monad and MonadFix instances for Either from mtl (proposal #4159) 41fe4e3 Add mfilter to Control.Monad bae5886 Bump version to 0.2.0.0 f4acc35 Bump version to 0.2.0.0 5cc558c Pad version to 0.1.0.0 d1c396b Set the path to nm before configuring the C gmp lib 6b3eea4 Fix Trac #3572 (pls merge) f8fe4fd Fix pretty-printing of INLINE pragmas 659ca88 Windows DLLs: Tag imported gmp symbols with the package they're from. 33a319e Add new GHC.Magic module 471b14a Undo previous patch, caused linker problems on x86_64/linux ccdaa27 allocateLocal was renamed to allocate 631bb7f Add a missing dependency on gmp.h 9dbad72 bump base dep; apparently base4 is now required 620cdc5 Fix a makefile dep a7a7d7b Move .depend file dependency inside HaveLibGmp test We were building GMP even if we didn't need to. 6fd63e5 Tag imported gmp symbols with the package they're from 2eaf722 MERGED: Pass GMP paths when compiling mkGmpDerivedConstants; fixes trac #3784 Ian Lynagh **20100118191831 d7e56c1 Don't rely on tar supporting -j; trac #3841 cd0cecb Fix the build A missing | meant that the build broke on machines that don't have libgmp available. 2528077 Fix the $(GMP_DIR) path that we remove b749fed pass $(AR) to the GMP build 1f4961a Follow variable name changes e69ab88 FIX #38000 Store StgArrWords payload size in bytes 87af623 Tighten the base dep; fixes trac #3809 619fc6b Add quasiquote definitions for declarations and types 7c93bf7 Add parens in patterns; fix Trac #3899 49f2a3b Format most comments for haddock. 65160e0 Fix typo d474eda Replace an (incorrect) bytes-to-words calculation with ROUNDUP_BYTES_TO_WDS 4d372bc Follow SET_ARR_HDR change af3c0ac Hide GHC.Integer from haddock again, now that haddock #24 is fixed; trac #2839 77f432c re-instate the documentation for 'Char', which got lost at some point 43583aa Integrated new I/O manager (patch originally by Johan Tibell , minor merging by me) 37f9e66 Add type signature in local where a76bad5 Add type signatures to cope with lack of local generalisation aae6f86 deprecate unGetChan and isEmptyChan (see #4154) 74500d4 Improve TH pretty printing 0d34321 export allocaBytesAligned; make allocaArray use the correct alignment (#2917) e449f18 Fixed a rounding error in threadDelay 2e197f1 Add a missing castPtr (only shows up in -DDEBUG) dc8d692 fix cache variable name used by FP_SEARCH_LIBS_PROTO cbd9e54 Fix warnings 3e3cfe9 Fix the build when HAVE_KQUEUE but not HAVE_KEVENT64 e7f7ce7 More accurate isatty test for MinGW. 158edf1 Fix Windows build; patches frmo ezyang 29cc62c Remove debugging code accidentally left in 68e20b5 avoid Foreign.unsafePerformIO f5f073d Put the state-token argument on fill, done, adjust on the RHS 4176e8a fix warning on Windows a442e21 deriving (Eq, Ord, Read, Show) for Newline and NewlineMode 1957027 don't fill a finalized handle with an error (see comment) c3563c6 Add a suitable Show instance for TextEncoding (#4273) b6c6bc8 Add missing import, fixes build on windows c3c5bee Add absentError. 1b0a5be tighten up parsing of numbers (#1579) deea031 Windows: map ERROR_NO_DATA to EPIPE, rather than EINVAL WriteFile() returns ERROR_NO_DATA when writing to a pipe that is "closing", however by default the write() wrapper in the CRT maps this to EINVAL so we get confusing things like 0363c0b some fixes for hGetBufSome - fix one case where it was blocking when it shouldn't - a couple of error-message tweaks 880046f Allow Data.HashTable construction with user-supplied size a5e8598 Use the stage-specific CONF_CC_OPTS variables 76dcfb8 Add a StringPrimL constructor to the Lit type (fix Trac #4168) 8ac36fd implement integer2Int# and integer2Word# in Haskell, not foreign prim 6c00372 fix hashInteger to be the same as fromIntegral, and document it (#4108) 13393fc documentation for IODeviceType (#4317, edited by me) 6cc96ac doc tweak for Directory file type: file names are '\0'-separated 8e81282 Make intersectBy lazier Add shortcuts to intersectBy for empty list arguments. In addition to being faster in that case, more inputs yield defined results. Treats ticket #4323 13e2f4a FIX #4228 (atanh (-1) returns NaN instead of -Infinity) 61b7635 Fix compile warning on 32bit machine 54047d1 Add quoteFile function (see Trac #4293) 4292f7c Add TH reification of instances (Trac #1835) e6ad4fd Bump version to 2.5.0.0 c33ce37 Export recent additions from Language.Haskell.TH e7bd0d0 Extend Template Haskell support for interruptible calls. ce7e28e Bump version number to 0.2.0.2 efc5f12 Lazier intersperse A lazier implementation of intersperse, and consequentially intercalate, to avoid space leaks. 9e176dc Added initial .authorspellings c60ff20 Replaced some throws to throwIOs where the type is IO e015075 FIX #4381 Fix scaleFloat by clamping the scaling parameter so that exponent + scale doesn't overflow. fed095f remove trailing whitespace bb0e835 throwTo: mention interruptible foreign calls 686bce8 Define SpecConstrAnnotation in GHC.Exts, and import it from there 2620fbe FIX #1434 Rewrite rules for RealFrac methods with sized Int and Word targets. For all types whose range is contained in Int's range, there are now rewrite rules for properFraction, truncate, floor, ceiling and round from Double and Float, going through the specialised methods for Int. c3c3533 FIX #4334 Make selector thunks visible to GHC to fix a space leak in lines. 55d1537 Generalize catchSTM 834b9cf Add throwSTM :: Exception e => e -> STM a 5329059 Added view patterns (Trac #2399) a59bf17 FIX #4336 Avoid superfluous gcd calculation in recip for Ratio a because numerator and denominator are known to be coprime. f87c2eb remove trailing whitespace ca69c4f FIX #4337 Special versions for the power functions with a Rational base and rewrite rules. 27310e0 FIX #4335 fromRational :: Rational -> Ratio a produced invalid results for fixed-width types a. Reduce the fraction to avoid that. 16e5ce1 Remove redundant imports, now that NoImplicitPrelude does not imply RebindableSyntax 132e2c2 Follow GHC.Bool/GHC.Types merge aeb9367 CIntPtr, CUIntPtr, CIntMax, CUIntMax are new to nhc98. 4041be6 Add showMultiLineString to GHC.Show a75383c Refer to 'mask' instead of 'block' in documentation of Control.Exception e6c8e5d hGetBuf: fix a case of a short read being returned (#4427) 4e089af Add an INLINE pragme for fmapDefault f5dc1f6 Add an INLINE pragma on fromInteger on Int e44eac2 Fix whitespace in codepages/MakeTable.hs db5a9f5 Add a Makefile for MakeTable, and remove GHC.Num generated import 2c9b441 Re-gen GHC/IO/Encoding/CodePage/Table.hs ac6e50b Remove redundant import cd5e82e Reimplement firstPowerOf2 679d2c3 Add LANGUAGE BangPatterns to modules that use bang patterns b1b414a System.Event.KQueue conditionally uses BangPatterns 2494866 Add some comments to the generated Table.hs 3b01da3 Remove unnecessary fromIntegral calls 36896b6 Use throwIO instead of throw in runInBoundThread and runInUnboundThread 3503268 There's no need to explicitly check for blocked status in runInUnboundThread when we have mask eea9504 Catch exceptions in current thread and throw them to the forked thread in runInUnboundThread f891dda Fixing uses of fromIntegral for Windows 61eb4de Remove redundant fromIntegral 0a5ae50 Make (^) and (^^) INLINABLE 4c6bc7f Remove a redundant fromIntegral 04e3a09 Remove an unnecessary fromIntegral e7b799f Remove unused import on Windows db78cae doc fix: don't refer to unblock. 3beebdc use LANGUAGE instead of OPTIONS_GHC 443a9f1 Don't throw an error if the output buffer had no room This is consistent with the other codecs, and will be relied on by some upcoming changes in the IO library. 62c11c9 Encode immediately in hPutStr and hPutChar This means that decoding errors will be detected accurately, and can be caught and handled. Overall the implementation is simpler this way too. 0944a3b fix hTell behaviour with Unicode Handles d1e5852 Fix typo 9c0da18 check for ClosedHandle in read/write operations on DuplexHandles (#4808) 0b73a8d -XPArr is now -XParallelArrays 2046516 fix a discarded exception in hClose 21c4b26 extend the documentation about interruptible operations 8b3134d Export String from Data.String 5b0dbb5 Do not export String from Data.Char fab6b97 Also export lines, words, unlines and unwords from Data.String d8a0209 Add a Read instance for Data.Fixed.Fixed c69ecdd FIX #4383 Use a better approximation to logBase 10 2 to prevent leading zeros in floatToDigits. bdb39d8 Performance enchancement for floatToDigits Use quot and quotRem instead of div and divMod for dividing positive Integers since that is a bit faster. ef360ef Fix typo in floatToDigits The mDn value for powers of 2 >= floatDigits x - 1 was typo'ed, leading to longer than necessary show results in a few cases (e.g. 2.0^852). Corrected in accordance with Burger and Dybvig's paper. 0853287 Cache for powers of 10 Add a cache for commonly needed powers of 10 to speed up floatToDigits. cd497c6 Bump the version of base 79cf73c Fix #4514 - IO manager deadlock b6b40e4 Drop System.Mem.Weak's dependency on Prelude b9aeafa Fix #4533 - unregister callbacks on exception, fixing a memory leak dcc27a9 Drop closeFd from Control.Concurrent, rename to closeFdWith e30b2f4 Use onException for exception cleanup, and mask async exceptions 7617a10 Fix warnings 3485636 Fix build on Windows 7676811 Replace uses of the old catch function with the new one 798805f Always use 8k buffers instead of BUFSIZ This makes a huge difference to I/O performance for me on Windows, where BUFSIZ is 512. It might help on Mac too. 85bbbc4 Add Applicative instances for ST monads (proposal #4455) 0a55732 indentation tweaks, re-order exports c32e204 indentation tweaks (whitespace only) 52dbd3a Instances for ST not available in nhc98. 88faf22 fix #4876 511cbda Derived Eq instance for Chan a6d475c Derived Eq instance for QSem and QSemN 842d0d2 Added a Typeable instance for SampleVar 4f20ff4 Remove extensions required for GHC < 6.10 5578d58 Add NondecreasingIndentation to the extensions needed 232b001 Document System.Event 6036932 Clean up remnants of the Event Manager after forkProcess. Closes #4449 4cc27e7 fix silly mistake in hGetBufSome (#4895) 32ba285 Use explicit language extensions & remove extension fields from base.cabal c3d80a4 add NoImplicitPrelude (fix Windows build failure) c1a2db0 add missing extensions for Windows 6504ff9 add getNumCapabilities :: IO Int fa535ef Deprecate System.IO.Error.{catch,try} and Prelude.catch; fixes trac #4865 a8003b2 Regenerated cbits/WCsubst.c based on Unicode 6.0.0 f8dc7e4 Add Data.String to the nhc98 build 3771f1c Fix incorrect #ifdef for nhc98 9d379ca Do not export GHC.Generics from GHC.Base 9a6c22b Merge GHC.Bool into GHC.Types ab7f235 Update GHC.Generics to new generic programming library 2040842 Roll back generics changes in the HEAD repos c4ae3b4 Remove most of GHC.PArr - First step of migrating this code into the dph package d06adaf Expand and clarify MVar documentation. bdbbfc7 Grammar fix 93038d5 Add some more explanation to the skip channel example in the MVar docs 92b5624 improve discussion of the laws (doc comments only) 92028dc Make the Timeout exception a newtype instead of a datatype 85a39f5 follow changes to threadStatus#, and update stat values 06c59e5 add threadCapability :: ThreadId -> IO (Int,Bool) 9aaeb94 FIX #2271 Faster rounding functions for Double and float with Int or Integer results. Fixes #2271. Since some glibc's have buggy rintf or rint functions and the behaviour of these functions depends on the setting of the rounding mode, we provide our own implementations which always round ties to even. 30f9427 Follow GHC.Bool/GHC.Types merge a350b02 Follow GHC.Bool/GHC.Types merge 816f7e6 Follow GHC.Bool/GHC.Types merge f63a3ea Use showMultiLineString from GHC.Show 056d48a Add a rewrite rule for toInt# so literals work right 14476b7 Follow GHC.Types changes 2ed6c18 Add LANGUAGE BangPatterns to modules that use bang patterns 8a0e139 Remove unused functions combine, rename, genpat, simpleMatch 8f16f80 Remove unnecessary toRational 8eed780 Remove the "alpha" helper function; trac #4423 64b90e7 Fix unknown symbol base_ControlziExceptionziBase_patError_info by helping GHC generate smarter core. 37912e6 Put FlexibleInstances in PprLib alone 008d230 Use type families ee74f61 Fix warning 04f4b12 Never use epoll_create1; fixes trac #5005 There is little benefit to using epoll_create1 (especially if we still have the epoll_create code too), and it cuases problems if people build a GHC binary on one machine and try to use it on another. 9ff857c Rename System.Event to GHC.Event It's just an internal GHC library, for now at least a1025fa Work around a limitation in the hsc2hs cross-compilation mode 2811d81 Fix documentation for mkWeakIORef: argument is finalizer, not key or value b2e0b65 Add allowInterrupt :: IO () (#4810) 8acfc99 Use functional dependencies 5509e8a Use functional dependencies. 381ce0f Add extensions to LANGUAGE pragmas f496f8b Add extensions to LANGUAGE pragma bbf06bf Change type of TH.classInstances (and qClassInstances) c7a4168 Tidy up gmp cleaning 614c26b Correct the gmp build phase be8301a Update for changes in GHC's build system 56d4508 We should not use XGenerics in ghc-prim, for now at least. 35c86cc Call the final build system phase "final" rather than "" 3b1ec6e Add unboxed tuple support to Template Haskell 150a157 Roll back generics changes in the HEAD repos bb01c72 Add GHC.IO.Handle.FD.openFileBlocking (#4248) like openFile, but opens the file without O_NONBLOCK 54c33b2 add forkIOWithUnmask, forkOnIOWithUnmask; deprecate forkIOUnmasked ba301c4 fix Haddock error 53a93d1 Deprecate Control.Exception.blocked in favour of getMaskingState aec9d3e Export the affinity API from Control.Concurrent: forkOn and friends. 31cb13b No need to include the OpenGL / OpenAL headers in aclocal.m4 5534946 Rewrite FPTOOLS_CHECK_HTYPE to be cross-compilation-friendly Inspired by a patch from Mark Lentczner 9463922 Generalize the type of Foreign.Marshal.Utils.maybeNew; fixes trac #5044 a018a9c Tweak alloca docs 0b6ff78 Less strict inits and tails 763b7be Add .gitignore b9bab42 Merge branch 'master' of ssh://darcs.haskell.org/srv/darcs/packages/base fee7e18 Change debug prints in readTextDevice' to refer to right function 84145c3 Fix handling of suffixes for GNU iconv fe98324 Change some uses of CString functions to CAString instead 7089444 Document invariants on mkText{Decoder,Encoder} 6ec3bbc Bump Cabal version we implement, and add source repository to .cabal file 88020c7 Update source-repository in the .cabal file to point to the git repo 4ded72a Update source-repository in the .cabal file to point to the git repo 4970a5c Update source-repository in the .cabal file to point to the git repo 43d12dc Use _NSGetEnviron on OS X: fixes #2458 c7d6b4c Use FP_COMPUTE_INT rather than AC_COMPUTE_INT 03de58e Swap FP_COMMUTE_INT argument order to match AC_COMPUTE_INT ed8f672 Removed Show instance for IOCallback and FdData The IOCallback instance conflicts with the more general instance Show (a -> b) defined in Text.Show.Functions e276da0 Update source repo location to be the git repo in .cabal file b49dea0 Initial commit for Pedro's new generic-default mechanism 5b11dc6 Second initial commit for Pedro's generic-default mechanism 3bf05a2 Initial commit for Pedro's generic-default mechanism 3796c18 Improve docs for GHC.IO.FD.openFile 976a913 Tweak build rules b1a391b Update comment on fmapDefault to note that it only works for Traversable instances with a given definition of traversable, and NOT for instances with only sequenceA given. 48dd2aa Part of #5122 "Faster conversion between Rational and Double/Float" fix 17f1654 Part of #5122 "Faster conversion between Rational and Double/Float" fix 3812286 Part of #5122 "Faster conversion between Rational and Double/Float" fix bea20c0 Fix build on 64bit machines 6203474 Make and use AR_STAGE[0123] makefile vars 091e108 Follow CC var changes in makefiles 1874189 For GHC, implement the Typeable.hs macros using standalone deriving 6984014 Remove an unnecessary -fno-warn-unused-binds flag 366bda5 Remove a redundant -fno-warn-unused-binds flag 471bcc5 Merge branch 'master' of http://darcs.haskell.org/packages/base into ghc-generics 5286a2e Remove old generics stuff. 16482a4 Whitespace only. 4c990cc Add instances for basic types of the new generic deriving mechanism. 2f8e099 Update comments. 00d0bc2 monad comprehensions: Group and Zip monad 08db4da Performance improvement for division: got rid of an unnecessary branching in cases where the second argument is a constant and is not -1. f506257 Add GHC.Event.getSystemEventManager :: IO (Maybe EventManager) 32038d8 Add a note about the definition of quot etc e40066a Comment the generics stuff instances in GHC.Int, for now. c0f3860 Merge branch 'master' of http://darcs.haskell.org/packages/base into ghc-generics 89e8676 Add new module GHC.CString with functions relating to CString (moved from GHC.Base). Updated the base type modules so that the Generics flag is on (the CString functions are required because the generic representation uses strings). d4c8911 Moved the CString functions to GHC.CString in ghc-prim (needed for the new generic deriving mechanism). 6ec0c9f Move Eq and Ord for Int from GHC.Base to GHC.Classes, so they are not longer orphan. fc3f3c9 Add Representable0 instances where needed. 884f2be Add Representable0 instances to Either and Maybe. 6bebb34 Merge branch 'monad-comp' f84e3b6 Merge branch 'master' of http://darcs.haskell.org/packages/base into ghc-generics c37911f Adapt to the renaming of `Representable0` to `Generic`. 53ccafe Adapt to the renaming of `Representable0` to `Generic`. cdbce12 disable incorrect RULEs for Floats (#5178) 741a5e3 Merge branch 'master' of http://darcs.haskell.org/packages/base into ghc-generics dc58b73 Big patch to improve Unicode support in GHC. Validated on OS X and Windows, this patch series fixes #5061, #1414, #3309, #3308, #3307, #4006 and #4855. 8ea485f Merge branch 'master' of http://darcs.haskell.org/packages/base into ghc-generics d3ebf52 Use Unicode private-use characters for roundtripping 036830b Change to the 0xEF80..0xEFFF private-use range for //ROUNDTRIP d48f6ea Merge remote branch 'origin/master' into ghc-generics d2c2c2a Merge branch 'master' of http://darcs.haskell.org/packages/base into ghc-generics 4a66940 Add tests from testsuite/tests/h98 a21710b Move tests from testsuite/tests/libraries 1559fb3 Add System.IO.char8, the encoding used by openBinaryFile, and correct the documentation for hSetBinaryMode which claimed that it was using the latin1 encoding when in fact it was using an unchecked modulo-256 version of it. 02beed4 docs: note strict sequential ordering of MVar operations e09bf1f document the memory model of IORef ada4548 document the behaviour of throwTo to the current thread (#4888) 81443da add final newline ea28013 Remove datatype contexts from base d321fba Merge branch 'ghc-generics' of http://darcs.haskell.org/packages/base into ghc-generics a167d69 Merge remote branch 'origin/master' into ghc-generics 240897e Add a missing "deriving Generic" 39b51b1 Detab GHC/Tuple.hs a642f15 Don't derive Generic for tuples for now c1e88d8 FIX #5227: derive Generic only up to 7-tuples, like Data. 2c240a8 Make 'forever' inlinable (fixes Trac #5205) b8e0de6 Add Haskell types for C types useconds_t and suseconds_t, which are respectively CUSeconds and CSUSeconds. a1a373a Whitespace only. This patch is part 2 of 4 for trac #4247 and #4970. e2850de Use CSUSeconds in getCPUTime and getCurrentTime. Fixes #4247. 7c85f70 Remove wint_t configure test 687c4e7 In configure, remove default Haskell equivalent of C types b565506 Refactor the FPTOOLS_CHECK_HTYPE macro 119deaa In configure, set $WINDOWS to YES or NO 47aa065 configure: fail if suseconds_t doesn't exist, except on Windows fe14485 Adjust behaviour of gcd 3fb44a5 Fix suseconds configure test on Windows fd5c862 New gcd documentation 1916561 Only the type definition of '[::]' (which is wired in) remains in 'GHC.PArr'. a61aedc SafeHaskell: Added SafeHaskell to base 1dbde5d Changes for TypeNats. fd5e2bb Support for TypeNats 6d1d9bd Merge branch 'master' into type-nats 88d77e0 Fix build on Windows 8d2d301 Fix Haddock. 4d2ac2d Fix quoteRem, rem, divMod and mod definitions c4bcd9a Add a test for quot/rem/div/mod overflow aa46613 Fix a comment about splitAt (fixes #1182). 196785e use seq# as the implementation of evaluate (see #5129) c04a6fb Fix some haddock markup 066670a Make the calls to 'error' more informative (Trac #5274) 5586f1b Bump version number ec1c486 Bump version number a36435e Fix a copy-and-paste-o 956b98d Bump version number 3c0d916 Foreign.Marshal now reexports Foreign.Marshal.Safe b89a2f8 Remove some legacy comments 3f1606f Fix a typo e11e9ff Correct a comment e0b63e0 Typeable overhaul (see #5275) 014775f fix warning 3ffbf9a fix warnings (including moving things around to avoid orphan instances) ac28a24 In the deprecation warning for mkTyCon, suggest deriving Typeable. 9698887 Follow removal of 'threadsafe' FFI imports 73103ca Move the munzip function in the Zip type class; fb3ff79 small tweaks to docs 51ea3e6 export unsafeDupablePerformIO 1042a2c Implement unsafeLocalState by unsafeDupablePerformIO, not unsafePerformIO. The latter is more efficient, and will work correctly for clients that are using unsafeLocalState for its documented uses. b855357 give instances of Ord for TyCon and TypeRep e08fb3a DEPRECATE typeRepKey c99e34d Add TH support for UNPACK pragmas (Trac #5290) 052a964 Merge branch 'master' of http://darcs.haskell.org/packages/template-haskell 79a8e5b Make Typeable safe now that handcrafted instances aren't allowed. a498671 Move GHC.Classes here from base e939cea GHC.Classes has moved to ghc-prim 546d609 Use LANGUAGE pragmas rather than OPTIONS_GHC 3c793f7 Integer Eq and Ord instances are now in the integer package 1f9e4a3 Eq and Ord instances are now in the integer package, not base 246d0f7 Fix build following modules moving around d4d3094 Follow library changes 78aba9a Sync the typeable fingerprinting with GHC 7359f81 Tweak the typeable fingerprinting 0a69e14 Follow toInt# -> integerToInt renaming ddada32 Rename toInt# -> integerToInt for consistency 69985f0 Rename toInt# -> integerToInt for consistency 13ebd1e Simplify int2Word# . integerToInt -> integerToWord 6e57e93 Don't inline most integer operations ccbb32d Add a missing implicit build dependency 9dc19cd Add support for unresolved infix expressions and patterns. e72f6d4 Remove mention of setUncaughtExceptionHandler from forkIO. f6fe25d Add newline to the end of Control/Monad/Zip.hs 8eecfc2 Upgrade gmp, 4.2.4 -> 5.0.2 84bcbde Trailing whitespace 62f5c97 Remove import of GHC.Show from IOBase.hs 9ad111e Remove now-unnecessary import of GHC.Show fc1f061 Merge branch 'master' of /home/dafis/GHC/./ghc//libraries/base 7c662d6 Data.Bits: specialise shift[LR] for instance Bits e72a0a3 Remove unnecessary import (Windows only) 95d90ba Make Q an instance of Applicative d1050b0 Merge branch 'master' of /home/dafis/GHC/./ghc//libraries/base 7d9e4f7 Remove -Werror from the cabal file 7787668 No need to export Integer from GHC.Integer.GMP.Internals 6f9d180 Eliminate orphan instances a6b1f7f Eliminate orphan instances 9695595 New GHC.Stats module for accessing GC statistics. 95f3b1a Warning police 1fe8239 Merge branch 'master' of /home/dafis/GHC/./ghc//libraries/base 8f43c3c Merge branch 'master' of /home/dafis/GHC/./ghc//libraries/base b2cec86 Fix the behaviour of scaleFloat; part of #3898 15bc61c Remove some antiquated C constructs a097edc Merge branch 'master' of /home/dafis/GHC/./ghc//libraries/base 232ad99 This should finally fix #5293 by fixing two bugs in GMP's configuration setup c99b8ec Make pattern matches more obviously complete dfd374c Trailing whitespace 78d3296 Unbox all GCStats fields, also add cpu_seconds and wall_seconds. 166e72f Merge branch 'master' of /home/dafis/GHC/./ghc//libraries/base 2ea4044 Expand documentation for RealFloat. Part of #3898. db2ac3a Delete stray comma in doc for encodeFloat 0ba0dbc Add a note about why/how we avoid patError 0826e99 Use Safe Haskell when GHC >= 7.2 21adc1d Formatting fixes 91aceda Remove old darcs boring file 779f36d Remove old darcs boring file 98b804a Remove old darcs boring file eaa2fe4 Remove old darcs boring file a47a745 Add fallbacks for processor specific instructions (e.g. POPCNT). These fallbacks are referred to by code generated by GHC. f708b3d The unit tuple is defined in a different module to other tuples (oddly) d31c81f .gitignore 963bd4b Update import of Text.PrettyPrint 54ee4da Implement lookupTypeName/lookupValueName, and reification of type family instances b38f083 Drop bitrotted code for < 32-bit platforms 03e8758 Drop bitrotted code for < 32-bit platforms 65ba73b Fix documentation for withCWStringLen (#5396) 5eaf161 Export Integer(..) from GHC.Integer.GMP.Internals again; fixes #5419 4dfdbd1 Add Data.Bits.popCount 93d2061 Follow ghc-prim changes 88db1ec Merge GHC.Unit into GHC.Tuple, and GHC.Ordering into GHC.Types b0b6424 Follow ghc-prim changes 19493a0 Follow ghc-prim changes 9018422 Trailing Whitespace 2b50f31 Fix return type of hs_popcntX b0be190 FIX BUILD on 32-bits dcb2d63 Add a data type we can use to box up equality evidence for -XConstraintKind 0706002 Break the GHC.Generics / GHC.Types import loop. 6c9c37f Update imports b685745 Fix build on Windows 97bf1c5 Don't export gcdInteger, lcmInteger from GHC.Integer cd4d0fb Add NOINLINE pragmas 77d0c63 NOINLINE a couple more functions c9b1dee Import GMP-only functions from a GMP modules 9935359 Export GMP-only functions from the Internals module 5480b00 Eliminate the orphaned Enum Integer instance 61cd1df Move some Enum helpers into GHC.Enum 19c467e Give Word a proper Show instance 680c1a9 Define mkInteger f9dad24 Define mkInteger ee727e8 Don't define our own list type d02622a Define mkInteger 5a195cc Merge branch 'master' into tmp c9b4d05 Use the Ratio constructor for toRational from Int/Integer 8266f5f Whitespace only in Text.Read.Lex 0eafdcd Be more efficient reading fractional literals 2d17a5c Fix #5436 by using 'recover' on handle EOF 9286e3b Don't try to detect iconv or libcharset if we are on Windows c0e43d4 Break the GHC.Generics / GHC.Types import loop. c8d544e Merge branch 'fix#5464' of /home/staff/magal101/repos/ghc/libraries/ghc-prim into fix#5464 8aedaae Untabify cbits/float.c 72de218 Eliminate intermediate overflow for encodeFloat, fixes #5524 7f72975 Removed pointless rule (realToFrac :: Int -> Int) 661f19f Whitespace only in GHC.Show 5d0d46b Fixed documentation bug 8473017 Fixed mistake in documentation and a typo in a comment cdca0c4 Change haddock for encodeFloat, fixes #5525 e885907 Fix fromRat' and fromRat'' 8005148 Explanatory comments 0101c91 Use Rational constructor if numerator or denominator is 1 34cd5f1 Eliminate unnecessary shift and reorder branches in fromRat'' 41841f6 Align arrows 3db78d1 Whitespace only 6107984 Fix typo in error message 78885e5 Merge /home/dafis/GHC/bghc/libraries/base ec96cd6 Remove now unnecessary helper function 0d4c9cd Minor: replace undefined uses with error as mentioned in ticket #5532 6871fa9 Improve performance of the unpack loop 4d47404 Combine two calls to 'ord' (seems to be just slightly faster) 817c4e1 Remove the Show superclass of Num 0a40540 Remove the Eq superclass of Num 6557680 De-orphan the Show Integer instance 77edace 80-columnify d27da47 tweak unpack/unpack_nl to generate better Core (#5536) 43f5377 Merge branch 'master' of mac:ghc/git/val32/libraries/base e84f5b1 remove erroneous '::' in NOINLINE pragma 4791ff8 Fix build on Windows 4b46bbd fix cross-ref to "Catching all exceptions" section (#5546) 28cfbf3 update ref to deprecated function forkIOUnmasked -> forkIOWithUnmask (#5546) f878f1b update IO manager documentation (#5547) ffe2f8d If an assertion fails, through it rather than a deeper error; fixes #5561 f2ef82e Export constructors for Foreign.C.Types and System.Posix.Types newtypes ac3ddf2 Fix error in KQueue caused by changes to FFI import requirements cd6a715 Warn about ArrowLoop instance for Kleisli Arrows c9dceb6 Update base for new Safe Haskell design 378dd29 Update base for latest Safe Haskell. 4b1de9f GHC.Stats: Use camelCase in public APIs e2df98c add laws to class documentation d8633ce Add pure traceEvent and re-export from Debug.Trace 201a47c Update Debug.Trace haddock docs and rename putTraceMsg to traceIO 2043afc Avoid using iconv for the locale TextEncoding if we can help it de77751 Be more forgiving about encoding name capitalization/hyphenization f2067ca Fix build on Windows c7c9db4 use MVar to define fixIO, for thread-safety (see #5421) ab0d93c addDependentFile #4900 eeae7d3 add unsafeFixIO (#5421) c7e5902 export flushAllHandles (#5594) f1c593e Add unsafeShift to Data.Bits 2766f50 export tyConName, tyConModule and tyConPackage; deprecate tyConString 9ac6337 fix typo 1422568 Make dataToQa work regardless of the set of in-scope names (fixes #4491). 53be8c8 Add GHC.PArr.PArr to break a cycle in compiling Data.Array.Parallel 59ecd68 Add "dropWhileEnd", as discussed on the libraries list b550077 Make the fileSystemEncoding/localeEncoding/foreignEncoding mutable 8019a64 Go back to using private-use characters in roundtripping bf9d5a3 Follow GHC build system change to the way we call rm 31159cb Move CPUTime001 here from testsuite/tests/lib/CPUTime 2b0adbd Remove some comments about interfaces being checked against H98 7e26078 Move lib/Char tests from testsuite to base 90e8b87 Move testsuite/tests/lib/Data.Fixed test to base/tests 7593ffd Move testsuite/tests/lib/Show to base/tests 1a9b04d Move testsuite/tests/lib/Numeric to base/tests d1fa09f Whitespace only in tests 0f386a8 Move hash001 to base/tests 56d233a Whitespace only in hash001 test 1627bf0 Move lexNum to base/tests 1303b93 Whitespce only in lexNum d7d45de Move Data.List tests to base/tests 180933b Whitespace only in tests b855aef Move ix001 to base/tests baf68bf Move lib/System tests to base/tests a4a686d Whitespace and modernise some tests 5a0b1a4 Move ioref001 to base/tests d45fd80 Update system001 output 8395104 Fix compilation error on windows. 7361c6c Rules for powers with small exponents (fixes #5237) 513cc84 Eta contract 'PArr' synonym 6962aa8 Add a C wrapper for gettimeofday ab5fa6c Remove some unused functions from include/HsBase.h 7b421c6 Simplify some CPP ff20d57 Make a wrapper for getrusage; part of #5480 73c4ff5 Convert come FFI bindings to use the capi calling convention ddc0d28 update to track changes to CCCS in the RTS 135680b Add a way to get hold of the current call stack 6bf8991 Use capi some more (part of #5480) 227e13c Use capi to define the fcntl FFI imports ab256d4 Use utf8 when decoding cost centre strings 02066df Expand the stack-tracing API 463b609 Add traceStack :: String -> a -> a 8c981c2 Change the layout of stack traces 4ec5661 Track changes to the way we reference CCCS in GHC (was: W_[CCCS], now: CCCS) 631796d Add source locations to call stack entries. fda7675 Use the mingw touch program on Windows e4c9384 Roll back the sigset capi changes 52abc41 doc update: mention -fprof-auto-calls 20007f5 renderStack: reverse the stack trace (most recent frame first) 637d791 add setNumCapabilities :: Int -> IO () 5789042 Add getNumProcessors :: IO Int 7855f10 Fix typo 95f330f Remove GHC.Exts.traceEventIO 77da470 Document that -T RTS flag is necessary. 66f4b10 Merge branch 'master' of http://darcs.haskell.org/packages/base 5fb9dee update documentation for getNumCapabilities and setNumCapabilities c0e32a3 Re-export Constraint from GHC.Exts d5ead92 Export "readEither" and add "readMaybe". 914da19 Merge branch 'master' into type-nats 9697def Remove all but the basics from the GHC module. 3b281a2 Change the representation of singletons from Integer to Word. da8f3c4 Export setNumCapabilities 800f575 Removing the MonadGroup class. This is to reflect the removal of the default grouping clause from the SQL-like comprehension notation ; 4b60b56 Add <> as an alias for mappend 5572345 Merge remote-tracking branch 'origin/master' into type-nats 3af923c Moved the instances from Control.Monad.Instances to GHC.Base and Data.Either 139d27a Remove Num superclass of Bits Add and export bitDefault, testBitDefault and popCountDefault from Data.Bits. a9e976c Use sharing in the Alternative instance of Maybe db94d0f Expand num009 to test more values, and add mingw32 output a63257f Added missing Functor, Applicative, Alternative and MonadPlus instances Added Applicative and Alternative instances for ReadP and ReadPrec Added Functor, Applicative, Alternative and MonadPlust instances for ArrowMonadx e3467bd Foldable typeclass: make foldl' and foldr' class methods; fixes trac #5538 03246bf Merge remote-tracking branch 'origin/master' into type-nats f948f83 Change extension name to match current GHC head. e184fcc Rename GHC.TypeNats to GHC.TypeList, cleanup, add type-level strings. 299f286 Add some rules; fixes #5767 acdd956 num009 now only fails on OS X i386, not OS X amd64 b2100a2 Export addDependentFile from Language.Haskell.TH.Syntax; part of #4900 ca85ca0 Updated to a newer version of gmp; fixes #5810 5c56453 Move Text.Printf tests from testsuite; part of #1161 86141a3 Fix the data constructors for tuples etc that dataToExpQ builds ad42fd9 Bump base's version to match 7.4.1's 30c0c02 Merge remote-tracking branch 'origin/master' into type-nats 5a16507 System.Environment: improve 'getEnv' doc to mention closest 'setEnv' we have ('System.Posix.putEnv') 11f108b Fix bug in popCountDefault. Fixes #5872 529a4cc Use the new quotRemInt# primop 04a8206 Fix documentation of minimal complete definition of Bits instances 4532045 Define a divModInt function that only does 1 division d7f6d0c Merge branch 'master' of http://darcs.haskell.org/packages/base 7b93b2c Add CTYPE pragmas cea77c1 Add CTYPE pragmas for GHC types 291633f Use throwIO rather than throw where possible This makes exceptions more predictable. f38789e Eta expand unsafeCoerce and add a pointer to the Note 9d60296 Merge branch 'master' of http://darcs.haskell.org/packages/base e757f8e Use the new unsigned quotRem primop 11c4880 Fix build on 32bit platforms a359804 Remove Control.OldException f016aa1 Minor Haddock documentation fix 142bfae Redo the sigset capi changes 3da3890 Convert some more declarations to use the CAPI 38799c7 Change CSigset into a (empty) datatype d5fa875 Fix an FFI decl: it should have been using capi but was using ccall e0db134 Remove an unsed definition in HsBase.h 702891c Convert some FFI bindings to use "value" imports 9ba5344 Remove some unused code 7ca5621 Remove another unused definition e416596 Use CAPI for lseek 31521d1 Move nocldstop from HsBase.h to HsUnix.h b677224 Remove some __HADDOCK__ CPP 62a506d Move chr's definition into a new GHC.Char f40aa90 Remove some redundant imports ba5bea9 Refactor number lexing; part of #5688 1752a9b Rename lexNum test to lex001, and expand it fbfa8f4 Add a test for reading Doubles 198c93e Change how NaN and Infinity are read by lex 81b6141 Add a readInteger001 test ba85754 Make "100e12" not parse as an Integer; part of #5688 63fedc7 Update .gitignore. f252b20 Update .gitignore. 6d0454a Update .gitignore. 7e84795 Copy tests from GHC testsuite; part of #1161. 533bcf0 Avoid making huge Rational's when reading Double/Float; fixes #5688 5c1c24f Sealed writeChan with mask_ to prevent a theoretical bug 588c08d Merge branch 'master' into type-nats ae75915 Add strict versions of modifyIORef and atomicModifyIORef 6f72869 Add fixity declarations to Template Haskell (Trac #1541) e1f950f Update gitignore 2638e80 Merge branch 'master' into type-nats b058d97 Updates to type-literal support. 064dc4a Win64 fix 3fb8c43 Fix building libgmp on cygwin 50005fa Merge remote-tracking branch 'origin/master' into type-nats eec29e9 Merge remote-tracking branch 'origin/master' into type-nats bd77f37 Fix typo in Data.List.(\\) documentation a732476 Add some useful functions for working with type literals. a218b90 Merge remote-tracking branch 'origin/master' into type-nats 3b8f092 Fix the type of IsEven cf67512 Revert IsEven to the way it was. bbcf397 change unsafeDupableInterleaveIO from INLINE to NOINLINE (#5943) 670eaf2 add test for #5943 86330a3 Merge remote-tracking branch 'origin/master' into type-nats 077ba3c Ensure hGetBufSome does not cause potentially blocking reads (#5843) ce96c14 Fix compilation under LLVM backend. (#5965) c899071 Fix an egregious bug in the fingerprint calculation for TypeRep b1d51d3 Test Trac #5962 ef9e348 Rename parAvgBytesCopied to parTotBytesCopied 0f1f0d9 Rewrite to use just one notion of singletons. c07266e Whitespace only: convert mixed tabs and spaces to spaces. 75efe3c Add System.Environment.lookupEnv (#5930) 3019319 Add testcase for #5930. f0e9b2b bugfix: use forkIOWithUnmask rather than forkIO 0b2923a add "Portions obtained from hbc (c) Lennart Augusstson" (#5963) 52d43ff move mkWeakThreadId to GHC.Conc.Sync; export it from Control.Concurrent 3b047ba doc tweaks b297a1f Add GHCi monad 6ea5981 Revert "Add GHCi monad" 386d3e2 Use monotonic time in Event/Manager.hs. 666bba8 Define monotonic time function for Darwin. 1fd0c2e Replace getUSecOfDay with monotonic timer (#5865) 22307c1 Add timer initialization for darwin. 5779768 Remove hardcoded mangling of the n_capability symbol (#5864) 91af2e9 Add GHCi monad. Experimental for now. 9949004 DEPRECATE Foreign.Marshal.Error.void (use Control.Monad.void instead) e119fe8 Don't include sys/timeb.h on FreeBSD. d5a3d79 use mkWeakNoFinalizer# (#5879) 7719344 Fix openFile003 for Win64 9c11265 Add a type-family for comparing numbers. 48c1949 Remove old test outputs a436735 Fix some more tests on Win64 56b05f1 system001 test is expected to fail on Win64 89e9295 Tidy up the ThreadDelay001 test code 4100b75 Fix an off-by-one error in freeProgArgv 8dda2df Use IORef/atomicModifyIORef instead of STM c031aec Use RTS version of getMonotonicNSec on Windows (#6061) 9cb3d36 Use in-process file locking on Windows (#4363) 4631489 Fix build. a75c1be Modify 'SingRep' to support arbitrary singleton types. e88cf25 Update to support singleton types with custom implementations. 5176c1f Don't use stdcall on Win64: It isn't supported; ccall is used instead 27e4036 Add INLINABLE pragmas in Template Haskell 58898eb Change TH syntax to allow promoted kinds and kind polymorphism cf14ed6 Change a few FFI imports to use CAPI 6fcc554 Remove some unnecessary Int specialised values c2f6f89 Remove some commented out code 5fdb0b5 Remove some more specialise-Int code c06e2a4 Use Word literals directly, rather than converting Int literals fda6ab9 Move the Word type from base to ghc-prim 312bd1c Move the Word type from base to ghc-prim a48be46 Abstract out a Ppr Inline instance 0eacc7f Use expect_broken rather than expect_fail in testsuite driver 93ac54f Fix typo in documentation of GHC.Exts.groupWith 5a3489f Update documentation of intersectBy 70d4e93 add mkWeakMVar; deprecate addMVarFinalizer (#6130) 797a829 Re-export Fingerprint in Data.Typeable.Internal. 3bcff29 Make Sing kind-polymorphic 4546adb Refactor findTempName: factor out file creation. 53184fb Allow openTempFile to retry when it hits a directory (#4968). 11b4bad add forkFinally e9f1000 Fix warning. bde4a84 add tests for deadlocks in readChan & writeChan 35d42ee add modifyMVarMasked, modifyMVarMasked_ 3425c77 fix another theoretical deadlock bug in the Chan implementation (c.f. #6153) 33416a2 omit the profasm way cbad295 Add GHC.IP for the new implicit-parameter story 1befc19 Fix typo; spotted by Gabor Greif 4276992 StringPrimL now takes [Word8] c41ac8f Add GHC.Stats.getGCStatsEnabled function (#5846) 14c4cd0 Re-export forallC in Language.Haskell.TH (#7009) b32d4e0 Export ForeignPtrContents in GHC.ForeignPtr (#7012) b08c092 Remove Prelude.catch and System.IO.Error.{catch,try} f1d3c29 Move divInt#/modInt# to ghc-prim e6594eb Move divInt#/modInt# from base 1bb3a57 Use divInt#/modInt# from ghc-prim c15b549 Use divInteger and modInteger fb66613 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base f83d3df Add divInteger and modInteger functions 36a2a5c Fix typos c4b81e3 Bump base's version b8d7b8f Update tests following changes in base f8b272a Use CLong, not CInt, for mp_bitcnt_t value; fixes #5965 827dab9 Use round-to-even when formatting floats (#5963) 3bac25f Move GHC.Generics to base d0a3eef Move GHC.Generics to base f0234bb Deprecate Control.Concurrent.{QSem,QSemNSampleVar} 9785fb9 Split a pragma into for better warnings 0a76803 Add System.Environment.getExecutablePath (#7029) f190e2d Add missing imports. 54c62c0 Deprecate the Data.HashTable module ec77f50 Fix parsing of RealFloat with huge exponents (#7034). c8a8b06 add some UNPACKs to improve performance a bit 9e3fb41 Add RatioZeroDenominator to ArithException, and use it instead of error 8e08f83 Add Functor instance for Handler (#7047) fc3edb4 Adapt to removal of catch from Prelude 658e926 Add strict version of modifySTRef 5e72463 Bump version to 0.3.0.0 72ec1df Bump version to 0.1.0.1 b9c580c export the constructors of ForeignPtrContents too 657153a Add alignment-restricted ForeignPtr allocation actions c888396 fix warnings e5629b9 Tweak RULEs; fixes #7041 e6bc6b7 Add another gcdInteger rule 47f0fd5 Remove a workaround for building with old GHCs 219c653 Added lambda-case support. 73c36bc Added multi-way if-expressions support. d27c454 Add documentation for Template Haskell functions 18d48b4 Remove Language.Haskell.TH.Syntax.Internals dccb90a Add reportError and reportWarning to TH 2ccf50a Reorganise the Language.Haskell.TH export list, so that it Haddocks better 1116d7b Add comment to GHC.Exts. 2c3a43d Move Down to Data.Ord (#7077) 4b0ccf8 Move some rules into PrelRules 52f7fa8 Simplify how gcd @ Int is implemented 69bacb8 Simplify how gcd @ Int is implemented 48987c1 Bump version to 0.5.0.0 fbf73d9 Bump version to 2.8.0.0 3bf0816 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 94c6921 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/integer-gmp 9557f5f Remove some deprecated modules and functions 5428d11 Remove hash001, as we no longer have Data.HashTable 13631d0 Remove tests for removed modules 9f0eca5 track integer-gmp and add 'divInteger', 'modInteger' ff06b84 Make numeric rules builtin. ac50935 Port more primop rules to PrelRules. de7d4e9 Fix inline rule shadowing warnings d19e3e0 Merge inline rule warning fixes 855ef73 Document that a FinalizerPtr is a pointer to a ccall function (#5254) 290310c Whitespace only: Line some things up better 54fccb5 Use testBitInteger; part of #3489. patch from pumpkingod at gmail.com 55df44b Define testBitInteger; part of #3489 fb83206 Define testBitInteger; part of #3489. Patch from pumpkingod at gmail.com 0ebac5b Fix building on Windows 3b3eb7d Refer and link to Haskell 2010 report in Prelude. 86ba770 Make startProfTimer and stopProfTimer available via GHC.Profiling 8dbc583 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 5682cac Fix build 7e01e07 Comments ony 9bd314e Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 935a043 Pragmas refactoring. Also adds RULES and 'SPECIALIZE instance' support. 120bd32 Fix Trac #7146, by displaying a "\n" in a multi-line string 2df687f Merge branch 'master' of http://darcs.haskell.org/packages/base b3ef645 Improve definition of forever (#5205) 889ff4a add errorWithStackTrace daa75ea Remove finalizers from a ForeignPtr atomically (#7170) 833ba65 add pointers to Data.STRef and Data.Array.ST (#7182) 0b14849 add eqStableName :: StableName a -> StableName b -> Bool 0d280e0 fix typo ea9570d Add missing instances for (<=) 20130c0 Fix a typo; spotted by Mikolaj Konarski 86f4eb5 Fix build; GHC.Constants is now empty 7f7c9ed In the Template Haskell pretty printer, don't call error e6b690d Remove deprecated functions from Data.Data c89b5a1 Remove GHC.IOBase 520b2dd Remove GHC.Handle 4f03d11 Follow module removal in hDuplicateTo001 test 39b9f94 Add a big warning to the documentation for Weak (#7250) 925782e Add bitSizeMaybe to Bits, and add FiniteBits class a9ecd61 Deprecate bitSize 02998bd Add unary natural numbers to experiment on matching with literals. e801dcc Merge remote-tracking branch 'origin/master' 0978d64 FIX #7263: derive Eq, Show, and Read for GHC.Generics representation types 4aa8bc1 Adapt to NetBSD's struct kevent e2fec97 FFI wrapper for kevent() cdf4d62 Adapt to new Cmm syntax 6097a94 Add Debug.Trace.traceMarker/traceMarkerIO 2ea50a1 Use CAPI to make the C wrapper for kevent d0b9ed0 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 1851a2f Update library to avoid using `Any` (also, replace fun-dep with type fam.) 0422ada Add CApiFFI to the extensions used by GHC.Event.KQueue 021a0f9 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base e9ab31d Remove out-of-date docs about Prelude.catch; fixes #7348 cbfc632 move fromRational into rationalToFloat/Double 636894f fix type mismatch in result of integer_cmm_testBitIntegerzh 1e1c03f remove deprecated pragmas (eliminating warnings) 3c083fa ErrorCall should be a newtype, and derive Eq/Ord 6f847e9 Fix #7233: avoid overflow in divInt64# a66b6ff Make sure testBit and bit get inlined; fixes #7292 6f32757 Handle UTF8 correctly in GHC.Conc.labelThread; fixes #6010 57f6591 alpha-rename the type signatures of foldl, foldl', and scanl to be consistent with foldr and scanr fda3002 Remove commented types in module export lists 123ba5e More type signature improvements from Bas van Dijk 9e9c6eb Remove GHC.Read.readp 0ec659d add Traversable laws f5dee98 Replace Rank2Types with RankNTypes 7fa0073 Merge branch 'master' of http://darcs.haskell.org//packages/base 9a1890d Fix Haddock formatting in Control.Exception 29f4ac8 Use nicer type variables in foldlM's type sig 14bad9a Declare a family for subtraction. 56c8e93 Merge documentation from inline's old primop entry 10a586e Move lazy from GHC.Base to GHC.Magic ce67249 Move lazy from GHC.Base to GHC.Magic e83b6cd Improve the Prelude doc header; part of #7108 fff4dbd Fix a typo 6db976d Change a commonet not to refer to the Haskell 2010 report in particular 0edcea0 Improve a comment 7dd230f Update some H98 references to refer to H2010 7be5177 Remove an out-of-date comment 1e41f1b Update a H98 reference to H2010 a651570 GHC.Windows: more error support (guards, system error strings) 5879d5c Add module header with some external links 5ea5b52 typo 87e61d8 Add a test for #6026 (fixity info for primops) df67010 Update haddock now that we can derive Generic1 (FIX #7444) 5142bc2 Add dataCast* definitions to Ptr/Array Data instances; fixes #7256 00ea200 typo a532c91 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 1cce322 Add comment to .cabal file saying what GHC 7.6.1 shipped with 415a26a Add comment to .cabal file saying what GHC 7.6.1 shipped with 5e20e4e Add comment to .cabal file saying what GHC 7.6.1 shipped with f389e29 Add comment to .cabal file saying what GHC 7.6.1 shipped with 7498923 Add comment to .cabal file saying what GHC 7.6.1 shipped with cfa1da9 Bump version number following new policy 1998210 Bump version number following new policy b14ec9c Bump version number following new policy a81e2cf Bump version number following new policy 67bb9e6 Bump version number following new policy ca327c2 Bump base lower version to 4.5 (the version GHC 7.4.1 came with) 954ef66 Add newFilePath to System.Posix.Internals 4ab3d16 Added threadWait functions to wait on FD readiness with STM actions. c0032c0 Added the unregistration command to the return value of threadWait*STM functions. 32c3f2e Fix warnings 4bd0fa9 fix #7479: ArrowChoice unit law in doc comment 84a989b Remove trailing whitespace in GHC.Base 43a383f Worker/Wrapper and static argument transform for `until` so it can be inlined c10a1b8 Add word2float 756a970 Make a class for asynchronous exceptions in the exception hierarchy 2f32d1d Add back new working QSem and QSemN implementations (#7417) c8db4bb getNumCapabilities should read enabled_capabilities (#7491) 22e5fc3 qsem001 and qsemn001 fail in HEAD: #7497 65d4f18 GHC.Event.IntMap.highestBitMap reimplementation ec335ed fix qsem001 & qsemn001 5f6551b unbreak qsem001/qsemn001 703b5cf highestBitMask: use shiftRL instead of shiftR a18cf9c Add fromIntegral/Word->Double and fromIntegral/Word-Float rules d369ae5 zap obsolete FIXME, fix typos 7a6ddb8 remove unnecessary STM import e1779a7 Define GHC.Read.expectP and Text.Read.Lex.expect 73730c5 Implement overlapping type family instances. 875beaf Add functions that compare singletons for equality (with evidence) 5d60827 Merge branch 'master' of http://darcs.haskell.org/packages/base f251bf5 Make sum and product INLINABLE d7b5f52 GHC.IO.Buffer: use memmove instead of memcpy in slideContents 0862dcc BufferedIO: fix bug in writeBufNonBlocking introduced by commit 7d39e100 5e3aec6 Expose Data.Fixed.Fixed's constructor 0921387 Provide a way for OS X users to indicate a preference for the GMP framework d0a0ca7 Fix configure when we don't have a gmp library f6ee55a Clarify the wording of the 'insert' haddock; fixes #7421 5f19f95 Fix Data.Fixed.Fixed's Read instance; fixes #7483 e68158a Remove unused import ccb16c1 Comment out IsEven, isEven, and friends, because the type is ambiguous 104aeb7 Merge branch 'master' of http://darcs.haskell.org//packages/base b0d27b9 Expose new threadWaitSTM functions in Control.Concurrent (see #7216). f54bc5f Fix warnings 753e3e3 Fix ambiguity error on Windows 8564b7f Fix warnings on Windows 6c0743c Add Generic instances to GHC.Generics representation types 171f638 Possible fix for detecting Float/Double bd0faf7 Use the RTS getMonotonicTime to implement getMonotonicNSec; fixes #7299 946a2d1 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base c0d723e num010(ghci) is broken on OS X 32 (#7043) 94e6d7d Removes the assumption that CLK_TCK is a constant (#7519) 52f5545 integer-gmp: improve cross-compiling support GmpDerivedConstants.h edbc826 Rename tests to not start with a digit 71221e2 Grotesque hack on Unsafe.Coerce f9d7045 Merge branch 'master' of http://darcs.haskell.org//packages/base 38c54bd Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 2cd5138 typos 23517de Rename some numeric tests: nnnn -> Tnnnn 64a6151 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 8768356 typos 7a49a34 Merge branch 'master' of darcs.haskell.org:/srv/darcs//packages/base 916be61 Revert "integer-gmp: improve cross-compiling support GmpDerivedConstants.h" 2ae4bcb Fix an 'if windows' test to cover Win64 too 07e79f5 fix negative numbers for * modifiers (#7457) c0e390f tabs -> spaces 7291418 add test for #7457 1cc5c9c Use capi for mkfifo, tcsetattr and tcgetattr (for Android) c7751c4 some more typos 49cb749 Release the FD lock before calling close() (#7646) 8129652 Remove the reliance on relative accuracy of short delays (#7656) 33d92b5 typo 2915195 Remove a redundant pragma 389fdc8 Follow testsuite changes 53f56f1 Fix detection rule to classify types as non-floating-point 1b91e70 Never try to use the system gmp on Windows e98090e Fix GMP_PREFER_FRAMEWORK 3743eb5 Follow changes in the testsuite be78f48 Follow changes in testsuite 0419c95 T3307 and environment001 just fail on MSYS 2e86f4f Resolve issue #7482 by removing the ability to create a new event manager. 298f0db Remove functions to step the system io manager in preparation for parallel io manager changes. 9a703bd Minor refactoring in GHC.Event.Thread to prepare for supporting per-capability IO managers. e963524 Refactor by introducing a boolean argument to newControl to determine whether the files created for a Control instance are registered with the RTS IO manager hooks. 38548ef Separated the IO manager into a timer manager and a file IO manager. bd94982 Specialized the TimerManager by removing the file monitoring support. 08e4e15 Removed control registration flag from Manager and TimerManager new functions. 3b911f5 Removed timer related features from Manager. e5ad3fb Use one IO manager per cap. be776ba Lock stripe the callback table in the IO managers. 0f8d659 Added support to backends for non-blocking poll() call. 107e81c Modify per-capability IO manager poll loop to avoid blocking (and context switching the OS thread) when the poll loop is heavily loaded. 18edb87 Allow backends to provide a command that register interest for an event source for exactly one event, and implement epoll implementation of this command. d584d8a Apply the epoll backend design (separate polling from registration) for the KQueue backend. 3d1b61f Added support for modifyFdOnce for the KQueue backend. 77fd94d Minor refactoring to simplify unregisterFd_ in Manager. edb6543 Refactor to handle activity on control files as special case. 8db9ad8 Manager takes a flag that indicates whether it should de-register a file registration once it has received a callback. adb5618 Minor clarification in registerFd_. 8cf7592 Minor simplification of calculation of new and old events in registerFd_. 778795d Implemented optimized registration and callbacks for the case when oneShot flag is set in Manager and the backend is KQueue or EPoll. 3bc0661 Wakeup is a no-op for KQueue and EPoll-based IO managers. dd48974 Use poll backend for TimerManager. de01f22 Use eventfd_write to write to wakeup eventfd in Control. 341296f Remove unnecessary import. e09e561 Remove UNPACK statement to eliminate warning about unusable UNPACK. 0df14e3 Added ioManagerCapabilitiesChanged function that is called from RTS to notify the IO manager that the number of capabilities has changed. dd54a09 Introduce IORef to refer to array of IO managers. cbe5c98 Replace use of numCapabilities with getNumCapabilities. adebaa4 Minor refactoring: pass eventManagerArray to startIOManagerThread. 12f3fef Parallel IO manager supports increasing and decreasing number of capabilities. d55070b removing trailing white spaces. 17b10ca preventing warnings. 99f5738 Making KQueue compilable. 1de63c7 renaming EventQueue to KQueue. 0fdb3fb Renaming QueueFd to KQueueFd. bedbb20 renaming parameters. 65309d8 Making KQueue.poll similar to EPoll.poll. a691b2d minor refactoring. 63981cb refactoring with guard. 3c0dab5 Improve comment on GHC.Event.Manager.closeFd_. de9b01b Added missing wakeup in GHC.Event.Manager.closeFd_. cca34b9 Avoid use of backend modifyFdOnce in Poll backend in unregisterFd_. 1025c8f Change GHC.Event.Manager.closeFd to unregister interest in the file with the backend. f500a2f Update closeFd_ to avoid unnecessary backend modifications. 1956ce5 closeFdWith closes fd after unregistering the fd with the backend. 54b00a7 Tidy up GHC.Event.Thread.closeFdWith. 62c2749 closeFdWith invokes callbacks only after the fd is closed. 50e65e1 Undo recent change to the type of GHC.Event.Thread.getSystemEventManager and update the commentary on this function. e88c6ef Avoid conditional compilation in GHC.Event.Manager. cd924e9 Fix wrong type in FFI call to eventfd_write in GHC.Event.Control. 5b81a90 ioManagerCapabilitiesChanged takes no arguments and instead gets the current enabled number of capabilities by executing getNumCapabilities after it acquires a lock on the IO managers array. f0d1822 Use (.&.) instead of mod in GHC.Event.Manager since the modulus is a power of 2. cbe3c39 Add some commentary in GHC.Event.Manager to the explain the poll loop. f182e7d Added UNPACK to emLock in GHC.Event.Manager Manager datatype. 7af45da Added NOINLINE directive to the numEnabledEventManagers IORef in GHC.Event.Thread. c9ca90d Removed unnecessary import from GHC.Event.Thread. 2abd38c Eliminate use of kevent64() calls. d8b94b3 Workaround buggy kqueue on os x. 5186ffc Removing unnecessary trailing spaces. ebf3787 Adding a comment about the workaround of the parallel IO manager on Mac. aceb3e8 Fix bug that caused ghci to create a large number of kqueues and pipes on OS X. 4a80762 Merge the new parallel I/O manager 3d53407 Implement poly-kinded Typeable 586f5a2 Only run dynamic004 with optimisation fb639c6 Export Proxy from Data.Typeable c301c61 Add isNewtype to GHC.Generics (FIX #7631) 65cd1c0 Change rules for RealFrac methods to pointfree, so that they can also fire in pointfree use. 90c9c83 Make 'length' into a good consumer, fixing Trac #876 6e04f05 Use fromException instead of cast when matching exceptions 9d604f8 base: use --host as target, not uname cc650e1 enable memo001/memo002 when fast a3f1fd1 Remove uses of compose(s) in tests 98949ab Add the IsList class, for OverloadedLists ab1d58b Merge branch 'master' of http://darcs.haskell.org/packages/base 25d1eaf Remove nhc98-specific files and content 36f2d30 Mark DEPRECATED pragmas with when they were added c3470c1 Remove DEPRECATED pragmas from a couple of tests a34f677 Remove some things deprecated since GHC 7.2 309c3a3 Give Control.Monad.Instances a proper DEPRECATED pragma 631a65b Merge branch 'master' into rule_fixes b7fc72b Define Functor instances for ArgOrder, OptDescr and ArgDescr e6f1209 Remove a redundant backwards compatibility hack b5c9939 Remove some always-true CPP tests from System.IO.Error 309d4f1 Add "deprecated in" comments to deprecated pragmas d58baf9 Remove block and unblock (deprecated since GHC 7.0) 6fc6859 Remove blocked (deprecated since 7.2) b641227 Fix documentation 7115def Typo fae4967 Merge branch 'master' into rule_fixes 8ca03bc Remove some functions deprecated since GHC 7.2. 8ff2942 Follow changes in GHC's build system 197125f Use correct type for poll on Mac/FreeBSD, fixes ticket #7714. 0e1b9bd integer-gmp: mpn_gcd_1 allocate one Word on stack instead of 'sizeof (__mpz_struct)' baa7eca Fix typo 90d1d92 Don't just fail if hGetBufSome is used on a non-FD: fall back on the slow path instead 69a8c2d Fix #7522 by checking for empty byte buffers a little more 3900186 Add test for #7522 740bee7 md5.c: fix a typo in the size argument of memset 3302951 throwTo is interruptible. 1e2e013 Build system refactoring 408998f add test for #7719 46548f7 Fix System.Timeout.timeout leaking Timeout exceptions (#7719). 7a3131e Implement faster System.Timeout.timeout for the threaded RTS. 7fadc60 Build fix for iOS; fixes #7759 424c7f2 Fix warnings 0b79c32 Add some more Data.Functor functions; fixes #7817 e3e9ada Add Debug.Trace.{traceId,traceShowId,traceM,traceShowM}; fixes #7626 6e06881 Fix #7853 f178826 Test fix for #7853 4eb3193 Improve documentation for mkTextEncoding fd6fb7c Add isLeft/isRight 557a9a8 Fix build on Windows 8a6e132 Fix build when gmp isn't installed c5a4de9 Update parallel IO manager to handle the invalid files in the same way as previous IO manager. 592e4ae Derive Typeable for RealWorld and (->), now that we can 2216b89 Support for Windows DBCS and new SBCS with MultiByteToWideChar 802e99a Add comprehensive test for codepage encodings+recovery for them d238ea4 Handle dependencies for .cmm files properly 14233fc Omit T7773 on Msys aba043a Fix build order when building with integer-simple 52719ad Fix build 9905899 More build ordering fixes 06bc377 More build fixes d77b3a0 Another build ordering fix f47ea8e Add an __hsbase_ prefix to the MD5 symbols (#7914) 8abb62b Merge branch 'master' of http://darcs.haskell.org/packages/base 02b9a24 Add code to convert from representation types, to existentially quantified singletons. 083a45e Merge branch 'master' of ssh://darcs.haskell.org/srv/darcs/packages/base 95853c7 Enable PolyKinds for Control.Category. 822ce01 Merge branch 'master' of ssh://darcs.haskell.org/srv/darcs/packages/base 3730af0 Revert "Add code to convert from representation types, to existentially quantified singletons." cb2f2d4 add Foldable and Traversable instances for Either a and (,) a dac845c Redo and cleanup the change replacing `unsafe*` with `toSing` de1ae80 Add tests for kind-polymorphic Control.Category 889b5bb Remove an import loop f3c261b Remove some unnecessary SOURCE imports 8d87b5b Re-jig SOURCE imports a8ede1e Revert accidental change b3afa0a Make GHC.Err depend on GHC.Integer ad6696e Comments 404327a GHC.Err is no longer a boot module; no GHC/Err.lhs-boot 4c6faba Fix import warnings 374fcdd Add an import to fix build ordering 68288cf Change a use of atomicModifyIORef to atomicModifyIORef' 55a5f05 Remove uses of RecordWildCards in GHC.Event.TimerManager 2d5eccd IO manager: Edit the timeout queue directly, rather than using an edit list bbf6c02 Add a test for #7653 c7ef98d Replace all atomicModifyIORef calls in GHC.Event.TimerManager f177fdb Use atomicModifyIORef' rather than atomicModifyIORef 5ae2385 expose new Word operation to swap endianness for Word{16,32,64} da7db19 add other architecture for bswap in a form of Stg functions. b9138a8 Fix some typos 72901d4 Revert "expose new Word operation to swap endianness for Word{16,32,64}" 089c686 One more GHC.Err import eliminated 7fef22a Clarification what 'atomic' means here. 3be6101 Add setEnv/unsetEnv to System.Environment; fixes #7427 9dc3418 Fix a comment 5257404 Update GHC.ForeignPtr to use addCFinalizerToWeak# f2ade3f Fix hClose002 with the threaded RTS IO manager 4780c7a Fix hSetBuffering004 to work with dynamic ghci 3508495 Ignore editor backup files 0ff54be Update to support closed type families. 44cff44 Fix build on OS X 3ae1bc4 Run "sh ./configure" rather than "sh configure"; part of #7992 8f23525 Catch an illegal pragma and fix a typo 7827f74 fix markup bugs 5e2a5dc Add a section of documentation about the interaction of threads and finalizers e40d433 Update export list for closed type families 0193f91 Follow GHC build system changes 5564980 Comparison primops return Int# (Fixes #6135) d3fbf77 Derive Show, Eq, Ord, Read for Control.Applicative.ZipList; fixes #5787 9cf8e57 Add atomicReadMVar to Control.Concurrent.MVar and friends. 38ff3b4 Implement tryAtomicReadMVar. 0bb58e2 Fix build. 9299fdf Rename atomicReadMVar and friends to readMVar, replacing old readMVar. c376c26 Minor rewording. 5a5ff27 Expose new Word operation to swap endianness for Word{16,32,64} 404c995 Fix #7787 af04f2b Add test for #7787 6aaf1e2 Comparison primops return Int# (Fixes #6135) 66cc86e Fix GHC.Enum on 32bit platforms; fixes #8072 d8b02c2 Fix bug in IO manager when number of capabilities is changed; fixes #8087 01aa22b Implement "TypeLevelReasoning" proposal at wiki:TypeLevelReasoning e7a9c06 Eliminate Equality.hs-boot and Proxy.hs-boot by moving instances 0cc90bf Comparison primops return Int# (Fixes #6135) ab1791f Remove some redundant warning suppression ca8a9f4 Add asProxyTypeOf and Trustworthy pragma to Data.Proxy 2505aba We need NegativeLiterals for GHC.Int or we get warnings bdde811 Mark the roles of Ptr and FunPtr as R, not P! 649219a Implement roles into Template Haskell. eb25664 Comparison primops return Int# (Fixes #6135) a57832b Change return type for emulated 64bit comparisons f4f5a17 Use primop wrappers instead of tagToEnum# c10454d Comments only 41c3ed2 Comments only 6170f97 Fingerprint: Add Show instance for easier debugging 8967959 Fingerprint: Add getFileHash 920bbbc Fix -Werror failure in GHC.Fingerprint 527803a Remove trailing whitespace from GHC.Fingerprint.* 797a368 Comments only 48a9fbc Fix GHC Trac #8186. a6c396b Improve pretty printing for Template Haskell operators cc99f64 Fix off-by-one error in the IO manager 28cf2e0 Switch IO manager to a mutable hashtable 67c0a98 GHC.Conc.Sync: Pass TSO to stackOverflow acac32c length001 passes now 7df9d83 Fix AMP warnings 3113270 EventManager: Gracefully handle an initial 'Finished' state (#8235) 17e2a5c Revert "GHC.Conc.Sync: Pass TSO to stackOverflow" 6cc1aae Revert "length001 passes now" 229513b Redo <= with a type synonym instead of a class, add instance for boolean singletons, remove (-) a1233f2 Update Git repo URL in `.cabal` file 8d59148 Update Git repo URL in `.cabal` file 9a91e51 Update Git repo URL in `.cabal` file 4abc8d4 Update Git repo URL in `.cabal` file a4cad04 Update Git repo URL in `base.cabal` fa34409 Add `Data` instance for `Data.Version` 2a5ac7b Define GHC.Types.Coercible acaa1c8 byteSwap16/32: Narrow the result to 16/32 bits 345c316 Follow changes in comparison primops (see #6135) d75ca3b Follow changes in comparison primops (see #6135) 907cd8c Add Data.Bool.bool (fixes #8302) 43ece17 Remove Hugs98 specific code 0f5eae0 Constant-fold `__GLASGOW_HASKELL__` CPP conditionals 8f9f100 Make `` obsolete and refactor away its use 3b6efce Replaced Text.Printf with extensible printf, and made comcommitant changes 98a63b9 Support new role annotation syntax. 0710184 Update use of role annotations to new syntax. b549d68 Add `{-# MINIMAL #-}` to `class Eq` and `class Ord` 1b608a0 Add `{-# MINIMAL #-}` annotations to typeclasses 2c2ead5 Trailing whitespaces 937fab7 Follow changes in comparison primops (see #6135) a4e9c7e Follow changes in comparison primops (see #6135) acb313a Trailing whitespaces ad89699 Follow changes in comparison primops (see #6135) f65cef6 Comments only 957511b Add Haddock docs for new `class FiniteBits` 77f32da Add Haddock `/Since: 4.7.0.0/` comments to new symbols 2642d9f Add Haddock `/Since: 4.6.0.0/` comments to symbols 0a5ecb5 Add Haddock `/Since: 4.5.[01].0/` comments to symbols 40c00af Add Haddock `/Since: 4.4.0.0/` comments to symbols 2ed1377 Remove obsolete pre-Haddock-2 `#hide` pragmas 4449dbc Add instance Monad (WrappedMonad m) to Control.Applicative (#8218) 35d55a6 Add type functions (-) and ToNat1; Turn FromNat1 into a closed family. 5e16d00 Add Foldable/Traversable instances for 'Const m' 1ab2b1f Add fmapCoerce to Functor class. a1b56fa Revert "Add fmapCoerce to Functor class." ad74a2a Documentation for GHC.Generics b857c29 Define typeRep in terms of new Proxy# 52767f1 Fix comment typo introduced in 6368362f44 deff0cc Add a few missing `{-# LANGUAGE CPP #-}`s a7e09b4 Modernize and refactor `base.cabal` a4f36a7 Drop redundant `{-# LANGUAGE #-}` pragmas 4503466 Remove obsolete `include/Nhc98BaseConfig.h` 0e33e3c Add `/Since: 4.7.0.0/` to new entities in fc904366 e864079 Add missing/remove redundant `{-# LANGUAGE CPP #-}`s 4fe151c Expose performMinorGC (#8257) 4d51685 Expose new internal exponentiation primitives 71e2958 Expose GMP's `mpz_gcdext()` as internal primitive b3caee6 Fix name of minor GC function. a29423d System.IO.Unsafe: cleanup: make unsafeFixIO pseudocode more valid 47dd3c2 Fix Windows build. c949f8b Add TH support for annotations (#8340) ccd6d58 Remove all but the basic operations on type-level literals. 40e7236 Rename someSymVal to someSymbolVal add3bae Add fixity declaration for type-level functions. 29ea943 Add TExp data type. 4d226b3 Add a method to the Quasi type class that adds new top-level declarations. 9caca0a Make a TExp a wrap a TH.Exp instead of a TH.ExpQ. 6b676e7 Add the TExpQ type alias. 18f2e52 Correctly pretty-print let and do expressions. bb89c59 Add support for top-level finalizers 8b08440 Add Template Haskell state. 982267f Merge New Template Haskell branch. a333f7b Add `instance Monoid a => Monoid (Const a b)` 0fcb06e Port ThreadDelay001 to the "time" library 4434dc9 Typo in documentation 98d6079 Rename (:=:) to (:~:) and add Data.Type.Coercion 3ea4d5a Clean-up implementation of GHC.TypeLits. 2fb746f Clarify docs for throwTo wrt atomicity (#8432) 6fc1c0f Fix hangs with -threaded on iOS (#8307) 478132f Add reifyAnnotations (#8397) c90b2dc Add Show and Read instances for Data.Ord.Down c503eff Spelling in commments db1a8c4 Remove now-unnecessary NOINLINE pragmas ec33d03 Make TExp's argument have nominal role (Trac #8459) 2630f4c Declare all language extensions via `{-# LANGUAGE #-}` bad2d6a Refactor & modernize `.cabal` to `cabal-version>=1.10` c8db315 Add aux files `config.{guess,sub}` and `install-sh` 0a39d19 Refactor & modernize `.cabal` to `cabal-version>=1.10` 944c190 Add overlooked files created by `configure` to `extra-tmp-files` b3fe43e Don't include `{Event,HsUnix}Config.h` in source distribution ae7587d GHC.Conc.Sync: Pass TSO to stackOverflow 71645bc Run length001 test with +RTS -K8m 536b791 Implement SPEC for SpecConstr as a built in type. cb08301 Add actual documentation for new SPEC type. 994ea5b Placate clang. 6220e6f Add missing `{-# LANGUAGE #-}` pragmas 845bb10 Modernize `ghc-prim.cabal` to `cabal-version>=1.10` fcd1390 Update aux files `config.{guess,sub}` and `install-sh` 273669e Update `bug-reports` URL and version constraints 7551d17 Add overlooked language extensions to `IntWord64.hs` d5afac8 Add side-channel attack resilient `powModSecInteger` 64296b4 Changed export list to create better haddock. Added eqT to exports. eb6725b Name changes and addition of gcastWith and (==) to Data.Type.Equality. 824ea41 Name change `CoercionT` to `CoercionType`, and addition of `repr`. ee24f27 Apply Gabor Lehel's suggestions. f497354 Expose two GMP primality operations 9265c88 Add new module Data.Type.Bool, defining &&, || and Not. 506cfd8 Add a couple of `/Since: 4.7.0.0/` annotations 218c2ea Export abstract `Text.Read.Lex.Number` type 2e73837 Add Ord instances for GHC.Generics (#7263) 336e94d Allow module reification (#1480) 28ef0bd Use addDependentFile in quoteFile. abd4fae Add primitives to write/read Integers to/from bytearrays 1415647 Clean-up Cmm of import/export primitives 00e04e8 Fix OSX RTS crash due to bad coercion. 33ed16b *Really* RTS crash due to bad coercion. 449f188 Rename `{import,export}Integer` 008e636 Add `Addr#` based `{import,export}Integer` variants 17c55a4 Optimize order of pattern matches for export operations d97951f Improve Haddock documentation 1e38f49 Spelling in comments 643f07c Handle ExitFailure (-sig) by killing process with signal 2ec9734 Add tests for the top level exception handler 14527c1 Fix up test topHandler03 by ignoring unhelpful shell output 775d13d Add `instance {Bits,FiniteBits} Bool` 87672e7 Update Autoconf tests for recent GMP version 160fb4c Avoid unsafeCoerce# in TopHandler cfe79fd Add fusion RULES for mapMaybe 3682558 Properly detect msys2/x64 shell as Windows. 8446ccf Use type synonym d9179a5 Kill trailing whitespaces 78e7066 Improve mkName, so that it correctly parses the name ^.. 4231ff3 s/therad/thread/ 8e2aa93 Improve error messages for partial functions in Data.Data ce3ff03 Try harder to demote results from `J#` to `S#` (re #8638) 2a28fde Use a more sensible `hashInteger` implementation fc8e15b Refactor and comment the smartJ# changes (re Trac #8638) 4cc6785 Make use of `quotRemInt#` primop in `quotRemInteger` f9c2888 Refactor `stgReallocForGMP` to use `memcpy` d71ced0 Add functions to compare Nat and Symbol types for equality. ce74d32 add 'Since' annotations and remove an unneeded import 2a33660 Refactor C-- wrappers to use macros for mpz_t access 4b859ee Add new `mpz_mul_si`-based primop (re #8647) 3b285ef Add new `mpz_{sub,add}_ui`-based primop (re #8647) 9e10e9c Hackishly fix parallel build failure with in-tree GMP 9143961 Document another unsafeDupablePerformIO limitation. aabc933 Wrap `gmpz_tdiv_{q,r,qr}_ui` to optimize `quot`/`rem` 67bcb32 Manually float out `int2Integer# INT_MINBOUND` a6243b3 Deprecate TH.global (Trac #8656) c0b5008 Temporary disable `mpz_gmpz_tdiv_qr_ui` to workaround #8661 7647997 Follow-up to a3878d17 069a49c Drop redundant formal parameter from TAKE1_UL1_RET2 7fdd026 Allocate initial 1-limb mpz_t on the Stack and introduce MPZ# type d075e1c Wrap `gmpz_fdiv_{q,r,qr}_ui` to optimize `div`/`mod` df1197a Fix in-tree GMP build (#8497) on OS X Mavericks 80c8c8c Use correct package id for `stg_INTLIKE_closure` import e0b3a05 Introduce new SIZEOF_MP_LIMB_T derived constant 531199d Dont use big/small-int primops on IL32P64 (i.e. Win/x86_64) for now 81b6bef go-ify foldr2 466d069 Bump version: 7.7 -> 7.9 be3c7fa Add newline before two `/Since: 4.7.0.0/` occurences 836fd7c Add Hackage-supported `changelog.md` file 48e3524 Add `/Since: 4.7.0.0/` to `MkFixed` constructor a9848b9 Update `changelog.md` to contain more changes cfa0159 Add changelog entry for new `FiniteBits` class 24669fe Update Win32 submodule to pull in version bump 9f58cec Fix glitch in core-spec pdf fcf0294 Improve Haddock markup in `Control.Concurrent.MVar` cc4ba35 Improve Haddock markup 276c462 Derive `FiniteBits` for integral newtype wrappers 48326cf Fix iOS build (fallout from 28b031c506) 99484c9 Add a perf-cross build setting. 044f233 Bump win32 version number in release notes 38b7182 Comment typo 1dd38a5 Remove Coercible documentation from compiler/prelude/primops.txt.pp 02dde83 Show docs for coerce and Coercible in GHC.Exts 7251d42 Document Coercible in GHC.Types fda9beb Fix some edge cases in 8f8bd88c (#7134) 6c8cc4f Improve documentation of `integer-gmp` 5671ad6 Update to latest Cabal 1.18 branch tip 71a412c No need to remove testsuite/.git 50e4d40 Individual sdist-foo targets b6253fa Add Hackage-supported `changelog.md` a2269bf Remove some references to deprecated -fglasgow-exts in user's guide ea584ab Loopification jump between stack and heap checks c6ce808 Remove unnecessary LANGUAGE pragma 99c3ed8 Simplify Control Flow Optimisations Cmm pass 78afa20 Nuke dead code c7a050f Fix a popular typo 5ad48fd Fix a popular typo d5fb670 Fix a popular typo in comments f028975 Remove redundant NoMonoLocalBinds pragma b5c45d8 Remove unused import bcd38ea Fix negation of `divMod`/`quotRem` results (fixes #8726) 5f64b2c Add test-case for #8726 526cbc7 Document deprecations in Hoopl dba9bf6 Eliminate duplicate code in Cmm pipeline 2b33f6e Final fix to #7134 (and #8717 as well.) 2f6d36f Tweak holes documentation 40ce203 Fix #8698 by properly handling long section names and reenabling .ctors handling 5bda0d0 Mention that MR is off by default in GHCi in documentation 2c2e1ec Add release note about new `SomeAsyncException` ad44e47 Switch to relative URLs in .gitmodules b755c7b Correctly clone submodules from github 41cfc96 Tweak documentation of monomorphism restriction 298a25b Fix __thread detection (#8722) b4eb630 Remove ios_HOST check for GCTDecl.h 03200e8 Fix some Python brainos in testlib (except e is not valid form). c3ff5f2 Add test case for #8743 312686c In deepSplitCprType_maybe, be more forgiving 218dead Fix #8706, documenting that type operators are not promoted. 4f6a0f4 T8256 needs vector 674c969 Fix #8631. e0a5541 Issue an error for pattern synonyms defined in a local scope (#8757) 719108f Add test suite for #8757 7561e37 double-negate test for Stage1Only to fix `make clean` 65170fc Let `make distclean` remove `/{ch01,ch02,index}.html` 02c7135 Move test case for #8631 to the correct directory. 8cc398f Fix #8758 by assuming RankNTypes when checking GND code. 9e0c1ae Test #6147, which was fixed with the roles commit. d1dff94 Test #7481, which had already been fixed. 6122efc Fix #8759 by not panicking with TH and patsyns. e0dadc8 Apply changes relative to TH.Pred becoming a TH.Type's synonym (issue #7021) 182ff9e Fix tests due to issue #7021 70b7a19 Make Pred a type synonym of Type (issue #7021) 0390a02 Change type of equalityT to be more parallel with others. 56f47fd Add documentation to why Pred has become a type synonym. 8e303d7 Refactor previous commit on fixing #7021. cdceadf Implement CallArity analysis 7822166 Implement foldl with foldr 79dfb96 Inline maximum/minium a bit more aggresively 9bc8265 Add a unit test for CallArity 393ea73 Update test cases due to call arity a4450ec Note [Eta expansion in match] b4715d6 Replace forall'ed Coercible by ~R# in RULES f4fb94f In CoreSubst, optimize Coercible values aggressively d557d8c In simpleOptExpr, unfold compulsary unfoldings 8f16233 Add Case TyConAppCo to match_co 377672a Test case for RULE map coerce = coerce a27b298 Use exprIsLambda_maybe in match cde88e2 Test case: Looking through unfoldings when matching lambdas 5d04603 Remove eta-expansion in Rules.match e16826b Cleaned up Maybes.lhs 9f607ee Link to #minimal-pragma from release notes e2cacb6 Manual hlinting: or (map f) = any f 3477216 Fix Manual hlinting patch 3d80787 Fix some typos in comments 3d9644c Remove space after ASSERT. 473f12a Fix #5682. Now, '(:) parses. 1382975 Fix #8773. 60ebfcf Improve list fusion for [n::Integer..m] 58c8934 Test case for #8374 61cf76d Wrong bug number 68f0a6a Fix --enable-unregistered by passing NOSMP to .hc compiler (#8748) 4bb50ed Fix --enable-unregistered by declaring missing RTS functions (#8748) ebace69 rts/Capability.c: fix crash in -threaded mode on UNREG build 858a807 includes/Stg.h: add declarations for hs_popcnt and frinds 2d0fa9a rts/package.conf.in: fix UNREG on --with-system-libffi when include-dir is passed explicitely 2d5372c mk/config.mk.in: lower -O2 optimization down to -O1 on UNREG a365eab Fix installation of hpc (#8735) c83eabf Fix check for TLS support in Storage.c 5023c91 Fix #8754 in a round-about way. a8a01e7 Fix #8745 - GND is now -XSafe compatible. dc08091 Fix #8770 23916ec Expand comment for enumDeltaToInteger1 b626c3d Add comments explaining #8754 2931d19 More liberally eta-expand a case-expression 47f473b Use NoGen plan for unboxed-tuple bindings 5dd1cbb Allow ($) to return an unlifted type (Trac #8739) cd3a3a2 Add some more traceTcS calls 89d2c04 Keep kind-inconsistent Given type equalities (fixes Trac #8705) 642bba3 Revert "Add comments explaining #8754" e789a4f Revert "Fix #8754 in a round-about way." 4c93a40 Make CallArity make more use of many-calls fa353f2 Call Arity refactoring: Use a product domain 983fbbe Call Arity refactoring: Factor out callArityBound 7c603ab Call Arity refactoring: instance Outputable Count 2ab00bf Call Arity: Now also done on Top-Level binds 7e787e7 Move unit call arity unittests into subdirectory d51d7ef Call arity: Handle type application correctly f347bfe Support mutual recursion d3c579c Call arity testcase for #3924 ba4616b Call Arity: Update compiler perf number changes af7428e Call Arity refactoring: fakeBoringCalls 124e568 Use new bitwise Int# primops in Data.Bits (re #8791) 90f83fa Minor typo in comment 47d725f Update to primitive-0.5.2.1 43c314c add omitted FP_PROG_AR_SUPPORTS_ATFILE into the distribution configure.ac (fixes #8794) 5c6ced5 fix build failure on Solaris 10 due to RANLIB being set to ':' by configure (#8795) 27fe128 add more information about the nature of support of prefetch primops on none x86/AMD64 -fasm platforms (and -fvia) to the 7.8 release notes e638acb fix sed expression in build dependencies rules to work well with non-GNU sed (fixes #8764) e75ebc4 Switch on -dynamic-too with QuasiQuotes as well. 2b34947 Clear up docs regarding LLVM backend (#8792) f99a032 Fix #8801: exclude extra packages from the sdist. d3af980 Really fix #5682 (parsing of promoted datacons) 925b0a4 RetainerProfile.c: include missing header (#8810) 3361e6c Update to primitive-0.5.2.1 (again) 55cc01a Add test case for #8806. 5a57675 Add a test for d3af980 (#5682) c72e889 Fix #8754 again. 5075c19 Add VERSION file to gitignore. beac525 Fix installation of ghc-split (#8760) c60da54 Fix typo in documentation of Data.Functor.($>) 4acc8ea Tweak Haddock markup in Control.Applicative 4f4f798 Minor fixes to Haddock markup ed1aced Fix #8696 - don't generate static intra-package references. 4f69b1e Fix Haddock formatting ede5b51 Make Outputable instance for HsDocString useful d3ad3ee Add `withMVarMasked` (re #8818) 018676c Use U+2018 instead of U+201B quote mark in compiler messages 0c7507a Provide Typeable1..7 as type synonyms (see #8813) b0e2736 Language extension wibble (see #8813) 6505c17 Tweak Haddock markup in Data.Typeable 98b6756 Fix #8807. 32f41c7 Make distribution tarball compression format configurable 4775d00 Fix GMP v4 compatibility. b1ee32e Follow-up to 32f41c79 b1ddec1 Fix a bug in codegen for non-updatable selector thunks (#8817) 68c0d86 fix comment on allocate() (#8254) af6746f Add hs_thread_done() (#8124) 67029f2 PPC: Fix loads of PIC data with > 16 bit offsets (#7830). 65d78dd Add new Data.Bits.Bits(zeroBits) method a864c34 Bump T6048 tests. e467d93 Create Data.Coerce (#8745) 1d1ff77 Add some instances for Monoid/Applicative (#8797) 7161152 Documentation updates for 7.8.1 release 025a66e Fix binary-dist target with xz/gzip f962725 Note that we need Cabal-1.18 in the release notes 251b18a binary-dist: when using xz, use extreme compression. 3fba875 add missing files (#8124) 176205c fix copy/pasto fd26a47 Add Since-annotation to `Coercible` 65869be Tweak documentation and update changelog.md d3317d4 Tweak Haddock comments in `Data.Ord.Down` added in ebc85262c 0d66095 Workaround failed constant-folding for zeroBits afb42a5 Update time to 1.4.2 release 01f9ac3 Update `Cabal` to 1.18.1.3 release cb8a63c Major Call Arity rework 2d82846 Typos in comments eeb1400 Add some debug tracing 4b355cd Make the demand on a binder compatible with type (fixes Trac #8569) 96daafc Attach the right location to pattern synonym error message (fixes Trac #8841) bf9bf60 Test for Trac #8841 now works 7fa6c67 Trac #8569 fixed 1ac9114 Test #8851. 0014fb3 Run testcase for 8124 only with threaded ways 3efcb0a Make sync-all handle all github protocols correctly cdac487 Make -XDeriveFunctor more generous about non-last arguments (Trac #8678) cf1a0f9 Fix the treatment of lexically scoped kind variables (Trac #8856) 062391b Test Trac #8856 d246c62 Also allow http://github.com (#8824) 9d14262 Improve documentation of standalone deriving (c.f. Trac #8851) f521a26 Unify, rather than match, in GND processing (fixes Trac #8865) ddf79eb Add "bench" build flavour to build system 9c9bb00 Fix copy-paste error in build system comment a10ed3e Comments only ef44a42 Make SetLevels do substitution properly (fixes Trac #8714) 41f8031 Fix last-minute typo in SetLevels commit ef44a4 22f010e codeGen: allocate small arrays of statically known size inline a70e7b4 Represent offsets into heap objects with byte, not word, offsets b684f27 Refactor inline array allocation c1d74ab Fix incorrect loop condition in inline array allocation 22e4bba Add test for inline array allocation d8b3826 Validate computed sums in inline array allocation test d793a14 Add perf test for inline array allocation 7f919de Call Arity: Resurrect fakeBoringCalls b0416e7 Comments on virtHp, realHp (Trac #8864) b340681 A bit more tracing to do with SPECIALISE pragmas 518706b Add shiftR and shiftL implementations to instance Bits Integer 16e2371 Comments only, about the "RA" and "RL" nomenclature for shifts 0efb246 Use not# rather than (`xor#` (-1)) for complement 60bbc0a Export runTcInteractive from TcRnDriver, and from GHC (Trac #8878) 7ef90e3 Comments only 8fd7d58 Add BuiltinRules for constant-folding not# and notI# (logical complement) ea6dcef Test Trac #8832 4d1b7b4 Add OutputableBndr instance for OccName 23c0f1e pprIfaceContextArr: print a context including the "=>" arrow 24eea38 pprIfaceDecl for IfacePatSyn: use pprPatSynSig 065c35a Pretty-print the following TyThings via their IfaceDecl counterpart: * AnId * ACoAxiom * AConLike ed2a8f0 Improve copy/clone array primop docs e55acf0 Update to containers-0.5.5.0 46d05ba Fix two issues in stg_newArrayzh 6f338dd Add RULE for "map coerce = map" (#8767) a0bcbb5 fix SHELL makefile variable to be set by the configure script (fixes #8783) 623883f disable shared libs on sparc (linux/solaris) (fixes #8857) b7e5d72 Fix incorrect blocksize calculation on Win64 d574fcb config.mk.in: ARM now supports dynamic linking with the LLVM backend b84b5da DriverPipeline: Ensure -globalopt is passed to LLVM opt b99ace3 Fix incorrect maxStkSize calculation (#8858) cbdd832 Fix T2110 now that base has map/coerce rule. 210ccab codeGen: allocate small byte arrays of statically known size inline 4245397 Remove misleading comment 5972229 Remove "Safe mode" check for Coercible instances 8ee6162 Recharacterize test according to discussion in #8851. 8c5ea91 Fix #8884. 337bac3 Fix typo in user's manual, changing "-j N" to "-jN". 797da5c Call Arity : Note about fakeBoringCalls 41ab584 Remove unused gHC_COERCIBLE 722193b Update Coercible docs due to Safe Haskell adjustment c61d40e testsuite: look for tests-ghc directories for libraries df265b9 Update to containers-0.5.5.1 a962e1e Note [Kind-changing of (~) and Coercible] 4133ff8 Reference Note [Kind-changing of (~) and Coercible] d53ccab Another reference to Note [Kind-changing of (~) and Coercible] 54c95ff Better Comment [Kind-changing of (~) and Coercible] f793302 Refer to the coercible paper in Coercible' docs 1e36a38 Document Coercible in the user guide f3eeb93 Honor Op_PrintExplicitForalls setting in pprIfaceForAllPart 5908a74 Use prefix notation in pprIfaceDecl for IfaceIds 5200369 Reinstate pretty-printing of AnIds via pprId (#8776) de32a95 Add test case for #8776 306d255 Call Arity: Never eta-expand thunks in recursive groups aab6b9b Call Arity test case: Check what happens with unboxed lets 7602bd4 Remove code reporting issues with Safe Haskell and coerce. 0142237 Test case: :info Coercible in GHCi db497cd Fix comment for ghci script files 59ace8b Import Coercible from GHC.Types 99869ef Export Coercible in GHC.Types (#8894) d59170b Coercible is now exported from GHC.Types (#8894) 5d59265 Remove support for "primclass" 7a7af1f Unflatten the constraints of an inferred types (Trac #8889) a79613a Revert ad15c2, which causes Windows seg-faults (Trac #8834) 7511d5b Fix validation issue due to Coercible move (#8894) 2b3feaa Comments only f4d15cb More debug info 0e2155d Test Trac #8889 a5ab610 Test case: ghci059: Forgot stdout file 3099e40 Add some documentation about type-level literals. 696bfc4 Update submodule to Win32-2.3.0.2 87bbc69 Make sure we occurrence-analyse unfoldings (fixes Trac #8892) 5e4bdb5 Implement ordering comparisons for type-level naturals and symbols. db5a43e Add functions for comparing type-level Nats and Symbols. a3f78e2 isLexVarSym: check all characters of the name, not just the first one. 21028ee Update expected test outputs to match new format of pretty-printing interface contents a6939ec Don't use gcptr for interior pointers df409de Flush after TH in #8884 test case ba0c012 Typos f9b6a2b testsuite: add test for #8831 7a1c851 linker: Fix indirect calls for x86_64 windows (#2283) 99ef279 Update ghc --help references to --make and a.out (fixes #8600) 1eece45 codeGen: inline allocation optimization for clone array primops 4bc3c82 Mark test for #8831 as known-broken 1921238 Make argument types in popcnt.c match declared primop types 1a63f17 Follow hs_popcntX changes in ghc-prim 16d04d9 Enable popcnt test now when segfault is fixed be2e0e8 Make cabal01 pass with Cabal 1.18 (#8738). 9b38f6a Comments only -- clarifying Notes around compatibility. b0bcbc0 Remove redundant compatibility check. 4779602 Add test case for #8917 c99941c Fix #8917. d523f9b sync-all: Skip END actions on exceptions ac24bf4 add --with-ar and --with-ranlib configure parameters ace7477 Add a simplistic Vagrantfile with bootstrapping 045b280 change deriveConstants to use nm in a POSIX way (fixes #8781) 717fc49 Bump to 2.10.0.0 34b0721 Convert haddock into a proper submodule (re #8545) 8f26728 ghc-cabal: force use of UTF8 when writing out `haddock-prologue.txt` ffed708 Apply the kind subst to the (kinds of the) quanitifed tyvars in deriveTyData 28e8d87 Simplify handling of the interactive package; fixes Trac #8831 7973bfb Test Trac #8893 1a7709e Trac #8831 is fixed 90142be Fix typo 4b4fc7d Catch a bunch of typos in comments 61654e5 The substitution is never needed, so don't prepare it a8512f6 Comments only. 8f73037 Revert "Fix #8745 - GND is now -XSafe compatible." c686179 Mark Data.Coerce as Unsafe (#8827) 15b1eb7 Revert "change deriveConstants to use nm in a POSIX way (fixes #8781)" 74894e0 Add missing kind-check for tcEqType on forall-types 3f59647 Don't export isTcReflCo_maybe (unused) 5a51b69 Comments only c89c57e For equalities with incompatible kinds, new IrredCan goes in the inert set, not work list 9f9b10f Debug tracing only 6ae678e Flattener preserves synonyms, rewriteEvidence can drop buggy "optimisation" a8b7b28 Implicit parameters should not be allowed in class and instance declarations 5c7ced0 Comments only 73cab20 relnotes: GND is not -XSafe compatible. 0b6fa3e Eliminate redundant seq's (Trac #8900) 41ba7cc Improve the desugaring of RULE left-hand-sides (fixes Trac #8848) b800e52 Comments only 88d9452 Test Trac #8848 2d1ecd2 Suppress uniques for simpl016 to normalise debug output ce335ce Typos in comments 11b31c3 Add flags to control memcpy and memset inlining f868254 Fixup help text 6189c76 --with-gcc overrides CC_STAGE0 when not cross-compiling (#8498) a6f2c85 Don't perform permission checks for scripts named with -ghci-script (#6017) 975e9cb Include EXTRA_LD_OPTS (amongst other things) when linking programs e7f26cd Pass custom CC and LD opts to Cabal when configuring a package d011cde Include SRC_CC_OPTS and SRC_LD_OPTS when compiling ghc-cabal 2aa7810 Use LDFLAGS when compiling ghc-pwd 261a97b increase bounds for T3064 260189a add /Since/ annotation c4eeacd Use the correct callClobberedRegs on Windows/x64 (#8834) 7ef3f0d rts: remove unused functions, fix validate on OS X e54828b Make copy array ops out-of-line by default 4c8edfd Remove debugging output 90329b6 Add SmallArray# and SmallMutableArray# types 838bfb2 Add missing symbols to linker dd02850 PrimOps.cmm: whitespace only 4de517f Add more missing linker symbols c310823 CopySmallArrayStressTest needs random 1a11e9b Add inline versions of copy ops for small arrays 345eea2 Update Haddock submodule 52c6dc9 Temporarily fight off build bogons on OS X d8072fa Typo 5d7f590 Support thin archive format 63b0e1b Update Haddock submodule 791f4fa Make sure that polykinded Typeable is defaultable (Trac #8931) 3671d00 Fix desguaring of bang patterns (Trac #8952) 8bf8ce1 Test Trac #8931 b20bc18 Parse the variables in a type signature in the order given (Trac #8945) 2033a58 Update Haddock submodule e94ed11 With AutoDeriveTypeable, derive for promoted constructors, too. 750271e Simplify and tidy up the handling of tuple names c6c8678 Revert "Revert ad15c2, which causes Windows seg-faults (Trac #8834)" f0af58d windows: Fix #8870 59b9b06 Fix copy/paste error (#8937) ee13437 Test return value of clock_gettime() for errors. e81d110 Disable thin archive support on Windows d468cd3 Fix #8958. f772344 Add test case for #8950. 8f831ec Require PatternSynonyms language flag when encountering a use of pattern synonym (#8961) d8d798b Small issue with signatures in a TH splice (fixes Trac #8932) bd79b98 Update long-out-of-date performance numbers on 32-bit ee481ff Ignore repeated loads of the same archive (#8942) ec3e949 Include LD_OPTS when building the RTS shared libs 54e6555 Derive Typable for promoted data constructors (Trac #8950) b059dcc users_guide: note -XPatternSynonyms is required for use sites b30771d Clarify bits about role inference in users' guide. cbe59d8 Improve tracing slightly 4dc9f98 Zonk the existential type variables in tcPatSynDecl 17c9554 Improve documentation of GeneralisedNewtypeDeriving d2c4f97 Add comments & notes explaining the typing of pattern synonym definitions 396648e Don't preprocess .s files 848f595 Allow a longer demand signature than arity 2c516c4 Refactor in worker/wrapper generation cc3ccf9 Test Trac #8963 50bfd42 Improve error reporting for untouchable type variables f8e12e2 Fix #5435, adding new test config check_stdout. b4dd566 Suppress uniques to stop output wobbling (test for Trac #8958) b8132a9 Fix egregious blunder in the type flattener c269b7e Split off pattern synonym definition checking from pattern inversion c7498bb Fix #8641, creating directories when we have stubs. 6782330 Update Haddock submodule reference. b7f51d6 Remove unused variable binding to fix validate dd3a6d2 Add source file for new test that checks that as-patterns are rejected in pattern synonym definitions 7233638 Expected output of as-pattern test e3938f3 Fix linked list manipulation code (buggy on consecutive deletion) 7fa0b43 Make BlockAlloc.c comment slightly more accurate (fixes #8491) eeaea2d Instead of tracking Origin in LHsBindsLR, track it in MatchGroup 80bdb88 Typos in comments b4a820f Update Haddock submodule to follow LHsBindsLR changes 70d263e Better layout for coercion error message bfd0064 Tidy up trace message 14046d0 A bit more trace information in an ASSERT failure e7f0ae7 Honour the untouchability of kind variables ff9f9a7 Test Trac #8985 a107737 s/FromList/isList in docs 8992d52 Update Cabal submodule to tip of v1.20 branch 241c660 Make qReport force its error message before printing it dbe0b8c Update Cabal submodule to latest tip of 1.20 branch dc4b66f Update Cabal submodule to fix Solaris build f964cd9 Take account of the AvailTC invariant when importing a6e68af Fold ghc-prim.git into ghc.git (re #8545) c83bec7 Fold base.git into ghc.git (re #8545) 85febc0 Fold integer-simple.git into ghc.git (re #8545) 670599d Fold integer-gmp.git into ghc.git (re #8545) 8bcb206 Fold template-haskell.git into ghc.git (re #8545) 41f5b7e Update `sync-all` and `packages` wrt to fold-in 1d2ffb6 Validate inferred theta. Fixes #8883 1bf6c0e Add reverse application operator Data.Function.(&) 44512e3 Add Data.List.sortOn function (re #9004 and #2659) dc2b8ae Fix sync-all error message introduced in 41f5b7e3e 7b04d35 Weaken constraints on Data.Complex functions bd7b973 Kill trailing whitespace in recently touched files 2eb40eb Normalize GHC Trac URLs 974a97e sync-all: Apply submodule url rewriting also to stuff in util/ f1f2d8f Remove some redundancy in sync-all bbf1cca More github url variants 33350ea Do not use basename() 386e874 Update Cabal source-repository entries (re #8545) 6074c5d Remove -fno-warn-amp sledgehammers for validate 35d95a2 Update submodule to final Cabal-1.20.0.0 release 3608f65 Deprecate the AMP warnings. 31dd5e5 testsuite/spec001: untabify, kill trailing whitespace 574ef42 ghc: Do not add a space in '-U __PIC__' e2b14c7 Use import list to hide new System.Exit.die 77ea2eb Add System.Exit.die (re #9016) 4ab8fc5 Kill whitespace after cpp's `-I` flag bcd989d Generalise type of recently added System.Exit.die a383139 ghc & docs: kill unused flags c29bf98 ghc: initial AArch64 patches 5a31f23 Be less untruthful about the prototypes of external functions 8586f60 Add the powerpc64le architecture 9ca17f8 Separate thousands when printing allocated bytes 4842dde Fix `make help` bb85759 Adapt .gitignore (re #8545) c6a31d2 Update integer-gmp's .gitignore file 33e585d Handle base et al. specially in foreachLibrary.mk 0a0115f Be more aggressive in `make clean` 31a7bb4 Add comments to explain the change to EF_ (Trac #8965) 98aab76 Be sure to UNPACK the size of an array 68a1e67 Make absolutely sure that 'done' and 'safeIndex' are strict in the index 134b722 Be less verbose when printing Names when we don't know what's in scope 79e46ae Don't eta-expand PAPs (fixes Trac #9020) 4ceb5de Some typos in comments 07388af Drop `template-haskell`'s build-dep on `containers` 95da409 rts: Fix potential memory leak in ProfHeap.c 111b845 rts: Fix possible int overflow in resize_nursery 6d11a0e coverity: Suppress some time-of-check-time-of-use reports f2595fd Check return value of sigaction fa0cbd2 Fix potential out-of-bound memory access 6ed7123 Check correct variable for NULL f17dcf0 Fix memleak in hp2ps fa5ac96 Don't require mk/config.mk for all cleanup targets c4e9f24 Test Trac #9036 0960a37 rm -rf ./docs/comm ba2e201 Do type-class defaulting even if there are insoluble constraints ef35d4c Remove the definition of die, which is now provided by System.Exit 7201e2a Update 32-bit perf numbers 3c990bf Start on 7.10.1 release notes 48e475e Fix annotation reification for home package modules 5f5e326 Add a comprehensive test for using Annotations from TH 7b967af tcrun045 should fail (implicit parameter as superclass) 2f3ea95 Print for-alls more often (Trac #9018) 0fe7268 annth_make, annth_compunits: Only run these tests if have_dynamic() a3896ab Improve implementation of unSubCo_maybe. ab8bb48 Fix scavenge_stack crash (#9045) 1d0798c Typo in comments 3a5c549 Typo in comment 4539400 rts: Add an initial Coverity model 7400810 Revert "rts: Add an initial Coverity model" 91cc88b Add Note [Role twiddling functions] to Coercion. 275ea0f rts: Add an initial Coverity model e597f5f rts: Fix leak of file archive handle b7278d3 rts: Fix memory leak when loading ELF objects 43b3bab Rts: Consistently use StgWord for sizes of bitmaps 05fcc33 Rts: Reuse scavenge_small_bitmap (#8742) 83a003f Don't inline non-register GlobalRegs 34db5cc Replace all #!/usr/bin/perl with #!/usr/bin/env perl b0534f7 Per-thread allocation counters and limits a05f8dd Update Haddock submodule ref. Fixes `cabal test'. 5bf22f0 Remove external core 54b31f7 fix rts exported symbols base_GHCziIOziException_allocationLimitExceeded_closure 2e03d86 Update comment now that we have per-gen weak pointer lists. 5141baf Improve docs for array indexing primops f0fcc41 Revert "Per-thread allocation counters and limits" 9f3e39d Fix over-zealous unused-import warning 1302d50 Add -fno-full-laziness to get consistent profiling output cdca791 Changed profiling output is fine (according to Simon Marlow) 675c547 Improve comments and tracing in SpecConstr 3c3ce82 Modularise pretty-printing for foralls 5b73dc5 Second go at fixing #9061 13a330e Fix Trac #9071, an egregious bug in TcDeriv.inferConstraints 02227dd Add a bit more typechecker tracing 59b4e6d Adding missing test files for #9071 22ed9ef Update transformers submodule to new v0.4 rel 76820ca Improve tracing in Simplifier 0f978b5 Refactor buildClass and mkDictSelId a bit, to avoid the no_unf argument 4088799 Mark evaluated arguments in dataConInstPat 35be701 Preserve evaluated-ness in CoreTidy b5ca10c Better error message in vectoriser 12332f1 Error message wibble, presumably due to recent changes in transformers c302a46 Update .gitignore 2f9a846 testsuite: fix cgrun051 exit code 3ed867f testsuite: fix cc004 3abf949 Require transformers for T5979 fe8a378 Revert output of T5979 2745164 Comments only, on inert_fsks and inert_no_eqs 770e16f In splitHsFunType, take account of prefix (->) b5cf17f Improve desugaring of lazy pattern match 315fff6 Typo in comment 1f8f927 Typo in note 4cfc1fa Lint should check that TyConAppCo doesn't have a synonym in the tycon position 21f17d0 Fix invariant in mkAppCoFlexible 214ad2d Fix globalRegMaybe for unregisterised build. 3fd7f54 Wibble to 4cfc1fae b036424 Update Haddock submodule. 0148a1c Add strict ver. of (<$>): (<$!>) to Control.Monad dd92e21 Set cabal files to default-language:Haskell2010 88c0870 Remove LANGUAGE pragrams implied by Haskell2010 fc0ed8a Add missing stack checks to stg_ap_* functions (#9001) 913b314 Avoid NondecreasingIndentation syntax in ghc-pkg 61fdafc Drop use of CPP in `bin-package-db` d4aa4e4 Drop default-extensions:CPP in hpc-bin.cabal 2dd80f6 Convert `ghc-bin.cabal` to use others-extensions e199891 Avoid trivial cases of NondecreasingIndentation 2389244 Add LANGUAGE pragmas to compiler/ source files 9a58cac Express OPTIONS_GHC as LANGUAGE pragmas 022f875 Refactoring around TyCon.isSynTyCon bc7d49a Only uninstall signal handlers if they were actually installed (#9068) 882978d ghc: Update containers submodule 4dac3a4 base: Document Foreign.ForeignPtr (#8475) b75d126 rts: remove stable-names from hashtable upon free 39aa1e9 integer-gmp: do not confuse ./configure (#8783) 3df1c51 Extract derived constants from nm output for various OSes differently. 3a61e6d Tighten up wording in the section on let-generalisation and MonoLocalBinds eab173b Remove the bit about External Core from flags.xml 4117551 Re-add 'classP' with a compatible implementation and a deprecation notice 135489d Provide deprecated backward compatible implementation to 'equalP' a8cba19 Catch some typos 3a04ce2 Fix below warning by including "unistd.h" also a15d243 Harden imports in `DeriveConstants.hs` module 7e78faf Coercible: Unwrap newtypes before coercing under tycons 94c5767 Coercible: Test case for now broken(?) corner case 7d958ce Tweaks to note; also fixed unicode quotes bc58d2e Simple eta reduction in call to adjustMatchResults, just a tidy-up d8d9711 Make the unifier a fixpoint even for the free kind vars of a tyvar d41aa76 Better pretty-printing for ClsInst 02437a1 More debug info for failures in typeKind and kindFunResult 427e205 White space only 4dea15a Bump bytes-allocated for T3064 b33f321 Typos in comments 864759c test.mk: Be liberal in accepting GHC_PKG output b1436f5 Fix yet another bug in 'deriving' for polykinded classes (Trac #7269) db869e7 Add missing test file T7269 6ed5430 Replace DeriveDataTypeable by AutoDeriveTypeable ac2796e Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. fb74d71 Assert that matcher-derived PatSyn types match the (redundant) stored types in IfacePatSyn 2745dfb Test Trac #9144 b95dbb5 T4006, environment001, T3307 all work on msys2 8668c54 Use mkTcEqPred rather than mkEqPred in the type checker 3c1f2f7 No need to call defaultKind in mkTcEqPred e80089e Fix comment typo a518500 Update Haddock submodule. dcc6e04 Update T4891, T8639_api to follow 73c08ab10 (GHCi naming changes) 6c5017a Add .gitignore for autogenerated test files. cd14075 Fix bitrotted GHC API test T6145. a23f131 Add missing stderr file for tcrun045. fc6a952 s/implict/implicit/i a53fc11 Refresh recomp006 error message. 0c1974c Remove obsolete -fno-warn-amp from spec001 723095b Per-capability nursery weak pointer lists, fixes #9075 5a392ca Disable FixEither tests in TcCoercible a8d81af mkHiPath & mkObjPath didn't need to be in IO 994d5e3 Remove deprecated -optdep options 660c3f9 Just formatting 96a95f0 Fix missing unlockClosure() call in tryReadMVar (#9148) 9e10963 Improve Note [Order of Coercible Instances] about Trac #9117 2da439a fix missing space 09dc9a8 Rename TypeRep.Prec to TypeRep.TyPrec 0ba74f6 Use mkTcEqPred rather than mkEqPred da64c97 Fix inverted gadt-syntax flag for data families b4856f9 Do pretty-printing of TyThings via IfaceDecl (Trac #7730) 6e8861c Use IfLclName instead of OccName in IfaceEqSpec d02cd1a Add :kind test in T7730 dd99434 Comments only (related to Trac #7730) d7a228b Set/update upstream repo url for haddock fe59334 Export `TimerManager` from GHC.Event (re #9165) c63a465 Subsume NullaryTypeClasses by MultiParamTypeClasses (#8993) 0a55a3c Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) 616f54b Test Trac #9023 3faf83e Add .arcconfig file. Do not use yet. 56ea745 Add ".text.unlikely" to recognized code sections on Windows. c226d25 Emit error in case of duplicate GRE; fixes #7241 6ad11c4 Fix .arcconfig 9ff32f9 Typo 4627575 Tweak comments 2a463eb Fix compilation of cmm files with -outputdir (Trac #9050) f9def07 Typo 009e86f Suggest Int when user writes int ae41a50 Report all possible results from related name spaces d3cae19 Add testcase for #9177 and adjust test output 6e50553 Update test results (last minuite changes) 3a2b21d Added link ends to role documentation. 6fa7577 Sorted the language options list alphabetically, and added missing options. 57cc003 Prevent line wrapping after the dash of an option. 7ac600d Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds 63e1f09 Added more option implication documentation. 5c89f88 Merge branch 'master' of git://git.haskell.org/ghc 3bdc78b Make DeriveTraversable imply DeriveFunctor/Foldable 63d7047 Added testcase for #9069 1178fa4 Update mod73 test output 819e1f2 Use UnicodeSyntax when printing 6e4a750 Only use UnicodeSytanx pretty printing if the locale supports it b021572 Test case: GHCi uses UnicodeSyntax if the loaded file uses it. e577a52 Fix discarding of unreachable code in the register allocator (#9155) fbdebd3 supress warning of bang wildcard pattern-binding (i.e. let !_ = rhs). This fixes #9127 ab3f95b s/-hi-diffs/-ddump-hi-diffs/ in docs (#9179) b36bc2f Test case for #9181 (:browse GHC.TypeLits panic) 96a8980 Pretty-print built in synonym families in interfaces 2f8b4c9 Fix obscure problem with using the system linker (#8935) 9fd507e Raise exceptions when blocked in bad FDs (fixes Trac #4934) 70f58eb Remove unused --run-cps/--run-cpsz options c025817 Don't use showPass in the backend (#8973) 66bddbb Check that an associated type mentions at least one type variable from the class aa18a46 Improve documentation for -fwarn-unused-binds 52509d8 Document -fwarn-inline-rule-shadowing (Trac #9166) 59cdb99 Document explicit import/export of data constructors (Trac #8753) 4b4d81a Suggest -fprint-explicit-kinds when only kind variables are ambiguous 877a957 Better warning message for orphan instances (Ticket #9178) 4caadb7 Ship xhtml, terminfo, haskeline (#8919) 25fb4fe Add .arclint file 1946922 Make Ptr's parameter phantom 707bde5 Update test results with new orphan instance warning f251afe Revert "Make Ptr's parameter phantom" 5bdbd51 Make Ptr's parameter phantom faddad7 Improve the API doc description of the SmallArray primitive types f764aac Fire "map/coerce" only in phase 1 fdf370e Forgot to amend before pushing... 0e6bc84 Make better use of the x86 addressing mode 9e6c6b4 Make FunPtr's role be phantom; add comments. 1153194 Clarify error message. See #9167. 8dcfdf9 Add comments about instances of type-level (==). 0f584ae Refine deprecation warnings in template-haskell. 051d694 Fix #9097. 6a1d7f9 Fix #9085. e79e2c3 Fix #9062. 7b10d01 Test #9097. 9dbf340 Fix #9111. f502617 Test #9085. f73d42f Test #9111. a9ff7d0 Typo in variable name, no functional change edd5764 Some typos in comments 56f8777 Improve error message in Trac #8883 7817ec1 Comments only explaining the imports for GHC.Integer, GHC.Tuple 748bec4 White space only e5257f8 Fix tyConToIfaceDecl (Trac #9190) c8295c0 Simplify variable naming in tcDataKindSig 7d9feb2 Fix a serious, but rare, strictness analyser bug (Trac #9128) 7f467d0 Fix Windows build (wibble to fix for Trac #4934) 165ac4a Catch two typos a600c91 Improve IfaceSyn a bit further b60df0f Better debug printing 571f0ad Line up kind and type variables correctly when desugaring TH brackets b637585 Fix elemLocalRdrEnv (Trac #9160) 970e5d9 Bytes allocated by haddock.base has crept up (again) 632fcf1 Remove forgotten redundant import ce19d50 Fixes #95 :edit command should jump to the last error 0354fb3 Implement `Typeable` support for type-level literals (#8778). 5ffc68b Fix recomputation of TypeRep in the instance for Typeable (s a) (#9203) e09be5f Update the incorrect comment on when function was introduced. 836981c Redo instance to be more efficient (see #8778, #9203) 00fc4ba Optimise the Typeable instance for type app a bit, and add a perf test e38fe3b accept T9181 output 652c9e6 Haddock: haddock-library release and Travis stuff 2ba1a56 Only comments: add notes explaining the various oddities of the `Typeable` implementation for type-level literals. 2a41db3 In progress Backpack implementation docs. 46ec4ae haddock-library: allow 7.4.x building 453e0fd Typo 3d81359 Typos in comments a52bf96 Finish the rest of the writeup. b1888aa Typos in comments b6693d3 A bit more tracing of functional dependencies 0ceb84e Tidy up the printing of single-predicate contexts cdc7431 Add a new section to the manual about hiding things that a module doesn't export aec9e75 Improve documentation of defaulting rules with OverloadedStrings 2e362dd Make splitStrProdDmd (and similarly Use) more robust 64224f1 Comment typo 9c621e9 Reject forall types in constraints in signatures e47baaf More fixes and updates to implementation document 48abb88 Update documentation to follow 2dc3b476aff28 aa3166f Add fake entries into the global kind environment for pattern synonyms. b6352c9 Simplify package dump for -v4 b847481 Fix #9047 95f95ed Fix up b84748121e777d 446b0e1 arclint: disable Bad Charset lint rule 4612524 sync-all: cleanup bd07942 sync-all: delete dead code calling gitInitSubmodules 101c3f7 sync-all: die for real when required repo is missing bdb5809 sync-all: make --no-dph work for all subcommands 9a131dd sync-all: set and check variable $repo_is_submodule 72fe49d sync-all: infer remotepath from .gitmodules file 518ada5 Mark T9208 as broken when debugging is on 7a78374 More updates to Backpack impl docs. c1035d5 Fix regression in Data.Fixed Read instance (re #9231) 761c4b1 Minor refactoring of interface to extraTyVarInfo 8a0aa19 Comment the expect_broken for Trac #9208 0757831 Add Note [Placeholder PatSyn kinds] in TcBinds a4a79b5 Describe signature mini-backpack. d8abf85 Add more primops for atomic ops on byte arrays ec550e8 Fixup c1035d51e to behave more like in GHC 7.6 db19c66 Convert loose sub-repos into proper submodules (re #8545) 97ac32a Typos in comments 881be80 Fix anchors in Haddock 9833090 Fix few Haddock parser brainfarts d587ebd The linking restriction, no shaping necessary. c7dacdb sync-all: Allow - in submodule URLs c61260e Merge Thomas Miedema?s syn-all improvments 4bf3aa2 Fix sync-all get from a local working copy bcccadd Fix ?Checking for old .. repo? messages 04dd7cb Work around lack of __sync_fetch_and_nand in clang 84d7845 Lots of rewrites to further move toward new world order 950fcae Revert "Add more primops for atomic ops on byte arrays" 22c16eb Update parallel and stm submodules to have .gitignore 5bbbc7d arclint: update rules for xml files ab105f8 Add new flag -fwrite-interface for -fno-code. aa4c5e7 Add testsuite-related .gitignore files af913ad s/KnownLit/KnownSymbol/g and a typo fix 0451f91 More allDistinctTyVars from TcDeriv to Type 2be99d2 In TcValidity.checkAmbiguity, skolemise kind vars that appear free in the kinds of type variables fe0cbe4 Fix docs typo. b80d573 Refactor extension-bitmap in Lexer 05120ec Make -fno-write-interface to all modes of GHC, not just -fno-code. 5031772 Revert "Make -fno-write-interface to all modes of GHC, not just -fno-code." f4766c4 Comments only 1c0b5fd Add -XBinaryLiterals language extension (re #9224) ec38f4a Minor updates to Backpack docs. 713b271 Whitespace only 4144996 Untabify and M-x whitespace cleanup 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 007c39f New parser for pattern synonym declarations: 105f16f Update baseline shift/reduce conflict number 6986976 Add parser for pattern synonym type signatures. Syntax is of the form From git at git.haskell.org Mon Jul 14 10:22:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:22:03 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9023' deleted Message-ID: <20140714102203.1A2FD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T9023 From git at git.haskell.org Mon Jul 14 10:23:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:23:10 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T8968' created Message-ID: <20140714102310.2576F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T8968 Referencing: 698697656bb0501df40713aff847555e61b9411c From git at git.haskell.org Mon Jul 14 10:23:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:23:13 +0000 (UTC) Subject: [commit: ghc] wip/T8968: Update baseline shift/reduce conflict number (105f16f) Message-ID: <20140714102313.274922406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8968 Link : http://ghc.haskell.org/trac/ghc/changeset/105f16f1862eee9c3dd2f8eda2947552f8e570f2/ghc >--------------------------------------------------------------- commit 105f16f1862eee9c3dd2f8eda2947552f8e570f2 Author: Dr. ERDI Gergo Date: Wed Jul 2 19:18:43 2014 +0800 Update baseline shift/reduce conflict number >--------------------------------------------------------------- 105f16f1862eee9c3dd2f8eda2947552f8e570f2 compiler/parser/Parser.y.pp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 073afd8..45b0a2b 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -55,6 +55,12 @@ import Control.Monad ( mplus ) {- ----------------------------------------------------------------------------- +25 June 2014 + +Conflicts: 47 shift/reduce + 1 reduce/reduce + +----------------------------------------------------------------------------- 12 October 2012 Conflicts: 43 shift/reduce From git at git.haskell.org Mon Jul 14 10:23:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 10:23:15 +0000 (UTC) Subject: [commit: ghc] wip/T8968: Add parser for pattern synonym type signatures. Syntax is of the form (6986976) Message-ID: <20140714102315.B40122406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8968 Link : http://ghc.haskell.org/trac/ghc/changeset/698697656bb0501df40713aff847555e61b9411c/ghc >--------------------------------------------------------------- commit 698697656bb0501df40713aff847555e61b9411c Author: Dr. ERDI Gergo Date: Mon Jul 14 18:18:44 2014 +0800 Add parser for pattern synonym type signatures. Syntax is of the form pattern type Eq a => P a T b :: Num b => R a b which declares a pattern synonym called P, with argument types a, T, and b. >--------------------------------------------------------------- 698697656bb0501df40713aff847555e61b9411c compiler/hsSyn/HsBinds.lhs | 1 + compiler/hsSyn/HsTypes.lhs | 2 +- compiler/parser/Parser.y.pp | 12 ++++++++---- compiler/parser/RdrHsSyn.lhs | 29 ++++++++++++++++++++++++++++- 4 files changed, 38 insertions(+), 6 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 2261a89..3b3f3f8 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -717,6 +717,7 @@ pprPatSynSig :: (OutputableBndr a) => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> Maybe SDoc -> Maybe SDoc -> SDoc pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta = sep [ ptext (sLit "pattern") + , ptext (sLit "type") , thetaOpt prov_theta, name_and_args , colon , thetaOpt req_theta, rhs_ty diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 08a0eef..52b919e 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -31,7 +31,7 @@ module HsTypes ( hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, - splitHsFunType, + splitHsFunType, splitLHsForAllTy, splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy, -- Printing diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 45b0a2b..4773e9b 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -829,12 +829,15 @@ role : VARID { L1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl RdrName } : 'pattern' pat '=' pat {% do { (name, args) <- splitPatSyn $2 - ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional - }} + ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional }} | 'pattern' pat '<-' pat {% do { (name, args) <- splitPatSyn $2 - ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional - }} + ; return . LL $ ValD $ mkPatSynBind name args $4 Unidirectional }} + +pattern_synonym_sig :: { LSig RdrName } + : 'pattern' 'type' ctype '::' ctype + {% do { (name, details, ty, prov, req) <- splitPatSynSig $3 $5 + ; return . LL $ PatSynSig name details ty prov req }} vars0 :: { [Located RdrName] } : {- empty -} { [] } @@ -1445,6 +1448,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } { LL $ toOL [ LL $ SigD (TypeSig ($1 : reverse (unLoc $3)) $5) ] } | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | n <- unLoc $3 ] } + | pattern_synonym_sig { LL . unitOL $ LL . SigD . unLoc $ $1 } | '{-# INLINE' activation qvar '#-}' { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) } | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}' diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 0536286..cd025a7 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -16,7 +16,7 @@ module RdrHsSyn ( mkTySynonym, mkTyFamInstEqn, mkTyFamInst, mkFamDecl, - splitCon, splitPatSyn, mkInlinePragma, + splitCon, splitPatSyn, splitPatSynSig, mkInlinePragma, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -431,6 +431,33 @@ splitPatSyn pat@(L loc (ConPatIn con details)) = do splitPatSyn pat@(L loc _) = parseErrorSDoc loc $ text "invalid pattern synonym declaration:" $$ ppr pat +-- Given two types like +-- Eq a => P a T b +-- and +-- Num b => R a b +-- +-- This returns +-- P as the name, +-- PrefixPatSyn [a, T, b] as the details, +-- R a b as the result type, +-- and (Eq a) and (Num b) as the provided and required thetas (respectively) +splitPatSynSig :: LHsType RdrName + -> LHsType RdrName + -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, LHsContext RdrName, LHsContext RdrName) +splitPatSynSig lty1 lty2 = do + (name, details) <- splitCon pat_ty + details' <- case details of + PrefixCon tys -> return $ PrefixPatSyn tys + InfixCon ty1 ty2 -> return $ InfixPatSyn ty1 ty2 + RecCon{} -> parseErrorSDoc (getLoc lty1) $ + text "record syntax not supported for pattern synonym declarations:" $$ ppr lty1 + return (name, details', res_ty, prov', req') + where + (_, prov, pat_ty) = splitLHsForAllTy lty1 + (_, req, res_ty) = splitLHsForAllTy lty2 + prov' = L (getLoc lty1) prov + req' = L (getLoc lty2) req + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] From git at git.haskell.org Mon Jul 14 11:03:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 11:03:19 +0000 (UTC) Subject: [commit: ghc] master: Update various performance benchmarks (194107e) Message-ID: <20140714110319.AB6512406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/194107ea9333c1d9d61abf307db2da6a699847af/ghc >--------------------------------------------------------------- commit 194107ea9333c1d9d61abf307db2da6a699847af Author: Joachim Breitner Date: Mon Jul 14 13:02:07 2014 +0200 Update various performance benchmarks I started monitoring perfomance on a per-commit base. These seem to be off for a while now. Adjusting them, and from now I hope I can keep closer tabs on them. >--------------------------------------------------------------- 194107ea9333c1d9d61abf307db2da6a699847af testsuite/tests/perf/compiler/all.T | 11 +++++++---- testsuite/tests/perf/haddock/all.T | 16 +++++++++------- testsuite/tests/perf/should_run/all.T | 4 +++- 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 3851eef..ba2ebd5 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -120,7 +120,7 @@ test('T3294', # 2013-02-10 20772984 (x86/OSX) # 2013-11-13 24009436 (x86/Windows, 64bit machine) # 2014-04-24 19882188 (x86/Windows, 64bit machine) - (wordsize(64), 43224080, 15)]), + (wordsize(64), 40000000, 15)]), # prev: 25753192 (amd64/Linux) # 29/08/2012: 37724352 (amd64/Linux) # (increase due to new codegen, see #7198) @@ -130,6 +130,8 @@ test('T3294', # (reason for decrease unknown) # 29/5/2013: 43224080 (amd64/Linux) # (reason for increase back to earlier value unknown) + # 2014-07-14: 36670800 (amd64/Linux) + # (reason unknown, setting expected value somewhere in between) compiler_stats_num_field('bytes allocated', [(wordsize(32), 1377050640, 5), @@ -404,12 +406,13 @@ test('T6048', # prev: 38000000 (x86/Linux) # 2012-10-08: 48887164 (x86/Linux) # 2014-04-04: 62618072 (x86 Windows, 64 bit machine) - (wordsize(64), 110646312, 12)]) - # 18/09/2012 97247032 amd64/Linux + (wordsize(64), 125431448, 12)]) + # 18/09/2012 97247032 amd64/Linux # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr) - # 18/01/2014 95960720 amd64/Linux Call Arity improvements + # 18/01/2014 95960720 amd64/Linux Call Arity improvements # 28/02/2014 105556793 amd64/Linux (unknown, tweak in base/4d9e7c9e3 resulted in change) # 05/03/2014 110646312 amd64/Linux Call Arity became more elaborate + # 14/07/2014 125431448 amd64/Linux unknown reason. Even worse in GHC-7.8.3. *shurg* ], compile,['']) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index cafe738..647a562 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -60,7 +60,7 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 278, 10) + [(wordsize(64), 309, 10) # 2012-08-14: 202 (amd64/Linux) # 2012-08-29: 211 (amd64/Linux, new codegen) # 2012-09-20: 227 (amd64/Linux) @@ -68,6 +68,7 @@ test('haddock.Cabal', # 2013-06-07: 246 (amd64/Linux) (reason unknown) # 2013-11-21: 269 # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) + # 2014-07-14: 309 (amd64/Linux) ,(platform('i386-unknown-mingw32'), 144, 10) # 2012-10-30: 83 (x86/Windows) # 2013-02-10: 116 (x86/Windows) @@ -80,12 +81,13 @@ test('haddock.Cabal', # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) # 2014-06-29: 147 (x86/Linux) ,stats_num_field('max_bytes_used', - [(wordsize(64), 95356616, 15) - # 2012-08-14: 74119424 (amd64/Linux) - # 2012-08-29: 77992512 (amd64/Linux, new codegen) - # 2012-10-02: 91341568 (amd64/Linux) - # 2012-10-08: 80590280 (amd64/Linux) - # 2013-03-13: 95356616 (amd64/Linux) Cabal updated + [(wordsize(64), 113232208, 15) + # 2012-08-14: 74119424 (amd64/Linux) + # 2012-08-29: 77992512 (amd64/Linux, new codegen) + # 2012-10-02: 91341568 (amd64/Linux) + # 2012-10-08: 80590280 (amd64/Linux) + # 2013-03-13: 95356616 (amd64/Linux) Cabal updated + # 2014-07-14: 113232208 (amd64/Linux) ,(platform('i386-unknown-mingw32'), 63493200, 15) # 2012-10-30: 44224896 (x86/Windows) # 2013-11-13: 49391436 (x86/Windows, 64bit machine) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 4fa77a5..e9e7ef3 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -371,7 +371,9 @@ test('InlineCloneArrayAlloc', test('T9203', [stats_num_field('bytes allocated', [ (wordsize(32), 50000000, 5) - , (wordsize(64), 95747304, 5) ]), + , (wordsize(64), 42946176, 5) ]), + # previously: 95747304 + # 2014-07-14: 42946176 (amd64/Linux) only_ways(['normal'])], compile_and_run, ['-O2']) From git at git.haskell.org Mon Jul 14 11:31:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 11:31:24 +0000 (UTC) Subject: [commit: ghc] master: New testsuite verbosity level 4 (cfeeded) Message-ID: <20140714113124.9EAC82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cfeededff5662a6e2dc0104eb00adcca4d4ae984/ghc >--------------------------------------------------------------- commit cfeededff5662a6e2dc0104eb00adcca4d4ae984 Author: Joachim Breitner Date: Mon Jul 14 13:29:47 2014 +0200 New testsuite verbosity level 4 which makes it print performance numbers even when the test succeeds (good for historic analysis) >--------------------------------------------------------------- cfeededff5662a6e2dc0104eb00adcca4d4ae984 testsuite/driver/runtests.py | 4 ++-- testsuite/driver/testlib.py | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index c92eaef..103c7ac 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -98,8 +98,8 @@ for opt,arg in opts: config.skip_perf_tests = True if opt == '--verbose': - if arg not in ["0","1","2","3"]: - sys.stderr.write("ERROR: requested verbosity %s not supported, use 0,1,2 or 3" % arg) + if arg not in ["0","1","2","3","4"]: + sys.stderr.write("ERROR: requested verbosity %s not supported, use 0,1,2,3 or 4" % arg) sys.exit(1) config.verbose = int(arg) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 3479b6a..e44f5f5 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1052,7 +1052,7 @@ def checkStats(stats_file, range_fields): print field, 'value is too high:' result = failBecause('stat not good enough') - if val < lowerBound or val > upperBound: + if val < lowerBound or val > upperBound or config.verbose >= 4: valStr = str(val) valLen = len(valStr) expectedStr = str(expected) From git at git.haskell.org Mon Jul 14 11:31:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 11:31:27 +0000 (UTC) Subject: [commit: ghc] master: Give performance benchmark deviation also in percents (300c721) Message-ID: <20140714113127.B7A1A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/300c7217fce003e9a620e297c625ab26f31f6949/ghc >--------------------------------------------------------------- commit 300c7217fce003e9a620e297c625ab26f31f6949 Author: Joachim Breitner Date: Mon Jul 14 13:30:24 2014 +0200 Give performance benchmark deviation also in percents this makes it easier to spot a ?just over the mark? change (e.g. +5.1%), compared to a more radical jump (e.g. +15%). >--------------------------------------------------------------- 300c7217fce003e9a620e297c625ab26f31f6949 testsuite/driver/testlib.py | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index e44f5f5..f3bfd58 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1040,8 +1040,10 @@ def checkStats(stats_file, range_fields): result = failBecause('no such stats field') val = int(m.group(1)) - lowerBound = trunc( expected * ((100 - float(dev))/100)); - upperBound = trunc(0.5 + ceil(expected * ((100 + float(dev))/100))); + lowerBound = trunc( expected * ((100 - float(dev))/100)) + upperBound = trunc(0.5 + ceil(expected * ((100 + float(dev))/100))) + + deviation = round(((val * 100)/ expected) - 100, 1) if val < lowerBound: print field, 'value is too low:' @@ -1064,6 +1066,8 @@ def checkStats(stats_file, range_fields): display(' Lower bound ' + field + ':', lowerBound, '') display(' Upper bound ' + field + ':', upperBound, '') display(' Actual ' + field + ':', val, '') + if val != expected: + display(' Deviation ' + field + ':', deviation, '%') return result From git at git.haskell.org Mon Jul 14 12:42:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 12:42:07 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' created Message-ID: <20140714124208.C93632406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/travis Referencing: 87f3b01ea49ef866b50f900eda7b554f82d17aaf From git at git.haskell.org Mon Jul 14 12:42:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 12:42:10 +0000 (UTC) Subject: [commit: ghc] wip/travis: Traivs: See if we can afford to run the performance benchmarks (87f3b01) Message-ID: <20140714124210.69C082406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/87f3b01ea49ef866b50f900eda7b554f82d17aaf/ghc >--------------------------------------------------------------- commit 87f3b01ea49ef866b50f900eda7b554f82d17aaf Author: Joachim Breitner Date: Mon Jul 14 14:41:17 2014 +0200 Traivs: See if we can afford to run the performance benchmarks we have ~15 minutes until the limit, so lets try this. >--------------------------------------------------------------- 87f3b01ea49ef866b50f900eda7b554f82d17aaf .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5dc1e53..9919538 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=3 PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Mon Jul 14 12:52:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 12:52:57 +0000 (UTC) Subject: [commit: ghc] tag 'ghc-7.8.3-release' created Message-ID: <20140714125257.8E9962406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New tag : ghc-7.8.3-release Referencing: 4b1bcd4bfed2de5a1cd5ab2eb64e396ae647d963 From git at git.haskell.org Mon Jul 14 12:53:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 12:53:16 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: RELEASE=NO (dc6a60a) Message-ID: <20140714125316.888AF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/dc6a60a74a9aa2301dadeeb3b67a9d1b2d41c353/ghc >--------------------------------------------------------------- commit dc6a60a74a9aa2301dadeeb3b67a9d1b2d41c353 Author: Austin Seipp Date: Mon Jul 14 07:52:27 2014 -0500 RELEASE=NO Signed-off-by: Austin Seipp >--------------------------------------------------------------- dc6a60a74a9aa2301dadeeb3b67a9d1b2d41c353 configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index f3ae26e..8f53bdf 100644 --- a/configure.ac +++ b/configure.ac @@ -16,7 +16,7 @@ dnl AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.3], [glasgow-haskell-bugs at haskell.org], [ghc]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=YES} +: ${RELEASE=NO} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the From git at git.haskell.org Mon Jul 14 17:28:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 17:28:34 +0000 (UTC) Subject: [commit: ghc] master: Partially revert 194107ea9333c1d9d61abf307db2da6a699847af (4690466) Message-ID: <20140714172834.B71202406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4690466de2249fd73600567bd90d462ac26b2d1c/ghc >--------------------------------------------------------------- commit 4690466de2249fd73600567bd90d462ac26b2d1c Author: Austin Seipp Date: Mon Jul 14 12:27:58 2014 -0500 Partially revert 194107ea9333c1d9d61abf307db2da6a699847af This reverts the numbers for T9203. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4690466de2249fd73600567bd90d462ac26b2d1c testsuite/tests/perf/should_run/all.T | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index e9e7ef3..4fa77a5 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -371,9 +371,7 @@ test('InlineCloneArrayAlloc', test('T9203', [stats_num_field('bytes allocated', [ (wordsize(32), 50000000, 5) - , (wordsize(64), 42946176, 5) ]), - # previously: 95747304 - # 2014-07-14: 42946176 (amd64/Linux) + , (wordsize(64), 95747304, 5) ]), only_ways(['normal'])], compile_and_run, ['-O2']) From git at git.haskell.org Mon Jul 14 18:58:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 18:58:33 +0000 (UTC) Subject: [commit: ghc] wip/travis: Traivs: See if we can afford to run the performance benchmarks (9249fe5) Message-ID: <20140714185833.ED6A32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/9249fe5acef77fc5d18c492c12507f235dc3ad6c/ghc >--------------------------------------------------------------- commit 9249fe5acef77fc5d18c492c12507f235dc3ad6c Author: Joachim Breitner Date: Mon Jul 14 14:41:17 2014 +0200 Traivs: See if we can afford to run the performance benchmarks we have ~15 minutes until the limit, so lets try this. >--------------------------------------------------------------- 9249fe5acef77fc5d18c492c12507f235dc3ad6c .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5dc1e53..9919538 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=3 PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Mon Jul 14 18:58:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 18:58:35 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: Traivs: See if we can afford to run the performance benchmarks (9249fe5) Message-ID: <20140714185835.EF8092406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: 4690466 Partially revert 194107ea9333c1d9d61abf307db2da6a699847af 9249fe5 Traivs: See if we can afford to run the performance benchmarks From git at git.haskell.org Mon Jul 14 21:23:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 21:23:05 +0000 (UTC) Subject: [commit: ghc] master: Add a clarifying comment about scoping of type variables in associated type decls (c973c70) Message-ID: <20140714212305.C54BA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c973c70a2147358e0f5489a2906723fd2ef3fc33/ghc >--------------------------------------------------------------- commit c973c70a2147358e0f5489a2906723fd2ef3fc33 Author: Simon Peyton Jones Date: Wed Jul 2 23:05:52 2014 +0100 Add a clarifying comment about scoping of type variables in associated type decls >--------------------------------------------------------------- c973c70a2147358e0f5489a2906723fd2ef3fc33 compiler/typecheck/TcHsType.lhs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index eb3dd32..723206b 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1307,6 +1307,11 @@ tcTyClTyVars tycon (HsQTvs { hsq_kvs = hs_kvs, hsq_tvs = hs_tvs }) thing_inside ; tvs <- zipWithM tc_hs_tv hs_tvs kinds ; tcExtendTyVarEnv tvs (thing_inside (kvs ++ tvs) res) } where + -- In the case of associated types, the renamer has + -- ensured that the names are in commmon + -- e.g. class C a_29 where + -- type T b_30 a_29 :: * + -- Here the a_29 is shared tc_hs_tv (L _ (UserTyVar n)) kind = return (mkTyVar n kind) tc_hs_tv (L _ (KindedTyVar n hs_k)) kind = do { tc_kind <- tcLHsKind hs_k ; checkKind kind tc_kind From git at git.haskell.org Mon Jul 14 21:23:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 14 Jul 2014 21:23:08 +0000 (UTC) Subject: [commit: ghc] master: White space only (f6f4f54) Message-ID: <20140714212309.33D352406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6f4f54618cc27e7d9ed1a4cc110c6cb120454bc/ghc >--------------------------------------------------------------- commit f6f4f54618cc27e7d9ed1a4cc110c6cb120454bc Author: Simon Peyton Jones Date: Wed Jul 2 23:08:00 2014 +0100 White space only >--------------------------------------------------------------- f6f4f54618cc27e7d9ed1a4cc110c6cb120454bc compiler/typecheck/TcTyDecls.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index fcb8c03..262aa51 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -121,7 +121,7 @@ synTyConsOfType ty mkSynEdges :: [LTyClDecl Name] -> [(LTyClDecl Name, Name, [Name])] mkSynEdges syn_decls = [ (ldecl, name, nameSetToList fvs) | ldecl@(L _ (SynDecl { tcdLName = L _ name - , tcdFVs = fvs })) <- syn_decls ] + , tcdFVs = fvs })) <- syn_decls ] calcSynCycles :: [LTyClDecl Name] -> [SCC (LTyClDecl Name)] calcSynCycles = stronglyConnCompFromEdgedVertices . mkSynEdges From git at git.haskell.org Tue Jul 15 06:57:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Jul 2014 06:57:15 +0000 (UTC) Subject: [commit: ghc] master: Define PrelNames.allNameStrings and use it in TcHsType (f692e8e) Message-ID: <20140715065715.6D7112406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f692e8e7cde712cc4dce4245d5745063fd8b0626/ghc >--------------------------------------------------------------- commit f692e8e7cde712cc4dce4245d5745063fd8b0626 Author: Simon Peyton Jones Date: Tue Jul 15 07:39:51 2014 +0100 Define PrelNames.allNameStrings and use it in TcHsType Refactoring only. >--------------------------------------------------------------- f692e8e7cde712cc4dce4245d5745063fd8b0626 compiler/prelude/PrelNames.lhs | 13 +++++++++++++ compiler/typecheck/TcHsType.lhs | 7 ++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 395ffbb..01c5764 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -130,6 +130,19 @@ import FastString %************************************************************************ %* * + allNameStrings +%* * +%************************************************************************ + +\begin{code} +allNameStrings :: [String] +-- Infinite list of a,b,c...z, aa, ab, ac, ... etc +allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ] +\end{code} + + +%************************************************************************ +%* * \subsection{Local Names} %* * %************************************************************************ diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 723206b..cdeb191 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -76,7 +76,7 @@ import Util import Data.Maybe( isNothing ) import Control.Monad ( unless, when, zipWithM ) -import PrelNames( ipClassName, funTyConKey ) +import PrelNames( ipClassName, funTyConKey, allNameStrings ) \end{code} @@ -1330,7 +1330,7 @@ tcDataKindSig kind ; us <- newUniqueSupply ; rdr_env <- getLocalRdrEnv ; let uniqs = uniqsFromSupply us - occs = [ occ | str <- strs + occs = [ occ | str <- allNameStrings , let occ = mkOccName tvName str , isNothing (lookupLocalRdrOcc rdr_env occ) ] -- Note [Avoid name clashes for associated data types] @@ -1342,9 +1342,6 @@ tcDataKindSig kind mk_tv loc uniq occ kind = mkTyVar (mkInternalName uniq occ loc) kind - strs :: [String] - strs = [ c:cs | cs <- "" : strs, c <- ['a'..'z'] ] - badKindSig :: Kind -> SDoc badKindSig kind = hang (ptext (sLit "Kind signature on data type declaration has non-* return kind")) From git at git.haskell.org Tue Jul 15 06:57:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Jul 2014 06:57:19 +0000 (UTC) Subject: [commit: ghc] master: Entirely re-jig the handling of default type-family instances (fixes Trac #9063) (9b8ba62) Message-ID: <20140715065719.1C18E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9b8ba62991ae22420a0c4486127a3b22ee7f22bd/ghc >--------------------------------------------------------------- commit 9b8ba62991ae22420a0c4486127a3b22ee7f22bd Author: Simon Peyton Jones Date: Tue Jul 15 07:43:55 2014 +0100 Entirely re-jig the handling of default type-family instances (fixes Trac #9063) In looking at Trac #9063 I decided to re-design the default instances for associated type synonyms. Previously it was all jolly complicated, to support generality that no one wanted, and was arguably undesirable. Specifically * The default instance for an associated type can have only type variables on the LHS. (Not type patterns.) * There can be at most one default instances declaration for each associated type. To achieve this I had to do a surprisingly large amount of refactoring of HsSyn, specifically to parameterise HsDecls.TyFamEqn over the type of the LHS patterns. That change in HsDecls has a (trivial) knock-on effect in Haddock, so this commit does a submodule update too. The net result is good though. The code is simpler; the language specification is simpler. Happy days. Trac #9263 and #9264 are thereby fixed as well. >--------------------------------------------------------------- 9b8ba62991ae22420a0c4486127a3b22ee7f22bd compiler/deSugar/DsMeta.hs | 8 +- compiler/hsSyn/Convert.lhs | 15 +- compiler/hsSyn/HsDecls.lhs | 97 +++++---- compiler/iface/IfaceSyn.lhs | 23 ++- compiler/iface/MkIface.lhs | 91 +++++---- compiler/iface/TcIface.lhs | 11 +- compiler/parser/RdrHsSyn.lhs | 74 +++++-- compiler/rename/RnSource.lhs | 45 +++-- compiler/typecheck/TcDeriv.lhs | 4 +- compiler/typecheck/TcInstDcls.lhs | 93 +++++---- compiler/typecheck/TcRnDriver.lhs | 13 +- compiler/typecheck/TcTyClsDecls.lhs | 224 +++++++++++---------- compiler/typecheck/TcValidity.lhs | 25 +-- compiler/types/Class.lhs | 47 ++++- docs/users_guide/glasgow_exts.xml | 103 +++++++--- .../indexed-types/should_fail/Overlap4.stderr | 1 - .../indexed-types/should_fail/Overlap5.stderr | 7 +- .../indexed-types/should_fail/SimpleFail1a.stderr | 2 +- .../indexed-types/should_fail/SimpleFail1b.stderr | 2 +- .../indexed-types/should_fail/SimpleFail4.stderr | 10 +- testsuite/tests/parser/should_fail/T8506.stderr | 2 +- .../tests/parser/should_fail/readFail025.stderr | 2 +- testsuite/tests/polykinds/Makefile | 6 + testsuite/tests/polykinds/T7939a.stderr | 2 +- testsuite/tests/polykinds/T9063.hs | 16 ++ testsuite/tests/polykinds/T9263.hs | 2 + testsuite/tests/polykinds/T9263a.hs | 9 + testsuite/tests/polykinds/T9263b.hs | 8 + testsuite/tests/polykinds/T9264.hs | 6 + testsuite/tests/polykinds/all.T | 3 + .../tests/typecheck/should_compile/T5481.stderr | 8 +- testsuite/tests/typecheck/should_compile/tc253.hs | 7 +- .../typecheck/should_fail/AssocTyDef02.stderr | 10 +- .../typecheck/should_fail/AssocTyDef03.stderr | 2 +- .../typecheck/should_fail/AssocTyDef04.stderr | 2 +- .../typecheck/should_fail/AssocTyDef05.stderr | 4 +- .../typecheck/should_fail/AssocTyDef06.stderr | 9 +- utils/haddock | 2 +- 38 files changed, 616 insertions(+), 379 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9b8ba62991ae22420a0c4486127a3b22ee7f22bd From git at git.haskell.org Tue Jul 15 08:18:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Jul 2014 08:18:24 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation of :set/:seti (d761654) Message-ID: <20140715081824.BAAC12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d76165412a07f57bc21e3d7ac42ef9ea231d04e2/ghc >--------------------------------------------------------------- commit d76165412a07f57bc21e3d7ac42ef9ea231d04e2 Author: Simon Peyton Jones Date: Tue Jul 15 09:18:05 2014 +0100 Improve documentation of :set/:seti Prompted by Trac #9299 >--------------------------------------------------------------- d76165412a07f57bc21e3d7ac42ef9ea231d04e2 docs/users_guide/ghci.xml | 82 ++++++++++++++++++++++----------------- docs/users_guide/glasgow_exts.xml | 2 +- 2 files changed, 47 insertions(+), 37 deletions(-) diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index 50b59e9..729f96f 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -3296,12 +3296,38 @@ Prelude> :set -fno-warn-incomplete-patterns -XNoMultiParamTypeClasses Setting options for interactive evaluation only - GHCi actually maintains two sets of options: one set that - applies when loading modules, and another set that applies for - expressions and commands typed at the prompt. The - :set command modifies both, but there is + GHCi actually maintains two sets of options: + + + The loading options apply when loading modules + + + The interactive options apply when evaluating expressions and commands typed at the GHCi prompt. + + +The :set command modifies both, but there is also a :seti command (for "set - interactive") that affects only the second set. + interactive") that affects only the interactive options set. + + + + It is often useful to change the interactive options, + without having that option apply to loaded modules + too. For example + +:seti -XMonoLocalBinds + + It would be undesirable if were to + apply to loaded modules too: that might cause a compilation error, but + more commonly it will cause extra recompilation, because GHC will think + that it needs to recompile the module because the flags have changed. + + + + If you are setting language options in your .ghci file, it is good practice + to use :seti rather than :set, + unless you really do want them to apply to all modules you + load in GHCi. @@ -3309,8 +3335,6 @@ Prelude> :set -fno-warn-incomplete-patterns -XNoMultiParamTypeClasses :set and :seti commands respectively, with no arguments. For example, in a clean GHCi session we might see something like this: - - Prelude> :seti base language is: Haskell2010 @@ -3324,38 +3348,24 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified warning settings: - - Note that the option - is on, because we apply special defaulting rules to + + +The two sets of options are initialised as follows. First, both sets of options +are initialised as described in . +Then the interactive options are modified as follows: + + + The option + is enabled, in order to apply special defaulting rules to expressions typed at the prompt (see ). - - - - Furthermore, the Monomorphism Restriction is disabled by default in - GHCi (see ). - - - - It is often useful to change the language options for expressions typed - at the prompt only, without having that option apply to loaded modules - too. For example - -:seti -XMonoLocalBinds - - It would be undesirable if were to - apply to loaded modules too: that might cause a compilation error, but - more commonly it will cause extra recompilation, because GHC will think - that it needs to recompile the module because the flags have changed. - + - - It is therefore good practice if you are setting language - options in your .ghci file, to use - :seti rather than :set - unless you really do want them to apply to all modules you - load in GHCi. - + + The Monomorphism Restriction is disabled (see ). + + + diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 42e04fc..85c8a80 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -8162,7 +8162,7 @@ scope over the methods defined in the where part. For exampl of the Haskell Report) can be completely switched off by . Since GHC 7.8.1, the monomorphism -restriction is switched off by default in GHCi. +restriction is switched off by default in GHCi's interactive options (see ). From git at git.haskell.org Tue Jul 15 16:40:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Jul 2014 16:40:55 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation of overlapping instances (again) (0fcf060) Message-ID: <20140715164055.618AA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0fcf060418167e05adfbde174b2f030077cb1c1b/ghc >--------------------------------------------------------------- commit 0fcf060418167e05adfbde174b2f030077cb1c1b Author: Simon Peyton Jones Date: Tue Jul 15 17:40:39 2014 +0100 Improve documentation of overlapping instances (again) Prompted by Trac #9288 >--------------------------------------------------------------- 0fcf060418167e05adfbde174b2f030077cb1c1b docs/users_guide/glasgow_exts.xml | 128 ++++++++++++++++++++++---------------- 1 file changed, 73 insertions(+), 55 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 85c8a80..9acb56f 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5011,7 +5011,8 @@ with N. In general, as discussed in , GHC requires that it be unambiguous which instance declaration -should be used to resolve a type-class constraint. This behaviour +should be used to resolve a type-class constraint. +This behaviour can be modified by two flags: -XOverlappingInstances @@ -5020,6 +5021,8 @@ and , as this section discusses. Both these flags are dynamic flags, and can be set on a per-module basis, using an LANGUAGE pragma if desired (). + + The flag instructs GHC to loosen the instance resolution described in , by @@ -5027,18 +5030,83 @@ allowing more than one instance to match, provided there is a most specific one. The flag further loosens the resolution, by allowing more than one instance to match, irespective of whether there is a most specific one. +The flag implies the + flag, but not vice versa. -For example, consider +A more precise specification is as follows. +The willingness to be overlapped or incoherent is a property of +the instance declaration itself, controlled by the +presence or otherwise of the +and flags when that instance declaration is +being compiled. Now suppose that, in some client module, we are searching for an instance of the +target constraint (C ty1 .. tyn). +The search works like this. + + +Find all instances I that match the target constraint; +that is, the target constraint is a substitution instance of I. These +instance declarations are the candidates. + + + +Find all non-candidate instances +that unify with the target constraint. +Such non-candidates instances might match when the target constraint is further +instantiated. If all of them were compiled with +, proceed; if not, the search fails. + + + +Eliminate any candidate IX for which both of the following hold: + + +There is another candidate IY that is strictly more specific; +that is, IY is a substitution instance of IX but not vice versa. + +Either IX or IY was compiled with +. + + + + + + +If only one candidate remains, pick it. +Otherwise if all remaining candidates were compiled with +, pick an arbitrary candidate. + + + +These rules make it possible for a library author to design a library that relies on +overlapping instances without the library client having to know. + + +Errors are reported lazily (when attempting to solve a constraint), rather than eagerly +(when the instances themselves are defined). So for example + + instance C Int b where .. + instance C a Bool where .. + +These potentially overlap, but GHC will not complain about the instance declarations +themselves, regardless of flag settings. If we later try to solve the constraint +(C Int Char) then only the first instance matches, and all is well. +Similarly with (C Bool Bool). But if we try to solve (C Int Bool), +both instances match and an error is reported. + + + +As a more substantial example of the rules in action, consider instance context1 => C Int b where ... -- (A) instance context2 => C a Bool where ... -- (B) instance context3 => C a [b] where ... -- (C) instance context4 => C Int [Int] where ... -- (D) -compiled with enabled. The constraint -C Int [Int] matches instances (A), (C) and (D), but the last +compiled with enabled. Now suppose that the type inference +engine needs to solve The constraint +C Int [Int]. This constraint matches instances (A), (C) and (D), but the last is more specific, and hence is chosen. If (D) did not exist then (A) and (C) would still be matched, but neither is @@ -5054,7 +5122,7 @@ the head of former is a substitution instance of the latter. For example substituting a:=Int. -However, GHC is conservative about committing to an overlapping instance. For example: +GHC is conservative about committing to an overlapping instance. For example: f :: [b] -> [b] f x = ... @@ -5151,56 +5219,6 @@ the program prints would be to reject module Help on the grounds that a later instance declaration might overlap the local one.) - -The willingness to be overlapped or incoherent is a property of -the instance declaration itself, controlled by the -presence or otherwise of the -and flags when that module is -being defined. Suppose we are searching for an instance of the -target constraint (C ty1 .. tyn). -The search works like this. - - -Find all instances I that match the target constraint; -that is, the target constraint is a substitution instance of I. These -instance declarations are the candidates. - - - -Find all non-candidate instances -that unify with the target constraint. -Such non-candidates instances might match when the target constraint is further -instantiated. If all of them were compiled with -, proceed; if not, the search fails. - - - -Eliminate any candidate IX for which both of the following hold: - - -There is another candidate IY that is strictly more specific; -that is, IY is a substitution instance of IX but not vice versa. - -Either IX or IY was compiled with -. - - - - - - -If only one candidate remains, pick it. -Otherwise if all remaining candidates were compiled with -, pick an arbitrary candidate. - - - -These rules make it possible for a library author to design a library that relies on -overlapping instances without the library client having to know. - -The flag implies the - flag, but not vice versa. - From git at git.haskell.org Tue Jul 15 20:47:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Jul 2014 20:47:04 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9233' created Message-ID: <20140715204705.094192406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9233 Referencing: 6772f8f2ac70fa6dc246aff001ddbd1533db4b5b From git at git.haskell.org Tue Jul 15 20:47:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Jul 2014 20:47:07 +0000 (UTC) Subject: [commit: ghc] wip/T9233: Address #9233. (6772f8f) Message-ID: <20140715204707.9E7982406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9233 Link : http://ghc.haskell.org/trac/ghc/changeset/6772f8f2ac70fa6dc246aff001ddbd1533db4b5b/ghc >--------------------------------------------------------------- commit 6772f8f2ac70fa6dc246aff001ddbd1533db4b5b Author: Richard Eisenberg Date: Tue Jul 15 16:45:06 2014 -0400 Address #9233. The implementation of coercionRole on an NthCo coercion was terrible terrible terrible when called on deeply-nested NthCo's. This commit includes a streamlined algorithm to get this role. >--------------------------------------------------------------- 6772f8f2ac70fa6dc246aff001ddbd1533db4b5b compiler/types/Coercion.lhs | 35 ++++++++++++++++++++++++++++++++--- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index b33eae9..3c1221a 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -1854,13 +1854,42 @@ coercionRole = go go (UnivCo r _ _) = r go (SymCo co) = go co go (TransCo co1 _) = go co1 -- same as go co2 - go (NthCo n co) = let Pair ty1 _ = coercionKind co - (tc, _) = splitTyConApp ty1 - in nthRole (coercionRole co) tc n + go (NthCo n co) = nthCoRole n co go (LRCo _ _) = Nominal go (InstCo co _) = go co go (SubCo _) = Representational go (AxiomRuleCo c _ _) = coaxrRole c + +-- | Gets the role of an NthCo. This is implemented separately +-- because the naive version was very very slow. See #9233. +nthCoRole :: Int -> Coercion -> Role +nthCoRole n0 co0 + | Representational <- r + = nthRole r tc n0 + | otherwise + = r -- Nominal and Phantom are simpler! + where + (tc, r) = tycon_role co0 + + tycon_role (Refl r ty) + = (tyConAppTyCon ty, r) + tycon_role (TyConAppCo r tc _) = (tc, r) + tycon_role (CoVarCo cv) + = (tyConAppTyCon $ fst $ coVarKind cv, coVarRole cv) + tycon_role (UnivCo r ty1 _) + = (tyConAppTyCon ty1, r) + tycon_role (SymCo co) = tycon_role co + tycon_role (TransCo co1 _) = tycon_role co1 + tycon_role (NthCo n co) + = case tycon_role co of + (tc1, Representational) -> (tc1, nthRole Representational tc1 n) + (_, role) -> (panic "tycon_role NthCo", role) + tycon_role (LRCo {}) + = (panic "tycon_role LRCo", Nominal) + tycon_role co + -- can't really improve upon other algorithms in other cases + = (tyConAppTyCon $ pFst $ coercionKind co, coercionRole co) + \end{code} Note [Nested InstCos] From git at git.haskell.org Wed Jul 16 12:01:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Jul 2014 12:01:00 +0000 (UTC) Subject: [commit: ghc] wip/T9233: Rewrite coercionRole. (#9233) (0dddca3) Message-ID: <20140716120100.F39FC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9233 Link : http://ghc.haskell.org/trac/ghc/changeset/0dddca3a9b700aac9dc59cfa4227b800186afd58/ghc >--------------------------------------------------------------- commit 0dddca3a9b700aac9dc59cfa4227b800186afd58 Author: Richard Eisenberg Date: Tue Jul 15 22:32:29 2014 -0400 Rewrite coercionRole. (#9233) coercionRole is now much more efficient, computing both the coercion's kind and role together. The previous version calculated them separately, leading to quite possibly exponential behavior. This is still too slow, but it's a big improvement. >--------------------------------------------------------------- 0dddca3a9b700aac9dc59cfa4227b800186afd58 compiler/coreSyn/MkCore.lhs | 4 +-- compiler/types/Coercion.lhs | 77 +++++++++++++++++++++++++++++------------- compiler/types/OptCoercion.lhs | 9 +++-- 3 files changed, 60 insertions(+), 30 deletions(-) diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 721dc96..4d8e44c 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -304,9 +304,9 @@ mkStringExprFS str mkEqBox :: Coercion -> CoreExpr mkEqBox co = ASSERT2( typeKind ty2 `eqKind` k, ppr co $$ ppr ty1 $$ ppr ty2 $$ ppr (typeKind ty1) $$ ppr (typeKind ty2) ) Var (dataConWorkId datacon) `mkTyApps` [k, ty1, ty2] `App` Coercion co - where Pair ty1 ty2 = coercionKind co + where (Pair ty1 ty2, role) = coercionKindRole co k = typeKind ty1 - datacon = case coercionRole co of + datacon = case role of Nominal -> eqBoxDataCon Representational -> coercibleDataCon Phantom -> pprPanic "mkEqBox does not support boxing phantom coercions" diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index b33eae9..2cba7b3 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -18,7 +18,7 @@ module Coercion ( -- ** Functions over coercions coVarKind, coVarRole, coercionType, coercionKind, coercionKinds, isReflCo, - isReflCo_maybe, coercionRole, + isReflCo_maybe, coercionRole, coercionKindRole, mkCoercionType, -- ** Constructing coercions @@ -104,8 +104,10 @@ import PrelNames ( funTyConKey, eqPrimTyConKey, eqReprPrimTyConKey ) import Control.Applicative import Data.Traversable (traverse, sequenceA) import FastString +import ListSetOps import qualified Data.Data as Data hiding ( TyCon ) +import Control.Arrow ( first ) \end{code} %************************************************************************ @@ -1794,8 +1796,8 @@ seqCos (co:cos) = seqCo co `seq` seqCos cos \begin{code} coercionType :: Coercion -> Type -coercionType co = case coercionKind co of - Pair ty1 ty2 -> mkCoercionType (coercionRole co) ty1 ty2 +coercionType co = case coercionKindRole co of + (Pair ty1 ty2, r) -> mkCoercionType r ty1 ty2 ------------------ -- | If it is the case that @@ -1827,11 +1829,10 @@ coercionKind co = go co go (InstCo aco ty) = go_app aco [ty] go (SubCo co) = go co go (AxiomRuleCo ax tys cos) = - case coaxrProves ax tys (map coercionKind cos) of + case coaxrProves ax tys (map go cos) of Just res -> res Nothing -> panic "coercionKind: Malformed coercion" - go_app :: Coercion -> [Type] -> Pair Type -- Collect up all the arguments and apply all at once -- See Note [Nested InstCos] @@ -1842,25 +1843,55 @@ coercionKind co = go co coercionKinds :: [Coercion] -> Pair [Type] coercionKinds tys = sequenceA $ map coercionKind tys -coercionRole :: Coercion -> Role -coercionRole = go +-- | Get a coercion's kind and role. More efficient than getting +-- each individually, but less efficient than calling just +-- 'coercionKind' if that's all you need. +coercionKindRole :: Coercion -> (Pair Type, Role) +coercionKindRole = go where - go (Refl r _) = r - go (TyConAppCo r _ _) = r - go (AppCo co _) = go co - go (ForAllCo _ co) = go co - go (CoVarCo cv) = coVarRole cv - go (AxiomInstCo ax _ _) = coAxiomRole ax - go (UnivCo r _ _) = r - go (SymCo co) = go co - go (TransCo co1 _) = go co1 -- same as go co2 - go (NthCo n co) = let Pair ty1 _ = coercionKind co - (tc, _) = splitTyConApp ty1 - in nthRole (coercionRole co) tc n - go (LRCo _ _) = Nominal - go (InstCo co _) = go co - go (SubCo _) = Representational - go (AxiomRuleCo c _ _) = coaxrRole c + go (Refl r ty) = (Pair ty ty, r) + go (TyConAppCo r tc cos) + = (mkTyConApp tc <$> (sequenceA $ map coercionKind cos), r) + go (AppCo co1 co2) + = let (tys1, r1) = go co1 in + (mkAppTy <$> tys1 <*> coercionKind co2, r1) + go (ForAllCo tv co) + = let (tys, r) = go co in + (mkForAllTy tv <$> tys, r) + go (CoVarCo cv) = (toPair $ coVarKind cv, coVarRole cv) + go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax) + go (UnivCo r ty1 ty2) = (Pair ty1 ty2, r) + go (SymCo co) = first swap $ go co + go (TransCo co1 co2) + = let (tys1, r) = go co1 in + (Pair (pFst tys1) (pSnd $ coercionKind co2), r) + go (NthCo d co) + = let (Pair t1 t2, r) = go co + (tc1, args1) = splitTyConApp t1 + (_tc2, args2) = splitTyConApp t2 + in + ASSERT( tc1 == _tc2 ) + ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d) + go co@(LRCo {}) = (coercionKind co, Nominal) + go (InstCo co ty) = go_app co [ty] + go (SubCo co) = (coercionKind co, Representational) + go co@(AxiomRuleCo ax _ _) = (coercionKind co, coaxrRole ax) + + go_app :: Coercion -> [Type] -> (Pair Type, Role) + -- Collect up all the arguments and apply all at once + -- See Note [Nested InstCos] + go_app (InstCo co ty) tys = go_app co (ty:tys) + go_app co tys + = let (pair, r) = go co in + ((`applyTys` tys) <$> pair, r) + +-- | Retrieve the role from a coercion. +coercionRole :: Coercion -> Role +coercionRole = snd . coercionKindRole + -- There's not a better way to do this, because NthCo needs the + -- *kind* and role of its argument. Luckily, laziness should + -- generally avoid the need for computing kinds in other cases. + \end{code} Note [Nested InstCos] diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs index dc7ab78..657bd31 100644 --- a/compiler/types/OptCoercion.lhs +++ b/compiler/types/OptCoercion.lhs @@ -110,9 +110,9 @@ opt_co env sym co opt_co' env _ mrole (Refl r ty) = Refl (mrole `orElse` r) (substTy env ty) opt_co' env sym mrole co - | mrole == Just Phantom - || coercionRole co == Phantom - , Pair ty1 ty2 <- coercionKind co + | let (Pair ty1 ty2, role) = coercionKindRole co + , mrole == Just Phantom + || role == Phantom = if sym then opt_univ env Phantom ty2 ty1 else opt_univ env Phantom ty1 ty2 @@ -570,8 +570,7 @@ etaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion) etaAppCo_maybe co | Just (co1,co2) <- splitAppCo_maybe co = Just (co1,co2) - | Nominal <- coercionRole co - , Pair ty1 ty2 <- coercionKind co + | (Pair ty1 ty2, Nominal) <- coercionKindRole co , Just (_,t1) <- splitAppTy_maybe ty1 , Just (_,t2) <- splitAppTy_maybe ty2 , typeKind t1 `eqType` typeKind t2 -- Note [Eta for AppCo] From git at git.haskell.org Wed Jul 16 12:03:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Jul 2014 12:03:11 +0000 (UTC) Subject: [commit: ghc] master: Try to explain the applicativity problem (a065f9d) Message-ID: <20140716120311.3550D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a065f9d3bd3d1d1b02c9552c3c2763bcd8aed6da/ghc >--------------------------------------------------------------- commit a065f9d3bd3d1d1b02c9552c3c2763bcd8aed6da Author: Edward Z. Yang Date: Wed Jul 16 12:59:37 2014 +0100 Try to explain the applicativity problem Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a065f9d3bd3d1d1b02c9552c3c2763bcd8aed6da docs/backpack/backpack-impl.tex | 96 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 86 insertions(+), 10 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index 4775a5a..3d69565 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -669,22 +669,98 @@ In this world, we create a dynamic library per definite package (package with no holes). Indefinite packages don't get compiled into libraries, the code is duplicated and type equality is only seen if a type came from the same definite package. In the running example, we only generate \verb|libHSq.so| -which exports all of the modules (\verb|p| is indefinite), and if another -package instantiates \verb|p|, the instances of \verb|C| will be considered -different. \\ +which exports all of the modules (\verb|p| is indefinite). \\ \begin{tikzpicture}[->,>=stealth',shorten >=1pt,auto,node distance=6cm, thick,m/.style={rectangle,draw,font=\sffamily\Large\bfseries}] \node[m] (1) {libHSq.so (A,B,C,D,E)}; \end{tikzpicture} -As a refinement, if the instantiations of an indefinite package's holes -live in libraries which do not have a mutually recursive dependency on -the indefinite package, then it can be instantiated. In the previous -example, this was not true: hole \verb|A| in package \verb|p| was -instantiated with \verb|q:A|, but package \verb|q| has a dependency -on \verb|p|. However, we could break the dependence by separating \verb|A| -into another package: +If another package instantiates \verb|p|, the instances of \verb|C| will +be considered different: + +\begin{verbatim} +package q2 where + include q (C) + A = [ a = True ] + include p # does not link, C's are different +\end{verbatim} + +This scheme, by itself, is fairly unsatisfactory. Here are some of its +limitations: + +\paragraph{Limited applicativity} Many programs which take advantage of +Backpack's applicativity no longer work: + +\begin{verbatim} +package a where + A = [ ... ] +package b where + A :: [ ... ] + B = [ ... ] +package applic-left where + include a + include b +package applic-right where + include b + include a +package applic-both where + include applic-left + include applic-right +\end{verbatim} + +This would not link, because we would end up with original names +\verb|applic-left:B(A)| and \verb|applic-right:B(A)|, which are +considered separate entities. + +Furthermore, \emph{what} works and doesn't work can be quite confusing. +For example, suppose we leave an unresolved hole for prelude in the example +(as was the case in the Backpack paper): + +\begin{verbatim} +package prelude-sig where + Prelude = [ ... ] +package a where + include prelude-sig + A = [ ... ] +package b where + include prelude-sig + A :: [ ... ] + B = [ ... ] +package applic-left where + include a + include b +package applic-right where + include b + include a +package applic-both where + include applic-left + include applic-right +\end{verbatim} + +Now this \emph{does} typecheck, because \verb|B| won't get assigned an +original name until some final project links everything together. The +overall picture seems to be something as follows: + +\begin{enumerate} + \item If you defer linking an indefinite module with implementations + of its holes until all code is visible, you will get the + type-equality you expect. + \item If you compile an indefinite module as soon as possible, you + will unable to observe type equality of any other users who + reinstantiate the indefinite module in the same way. (However, + if they directly use your instantiation, type equality works + out in the correct way.) +\end{enumerate} + +\paragraph{A bridge over troubled water} As a refinement, if the +instantiations of an indefinite package's holes live in libraries which +do not have a mutually recursive dependency on the indefinite package, +then it can be instantiated. In the previous example, this was not +true: hole \verb|A| in package \verb|p| was instantiated with +\verb|q:A|, but package \verb|q| has a dependency on \verb|p|. However, +we could break the dependence by separating \verb|A| into another +package: \begin{verbatim} package a where From git at git.haskell.org Wed Jul 16 12:26:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Jul 2014 12:26:41 +0000 (UTC) Subject: [commit: ghc] wip/T9233: Rewrite coercionRole. (#9233) (beb6a2f) Message-ID: <20140716122641.3438E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9233 Link : http://ghc.haskell.org/trac/ghc/changeset/beb6a2f53d46fe5bb346841eeb8fce3dfbaed02f/ghc >--------------------------------------------------------------- commit beb6a2f53d46fe5bb346841eeb8fce3dfbaed02f Author: Richard Eisenberg Date: Tue Jul 15 22:32:29 2014 -0400 Rewrite coercionRole. (#9233) Summary: coercionRole is now much more efficient, computing both the coercion's kind and role together. The previous version calculated them separately, leading to quite possibly exponential behavior. This is still too slow, but it's a big improvement. Test Plan: Evaluate by running the "minimized" test from the Trac ticket. Reviewers: simonpj, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D73 >--------------------------------------------------------------- beb6a2f53d46fe5bb346841eeb8fce3dfbaed02f compiler/coreSyn/MkCore.lhs | 4 +-- compiler/types/Coercion.lhs | 77 +++++++++++++++++++++++++++++------------- compiler/types/OptCoercion.lhs | 9 +++-- 3 files changed, 60 insertions(+), 30 deletions(-) diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 721dc96..5213f92 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -304,9 +304,9 @@ mkStringExprFS str mkEqBox :: Coercion -> CoreExpr mkEqBox co = ASSERT2( typeKind ty2 `eqKind` k, ppr co $$ ppr ty1 $$ ppr ty2 $$ ppr (typeKind ty1) $$ ppr (typeKind ty2) ) Var (dataConWorkId datacon) `mkTyApps` [k, ty1, ty2] `App` Coercion co - where Pair ty1 ty2 = coercionKind co + where (Pair ty1 ty2, role) = coercionKindRole co k = typeKind ty1 - datacon = case coercionRole co of + datacon = case role of Nominal -> eqBoxDataCon Representational -> coercibleDataCon Phantom -> pprPanic "mkEqBox does not support boxing phantom coercions" diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index b33eae9..8337681 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -18,7 +18,7 @@ module Coercion ( -- ** Functions over coercions coVarKind, coVarRole, coercionType, coercionKind, coercionKinds, isReflCo, - isReflCo_maybe, coercionRole, + isReflCo_maybe, coercionRole, coercionKindRole, mkCoercionType, -- ** Constructing coercions @@ -104,8 +104,10 @@ import PrelNames ( funTyConKey, eqPrimTyConKey, eqReprPrimTyConKey ) import Control.Applicative import Data.Traversable (traverse, sequenceA) import FastString +import ListSetOps import qualified Data.Data as Data hiding ( TyCon ) +import Control.Arrow ( first ) \end{code} %************************************************************************ @@ -1794,8 +1796,8 @@ seqCos (co:cos) = seqCo co `seq` seqCos cos \begin{code} coercionType :: Coercion -> Type -coercionType co = case coercionKind co of - Pair ty1 ty2 -> mkCoercionType (coercionRole co) ty1 ty2 +coercionType co = case coercionKindRole co of + (Pair ty1 ty2, r) -> mkCoercionType r ty1 ty2 ------------------ -- | If it is the case that @@ -1827,11 +1829,10 @@ coercionKind co = go co go (InstCo aco ty) = go_app aco [ty] go (SubCo co) = go co go (AxiomRuleCo ax tys cos) = - case coaxrProves ax tys (map coercionKind cos) of + case coaxrProves ax tys (map go cos) of Just res -> res Nothing -> panic "coercionKind: Malformed coercion" - go_app :: Coercion -> [Type] -> Pair Type -- Collect up all the arguments and apply all at once -- See Note [Nested InstCos] @@ -1842,25 +1843,55 @@ coercionKind co = go co coercionKinds :: [Coercion] -> Pair [Type] coercionKinds tys = sequenceA $ map coercionKind tys -coercionRole :: Coercion -> Role -coercionRole = go +-- | Get a coercion's kind and role. More efficient than getting +-- each individually, but less efficient than calling just +-- 'coercionKind' if that's all you need. +coercionKindRole :: Coercion -> (Pair Type, Role) +coercionKindRole = go where - go (Refl r _) = r - go (TyConAppCo r _ _) = r - go (AppCo co _) = go co - go (ForAllCo _ co) = go co - go (CoVarCo cv) = coVarRole cv - go (AxiomInstCo ax _ _) = coAxiomRole ax - go (UnivCo r _ _) = r - go (SymCo co) = go co - go (TransCo co1 _) = go co1 -- same as go co2 - go (NthCo n co) = let Pair ty1 _ = coercionKind co - (tc, _) = splitTyConApp ty1 - in nthRole (coercionRole co) tc n - go (LRCo _ _) = Nominal - go (InstCo co _) = go co - go (SubCo _) = Representational - go (AxiomRuleCo c _ _) = coaxrRole c + go (Refl r ty) = (Pair ty ty, r) + go (TyConAppCo r tc cos) + = (mkTyConApp tc <$> (sequenceA $ map coercionKind cos), r) + go (AppCo co1 co2) + = let (tys1, r1) = go co1 in + (mkAppTy <$> tys1 <*> coercionKind co2, r1) + go (ForAllCo tv co) + = let (tys, r) = go co in + (mkForAllTy tv <$> tys, r) + go (CoVarCo cv) = (toPair $ coVarKind cv, coVarRole cv) + go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax) + go (UnivCo r ty1 ty2) = (Pair ty1 ty2, r) + go (SymCo co) = first swap $ go co + go (TransCo co1 co2) + = let (tys1, r) = go co1 in + (Pair (pFst tys1) (pSnd $ coercionKind co2), r) + go (NthCo d co) + = let (Pair t1 t2, r) = go co + (tc1, args1) = splitTyConApp t1 + (_tc2, args2) = splitTyConApp t2 + in + ASSERT( tc1 == _tc2 ) + ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d) + go co@(LRCo {}) = (coercionKind co, Nominal) + go (InstCo co ty) = go_app co [ty] + go (SubCo co) = (coercionKind co, Representational) + go co@(AxiomRuleCo ax _ _) = (coercionKind co, coaxrRole ax) + + go_app :: Coercion -> [Type] -> (Pair Type, Role) + -- Collect up all the arguments and apply all at once + -- See Note [Nested InstCos] + go_app (InstCo co ty) tys = go_app co (ty:tys) + go_app co tys + = let (pair, r) = go co in + ((`applyTys` tys) <$> pair, r) + +-- | Retrieve the role from a coercion. +coercionRole :: Coercion -> Role +coercionRole = snd . coercionKindRole + -- There's not a better way to do this, because NthCo needs the + -- *kind* and role of its argument. Luckily, laziness should + -- generally avoid the need for computing kinds in other cases. + \end{code} Note [Nested InstCos] diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs index dc7ab78..5be042e 100644 --- a/compiler/types/OptCoercion.lhs +++ b/compiler/types/OptCoercion.lhs @@ -110,9 +110,9 @@ opt_co env sym co opt_co' env _ mrole (Refl r ty) = Refl (mrole `orElse` r) (substTy env ty) opt_co' env sym mrole co - | mrole == Just Phantom - || coercionRole co == Phantom - , Pair ty1 ty2 <- coercionKind co + | let (Pair ty1 ty2, role) = coercionKindRole co + , mrole == Just Phantom + || role == Phantom = if sym then opt_univ env Phantom ty2 ty1 else opt_univ env Phantom ty1 ty2 @@ -570,8 +570,7 @@ etaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion) etaAppCo_maybe co | Just (co1,co2) <- splitAppCo_maybe co = Just (co1,co2) - | Nominal <- coercionRole co - , Pair ty1 ty2 <- coercionKind co + | (Pair ty1 ty2, Nominal) <- coercionKindRole co , Just (_,t1) <- splitAppTy_maybe ty1 , Just (_,t2) <- splitAppTy_maybe ty2 , typeKind t1 `eqType` typeKind t2 -- Note [Eta for AppCo] From git at git.haskell.org Wed Jul 16 16:30:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Jul 2014 16:30:07 +0000 (UTC) Subject: [commit: ghc] wip/T9233: Optimise optCoercion. (#9233) (9a432fb) Message-ID: <20140716163007.B32952406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9233 Link : http://ghc.haskell.org/trac/ghc/changeset/9a432fb77ce54c2d4fa38e0d1d40b10ebc90cd74/ghc >--------------------------------------------------------------- commit 9a432fb77ce54c2d4fa38e0d1d40b10ebc90cd74 Author: Richard Eisenberg Date: Wed Jul 16 12:25:24 2014 -0400 Optimise optCoercion. (#9233) The old optCoercion (and helper functions) used coercionKind and coercionRole internally. This was terrible when these had to be called at *every* point in the coercion tree during the recursive descent. This is rewritten to avoid such calls. >--------------------------------------------------------------- 9a432fb77ce54c2d4fa38e0d1d40b10ebc90cd74 compiler/types/OptCoercion.lhs | 281 +++++++++++++++++++++++++++-------------- 1 file changed, 187 insertions(+), 94 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9a432fb77ce54c2d4fa38e0d1d40b10ebc90cd74 From git at git.haskell.org Wed Jul 16 18:21:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Jul 2014 18:21:02 +0000 (UTC) Subject: [commit: ghc] master: Rewrite coercionRole. (#9233) (34ec0bd) Message-ID: <20140716182102.86BA32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34ec0bd942b732b127b1a955cd3508da0a588b6f/ghc >--------------------------------------------------------------- commit 34ec0bd942b732b127b1a955cd3508da0a588b6f Author: Richard Eisenberg Date: Tue Jul 15 22:32:29 2014 -0400 Rewrite coercionRole. (#9233) Summary: coercionRole is now much more efficient, computing both the coercion's kind and role together. The previous version calculated them separately, leading to quite possibly exponential behavior. This is still too slow, but it's a big improvement. Test Plan: Evaluate by running the "minimized" test from the Trac ticket. Reviewers: simonpj, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D73 >--------------------------------------------------------------- 34ec0bd942b732b127b1a955cd3508da0a588b6f compiler/coreSyn/MkCore.lhs | 4 +-- compiler/types/Coercion.lhs | 77 +++++++++++++++++++++++++++++------------- compiler/types/OptCoercion.lhs | 9 +++-- 3 files changed, 60 insertions(+), 30 deletions(-) diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 721dc96..5213f92 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -304,9 +304,9 @@ mkStringExprFS str mkEqBox :: Coercion -> CoreExpr mkEqBox co = ASSERT2( typeKind ty2 `eqKind` k, ppr co $$ ppr ty1 $$ ppr ty2 $$ ppr (typeKind ty1) $$ ppr (typeKind ty2) ) Var (dataConWorkId datacon) `mkTyApps` [k, ty1, ty2] `App` Coercion co - where Pair ty1 ty2 = coercionKind co + where (Pair ty1 ty2, role) = coercionKindRole co k = typeKind ty1 - datacon = case coercionRole co of + datacon = case role of Nominal -> eqBoxDataCon Representational -> coercibleDataCon Phantom -> pprPanic "mkEqBox does not support boxing phantom coercions" diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index b33eae9..8337681 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -18,7 +18,7 @@ module Coercion ( -- ** Functions over coercions coVarKind, coVarRole, coercionType, coercionKind, coercionKinds, isReflCo, - isReflCo_maybe, coercionRole, + isReflCo_maybe, coercionRole, coercionKindRole, mkCoercionType, -- ** Constructing coercions @@ -104,8 +104,10 @@ import PrelNames ( funTyConKey, eqPrimTyConKey, eqReprPrimTyConKey ) import Control.Applicative import Data.Traversable (traverse, sequenceA) import FastString +import ListSetOps import qualified Data.Data as Data hiding ( TyCon ) +import Control.Arrow ( first ) \end{code} %************************************************************************ @@ -1794,8 +1796,8 @@ seqCos (co:cos) = seqCo co `seq` seqCos cos \begin{code} coercionType :: Coercion -> Type -coercionType co = case coercionKind co of - Pair ty1 ty2 -> mkCoercionType (coercionRole co) ty1 ty2 +coercionType co = case coercionKindRole co of + (Pair ty1 ty2, r) -> mkCoercionType r ty1 ty2 ------------------ -- | If it is the case that @@ -1827,11 +1829,10 @@ coercionKind co = go co go (InstCo aco ty) = go_app aco [ty] go (SubCo co) = go co go (AxiomRuleCo ax tys cos) = - case coaxrProves ax tys (map coercionKind cos) of + case coaxrProves ax tys (map go cos) of Just res -> res Nothing -> panic "coercionKind: Malformed coercion" - go_app :: Coercion -> [Type] -> Pair Type -- Collect up all the arguments and apply all at once -- See Note [Nested InstCos] @@ -1842,25 +1843,55 @@ coercionKind co = go co coercionKinds :: [Coercion] -> Pair [Type] coercionKinds tys = sequenceA $ map coercionKind tys -coercionRole :: Coercion -> Role -coercionRole = go +-- | Get a coercion's kind and role. More efficient than getting +-- each individually, but less efficient than calling just +-- 'coercionKind' if that's all you need. +coercionKindRole :: Coercion -> (Pair Type, Role) +coercionKindRole = go where - go (Refl r _) = r - go (TyConAppCo r _ _) = r - go (AppCo co _) = go co - go (ForAllCo _ co) = go co - go (CoVarCo cv) = coVarRole cv - go (AxiomInstCo ax _ _) = coAxiomRole ax - go (UnivCo r _ _) = r - go (SymCo co) = go co - go (TransCo co1 _) = go co1 -- same as go co2 - go (NthCo n co) = let Pair ty1 _ = coercionKind co - (tc, _) = splitTyConApp ty1 - in nthRole (coercionRole co) tc n - go (LRCo _ _) = Nominal - go (InstCo co _) = go co - go (SubCo _) = Representational - go (AxiomRuleCo c _ _) = coaxrRole c + go (Refl r ty) = (Pair ty ty, r) + go (TyConAppCo r tc cos) + = (mkTyConApp tc <$> (sequenceA $ map coercionKind cos), r) + go (AppCo co1 co2) + = let (tys1, r1) = go co1 in + (mkAppTy <$> tys1 <*> coercionKind co2, r1) + go (ForAllCo tv co) + = let (tys, r) = go co in + (mkForAllTy tv <$> tys, r) + go (CoVarCo cv) = (toPair $ coVarKind cv, coVarRole cv) + go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax) + go (UnivCo r ty1 ty2) = (Pair ty1 ty2, r) + go (SymCo co) = first swap $ go co + go (TransCo co1 co2) + = let (tys1, r) = go co1 in + (Pair (pFst tys1) (pSnd $ coercionKind co2), r) + go (NthCo d co) + = let (Pair t1 t2, r) = go co + (tc1, args1) = splitTyConApp t1 + (_tc2, args2) = splitTyConApp t2 + in + ASSERT( tc1 == _tc2 ) + ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d) + go co@(LRCo {}) = (coercionKind co, Nominal) + go (InstCo co ty) = go_app co [ty] + go (SubCo co) = (coercionKind co, Representational) + go co@(AxiomRuleCo ax _ _) = (coercionKind co, coaxrRole ax) + + go_app :: Coercion -> [Type] -> (Pair Type, Role) + -- Collect up all the arguments and apply all at once + -- See Note [Nested InstCos] + go_app (InstCo co ty) tys = go_app co (ty:tys) + go_app co tys + = let (pair, r) = go co in + ((`applyTys` tys) <$> pair, r) + +-- | Retrieve the role from a coercion. +coercionRole :: Coercion -> Role +coercionRole = snd . coercionKindRole + -- There's not a better way to do this, because NthCo needs the + -- *kind* and role of its argument. Luckily, laziness should + -- generally avoid the need for computing kinds in other cases. + \end{code} Note [Nested InstCos] diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs index dc7ab78..5be042e 100644 --- a/compiler/types/OptCoercion.lhs +++ b/compiler/types/OptCoercion.lhs @@ -110,9 +110,9 @@ opt_co env sym co opt_co' env _ mrole (Refl r ty) = Refl (mrole `orElse` r) (substTy env ty) opt_co' env sym mrole co - | mrole == Just Phantom - || coercionRole co == Phantom - , Pair ty1 ty2 <- coercionKind co + | let (Pair ty1 ty2, role) = coercionKindRole co + , mrole == Just Phantom + || role == Phantom = if sym then opt_univ env Phantom ty2 ty1 else opt_univ env Phantom ty1 ty2 @@ -570,8 +570,7 @@ etaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion) etaAppCo_maybe co | Just (co1,co2) <- splitAppCo_maybe co = Just (co1,co2) - | Nominal <- coercionRole co - , Pair ty1 ty2 <- coercionKind co + | (Pair ty1 ty2, Nominal) <- coercionKindRole co , Just (_,t1) <- splitAppTy_maybe ty1 , Just (_,t2) <- splitAppTy_maybe ty2 , typeKind t1 `eqType` typeKind t2 -- Note [Eta for AppCo] From git at git.haskell.org Wed Jul 16 18:21:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Jul 2014 18:21:05 +0000 (UTC) Subject: [commit: ghc] master: Optimise optCoercion. (#9233) (5e7406d) Message-ID: <20140716182105.4BC332406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e7406d9f5857e4ff30aed348f731d16dbd8e64c/ghc >--------------------------------------------------------------- commit 5e7406d9f5857e4ff30aed348f731d16dbd8e64c Author: Richard Eisenberg Date: Wed Jul 16 12:25:24 2014 -0400 Optimise optCoercion. (#9233) The old optCoercion (and helper functions) used coercionKind and coercionRole internally. This was terrible when these had to be called at *every* point in the coercion tree during the recursive descent. This is rewritten to avoid such calls. >--------------------------------------------------------------- 5e7406d9f5857e4ff30aed348f731d16dbd8e64c compiler/types/OptCoercion.lhs | 281 +++++++++++++++++++++++++++-------------- 1 file changed, 187 insertions(+), 94 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5e7406d9f5857e4ff30aed348f731d16dbd8e64c From git at git.haskell.org Thu Jul 17 07:11:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 07:11:39 +0000 (UTC) Subject: [commit: ghc] master: Workaround haddock parser error caused by 5e7406d9 (3b8b826) Message-ID: <20140717071139.507912406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3b8b826b24f3d1656560c5f1b95acf2578d26a59/ghc >--------------------------------------------------------------- commit 3b8b826b24f3d1656560c5f1b95acf2578d26a59 Author: Herbert Valerio Riedel Date: Thu Jul 17 09:04:46 2014 +0200 Workaround haddock parser error caused by 5e7406d9 Haddock complains if a comment looks like a misplaced Haddock-comment. In this case, the comment line starting with `-- *kind* and` looked like a section-heading to Haddock and caused the following error: parse error on input ?-- *kind* and role of its argument. Luckily, laziness should? This commit just rewraps the line so that no `*` appear at the start of the non-Haddock comment lines. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 3b8b826b24f3d1656560c5f1b95acf2578d26a59 compiler/types/Coercion.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index 8337681..adfe9d7 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -1888,9 +1888,9 @@ coercionKindRole = go -- | Retrieve the role from a coercion. coercionRole :: Coercion -> Role coercionRole = snd . coercionKindRole - -- There's not a better way to do this, because NthCo needs the - -- *kind* and role of its argument. Luckily, laziness should - -- generally avoid the need for computing kinds in other cases. + -- There's not a better way to do this, because NthCo needs the *kind* + -- and role of its argument. Luckily, laziness should generally avoid + -- the need for computing kinds in other cases. \end{code} From git at git.haskell.org Thu Jul 17 08:27:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 08:27:58 +0000 (UTC) Subject: [commit: ghc] wip/travis: Try travis with CPUS=2 (a179572) Message-ID: <20140717082759.12C412406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/a17957289b2c96ffb74655e76d74f5e8c9e2147c/ghc >--------------------------------------------------------------- commit a17957289b2c96ffb74655e76d74f5e8c9e2147c Author: Joachim Breitner Date: Thu Jul 17 10:27:25 2014 +0200 Try travis with CPUS=2 >--------------------------------------------------------------- a17957289b2c96ffb74655e76d74f5e8c9e2147c .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5dc1e53..57153b6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Thu Jul 17 08:28:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 08:28:01 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: Try travis with CPUS=2 (a179572) Message-ID: <20140717082803.75F1E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: 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 a179572 Try travis with CPUS=2 From git at git.haskell.org Thu Jul 17 08:48:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 08:48:09 +0000 (UTC) Subject: [commit: ghc] master: Richards optCoercion improvement made test cases fail the nice way (da7cfa9) Message-ID: <20140717084809.D06CF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da7cfa99def372cde32af62801a7a7e0163efad8/ghc >--------------------------------------------------------------- commit da7cfa99def372cde32af62801a7a7e0163efad8 Author: Joachim Breitner Date: Thu Jul 17 10:46:27 2014 +0200 Richards optCoercion improvement made test cases fail the nice way This was likely caused by 5e7406d9, which fixed #9233. >--------------------------------------------------------------- da7cfa99def372cde32af62801a7a7e0163efad8 testsuite/tests/perf/compiler/all.T | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index ba2ebd5..fcaec8e 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -363,7 +363,7 @@ test('T5321FD', # prev: 213380256 # 2012-10-08: 240302920 (x86/Linux) # (increase due to new codegen) - (wordsize(64), 476497048, 10)]) + (wordsize(64), 426960992, 10)]) # prev: 418306336 # 29/08/2012: 492905640 # (increase due to new codegen) @@ -371,6 +371,10 @@ test('T5321FD', # (reason for decrease unknown) # 08/06/2013: 476497048 # (reason for increase unknown) + # before 2014-07-17: 441997096 + # (with -8%, still in range, hence cause not known) + # 2014-07-17: 426960992 (-11% of previous value) + # (due to better optCoercion, 5e7406d9, #9233) ], compile,['']) From git at git.haskell.org Thu Jul 17 09:01:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 09:01:49 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #9323 (ef4e8c5) Message-ID: <20140717090149.D5EA52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef4e8c54d8dfbceabe53f259ba15f42f6f1b967a/ghc >--------------------------------------------------------------- commit ef4e8c54d8dfbceabe53f259ba15f42f6f1b967a Author: Simon Peyton Jones Date: Thu Jul 17 10:01:25 2014 +0100 Test Trac #9323 >--------------------------------------------------------------- ef4e8c54d8dfbceabe53f259ba15f42f6f1b967a testsuite/tests/typecheck/should_fail/T9323.hs | 7 +++++++ testsuite/tests/typecheck/should_fail/T9323.stderr | 5 +++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 13 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T9323.hs b/testsuite/tests/typecheck/should_fail/T9323.hs new file mode 100644 index 0000000..1aea288 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9323.hs @@ -0,0 +1,7 @@ +module T9323 where + +broken :: [Int] +broken = () + +ambiguous :: a -> String +ambiguous _ = show 0 diff --git a/testsuite/tests/typecheck/should_fail/T9323.stderr b/testsuite/tests/typecheck/should_fail/T9323.stderr new file mode 100644 index 0000000..f98ce7b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9323.stderr @@ -0,0 +1,5 @@ + +T9323.hs:4:10: + Couldn't match expected type ?[Int]? with actual type ?()? + In the expression: () + In an equation for ?broken?: broken = () diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index c1dbd58..cf2af30 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -335,3 +335,4 @@ test('T9033', normal, compile_fail, ['']) test('T8883', normal, compile_fail, ['']) test('T9196', normal, compile_fail, ['']) test('T9305', normal, compile_fail, ['']) +test('T9323', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 17 09:10:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 09:10:08 +0000 (UTC) Subject: [commit: ghc] master: Include test case name in performance result (8b6cd6e) Message-ID: <20140717091008.A60F12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b6cd6e5cf7c358aaa30b5b2700c09418ba22586/ghc >--------------------------------------------------------------- commit 8b6cd6e5cf7c358aaa30b5b2700c09418ba22586 Author: Joachim Breitner Date: Thu Jul 17 11:08:41 2014 +0200 Include test case name in performance result With THREADS=n, for n > 1, it becomes impossible to match the performance numbers to the test case name. Hence include it in the output. This also makes grepping through a bunch of logs for a specific test case much easier, and outweighs the extra verbosity. >--------------------------------------------------------------- 8b6cd6e5cf7c358aaa30b5b2700c09418ba22586 testsuite/driver/testlib.py | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index f3bfd58..091a1ea 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1021,12 +1021,14 @@ def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ): def stats( name, way, stats_file ): opts = getTestOpts() - return checkStats(stats_file, opts.stats_range_fields) + return checkStats(name, way, stats_file, opts.stats_range_fields) # ----------------------------------------------------------------------------- # Check -t stats info -def checkStats(stats_file, range_fields): +def checkStats(name, way, stats_file, range_fields): + full_name = name + '(' + way + ')' + result = passed() if len(range_fields) > 0: f = open(in_testdir(stats_file)) @@ -1062,12 +1064,12 @@ def checkStats(stats_file, range_fields): length = max(map (lambda x : len(str(x)), [expected, lowerBound, upperBound, val])) def display(descr, val, extra): print descr, string.rjust(str(val), length), extra - display(' Expected ' + field + ':', expected, '+/-' + str(dev) + '%') - display(' Lower bound ' + field + ':', lowerBound, '') - display(' Upper bound ' + field + ':', upperBound, '') - display(' Actual ' + field + ':', val, '') + display(' Expected ' + full_name + ' ' + field + ':', expected, '+/-' + str(dev) + '%') + display(' Lower bound ' + full_name + ' ' + field + ':', lowerBound, '') + display(' Upper bound ' + full_name + ' ' + field + ':', upperBound, '') + display(' Actual ' + full_name + ' ' + field + ':', val, '') if val != expected: - display(' Deviation ' + field + ':', deviation, '%') + display(' Deviation ' + full_name + ' ' + field + ':', deviation, '%') return result @@ -1158,7 +1160,7 @@ def simple_build( name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, # ToDo: if the sub-shell was killed by ^C, then exit - statsResult = checkStats(stats_file, opts.compiler_stats_range_fields) + statsResult = checkStats(name, way, stats_file, opts.compiler_stats_range_fields) if badResult(statsResult): return statsResult @@ -1258,7 +1260,7 @@ def simple_run( name, way, prog, args ): if check_prof and not check_prof_ok(name): return failBecause('bad profile') - return checkStats(stats_file, opts.stats_range_fields) + return checkStats(name, way, stats_file, opts.stats_range_fields) def rts_flags(way): if (way == ''): From git at git.haskell.org Thu Jul 17 11:03:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 11:03:22 +0000 (UTC) Subject: [commit: ghc] master: Adjust a few performance numbers (13cb4c2) Message-ID: <20140717110322.5A5432406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/13cb4c279da4f4511e3bb78b22420daf9915d147/ghc >--------------------------------------------------------------- commit 13cb4c279da4f4511e3bb78b22420daf9915d147 Author: Joachim Breitner Date: Thu Jul 17 12:58:33 2014 +0200 Adjust a few performance numbers These did not yet trigger a failure, but are more than 1% away from the expected value. Since I now start collecting logs to investigate deviations from the expected value, it makes sense to reset them. This way we know that every significat deviation was caused since this commit. I only updated bytes_allocated numbers, as these are (mostly) deterministic. Other depend, AFAIK, on sampling timing, so I did not bother. >--------------------------------------------------------------- 13cb4c279da4f4511e3bb78b22420daf9915d147 testsuite/tests/callarity/perf/all.T | 3 ++- testsuite/tests/perf/compiler/all.T | 25 ++++++++++++++++++------- testsuite/tests/perf/haddock/all.T | 3 ++- testsuite/tests/perf/should_run/all.T | 16 ++++++++++------ 4 files changed, 32 insertions(+), 15 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 13cb4c279da4f4511e3bb78b22420daf9915d147 From git at git.haskell.org Thu Jul 17 11:03:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 11:03:24 +0000 (UTC) Subject: [commit: ghc] master: Correctly round when calculating the deviation (10f3d39) Message-ID: <20140717110325.36CBC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/10f3d396492742902d183a503c1bcb145d28df7f/ghc >--------------------------------------------------------------- commit 10f3d396492742902d183a503c1bcb145d28df7f Author: Joachim Breitner Date: Thu Jul 17 13:03:09 2014 +0200 Correctly round when calculating the deviation >--------------------------------------------------------------- 10f3d396492742902d183a503c1bcb145d28df7f testsuite/driver/testlib.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 091a1ea..126c8e4 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1045,7 +1045,7 @@ def checkStats(name, way, stats_file, range_fields): lowerBound = trunc( expected * ((100 - float(dev))/100)) upperBound = trunc(0.5 + ceil(expected * ((100 + float(dev))/100))) - deviation = round(((val * 100)/ expected) - 100, 1) + deviation = round(((float(val) * 100)/ expected) - 100, 1) if val < lowerBound: print field, 'value is too low:' From git at git.haskell.org Thu Jul 17 11:57:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 11:57:04 +0000 (UTC) Subject: [commit: ghc] wip/travis: Try travis again with CPUS=2 (78a58e6) Message-ID: <20140717115704.CB3162406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/78a58e6aa7b325c8e99c789234eee91b43939517/ghc >--------------------------------------------------------------- commit 78a58e6aa7b325c8e99c789234eee91b43939517 Author: Joachim Breitner Date: Thu Jul 17 10:27:25 2014 +0200 Try travis again with CPUS=2 (This setting used to work with ghc-complete...) >--------------------------------------------------------------- 78a58e6aa7b325c8e99c789234eee91b43939517 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5dc1e53..57153b6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Thu Jul 17 11:57:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 11:57:07 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: Try travis again with CPUS=2 (78a58e6) Message-ID: <20140717115707.574712406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: 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 78a58e6 Try travis again with CPUS=2 From git at git.haskell.org Thu Jul 17 14:07:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 14:07:30 +0000 (UTC) Subject: [commit: ghc] master: Remove unused parameters in OptCoercion (#9233) (612d948) Message-ID: <20140717140731.23CD02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/612d948b159c209020c12479a846af5b42e9601e/ghc >--------------------------------------------------------------- commit 612d948b159c209020c12479a846af5b42e9601e Author: Richard Eisenberg Date: Thu Jul 17 10:06:55 2014 -0400 Remove unused parameters in OptCoercion (#9233) >--------------------------------------------------------------- 612d948b159c209020c12479a846af5b42e9601e compiler/types/OptCoercion.lhs | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs index cc2ddb9..6eccf42 100644 --- a/compiler/types/OptCoercion.lhs +++ b/compiler/types/OptCoercion.lhs @@ -80,7 +80,7 @@ optCoercion :: CvSubst -> Coercion -> NormalCo -- *and* optimises it to reduce its size optCoercion env co | opt_NoOptCoercion = substCo env co - | otherwise = opt_co1 env False Nothing co + | otherwise = opt_co1 env False co type NormalCo = Coercion -- Invariants: @@ -100,10 +100,8 @@ type ReprFlag = Bool -- | Optimize a coercion, making no assumptions. opt_co1 :: CvSubst -> SymFlag - -> Maybe Role -- ^ @Nothing@ = no change; @Just r@ means to change role. - -- MUST be a downgrade. -> Coercion -> NormalCo -opt_co1 env sym mrole co = opt_co2 env sym mrole (coercionRole co) co +opt_co1 env sym co = opt_co2 env sym (coercionRole co) co {- opt_co env sym co = pprTrace "opt_co {" (ppr sym <+> ppr co $$ ppr env) $ @@ -133,11 +131,10 @@ opt_co env sym co -- | Optimize a coercion, knowing the coercion's role. No other assumptions. opt_co2 :: CvSubst -> SymFlag - -> Maybe Role -> Role -- ^ The role of the input coercion -> Coercion -> NormalCo -opt_co2 env sym _ Phantom co = opt_phantom env sym co -opt_co2 env sym mrole r co = opt_co3 env sym mrole r co +opt_co2 env sym Phantom co = opt_phantom env sym co +opt_co2 env sym r co = opt_co3 env sym Nothing r co -- See Note [Optimising coercion optimisation] -- | Optimize a coercion, knowing the coercion's non-Phantom role. @@ -172,7 +169,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos) (_, Representational) -> -- must use opt_co2 here, because some roles may be P -- See Note [Optimising coercion optimisation] - mkTyConAppCo r tc (zipWith (opt_co2 env sym Nothing) + mkTyConAppCo r tc (zipWith (opt_co2 env sym) (tyConRolesX r tc) -- the current roles cos) (_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g) @@ -206,7 +203,7 @@ opt_co4 env sym rep r (AxiomInstCo con ind cos) wrapSym sym $ -- some sub-cos might be P: use opt_co2 -- See Note [Optimising coercion optimisation] - AxiomInstCo con ind (zipWith (opt_co2 env False Nothing) + AxiomInstCo con ind (zipWith (opt_co2 env False) (coAxBranchRoles (coAxiomNthBranch con ind)) cos) -- Note that the_co does *not* have sym pushed into it @@ -269,7 +266,7 @@ opt_co4 env sym rep r (AxiomRuleCo co ts cs) wrapRole rep r $ wrapSym sym $ AxiomRuleCo co (map (substTy env) ts) - (zipWith (opt_co2 env False Nothing) (coaxrAsmpRoles co) cs) + (zipWith (opt_co2 env False) (coaxrAsmpRoles co) cs) ------------- @@ -333,7 +330,7 @@ opt_nth_co env sym rep r = go [] -- coercionRole, but as long as we don't have a long chain of -- NthCo's interspersed with some other coercion former, we should -- be OK. - opt_nths ns co = opt_nths' ns (opt_co1 env sym Nothing co) + opt_nths ns co = opt_nths' ns (opt_co1 env sym co) -- input coercion *is* sym'd and opt'd opt_nths' [] co From git at git.haskell.org Thu Jul 17 16:18:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 16:18:05 +0000 (UTC) Subject: [commit: ghc] master: OK, I think we've finally solved granularity. (a520072) Message-ID: <20140717161805.F0DCB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a5200723753eac2c3b9c960489a3130305fe9fad/ghc >--------------------------------------------------------------- commit a5200723753eac2c3b9c960489a3130305fe9fad Author: Edward Z. Yang Date: Thu Jul 17 17:16:55 2014 +0100 OK, I think we've finally solved granularity. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a5200723753eac2c3b9c960489a3130305fe9fad docs/backpack/backpack-impl.tex | 893 +++++++++++----------------------- docs/backpack/commands-new-new.tex | 891 +++++++++++++++++++++++++++++++++ docs/backpack/commands-rebindings.tex | 57 +++ 3 files changed, 1229 insertions(+), 612 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a5200723753eac2c3b9c960489a3130305fe9fad From git at git.haskell.org Thu Jul 17 18:45:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 18:45:59 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' deleted Message-ID: <20140717184559.415812406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/travis From git at git.haskell.org Thu Jul 17 18:46:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Jul 2014 18:46:01 +0000 (UTC) Subject: [commit: ghc] master: Build on travis with CPUS=2 (b542698) Message-ID: <20140717184601.8BC172406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b542698566ca5b68c207e72b821468707d945ce7/ghc >--------------------------------------------------------------- commit b542698566ca5b68c207e72b821468707d945ce7 Author: Joachim Breitner Date: Thu Jul 17 10:27:25 2014 +0200 Build on travis with CPUS=2 With CPU=3 we are hitting resoure limits (probably memory). With CPU=2 this is less likely to happen. We will get more random timeouts, but these are more easily spotted, and marked as "Failure", not as "Error". >--------------------------------------------------------------- b542698566ca5b68c207e72b821468707d945ce7 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5dc1e53..57153b6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=3 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph From git at git.haskell.org Fri Jul 18 14:34:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Jul 2014 14:34:06 +0000 (UTC) Subject: [commit: ghc] master: Comments only (3214ec5) Message-ID: <20140718143407.0A1672406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3214ec5abda4e5261770c3a996335e290bbb2a91/ghc >--------------------------------------------------------------- commit 3214ec5abda4e5261770c3a996335e290bbb2a91 Author: Simon Peyton Jones Date: Fri Jul 18 09:32:46 2014 +0100 Comments only >--------------------------------------------------------------- 3214ec5abda4e5261770c3a996335e290bbb2a91 compiler/types/Coercion.lhs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index adfe9d7..2f499b7 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -1794,6 +1794,19 @@ seqCos (co:cos) = seqCo co `seq` seqCos cos %* * %************************************************************************ +Note [Computing a coercion kind and role] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To compute a coercion's kind is straightforward: see coercionKind. +But to compute a coercion's role, in the case for NthCo we need +its kind as well. So if we have two separate functions (one for kinds +and one for roles) we can get exponentially bad behaviour, sinc each +NthCo node makes a seaprate call to coercionKind, which traverses the +sub-tree again. This was part of the problem in Trac #9233. + +Solution: compute both together; hence coercionKindRole. We keep a +separate coercionKind function because it's a bit more efficient if +the kind is all you wan. + \begin{code} coercionType :: Coercion -> Type coercionType co = case coercionKindRole co of @@ -1843,9 +1856,8 @@ coercionKind co = go co coercionKinds :: [Coercion] -> Pair [Type] coercionKinds tys = sequenceA $ map coercionKind tys --- | Get a coercion's kind and role. More efficient than getting --- each individually, but less efficient than calling just --- 'coercionKind' if that's all you need. +-- | Get a coercion's kind and role. +-- Why both at once? See Note [Computing a coercion kind and role] coercionKindRole :: Coercion -> (Pair Type, Role) coercionKindRole = go where From git at git.haskell.org Fri Jul 18 14:34:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Jul 2014 14:34:10 +0000 (UTC) Subject: [commit: ghc] master: Reduce volume of typechecker trace information (350ed08) Message-ID: <20140718143410.38E0A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/350ed0833b426234b7baf0bfd4c68d704305b94a/ghc >--------------------------------------------------------------- commit 350ed0833b426234b7baf0bfd4c68d704305b94a Author: Simon Peyton Jones Date: Fri Jul 18 09:32:30 2014 +0100 Reduce volume of typechecker trace information >--------------------------------------------------------------- 350ed0833b426234b7baf0bfd4c68d704305b94a compiler/typecheck/FamInst.lhs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 4d5eeea..d0b2d0d 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -217,9 +217,12 @@ tcLookupFamInst tycon tys | otherwise = do { instEnv <- tcGetFamInstEnvs ; let mb_match = lookupFamInstEnv instEnv tycon tys - ; traceTc "lookupFamInst" ((ppr tycon <+> ppr tys) $$ - pprTvBndrs (varSetElems (tyVarsOfTypes tys)) $$ - ppr mb_match $$ ppr instEnv) + ; traceTc "lookupFamInst" $ + vcat [ ppr tycon <+> ppr tys + , pprTvBndrs (varSetElems (tyVarsOfTypes tys)) + , ppr mb_match + -- , ppr instEnv + ] ; case mb_match of [] -> return Nothing (match:_) @@ -297,8 +300,11 @@ checkForConflicts :: FamInstEnvs -> FamInst -> TcM Bool checkForConflicts inst_envs fam_inst = do { let conflicts = lookupFamInstEnvConflicts inst_envs fam_inst no_conflicts = null conflicts - ; traceTc "checkForConflicts" (ppr (map fim_instance conflicts) $$ - ppr fam_inst $$ ppr inst_envs) + ; traceTc "checkForConflicts" $ + vcat [ ppr (map fim_instance conflicts) + , ppr fam_inst + -- , ppr inst_envs + ] ; unless no_conflicts $ conflictInstErr fam_inst conflicts ; return no_conflicts } From git at git.haskell.org Fri Jul 18 14:34:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Jul 2014 14:34:13 +0000 (UTC) Subject: [commit: ghc] master: Further improvements to floating equalities (4b3df0b) Message-ID: <20140718143413.9F5032406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b3df0bb705c9287046c07bbc6c038960fbf8d53/ghc >--------------------------------------------------------------- commit 4b3df0bb705c9287046c07bbc6c038960fbf8d53 Author: Simon Peyton Jones Date: Fri Jul 18 09:35:24 2014 +0100 Further improvements to floating equalities This equality-floating stuff is horribly delicate! Trac #9316 showed up yet another corner case. The main changes are * include CTyVarEqs when "growing" the skolem set * do not include the kind argument to (~) when growing the skolem set I added a lot more comments as well >--------------------------------------------------------------- 4b3df0bb705c9287046c07bbc6c038960fbf8d53 compiler/typecheck/TcSimplify.lhs | 311 +++++++++++++-------- .../tests/indexed-types/should_compile/T9316.hs | 87 ++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 279 insertions(+), 120 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4b3df0bb705c9287046c07bbc6c038960fbf8d53 From git at git.haskell.org Fri Jul 18 17:21:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Jul 2014 17:21:47 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal submodule to HEAD (1.21) (af28e61) Message-ID: <20140718172147.73B2A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af28e61c7e84b8eb89fdfd9671af83a2a13f554a/ghc >--------------------------------------------------------------- commit af28e61c7e84b8eb89fdfd9671af83a2a13f554a Author: Edward Z. Yang Date: Fri Jul 18 09:50:28 2014 -0700 Update Cabal submodule to HEAD (1.21) Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- af28e61c7e84b8eb89fdfd9671af83a2a13f554a libraries/Cabal | 2 +- libraries/bin-package-db/bin-package-db.cabal | 2 +- utils/ghc-cabal/ghc-cabal.cabal | 2 +- utils/ghctags/ghctags.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index c125342..337f9cd 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit c125342d4147ffb59c88d43024ae9abfc3a9c96d +Subproject commit 337f9cd7927b787c6796acddc943393cf5b8e64c diff --git a/libraries/bin-package-db/bin-package-db.cabal b/libraries/bin-package-db/bin-package-db.cabal index dd84f9c..e8b4fd4 100644 --- a/libraries/bin-package-db/bin-package-db.cabal +++ b/libraries/bin-package-db/bin-package-db.cabal @@ -26,5 +26,5 @@ Library build-depends: base >= 4 && < 5, binary >= 0.5 && < 0.8, - Cabal >= 1.20 && < 1.21 + Cabal >= 1.20 && < 1.22 diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index 0f13b9d..5437d63 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -18,7 +18,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 1.20 && < 1.21, + Cabal >= 1.20 && < 1.22, directory >= 1.1 && < 1.3, filepath >= 1.2 && < 1.4 diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal index 31e80b2..e9c7848 100644 --- a/utils/ghctags/ghctags.cabal +++ b/utils/ghctags/ghctags.cabal @@ -19,6 +19,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 1.20 && <1.21, + Cabal >= 1.20 && <1.22, ghc From git at git.haskell.org Fri Jul 18 23:59:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Jul 2014 23:59:21 +0000 (UTC) Subject: [commit: ghc] master: Set i686 as the minimum architecture on 32-bit mingw (b34fa11) Message-ID: <20140718235921.82E602406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b34fa11ae06b6827eb643fbf3e6549559e90c681/ghc >--------------------------------------------------------------- commit b34fa11ae06b6827eb643fbf3e6549559e90c681 Author: niklas Date: Thu Jul 17 21:39:40 2014 +0200 Set i686 as the minimum architecture on 32-bit mingw Signed-off-by: Austin Seipp >--------------------------------------------------------------- b34fa11ae06b6827eb643fbf3e6549559e90c681 aclocal.m4 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index 782cae5..42f760c 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -526,6 +526,9 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], esac case $$1 in + i386-unknown-mingw32) + $2="$$2 -march=i686" + ;; i386-apple-darwin) $2="$$2 -m32" $3="$$3 -m32" From git at git.haskell.org Sat Jul 19 13:06:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 13:06:03 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' created Message-ID: <20140719130604.129C92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/travis Referencing: e8999d437e8c18cd16ae8b2dbbdb2ed0073cd70a From git at git.haskell.org Sat Jul 19 13:06:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 13:06:07 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Install process via cabal (e8999d4) Message-ID: <20140719130607.2F6A62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/e8999d437e8c18cd16ae8b2dbbdb2ed0073cd70a/ghc >--------------------------------------------------------------- commit e8999d437e8c18cd16ae8b2dbbdb2ed0073cd70a Author: Joachim Breitner Date: Sat Jul 19 15:05:53 2014 +0200 travis: Install process via cabal >--------------------------------------------------------------- e8999d437e8c18cd16ae8b2dbbdb2ed0073cd70a .travis.yml | 2 +- libraries/Cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 57153b6..7ee309b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -21,7 +21,7 @@ install: - sudo apt-get update - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - cabal update - - cabal install happy alex + - cabal install happy alex process script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs diff --git a/libraries/Cabal b/libraries/Cabal index 337f9cd..c125342 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 337f9cd7927b787c6796acddc943393cf5b8e64c +Subproject commit c125342d4147ffb59c88d43024ae9abfc3a9c96d From git at git.haskell.org Sat Jul 19 14:30:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 14:30:58 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' deleted Message-ID: <20140719143059.B452A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/travis From git at git.haskell.org Sat Jul 19 14:31:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 14:31:57 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' created Message-ID: <20140719143158.2BC492406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/travis Referencing: d35404177e273c961295ef6e3f77f696fde8989b From git at git.haskell.org Sat Jul 19 14:32:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 14:32:00 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Install process via cabal (d354041) Message-ID: <20140719143201.861C52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/d35404177e273c961295ef6e3f77f696fde8989b/ghc >--------------------------------------------------------------- commit d35404177e273c961295ef6e3f77f696fde8989b Author: Joachim Breitner Date: Sat Jul 19 15:05:53 2014 +0200 travis: Install process via cabal >--------------------------------------------------------------- d35404177e273c961295ef6e3f77f696fde8989b .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 57153b6..7ee309b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -21,7 +21,7 @@ install: - sudo apt-get update - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - cabal update - - cabal install happy alex + - cabal install happy alex process script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs From git at git.haskell.org Sat Jul 19 14:46:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 14:46:14 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Install process via cabal (ca751dd) Message-ID: <20140719144614.72CA52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/ca751dd4e826427032aeb140d8c58de136e516b7/ghc >--------------------------------------------------------------- commit ca751dd4e826427032aeb140d8c58de136e516b7 Author: Joachim Breitner Date: Sat Jul 19 15:05:53 2014 +0200 travis: Install process via cabal and install to global data base (bad practice, but ok on a throw-away CI system). >--------------------------------------------------------------- ca751dd4e826427032aeb140d8c58de136e516b7 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 57153b6..10021a5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -21,7 +21,7 @@ install: - sudo apt-get update - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - cabal update - - cabal install happy alex + - cabal install --global happy alex process script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs From git at git.haskell.org Sat Jul 19 15:12:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 15:12:32 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Install process via cabal (c41b716) Message-ID: <20140719151232.3AC512406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/c41b716d82b1722f909979d02a76e21e9b68886c/ghc >--------------------------------------------------------------- commit c41b716d82b1722f909979d02a76e21e9b68886c Author: Joachim Breitner Date: Sat Jul 19 15:05:53 2014 +0200 travis: Install process via cabal and install to global data base (bad practice, but ok on a throw-away CI system). >--------------------------------------------------------------- c41b716d82b1722f909979d02a76e21e9b68886c .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 57153b6..8b64940 100644 --- a/.travis.yml +++ b/.travis.yml @@ -20,8 +20,8 @@ before_install: install: - sudo apt-get update - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - - cabal update - - cabal install happy alex + - sudo cabal update + - sudo cabal install --global happy alex process script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs From git at git.haskell.org Sat Jul 19 15:49:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 15:49:55 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' deleted Message-ID: <20140719154955.92AFD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/travis From git at git.haskell.org Sat Jul 19 15:49:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 15:49:57 +0000 (UTC) Subject: [commit: ghc] master's head updated: travis: Install process via cabal (c41b716) Message-ID: <20140719154957.92BD32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: c41b716 travis: Install process via cabal From git at git.haskell.org Sat Jul 19 23:04:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 23:04:48 +0000 (UTC) Subject: [commit: ghc] wip/ext-solver: Merge branch 'master' into wip/ext-solver (5246346) Message-ID: <20140719230448.9E46B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ext-solver Link : http://ghc.haskell.org/trac/ghc/changeset/524634641c61ab42c555452f6f87119b27f6c331/ghc >--------------------------------------------------------------- commit 524634641c61ab42c555452f6f87119b27f6c331 Merge: 79ad1d2 c41b716 Author: Iavor S. Diatchki Date: Sat Jul 19 14:29:57 2014 -0700 Merge branch 'master' into wip/ext-solver >--------------------------------------------------------------- Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 524634641c61ab42c555452f6f87119b27f6c331 From git at git.haskell.org Sat Jul 19 23:04:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 23:04:54 +0000 (UTC) Subject: [commit: ghc] wip/ext-solver's head updated: Merge branch 'master' into wip/ext-solver (5246346) Message-ID: <20140719230454.17FC32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/ext-solver' now includes: fa5ac96 Don't require mk/config.mk for all cleanup targets c4e9f24 Test Trac #9036 0960a37 rm -rf ./docs/comm ba2e201 Do type-class defaulting even if there are insoluble constraints ef35d4c Remove the definition of die, which is now provided by System.Exit 7201e2a Update 32-bit perf numbers 3c990bf Start on 7.10.1 release notes 48e475e Fix annotation reification for home package modules 5f5e326 Add a comprehensive test for using Annotations from TH 7b967af tcrun045 should fail (implicit parameter as superclass) 2f3ea95 Print for-alls more often (Trac #9018) 0fe7268 annth_make, annth_compunits: Only run these tests if have_dynamic() a3896ab Improve implementation of unSubCo_maybe. ab8bb48 Fix scavenge_stack crash (#9045) 1d0798c Typo in comments 3a5c549 Typo in comment 4539400 rts: Add an initial Coverity model 7400810 Revert "rts: Add an initial Coverity model" 91cc88b Add Note [Role twiddling functions] to Coercion. 275ea0f rts: Add an initial Coverity model e597f5f rts: Fix leak of file archive handle b7278d3 rts: Fix memory leak when loading ELF objects 43b3bab Rts: Consistently use StgWord for sizes of bitmaps 05fcc33 Rts: Reuse scavenge_small_bitmap (#8742) 83a003f Don't inline non-register GlobalRegs 34db5cc Replace all #!/usr/bin/perl with #!/usr/bin/env perl b0534f7 Per-thread allocation counters and limits a05f8dd Update Haddock submodule ref. Fixes `cabal test'. 5bf22f0 Remove external core 54b31f7 fix rts exported symbols base_GHCziIOziException_allocationLimitExceeded_closure 2e03d86 Update comment now that we have per-gen weak pointer lists. 5141baf Improve docs for array indexing primops f0fcc41 Revert "Per-thread allocation counters and limits" 9f3e39d Fix over-zealous unused-import warning 1302d50 Add -fno-full-laziness to get consistent profiling output cdca791 Changed profiling output is fine (according to Simon Marlow) 675c547 Improve comments and tracing in SpecConstr 3c3ce82 Modularise pretty-printing for foralls 5b73dc5 Second go at fixing #9061 13a330e Fix Trac #9071, an egregious bug in TcDeriv.inferConstraints 02227dd Add a bit more typechecker tracing 59b4e6d Adding missing test files for #9071 22ed9ef Update transformers submodule to new v0.4 rel 76820ca Improve tracing in Simplifier 0f978b5 Refactor buildClass and mkDictSelId a bit, to avoid the no_unf argument 4088799 Mark evaluated arguments in dataConInstPat 35be701 Preserve evaluated-ness in CoreTidy b5ca10c Better error message in vectoriser 12332f1 Error message wibble, presumably due to recent changes in transformers c302a46 Update .gitignore 2f9a846 testsuite: fix cgrun051 exit code 3ed867f testsuite: fix cc004 3abf949 Require transformers for T5979 fe8a378 Revert output of T5979 2745164 Comments only, on inert_fsks and inert_no_eqs 770e16f In splitHsFunType, take account of prefix (->) b5cf17f Improve desugaring of lazy pattern match 315fff6 Typo in comment 1f8f927 Typo in note 4cfc1fa Lint should check that TyConAppCo doesn't have a synonym in the tycon position 21f17d0 Fix invariant in mkAppCoFlexible 214ad2d Fix globalRegMaybe for unregisterised build. 3fd7f54 Wibble to 4cfc1fae b036424 Update Haddock submodule. 0148a1c Add strict ver. of (<$>): (<$!>) to Control.Monad dd92e21 Set cabal files to default-language:Haskell2010 88c0870 Remove LANGUAGE pragrams implied by Haskell2010 fc0ed8a Add missing stack checks to stg_ap_* functions (#9001) 913b314 Avoid NondecreasingIndentation syntax in ghc-pkg 61fdafc Drop use of CPP in `bin-package-db` d4aa4e4 Drop default-extensions:CPP in hpc-bin.cabal 2dd80f6 Convert `ghc-bin.cabal` to use others-extensions e199891 Avoid trivial cases of NondecreasingIndentation 2389244 Add LANGUAGE pragmas to compiler/ source files 9a58cac Express OPTIONS_GHC as LANGUAGE pragmas 022f875 Refactoring around TyCon.isSynTyCon bc7d49a Only uninstall signal handlers if they were actually installed (#9068) 882978d ghc: Update containers submodule 4dac3a4 base: Document Foreign.ForeignPtr (#8475) b75d126 rts: remove stable-names from hashtable upon free 39aa1e9 integer-gmp: do not confuse ./configure (#8783) 3df1c51 Extract derived constants from nm output for various OSes differently. 3a61e6d Tighten up wording in the section on let-generalisation and MonoLocalBinds eab173b Remove the bit about External Core from flags.xml 4117551 Re-add 'classP' with a compatible implementation and a deprecation notice 135489d Provide deprecated backward compatible implementation to 'equalP' a8cba19 Catch some typos 3a04ce2 Fix below warning by including "unistd.h" also a15d243 Harden imports in `DeriveConstants.hs` module 7e78faf Coercible: Unwrap newtypes before coercing under tycons 94c5767 Coercible: Test case for now broken(?) corner case 7d958ce Tweaks to note; also fixed unicode quotes bc58d2e Simple eta reduction in call to adjustMatchResults, just a tidy-up d8d9711 Make the unifier a fixpoint even for the free kind vars of a tyvar d41aa76 Better pretty-printing for ClsInst 02437a1 More debug info for failures in typeKind and kindFunResult 427e205 White space only 4dea15a Bump bytes-allocated for T3064 b33f321 Typos in comments 864759c test.mk: Be liberal in accepting GHC_PKG output b1436f5 Fix yet another bug in 'deriving' for polykinded classes (Trac #7269) db869e7 Add missing test file T7269 6ed5430 Replace DeriveDataTypeable by AutoDeriveTypeable ac2796e Store IfExtNames for PatSyn matchers and wrappers in interface file. This way, the Ids for the matchers/wrappers are reused by importing modules, and thus unfoldings are kept. fb74d71 Assert that matcher-derived PatSyn types match the (redundant) stored types in IfacePatSyn 2745dfb Test Trac #9144 b95dbb5 T4006, environment001, T3307 all work on msys2 8668c54 Use mkTcEqPred rather than mkEqPred in the type checker 3c1f2f7 No need to call defaultKind in mkTcEqPred e80089e Fix comment typo a518500 Update Haddock submodule. dcc6e04 Update T4891, T8639_api to follow 73c08ab10 (GHCi naming changes) 6c5017a Add .gitignore for autogenerated test files. cd14075 Fix bitrotted GHC API test T6145. a23f131 Add missing stderr file for tcrun045. fc6a952 s/implict/implicit/i a53fc11 Refresh recomp006 error message. 0c1974c Remove obsolete -fno-warn-amp from spec001 723095b Per-capability nursery weak pointer lists, fixes #9075 5a392ca Disable FixEither tests in TcCoercible a8d81af mkHiPath & mkObjPath didn't need to be in IO 994d5e3 Remove deprecated -optdep options 660c3f9 Just formatting 96a95f0 Fix missing unlockClosure() call in tryReadMVar (#9148) 9e10963 Improve Note [Order of Coercible Instances] about Trac #9117 2da439a fix missing space 09dc9a8 Rename TypeRep.Prec to TypeRep.TyPrec 0ba74f6 Use mkTcEqPred rather than mkEqPred da64c97 Fix inverted gadt-syntax flag for data families b4856f9 Do pretty-printing of TyThings via IfaceDecl (Trac #7730) 6e8861c Use IfLclName instead of OccName in IfaceEqSpec d02cd1a Add :kind test in T7730 dd99434 Comments only (related to Trac #7730) d7a228b Set/update upstream repo url for haddock fe59334 Export `TimerManager` from GHC.Event (re #9165) c63a465 Subsume NullaryTypeClasses by MultiParamTypeClasses (#8993) 0a55a3c Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) 616f54b Test Trac #9023 3faf83e Add .arcconfig file. Do not use yet. 56ea745 Add ".text.unlikely" to recognized code sections on Windows. c226d25 Emit error in case of duplicate GRE; fixes #7241 6ad11c4 Fix .arcconfig 9ff32f9 Typo 4627575 Tweak comments 2a463eb Fix compilation of cmm files with -outputdir (Trac #9050) f9def07 Typo 009e86f Suggest Int when user writes int ae41a50 Report all possible results from related name spaces d3cae19 Add testcase for #9177 and adjust test output 6e50553 Update test results (last minuite changes) 3a2b21d Added link ends to role documentation. 6fa7577 Sorted the language options list alphabetically, and added missing options. 57cc003 Prevent line wrapping after the dash of an option. 7ac600d Make the matcher and wrapper Ids in PatSyn into LocalIds, not GlobalIds 63e1f09 Added more option implication documentation. 5c89f88 Merge branch 'master' of git://git.haskell.org/ghc 3bdc78b Make DeriveTraversable imply DeriveFunctor/Foldable 63d7047 Added testcase for #9069 1178fa4 Update mod73 test output 819e1f2 Use UnicodeSyntax when printing 6e4a750 Only use UnicodeSytanx pretty printing if the locale supports it b021572 Test case: GHCi uses UnicodeSyntax if the loaded file uses it. e577a52 Fix discarding of unreachable code in the register allocator (#9155) fbdebd3 supress warning of bang wildcard pattern-binding (i.e. let !_ = rhs). This fixes #9127 ab3f95b s/-hi-diffs/-ddump-hi-diffs/ in docs (#9179) b36bc2f Test case for #9181 (:browse GHC.TypeLits panic) 96a8980 Pretty-print built in synonym families in interfaces 2f8b4c9 Fix obscure problem with using the system linker (#8935) 9fd507e Raise exceptions when blocked in bad FDs (fixes Trac #4934) 70f58eb Remove unused --run-cps/--run-cpsz options c025817 Don't use showPass in the backend (#8973) 66bddbb Check that an associated type mentions at least one type variable from the class aa18a46 Improve documentation for -fwarn-unused-binds 52509d8 Document -fwarn-inline-rule-shadowing (Trac #9166) 59cdb99 Document explicit import/export of data constructors (Trac #8753) 4b4d81a Suggest -fprint-explicit-kinds when only kind variables are ambiguous 877a957 Better warning message for orphan instances (Ticket #9178) 4caadb7 Ship xhtml, terminfo, haskeline (#8919) 25fb4fe Add .arclint file 1946922 Make Ptr's parameter phantom 707bde5 Update test results with new orphan instance warning f251afe Revert "Make Ptr's parameter phantom" 5bdbd51 Make Ptr's parameter phantom faddad7 Improve the API doc description of the SmallArray primitive types f764aac Fire "map/coerce" only in phase 1 fdf370e Forgot to amend before pushing... 0e6bc84 Make better use of the x86 addressing mode 9e6c6b4 Make FunPtr's role be phantom; add comments. 1153194 Clarify error message. See #9167. 8dcfdf9 Add comments about instances of type-level (==). 0f584ae Refine deprecation warnings in template-haskell. 051d694 Fix #9097. 6a1d7f9 Fix #9085. e79e2c3 Fix #9062. 7b10d01 Test #9097. 9dbf340 Fix #9111. f502617 Test #9085. f73d42f Test #9111. a9ff7d0 Typo in variable name, no functional change edd5764 Some typos in comments 56f8777 Improve error message in Trac #8883 7817ec1 Comments only explaining the imports for GHC.Integer, GHC.Tuple 748bec4 White space only e5257f8 Fix tyConToIfaceDecl (Trac #9190) c8295c0 Simplify variable naming in tcDataKindSig 7d9feb2 Fix a serious, but rare, strictness analyser bug (Trac #9128) 7f467d0 Fix Windows build (wibble to fix for Trac #4934) 165ac4a Catch two typos a600c91 Improve IfaceSyn a bit further b60df0f Better debug printing 571f0ad Line up kind and type variables correctly when desugaring TH brackets b637585 Fix elemLocalRdrEnv (Trac #9160) 970e5d9 Bytes allocated by haddock.base has crept up (again) 632fcf1 Remove forgotten redundant import ce19d50 Fixes #95 :edit command should jump to the last error 0354fb3 Implement `Typeable` support for type-level literals (#8778). 5ffc68b Fix recomputation of TypeRep in the instance for Typeable (s a) (#9203) e09be5f Update the incorrect comment on when function was introduced. 836981c Redo instance to be more efficient (see #8778, #9203) 00fc4ba Optimise the Typeable instance for type app a bit, and add a perf test e38fe3b accept T9181 output 652c9e6 Haddock: haddock-library release and Travis stuff 2ba1a56 Only comments: add notes explaining the various oddities of the `Typeable` implementation for type-level literals. 2a41db3 In progress Backpack implementation docs. 46ec4ae haddock-library: allow 7.4.x building 453e0fd Typo 3d81359 Typos in comments a52bf96 Finish the rest of the writeup. b1888aa Typos in comments b6693d3 A bit more tracing of functional dependencies 0ceb84e Tidy up the printing of single-predicate contexts cdc7431 Add a new section to the manual about hiding things that a module doesn't export aec9e75 Improve documentation of defaulting rules with OverloadedStrings 2e362dd Make splitStrProdDmd (and similarly Use) more robust 64224f1 Comment typo 9c621e9 Reject forall types in constraints in signatures e47baaf More fixes and updates to implementation document 48abb88 Update documentation to follow 2dc3b476aff28 aa3166f Add fake entries into the global kind environment for pattern synonyms. b6352c9 Simplify package dump for -v4 b847481 Fix #9047 95f95ed Fix up b84748121e777d 446b0e1 arclint: disable Bad Charset lint rule 4612524 sync-all: cleanup bd07942 sync-all: delete dead code calling gitInitSubmodules 101c3f7 sync-all: die for real when required repo is missing bdb5809 sync-all: make --no-dph work for all subcommands 9a131dd sync-all: set and check variable $repo_is_submodule 72fe49d sync-all: infer remotepath from .gitmodules file 518ada5 Mark T9208 as broken when debugging is on 7a78374 More updates to Backpack impl docs. c1035d5 Fix regression in Data.Fixed Read instance (re #9231) 761c4b1 Minor refactoring of interface to extraTyVarInfo 8a0aa19 Comment the expect_broken for Trac #9208 0757831 Add Note [Placeholder PatSyn kinds] in TcBinds a4a79b5 Describe signature mini-backpack. d8abf85 Add more primops for atomic ops on byte arrays ec550e8 Fixup c1035d51e to behave more like in GHC 7.6 db19c66 Convert loose sub-repos into proper submodules (re #8545) 97ac32a Typos in comments 881be80 Fix anchors in Haddock 9833090 Fix few Haddock parser brainfarts d587ebd The linking restriction, no shaping necessary. c7dacdb sync-all: Allow - in submodule URLs c61260e Merge Thomas Miedema?s syn-all improvments 4bf3aa2 Fix sync-all get from a local working copy bcccadd Fix ?Checking for old .. repo? messages 04dd7cb Work around lack of __sync_fetch_and_nand in clang 84d7845 Lots of rewrites to further move toward new world order 950fcae Revert "Add more primops for atomic ops on byte arrays" 22c16eb Update parallel and stm submodules to have .gitignore 5bbbc7d arclint: update rules for xml files ab105f8 Add new flag -fwrite-interface for -fno-code. aa4c5e7 Add testsuite-related .gitignore files af913ad s/KnownLit/KnownSymbol/g and a typo fix 0451f91 More allDistinctTyVars from TcDeriv to Type 2be99d2 In TcValidity.checkAmbiguity, skolemise kind vars that appear free in the kinds of type variables fe0cbe4 Fix docs typo. b80d573 Refactor extension-bitmap in Lexer 05120ec Make -fno-write-interface to all modes of GHC, not just -fno-code. 5031772 Revert "Make -fno-write-interface to all modes of GHC, not just -fno-code." f4766c4 Comments only 1c0b5fd Add -XBinaryLiterals language extension (re #9224) ec38f4a Minor updates to Backpack docs. 713b271 Whitespace only 4144996 Untabify and M-x whitespace cleanup 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 5246346 Merge branch 'master' into wip/ext-solver From git at git.haskell.org Sat Jul 19 23:54:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Jul 2014 23:54:45 +0000 (UTC) Subject: [commit: ghc] master: Document OVERLAP pragmas. (99c2823) Message-ID: <20140719235445.852FA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99c28232115702003d4c2728bc44e09bd60993f2/ghc >--------------------------------------------------------------- commit 99c28232115702003d4c2728bc44e09bd60993f2 Author: Iavor S. Diatchki Date: Sat Jul 19 16:54:35 2014 -0700 Document OVERLAP pragmas. >--------------------------------------------------------------- 99c28232115702003d4c2728bc44e09bd60993f2 docs/users_guide/glasgow_exts.xml | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 9acb56f..336798c 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5022,6 +5022,18 @@ and flags are dynamic flags, and can be set on a per-module basis, using an LANGUAGE pragma if desired (). + +In addition, it is possible to specify the overlap behavior for individual +instances with a pragma, written immediately after the +instance keyword. The pragma may be one of: +OVERLAP, NO_OVERLAP, +or INCOHERENT. An explicit pragma on an instance +takes precedence over the default specified with a flag or +a LANGUAGE pragma. For example, an instance marked with +{-# NO_OVERLAP #-} will be marked as non-overlapping, +even if the module contains {-# LANGUAGE OverlappingInstances #-}. + + The flag instructs GHC to loosen @@ -5037,7 +5049,8 @@ The flag implies the A more precise specification is as follows. The willingness to be overlapped or incoherent is a property of -the instance declaration itself, controlled by the +the instance declaration itself, controlled by +iether an explicit pragma, or the presence or otherwise of the and flags when that instance declaration is being compiled. Now suppose that, in some client module, we are searching for an instance of the @@ -10771,6 +10784,22 @@ data T = T {-# NOUNPACK #-} !(Int,Int) + +OVERLAP, NO_OVERLAP, and INCOHERENT pragmas + +The OVERLAP, NO_OVERLAP, and +INCOHERENT pragmas are used to specify the overlap +behavior for individual instances, as described in Section +. They take precedence over the behavior +specified with the corresponding LANGUAGE pragmas. +The pragmas are written immediately after the instance +keyword. For example: + + +instance {-# OVERLAP #-} C t where ... + + + From git at git.haskell.org Sun Jul 20 20:11:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 20:11:02 +0000 (UTC) Subject: [commit: ghc] master: Documentation typo (23cd98f) Message-ID: <20140720201102.E40572406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23cd98fdede1435e46785e7a6efc5e13132af984/ghc >--------------------------------------------------------------- commit 23cd98fdede1435e46785e7a6efc5e13132af984 Author: Gabor Greif Date: Sun Jul 20 22:08:48 2014 +0200 Documentation typo >--------------------------------------------------------------- 23cd98fdede1435e46785e7a6efc5e13132af984 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 336798c..0163ac9 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5050,7 +5050,7 @@ The flag implies the A more precise specification is as follows. The willingness to be overlapped or incoherent is a property of the instance declaration itself, controlled by -iether an explicit pragma, or the +either an explicit pragma, or the presence or otherwise of the and flags when that instance declaration is being compiled. Now suppose that, in some client module, we are searching for an instance of the From git at git.haskell.org Sun Jul 20 20:49:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 20:49:51 +0000 (UTC) Subject: [commit: ghc] master: Comments only (8249b50) Message-ID: <20140720204951.CA3B52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8249b509461c936d1d5fc6a81275d37fade5d1dc/ghc >--------------------------------------------------------------- commit 8249b509461c936d1d5fc6a81275d37fade5d1dc Author: Simon Peyton Jones Date: Sun Jul 20 21:47:50 2014 +0100 Comments only >--------------------------------------------------------------- 8249b509461c936d1d5fc6a81275d37fade5d1dc compiler/typecheck/TcSMonad.lhs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 898e2b8..9b73fe6 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1559,6 +1559,8 @@ data XEvTerm = XEvTerm { ev_preds :: [PredType] -- New predicate types , ev_comp :: [EvTerm] -> EvTerm -- How to compose evidence , ev_decomp :: EvTerm -> [EvTerm] -- How to decompose evidence + -- In both ev_comp and ev_decomp, the [EvTerm] is 1-1 with ev_preds + -- and each EvTerm has type of the corresponding EvPred } data MaybeNew = Fresh CtEvidence | Cached EvTerm @@ -1645,16 +1647,16 @@ Note [xCFlavor] ~~~~~~~~~~~~~~~ A call might look like this: - xCtFlavor ev subgoal-preds evidence-transformer + xCtEvidence ev evidence-transformer - ev is Given => use ev_decomp to create new Givens for subgoal-preds, + ev is Given => use ev_decomp to create new Givens for ev_preds, and return them - ev is Wanted => create new wanteds for subgoal-preds, + ev is Wanted => create new wanteds for ev_preds, use ev_comp to bind ev, return fresh wanteds (ie ones not cached in inert_cans or solved) - ev is Derived => create new deriveds for subgoal-preds + ev is Derived => create new deriveds for ev_preds (unless cached in inert_cans or solved) Note: The [CtEvidence] returned is a subset of the subgoal-preds passed in From git at git.haskell.org Sun Jul 20 21:51:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:51:27 +0000 (UTC) Subject: [commit: ghc] master: Revert "Update Cabal submodule to HEAD (1.21)" (f23b212) Message-ID: <20140720215127.E40062406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f23b2129aca24beb4ece0d5915f67c448dc64ae4/ghc >--------------------------------------------------------------- commit f23b2129aca24beb4ece0d5915f67c448dc64ae4 Author: Edward Z. Yang Date: Sun Jul 20 22:50:44 2014 +0100 Revert "Update Cabal submodule to HEAD (1.21)" This reverts commit af28e61c7e84b8eb89fdfd9671af83a2a13f554a. We'll wait until it's possible to bootstrap from 7.6 out of the box. >--------------------------------------------------------------- f23b2129aca24beb4ece0d5915f67c448dc64ae4 libraries/Cabal | 2 +- libraries/bin-package-db/bin-package-db.cabal | 2 +- utils/ghc-cabal/ghc-cabal.cabal | 2 +- utils/ghctags/ghctags.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 337f9cd..c125342 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 337f9cd7927b787c6796acddc943393cf5b8e64c +Subproject commit c125342d4147ffb59c88d43024ae9abfc3a9c96d diff --git a/libraries/bin-package-db/bin-package-db.cabal b/libraries/bin-package-db/bin-package-db.cabal index e8b4fd4..dd84f9c 100644 --- a/libraries/bin-package-db/bin-package-db.cabal +++ b/libraries/bin-package-db/bin-package-db.cabal @@ -26,5 +26,5 @@ Library build-depends: base >= 4 && < 5, binary >= 0.5 && < 0.8, - Cabal >= 1.20 && < 1.22 + Cabal >= 1.20 && < 1.21 diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index 5437d63..0f13b9d 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -18,7 +18,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 1.20 && < 1.22, + Cabal >= 1.20 && < 1.21, directory >= 1.1 && < 1.3, filepath >= 1.2 && < 1.4 diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal index e9c7848..31e80b2 100644 --- a/utils/ghctags/ghctags.cabal +++ b/utils/ghctags/ghctags.cabal @@ -19,6 +19,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 1.20 && <1.22, + Cabal >= 1.20 && <1.21, ghc From git at git.haskell.org Sun Jul 20 21:56:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:35 +0000 (UTC) Subject: [commit: ghc] master: ghci: detabify/dewhitespace RtClosureInspect (1486fc8) Message-ID: <20140720215635.65F3D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1486fc8398e37487a6adcc70a5c3191f5a2601e0/ghc >--------------------------------------------------------------- commit 1486fc8398e37487a6adcc70a5c3191f5a2601e0 Author: Austin Seipp Date: Fri Jul 18 22:08:43 2014 -0500 ghci: detabify/dewhitespace RtClosureInspect Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1486fc8398e37487a6adcc70a5c3191f5a2601e0 compiler/ghci/RtClosureInspect.hs | 24 ++++++++---------------- 1 file changed, 8 insertions(+), 16 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index a2f9af9..dde813d 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -7,14 +7,6 @@ -- Pepe Iborra (supported by Google SoC) 2006 -- ----------------------------------------------------------------------------- - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module RtClosureInspect( cvObtainTerm, -- :: HscEnv -> Int -> Bool -> Maybe Type -> HValue -> IO Term cvReconstructType, @@ -360,8 +352,8 @@ ppr_termM y p Term{dc=Right dc, subTerms=tt} ; return $ cparen (p >= app_prec) $ sep [ppr dc, nest 2 (pprDeeperList fsep tt_docs)] } where - sub_terms_to_show -- Don't show the dictionary arguments to - -- constructors unless -dppr-debug is on + sub_terms_to_show -- Don't show the dictionary arguments to + -- constructors unless -dppr-debug is on | opt_PprStyle_Debug = tt | otherwise = dropList (dataConTheta dc) tt @@ -474,7 +466,7 @@ cPprTermBase y = ppr_list p (Term{subTerms=[h,t]}) = do let elems = h : getListTerms t isConsLast = not(termType(last elems) `eqType` termType h) - is_string = all (isCharTy . ty) elems + is_string = all (isCharTy . ty) elems print_elems <- mapM (y cons_prec) elems if is_string @@ -762,7 +754,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do -- In such case, we return a best approximation: -- ignore the unpointed args, and recover the pointeds -- This preserves laziness, and should be safe. - traceTR (text "Not constructor" <+> ppr dcname) + traceTR (text "Not constructor" <+> ppr dcname) let dflags = hsc_dflags hsc_env tag = showPpr dflags dcname vars <- replicateM (length$ elems$ ptrs clos) @@ -1217,10 +1209,10 @@ zonkRttiType = zonkTcTypeToType (mkEmptyZonkEnv zonk_unbound_meta) zonk_unbound_meta tv = ASSERT( isTcTyVar tv ) do { tv' <- skolemiseUnboundMetaTyVar tv RuntimeUnk - -- This is where RuntimeUnks are born: - -- otherwise-unconstrained unification variables are - -- turned into RuntimeUnks as they leave the - -- typechecker's monad + -- This is where RuntimeUnks are born: + -- otherwise-unconstrained unification variables are + -- turned into RuntimeUnks as they leave the + -- typechecker's monad ; return (mkTyVarTy tv') } -------------------------------------------------------------------------------- From git at git.haskell.org Sun Jul 20 21:56:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:38 +0000 (UTC) Subject: [commit: ghc] master: ghci: detabify/unwhitespace ByteCodeInstr (23aee51) Message-ID: <20140720215641.8859B2406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23aee51166c2f2f5c43375ab4f3fdafb3ab18f1d/ghc >--------------------------------------------------------------- commit 23aee51166c2f2f5c43375ab4f3fdafb3ab18f1d Author: Austin Seipp Date: Fri Jul 18 22:12:55 2014 -0500 ghci: detabify/unwhitespace ByteCodeInstr Signed-off-by: Austin Seipp >--------------------------------------------------------------- 23aee51166c2f2f5c43375ab4f3fdafb3ab18f1d compiler/ghci/ByteCodeInstr.lhs | 158 +++++++++++++++++++--------------------- 1 file changed, 75 insertions(+), 83 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 23aee51166c2f2f5c43375ab4f3fdafb3ab18f1d From git at git.haskell.org Sun Jul 20 21:56:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:40 +0000 (UTC) Subject: [commit: ghc] master: cmm: detabify/unwhitespace CmmLex (ffcb14d) Message-ID: <20140720215642.3E3692406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ffcb14d4bd5ec410fc843f52ef78b790fb2f3cfd/ghc >--------------------------------------------------------------- commit ffcb14d4bd5ec410fc843f52ef78b790fb2f3cfd Author: Austin Seipp Date: Fri Jul 18 22:11:28 2014 -0500 cmm: detabify/unwhitespace CmmLex Signed-off-by: Austin Seipp >--------------------------------------------------------------- ffcb14d4bd5ec410fc843f52ef78b790fb2f3cfd compiler/cmm/CmmLex.x | 188 +++++++++++++++++++++++++------------------------- 1 file changed, 94 insertions(+), 94 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ffcb14d4bd5ec410fc843f52ef78b790fb2f3cfd From git at git.haskell.org Sun Jul 20 21:56:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:42 +0000 (UTC) Subject: [commit: ghc] master: ghci: detabify/unwhitespace ByteCodeGen (bd4e855) Message-ID: <20140720215643.062772406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd4e855142c660135b3017c0217c9586d38d394f/ghc >--------------------------------------------------------------- commit bd4e855142c660135b3017c0217c9586d38d394f Author: Austin Seipp Date: Fri Jul 18 22:12:29 2014 -0500 ghci: detabify/unwhitespace ByteCodeGen Signed-off-by: Austin Seipp >--------------------------------------------------------------- bd4e855142c660135b3017c0217c9586d38d394f compiler/ghci/ByteCodeGen.lhs | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index d4a5804..645a0d8 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -6,13 +6,6 @@ ByteCodeGen: Generate bytecode from Core \begin{code} {-# LANGUAGE CPP, MagicHash #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where #include "HsVersions.h" @@ -820,8 +813,8 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple MASSERT(isAlgCase) rhs_code <- schemeE (d_alts + size) s p' rhs return (my_discr alt, unitOL (UNPACK (trunc16 size)) `appOL` rhs_code) - where - real_bndrs = filterOut isTyVar bndrs + where + real_bndrs = filterOut isTyVar bndrs my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) @@ -1253,8 +1246,8 @@ pushAtom d p e | Just e' <- bcView e = pushAtom d p e' -pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things, - = return (nilOL, 0) -- treated just like a variable V +pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things, + = return (nilOL, 0) -- treated just like a variable V pushAtom d p (AnnVar v) | UnaryRep rep_ty <- repType (idType v) @@ -1564,12 +1557,12 @@ isVAtom :: AnnExpr' Var ann -> Bool isVAtom e | Just e' <- bcView e = isVAtom e' isVAtom (AnnVar v) = isVoidArg (bcIdArgRep v) isVAtom (AnnCoercion {}) = True -isVAtom _ = False +isVAtom _ = False atomPrimRep :: AnnExpr' Id ann -> PrimRep atomPrimRep e | Just e' <- bcView e = atomPrimRep e' -atomPrimRep (AnnVar v) = bcIdPrimRep v -atomPrimRep (AnnLit l) = typePrimRep (literalType l) +atomPrimRep (AnnVar v) = bcIdPrimRep v +atomPrimRep (AnnLit l) = typePrimRep (literalType l) atomPrimRep (AnnCoercion {}) = VoidRep atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate (undefined,other))) From git at git.haskell.org Sun Jul 20 21:56:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:45 +0000 (UTC) Subject: [commit: ghc] master: parser: detabify/dewhitespace Ctype (d2464b5) Message-ID: <20140720215645.B94C62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2464b56a2d3ae56617e2d82391f4e180e1e1180/ghc >--------------------------------------------------------------- commit d2464b56a2d3ae56617e2d82391f4e180e1e1180 Author: Austin Seipp Date: Fri Jul 18 22:08:56 2014 -0500 parser: detabify/dewhitespace Ctype Signed-off-by: Austin Seipp >--------------------------------------------------------------- d2464b56a2d3ae56617e2d82391f4e180e1e1180 compiler/parser/Ctype.lhs | 47 ++++++++++++++++++++--------------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/compiler/parser/Ctype.lhs b/compiler/parser/Ctype.lhs index c024ebe..7233f50 100644 --- a/compiler/parser/Ctype.lhs +++ b/compiler/parser/Ctype.lhs @@ -2,32 +2,25 @@ Character classification \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module Ctype - ( is_ident -- Char# -> Bool - , is_symbol -- Char# -> Bool - , is_any -- Char# -> Bool - , is_space -- Char# -> Bool - , is_lower -- Char# -> Bool - , is_upper -- Char# -> Bool - , is_digit -- Char# -> Bool - , is_alphanum -- Char# -> Bool - - , is_decdigit, is_hexdigit, is_octdigit, is_bindigit - , hexDigit, octDecDigit - ) where + ( is_ident -- Char# -> Bool + , is_symbol -- Char# -> Bool + , is_any -- Char# -> Bool + , is_space -- Char# -> Bool + , is_lower -- Char# -> Bool + , is_upper -- Char# -> Bool + , is_digit -- Char# -> Bool + , is_alphanum -- Char# -> Bool + + , is_decdigit, is_hexdigit, is_octdigit, is_bindigit + , hexDigit, octDecDigit + ) where #include "HsVersions.h" -import Data.Int ( Int32 ) -import Data.Bits ( Bits((.&.)) ) -import Data.Char ( ord, chr ) +import Data.Int ( Int32 ) +import Data.Bits ( Bits((.&.)) ) +import Data.Char ( ord, chr ) import Panic \end{code} @@ -76,13 +69,13 @@ octDecDigit c = ord c - ord '0' is_decdigit :: Char -> Bool is_decdigit c - = c >= '0' && c <= '9' + = c >= '0' && c <= '9' is_hexdigit :: Char -> Bool is_hexdigit c - = is_decdigit c - || (c >= 'a' && c <= 'f') - || (c >= 'A' && c <= 'F') + = is_decdigit c + || (c >= 'a' && c <= 'f') + || (c >= 'A' && c <= 'F') is_octdigit :: Char -> Bool is_octdigit c = c >= '0' && c <= '7' @@ -112,7 +105,7 @@ charType c = case c of '\7' -> 0 -- \007 '\8' -> 0 -- \010 '\9' -> cSpace -- \t (not allowed in strings, so !cAny) - '\10' -> cSpace -- \n (ditto) + '\10' -> cSpace -- \n (ditto) '\11' -> cSpace -- \v (ditto) '\12' -> cSpace -- \f (ditto) '\13' -> cSpace -- ^M (ditto) From git at git.haskell.org Sun Jul 20 21:56:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:48 +0000 (UTC) Subject: [commit: ghc] master: parser: detabify/dewhitespace cutils.c (20986a6) Message-ID: <20140720215648.3F1172406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/20986a63b427ac6061c3c871098ed4f045b07201/ghc >--------------------------------------------------------------- commit 20986a63b427ac6061c3c871098ed4f045b07201 Author: Austin Seipp Date: Fri Jul 18 22:09:03 2014 -0500 parser: detabify/dewhitespace cutils.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 20986a63b427ac6061c3c871098ed4f045b07201 compiler/parser/cutils.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/compiler/parser/cutils.c b/compiler/parser/cutils.c index c42ec9e..d714a0c 100644 --- a/compiler/parser/cutils.c +++ b/compiler/parser/cutils.c @@ -37,7 +37,7 @@ ghc_memcmp_off( HsPtr a1, HsInt i, HsPtr a2, HsInt len ) } void -enableTimingStats( void ) /* called from the driver */ +enableTimingStats( void ) /* called from the driver */ { RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS; } @@ -47,9 +47,7 @@ setHeapSize( HsInt size ) { RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE; if (RtsFlags.GcFlags.maxHeapSize != 0 && - RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) { - RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; + RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) { + RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; } } - - From git at git.haskell.org Sun Jul 20 21:56:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:50 +0000 (UTC) Subject: [commit: ghc] master: prelude: detabify/unwhitespace PrelInfo (b5b1a2d) Message-ID: <20140720215651.B0EBC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5b1a2dbd9f6f8057317ba36a65416a6d3daf475/ghc >--------------------------------------------------------------- commit b5b1a2dbd9f6f8057317ba36a65416a6d3daf475 Author: Austin Seipp Date: Fri Jul 18 22:21:28 2014 -0500 prelude: detabify/unwhitespace PrelInfo Signed-off-by: Austin Seipp >--------------------------------------------------------------- b5b1a2dbd9f6f8057317ba36a65416a6d3daf475 compiler/prelude/PrelInfo.lhs | 47 ++++++++++++++++++------------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs index 829b5e3..eaefff2 100644 --- a/compiler/prelude/PrelInfo.lhs +++ b/compiler/prelude/PrelInfo.lhs @@ -5,13 +5,6 @@ \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module PrelInfo ( wiredInIds, ghcPrimIds, primOpRules, builtinRules, @@ -49,9 +42,9 @@ import Data.Array \end{code} %************************************************************************ -%* * +%* * \subsection[builtinNameInfo]{Lookup built-in names} -%* * +%* * %************************************************************************ Notes about wired in things @@ -60,7 +53,7 @@ Notes about wired in things They are global values in GHC, (e.g. listTyCon :: TyCon). * A wired in Name contains the thing itself inside the Name: - see Name.wiredInNameTyThing_maybe + see Name.wiredInNameTyThing_maybe (E.g. listTyConName contains listTyCon. * The name cache is initialised with (the names of) all wired-in things @@ -80,15 +73,15 @@ wiredInThings :: [TyThing] -- get a Name with the correct known key (See Note [Known-key names]) wiredInThings = concat - [ -- Wired in TyCons and their implicit Ids - tycon_things - , concatMap implicitTyThings tycon_things + [ -- Wired in TyCons and their implicit Ids + tycon_things + , concatMap implicitTyThings tycon_things - -- Wired in Ids - , map AnId wiredInIds + -- Wired in Ids + , map AnId wiredInIds - -- PrimOps - , map (AnId . primOpId) allThePrimOps + -- PrimOps + , map (AnId . primOpId) allThePrimOps ] where tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons @@ -100,16 +93,16 @@ sense of them in interface pragmas. It's cool, though they all have "non-standard" names, so they won't get past the parser in user code. %************************************************************************ -%* * - PrimOpIds -%* * +%* * + PrimOpIds +%* * %************************************************************************ \begin{code} primOpIds :: Array Int Id -- A cache of the PrimOp Ids, indexed by PrimOp tag primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op) - | op <- allThePrimOps ] + | op <- allThePrimOps ] primOpId :: PrimOp -> Id primOpId op = primOpIds ! primOpTag op @@ -117,9 +110,9 @@ primOpId op = primOpIds ! primOpTag op %************************************************************************ -%* * +%* * \subsection{Export lists for pseudo-modules (GHC.Prim)} -%* * +%* * %************************************************************************ GHC.Prim "exports" all the primops and primitive types, some @@ -137,9 +130,9 @@ ghcPrimExports %************************************************************************ -%* * +%* * \subsection{Built-in keys} -%* * +%* * %************************************************************************ ToDo: make it do the ``like'' part properly (as in 0.26 and before). @@ -152,9 +145,9 @@ maybeIntLikeCon con = con `hasKey` intDataConKey %************************************************************************ -%* * +%* * \subsection{Class predicates} -%* * +%* * %************************************************************************ \begin{code} From git at git.haskell.org Sun Jul 20 21:56:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:52 +0000 (UTC) Subject: [commit: ghc] master: profiling: detabify/unwhitespace CostCentre (fcfa8ce) Message-ID: <20140720215653.040D82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fcfa8cea285db219cab485e8f95c415b3d1f2cf9/ghc >--------------------------------------------------------------- commit fcfa8cea285db219cab485e8f95c415b3d1f2cf9 Author: Austin Seipp Date: Fri Jul 18 22:09:47 2014 -0500 profiling: detabify/unwhitespace CostCentre Signed-off-by: Austin Seipp >--------------------------------------------------------------- fcfa8cea285db219cab485e8f95c415b3d1f2cf9 compiler/profiling/CostCentre.lhs | 80 ++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 44 deletions(-) diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs index 4a7a063..8a6ed04 100644 --- a/compiler/profiling/CostCentre.lhs +++ b/compiler/profiling/CostCentre.lhs @@ -1,32 +1,24 @@ \begin{code} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - {-# LANGUAGE BangPatterns, DeriveDataTypeable #-} - module CostCentre ( CostCentre(..), CcName, IsCafCC(..), - -- All abstract except to friend: ParseIface.y + -- All abstract except to friend: ParseIface.y - CostCentreStack, - CollectedCCs, + CostCentreStack, + CollectedCCs, noCCS, currentCCS, dontCareCCS, noCCSAttached, isCurrentCCS, maybeSingletonCCS, - mkUserCC, mkAutoCC, mkAllCafsCC, + mkUserCC, mkAutoCC, mkAllCafsCC, mkSingletonCCS, isCafCCS, isCafCC, isSccCountCC, sccAbleCC, ccFromThisModule, - pprCostCentreCore, + pprCostCentreCore, costCentreUserName, costCentreUserNameFS, costCentreSrcSpan, - cmpCostCentre -- used for removing dups in a list + cmpCostCentre -- used for removing dups in a list ) where import Binary @@ -79,10 +71,10 @@ data IsCafCC = NotCafCC | CafCC instance Eq CostCentre where - c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False } + c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False } instance Ord CostCentre where - compare = cmpCostCentre + compare = cmpCostCentre cmpCostCentre :: CostCentre -> CostCentre -> Ordering @@ -96,8 +88,8 @@ cmpCostCentre NormalCC {cc_key = n1, cc_mod = m1} cmpCostCentre other_1 other_2 = let - !tag1 = tag_CC other_1 - !tag2 = tag_CC other_2 + !tag1 = tag_CC other_1 + !tag2 = tag_CC other_2 in if tag1 <# tag2 then LT else GT where @@ -164,25 +156,25 @@ mkAllCafsCC m loc = AllCafsCC { cc_mod = m, cc_loc = loc } -- -- * the current cost centre stack (CCCS) -- * a pre-defined cost centre stack (there are several --- pre-defined CCSs, see below). +-- pre-defined CCSs, see below). data CostCentreStack = NoCCS - | CurrentCCS -- Pinned on a let(rec)-bound - -- thunk/function/constructor, this says that the - -- cost centre to be attached to the object, when it - -- is allocated, is whatever is in the - -- current-cost-centre-stack register. + | CurrentCCS -- Pinned on a let(rec)-bound + -- thunk/function/constructor, this says that the + -- cost centre to be attached to the object, when it + -- is allocated, is whatever is in the + -- current-cost-centre-stack register. | DontCareCCS -- We need a CCS to stick in static closures - -- (for data), but we *don't* expect them to - -- accumulate any costs. But we still need - -- the placeholder. This CCS is it. + -- (for data), but we *don't* expect them to + -- accumulate any costs. But we still need + -- the placeholder. This CCS is it. | SingletonCCS CostCentre - deriving (Eq, Ord) -- needed for Ord on CLabel + deriving (Eq, Ord) -- needed for Ord on CLabel -- synonym for triple which describes the cost centre info in the generated @@ -196,7 +188,7 @@ type CollectedCCs noCCS, currentCCS, dontCareCCS :: CostCentreStack -noCCS = NoCCS +noCCS = NoCCS currentCCS = CurrentCCS dontCareCCS = DontCareCCS @@ -204,20 +196,20 @@ dontCareCCS = DontCareCCS -- Predicates on Cost-Centre Stacks noCCSAttached :: CostCentreStack -> Bool -noCCSAttached NoCCS = True -noCCSAttached _ = False +noCCSAttached NoCCS = True +noCCSAttached _ = False isCurrentCCS :: CostCentreStack -> Bool -isCurrentCCS CurrentCCS = True -isCurrentCCS _ = False +isCurrentCCS CurrentCCS = True +isCurrentCCS _ = False isCafCCS :: CostCentreStack -> Bool isCafCCS (SingletonCCS cc) = isCafCC cc -isCafCCS _ = False +isCafCCS _ = False maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre maybeSingletonCCS (SingletonCCS cc) = Just cc -maybeSingletonCCS _ = Nothing +maybeSingletonCCS _ = Nothing mkSingletonCCS :: CostCentre -> CostCentreStack mkSingletonCCS cc = SingletonCCS cc @@ -230,8 +222,8 @@ mkSingletonCCS cc = SingletonCCS cc -- expression. instance Outputable CostCentreStack where - ppr NoCCS = ptext (sLit "NO_CCS") - ppr CurrentCCS = ptext (sLit "CCCS") + ppr NoCCS = ptext (sLit "NO_CCS") + ppr CurrentCCS = ptext (sLit "CCCS") ppr DontCareCCS = ptext (sLit "CCS_DONT_CARE") ppr (SingletonCCS cc) = ppr cc <> ptext (sLit "_ccs") @@ -242,19 +234,19 @@ instance Outputable CostCentreStack where -- There are several different ways in which we might want to print a -- cost centre: -- --- - the name of the cost centre, for profiling output (a C string) --- - the label, i.e. C label for cost centre in .hc file. --- - the debugging name, for output in -ddump things --- - the interface name, for printing in _scc_ exprs in iface files. +-- - the name of the cost centre, for profiling output (a C string) +-- - the label, i.e. C label for cost centre in .hc file. +-- - the debugging name, for output in -ddump things +-- - the interface name, for printing in _scc_ exprs in iface files. -- -- The last 3 are derived from costCentreStr below. The first is given -- by costCentreName. instance Outputable CostCentre where ppr cc = getPprStyle $ \ sty -> - if codeStyle sty - then ppCostCentreLbl cc - else text (costCentreUserName cc) + if codeStyle sty + then ppCostCentreLbl cc + else text (costCentreUserName cc) -- Printing in Core pprCostCentreCore :: CostCentre -> SDoc From git at git.haskell.org Sun Jul 20 21:56:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:55 +0000 (UTC) Subject: [commit: ghc] master: cmm: detabify/unwhitespace CmmInfo (fe6381b) Message-ID: <20140720215655.E9EEB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe6381b8316e637168867d63c1c6ca9417a83857/ghc >--------------------------------------------------------------- commit fe6381b8316e637168867d63c1c6ca9417a83857 Author: Austin Seipp Date: Fri Jul 18 22:11:08 2014 -0500 cmm: detabify/unwhitespace CmmInfo Signed-off-by: Austin Seipp >--------------------------------------------------------------- fe6381b8316e637168867d63c1c6ca9417a83857 compiler/cmm/CmmInfo.hs | 82 ++++++++++++++++++++++--------------------------- 1 file changed, 37 insertions(+), 45 deletions(-) diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index aae3ea1..3bfc728 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -1,11 +1,4 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module CmmInfo ( mkEmptyContInfoTable, cmmToRawCmm, @@ -84,31 +77,31 @@ cmmToRawCmm dflags cmms -- represented by a label+offset expression). -- -- With tablesNextToCode, the layout is --- --- --- +-- +-- +-- -- -- Without tablesNextToCode, the layout of an info table is --- --- --- +-- +-- +-- -- --- See includes/rts/storage/InfoTables.h +-- See includes/rts/storage/InfoTables.h -- -- For return-points these are as follows -- -- Tables next to code: -- --- --- --- ret-addr --> +-- +-- +-- ret-addr --> -- -- Not tables-next-to-code: -- --- ret-addr --> --- --- +-- ret-addr --> +-- +-- -- -- * The SRT slot is only there if there is SRT info to record @@ -168,15 +161,15 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks) reverse rel_extra_bits ++ rel_std_info)) ----------------------------------------------------- -type InfoTableContents = ( [CmmLit] -- The standard part - , [CmmLit] ) -- The "extra bits" +type InfoTableContents = ( [CmmLit] -- The standard part + , [CmmLit] ) -- The "extra bits" -- These Lits have *not* had mkRelativeTo applied to them mkInfoTableContents :: DynFlags -> CmmInfoTable -> Maybe Int -- Override default RTS type tag? -> UniqSM ([RawCmmDecl], -- Auxiliary top decls - InfoTableContents) -- Info tbl + extra bits + InfoTableContents) -- Info tbl + extra bits mkInfoTableContents dflags info@(CmmInfoTable { cit_lbl = info_lbl @@ -216,9 +209,9 @@ mkInfoTableContents dflags where mk_pieces :: ClosureTypeInfo -> [CmmLit] -> UniqSM ( Maybe StgHalfWord -- Override the SRT field with this - , Maybe CmmLit -- Override the layout field with this - , [CmmLit] -- "Extra bits" for info table - , [RawCmmDecl]) -- Auxiliary data decls + , Maybe CmmLit -- Override the layout field with this + , [CmmLit] -- "Extra bits" for info table + , [RawCmmDecl]) -- Auxiliary data decls mk_pieces (Constr con_tag con_descr) _no_srt -- A data constructor = do { (descr_lit, decl) <- newStringLit con_descr ; return ( Just (toStgHalfWord dflags (fromIntegral con_tag)) @@ -281,7 +274,7 @@ mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap) ------------------------------------------------------------------------- -- --- Position independent code +-- Position independent code -- ------------------------------------------------------------------------- -- In order to support position independent code, we mustn't put absolute @@ -305,16 +298,16 @@ makeRelativeRefTo _ _ lit = lit ------------------------------------------------------------------------- -- --- Build a liveness mask for the stack layout +-- Build a liveness mask for the stack layout -- ------------------------------------------------------------------------- -- There are four kinds of things on the stack: -- --- - pointer variables (bound in the environment) --- - non-pointer variables (bound in the environment) --- - free slots (recorded in the stack free list) --- - non-pointer data slots (recorded in the stack free list) +-- - pointer variables (bound in the environment) +-- - non-pointer variables (bound in the environment) +-- - free slots (recorded in the stack free list) +-- - non-pointer data slots (recorded in the stack free list) -- -- The first two are represented with a 'Just' of a 'LocalReg'. -- The last two with one or more 'Nothing' constructors. @@ -346,7 +339,7 @@ mkLivenessBits dflags liveness small_bitmap = case bitmap of [] -> toStgWord dflags 0 [b] -> b - _ -> panic "mkLiveness" + _ -> panic "mkLiveness" bitmap_word = toStgWord dflags (fromIntegral n_bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT dflags) @@ -357,7 +350,7 @@ mkLivenessBits dflags liveness ------------------------------------------------------------------------- -- --- Generating a standard info table +-- Generating a standard info table -- ------------------------------------------------------------------------- @@ -370,23 +363,23 @@ mkLivenessBits dflags liveness mkStdInfoTable :: DynFlags - -> (CmmLit,CmmLit) -- Closure type descr and closure descr (profiling) + -> (CmmLit,CmmLit) -- Closure type descr and closure descr (profiling) -> Int -- Closure RTS tag -> StgHalfWord -- SRT length - -> CmmLit -- layout field + -> CmmLit -- layout field -> [CmmLit] mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit - = -- Parallel revertible-black hole field + = -- Parallel revertible-black hole field prof_info - -- Ticky info (none at present) - -- Debug info (none at present) + -- Ticky info (none at present) + -- Debug info (none at present) ++ [layout_lit, type_lit] where prof_info - | gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr] - | otherwise = [] + | gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr] + | otherwise = [] type_lit = packHalfWordsCLit dflags (toStgHalfWord dflags (fromIntegral cl_type)) srt_len @@ -417,7 +410,7 @@ srtEscape dflags = toStgHalfWord dflags (-1) ------------------------------------------------------------------------- -- --- Accessing fields of an info table +-- Accessing fields of an info table -- ------------------------------------------------------------------------- @@ -492,7 +485,7 @@ funInfoTable dflags info_ptr = cmmOffsetB dflags info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags) | otherwise = cmmOffsetW dflags info_ptr (1 + stdInfoTableSizeW dflags) - -- Past the entry code pointer + -- Past the entry code pointer -- Takes the info pointer of a function, returns the function's arity funInfoArity :: DynFlags -> CmmExpr -> CmmExpr @@ -558,4 +551,3 @@ stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE dflags - From git at git.haskell.org Sun Jul 20 21:56:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:56:58 +0000 (UTC) Subject: [commit: ghc] master: main: detabify/unwhitespace PprTyThing (3ccc80c) Message-ID: <20140720215658.5546B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ccc80cb2ed2c79243dbc9a1f981aac87163d060/ghc >--------------------------------------------------------------- commit 3ccc80cb2ed2c79243dbc9a1f981aac87163d060 Author: Austin Seipp Date: Fri Jul 18 22:13:39 2014 -0500 main: detabify/unwhitespace PprTyThing Signed-off-by: Austin Seipp >--------------------------------------------------------------- 3ccc80cb2ed2c79243dbc9a1f981aac87163d060 compiler/main/PprTyThing.hs | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index d993ab8..eed4671 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -7,19 +7,12 @@ ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module PprTyThing ( - pprTyThing, - pprTyThingInContext, - pprTyThingLoc, - pprTyThingInContextLoc, - pprTyThingHdr, + pprTyThing, + pprTyThingInContext, + pprTyThingLoc, + pprTyThingInContextLoc, + pprTyThingHdr, pprTypeForUser, pprFamInst ) where @@ -159,9 +152,9 @@ pprTypeForUser :: Type -> SDoc -- b) Swizzle the foralls to the top, so that without -- -fprint-explicit-foralls we'll suppress all the foralls -- Prime example: a class op might have type --- forall a. C a => forall b. Ord b => stuff +-- forall a. C a => forall b. Ord b => stuff -- Then we want to display --- (C a, Ord b) => stuff +-- (C a, Ord b) => stuff pprTypeForUser ty = pprSigmaType (mkSigmaTy tvs ctxt tau) where @@ -175,6 +168,6 @@ pprTypeForUser ty showWithLoc :: SDoc -> SDoc -> SDoc showWithLoc loc doc = hang doc 2 (char '\t' <> comment <+> loc) - -- The tab tries to make them line up a bit + -- The tab tries to make them line up a bit where comment = ptext (sLit "--") From git at git.haskell.org Sun Jul 20 21:57:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:00 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace TargetReg (c754599) Message-ID: <20140720215700.CD2AB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c7545999cbf585d905d1a0e519b90ef13cbc8c54/ghc >--------------------------------------------------------------- commit c7545999cbf585d905d1a0e519b90ef13cbc8c54 Author: Austin Seipp Date: Fri Jul 18 22:25:29 2014 -0500 nativeGen: detabify/dewhitespace TargetReg Signed-off-by: Austin Seipp >--------------------------------------------------------------- c7545999cbf585d905d1a0e519b90ef13cbc8c54 compiler/nativeGen/TargetReg.hs | 34 ++++++++++++---------------------- 1 file changed, 12 insertions(+), 22 deletions(-) diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs index daf1e25..96c1777 100644 --- a/compiler/nativeGen/TargetReg.hs +++ b/compiler/nativeGen/TargetReg.hs @@ -1,28 +1,20 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - -- | Hard wired things related to registers. --- This is module is preventing the native code generator being able to --- emit code for non-host architectures. +-- This is module is preventing the native code generator being able to +-- emit code for non-host architectures. -- --- TODO: Do a better job of the overloading, and eliminate this module. --- We'd probably do better with a Register type class, and hook this to --- Instruction somehow. +-- TODO: Do a better job of the overloading, and eliminate this module. +-- We'd probably do better with a Register type class, and hook this to +-- Instruction somehow. -- --- TODO: We should also make arch specific versions of RegAlloc.Graph.TrivColorable - +-- TODO: We should also make arch specific versions of RegAlloc.Graph.TrivColorable module TargetReg ( - targetVirtualRegSqueeze, - targetRealRegSqueeze, - targetClassOfRealReg, - targetMkVirtualReg, - targetRegDotColor, - targetClassOfReg + targetVirtualRegSqueeze, + targetRealRegSqueeze, + targetClassOfRealReg, + targetMkVirtualReg, + targetRegDotColor, + targetClassOfReg ) where @@ -132,5 +124,3 @@ targetClassOfReg platform reg = case reg of RegVirtual vr -> classOfVirtualReg vr RegReal rr -> targetClassOfRealReg platform rr - - From git at git.haskell.org Sun Jul 20 21:57:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:03 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace Size (4173ae8) Message-ID: <20140720215703.77EF92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4173ae8699b3509a5aa9331c3036167db4cde480/ghc >--------------------------------------------------------------- commit 4173ae8699b3509a5aa9331c3036167db4cde480 Author: Austin Seipp Date: Fri Jul 18 22:22:59 2014 -0500 nativeGen: detabify/dewhitespace Size Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4173ae8699b3509a5aa9331c3036167db4cde480 compiler/nativeGen/Size.hs | 87 +++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 47 deletions(-) diff --git a/compiler/nativeGen/Size.hs b/compiler/nativeGen/Size.hs index 1b95ceb..8fe590f 100644 --- a/compiler/nativeGen/Size.hs +++ b/compiler/nativeGen/Size.hs @@ -1,22 +1,15 @@ -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - -- | Sizes on this architecture --- A Size is a combination of width and class +-- A Size is a combination of width and class -- --- TODO: Rename this to "Format" instead of "Size" to reflect --- the fact that it represents floating point vs integer. +-- TODO: Rename this to "Format" instead of "Size" to reflect +-- the fact that it represents floating point vs integer. -- --- TODO: Signed vs unsigned? +-- TODO: Signed vs unsigned? -- --- TODO: This module is currenly shared by all architectures because --- NCGMonad need to know about it to make a VReg. It would be better --- to have architecture specific formats, and do the overloading --- properly. eg SPARC doesn't care about FF80. +-- TODO: This module is currenly shared by all architectures because +-- NCGMonad need to know about it to make a VReg. It would be better +-- to have architecture specific formats, and do the overloading +-- properly. eg SPARC doesn't care about FF80. -- module Size ( Size(..), @@ -38,75 +31,75 @@ import Outputable -- without global consequences. -- -- A major use is as an opcode qualifier; thus the opcode --- mov.l a b +-- mov.l a b -- might be encoded --- MOV II32 a b +-- MOV II32 a b -- where the Size field encodes the ".l" part. -- ToDo: it's not clear to me that we need separate signed-vs-unsigned sizes --- here. I've removed them from the x86 version, we'll see what happens --SDM +-- here. I've removed them from the x86 version, we'll see what happens --SDM -- ToDo: quite a few occurrences of Size could usefully be replaced by Width data Size - = II8 - | II16 - | II32 - | II64 - | FF32 - | FF64 - | FF80 - deriving (Show, Eq) + = II8 + | II16 + | II32 + | II64 + | FF32 + | FF64 + | FF80 + deriving (Show, Eq) -- | Get the integer size of this width. intSize :: Width -> Size intSize width = case width of - W8 -> II8 - W16 -> II16 - W32 -> II32 - W64 -> II64 - other -> pprPanic "Size.intSize" (ppr other) + W8 -> II8 + W16 -> II16 + W32 -> II32 + W64 -> II64 + other -> pprPanic "Size.intSize" (ppr other) -- | Get the float size of this width. floatSize :: Width -> Size floatSize width = case width of - W32 -> FF32 - W64 -> FF64 - other -> pprPanic "Size.floatSize" (ppr other) + W32 -> FF32 + W64 -> FF64 + other -> pprPanic "Size.floatSize" (ppr other) -- | Check if a size represents a floating point value. isFloatSize :: Size -> Bool isFloatSize size = case size of - FF32 -> True - FF64 -> True - FF80 -> True - _ -> False + FF32 -> True + FF64 -> True + FF80 -> True + _ -> False -- | Convert a Cmm type to a Size. cmmTypeSize :: CmmType -> Size cmmTypeSize ty - | isFloatType ty = floatSize (typeWidth ty) - | otherwise = intSize (typeWidth ty) + | isFloatType ty = floatSize (typeWidth ty) + | otherwise = intSize (typeWidth ty) -- | Get the Width of a Size. sizeToWidth :: Size -> Width sizeToWidth size = case size of - II8 -> W8 - II16 -> W16 - II32 -> W32 - II64 -> W64 - FF32 -> W32 - FF64 -> W64 - FF80 -> W80 + II8 -> W8 + II16 -> W16 + II32 -> W32 + II64 -> W64 + FF32 -> W32 + FF64 -> W64 + FF80 -> W80 sizeInBytes :: Size -> Int sizeInBytes = widthInBytes . sizeToWidth From git at git.haskell.org Sun Jul 20 21:57:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:06 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace PPC/RegInfo (e6a32cc) Message-ID: <20140720215706.59F322406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e6a32cc4734258e416e852427d1d94082de19814/ghc >--------------------------------------------------------------- commit e6a32cc4734258e416e852427d1d94082de19814 Author: Austin Seipp Date: Fri Jul 18 22:24:40 2014 -0500 nativeGen: detabify/dewhitespace PPC/RegInfo Signed-off-by: Austin Seipp >--------------------------------------------------------------- e6a32cc4734258e416e852427d1d94082de19814 compiler/nativeGen/PPC/RegInfo.hs | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs index bffa9ea..c4724d4 100644 --- a/compiler/nativeGen/PPC/RegInfo.hs +++ b/compiler/nativeGen/PPC/RegInfo.hs @@ -7,20 +7,12 @@ -- (c) The University of Glasgow 1996-2004 -- ----------------------------------------------------------------------------- - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module PPC.RegInfo ( JumpDest( DestBlockId ), getJumpDestBlockId, - canShortcut, - shortcutJump, + canShortcut, + shortcutJump, - shortcutStatics + shortcutStatics ) where @@ -71,13 +63,12 @@ shortcutStatic _ other_static = other_static shortBlockId - :: (BlockId -> Maybe JumpDest) - -> BlockId - -> CLabel + :: (BlockId -> Maybe JumpDest) + -> BlockId + -> CLabel shortBlockId fn blockid = case fn blockid of Nothing -> mkAsmTempLabel uq Just (DestBlockId blockid') -> shortBlockId fn blockid' where uq = getUnique blockid - From git at git.haskell.org Sun Jul 20 21:57:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:08 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace Reg (a881813) Message-ID: <20140720215708.D34842406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8818138a2468f6fa9de040bd383579f4593d0d5/ghc >--------------------------------------------------------------- commit a8818138a2468f6fa9de040bd383579f4593d0d5 Author: Austin Seipp Date: Fri Jul 18 22:23:33 2014 -0500 nativeGen: detabify/dewhitespace Reg Signed-off-by: Austin Seipp >--------------------------------------------------------------- a8818138a2468f6fa9de040bd383579f4593d0d5 compiler/nativeGen/Reg.hs | 231 ++++++++++++++++++++++------------------------ 1 file changed, 110 insertions(+), 121 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a8818138a2468f6fa9de040bd383579f4593d0d5 From git at git.haskell.org Sun Jul 20 21:57:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:11 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace PPC/Cond (7bf273c) Message-ID: <20140720215711.BB4972406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7bf273cd62761331e9770891f5cb399122928e8d/ghc >--------------------------------------------------------------- commit 7bf273cd62761331e9770891f5cb399122928e8d Author: Austin Seipp Date: Fri Jul 18 22:24:16 2014 -0500 nativeGen: detabify/dewhitespace PPC/Cond Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7bf273cd62761331e9770891f5cb399122928e8d compiler/nativeGen/PPC/Cond.hs | 42 +++++++++++++++++------------------------- 1 file changed, 17 insertions(+), 25 deletions(-) diff --git a/compiler/nativeGen/PPC/Cond.hs b/compiler/nativeGen/PPC/Cond.hs index 2568da5..0e4b1fd 100644 --- a/compiler/nativeGen/PPC/Cond.hs +++ b/compiler/nativeGen/PPC/Cond.hs @@ -1,17 +1,9 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module PPC.Cond ( - Cond(..), - condNegate, - condUnsigned, - condToSigned, - condToUnsigned, + Cond(..), + condNegate, + condUnsigned, + condToSigned, + condToUnsigned, ) where @@ -19,18 +11,18 @@ where import Panic data Cond - = ALWAYS - | EQQ - | GE - | GEU - | GTT - | GU - | LE - | LEU - | LTT - | LU - | NE - deriving Eq + = ALWAYS + | EQQ + | GE + | GEU + | GTT + | GU + | LE + | LEU + | LTT + | LU + | NE + deriving Eq condNegate :: Cond -> Cond From git at git.haskell.org Sun Jul 20 21:57:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:13 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/Stack (2f7495d) Message-ID: <20140720215714.0DEB62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f7495d92a76f1d17793758c169c670f4382ccad/ghc >--------------------------------------------------------------- commit 2f7495d92a76f1d17793758c169c670f4382ccad Author: Austin Seipp Date: Fri Jul 18 22:26:20 2014 -0500 nativeGen: detabify/dewhitespace SPARC/Stack Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2f7495d92a76f1d17793758c169c670f4382ccad compiler/nativeGen/SPARC/Stack.hs | 49 ++++++++++++++++----------------------- 1 file changed, 20 insertions(+), 29 deletions(-) diff --git a/compiler/nativeGen/SPARC/Stack.hs b/compiler/nativeGen/SPARC/Stack.hs index 3560a0f..629b187 100644 --- a/compiler/nativeGen/SPARC/Stack.hs +++ b/compiler/nativeGen/SPARC/Stack.hs @@ -1,16 +1,8 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SPARC.Stack ( - spRel, - fpRel, - spillSlotToOffset, - maxSpillSlots + spRel, + fpRel, + spillSlotToOffset, + maxSpillSlots ) where @@ -24,43 +16,42 @@ import DynFlags import Outputable -- | Get an AddrMode relative to the address in sp. --- This gives us a stack relative addressing mode for volatile --- temporaries and for excess call arguments. +-- This gives us a stack relative addressing mode for volatile +-- temporaries and for excess call arguments. -- -spRel :: Int -- ^ stack offset in words, positive or negative +spRel :: Int -- ^ stack offset in words, positive or negative -> AddrMode -spRel n = AddrRegImm sp (ImmInt (n * wordLength)) +spRel n = AddrRegImm sp (ImmInt (n * wordLength)) -- | Get an address relative to the frame pointer. --- This doesn't work work for offsets greater than 13 bits; we just hope for the best +-- This doesn't work work for offsets greater than 13 bits; we just hope for the best -- fpRel :: Int -> AddrMode fpRel n - = AddrRegImm fp (ImmInt (n * wordLength)) + = AddrRegImm fp (ImmInt (n * wordLength)) -- | Convert a spill slot number to a *byte* offset, with no sign. -- spillSlotToOffset :: DynFlags -> Int -> Int spillSlotToOffset dflags slot - | slot >= 0 && slot < maxSpillSlots dflags - = 64 + spillSlotSize * slot + | slot >= 0 && slot < maxSpillSlots dflags + = 64 + spillSlotSize * slot - | otherwise - = pprPanic "spillSlotToOffset:" - ( text "invalid spill location: " <> int slot - $$ text "maxSpillSlots: " <> int (maxSpillSlots dflags)) + | otherwise + = pprPanic "spillSlotToOffset:" + ( text "invalid spill location: " <> int slot + $$ text "maxSpillSlots: " <> int (maxSpillSlots dflags)) -- | The maximum number of spill slots available on the C stack. --- If we use up all of the slots, then we're screwed. +-- If we use up all of the slots, then we're screwed. -- --- Why do we reserve 64 bytes, instead of using the whole thing?? --- -- BL 2009/02/15 +-- Why do we reserve 64 bytes, instead of using the whole thing?? +-- -- BL 2009/02/15 -- maxSpillSlots :: DynFlags -> Int maxSpillSlots dflags - = ((spillAreaLength dflags - 64) `div` spillSlotSize) - 1 - + = ((spillAreaLength dflags - 64) `div` spillSlotSize) - 1 From git at git.haskell.org Sun Jul 20 21:57:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:16 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace RegClass (e193380) Message-ID: <20140720215716.901A52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e193380c49a2a5a25efcadbf4afb7bfb48c7034c/ghc >--------------------------------------------------------------- commit e193380c49a2a5a25efcadbf4afb7bfb48c7034c Author: Austin Seipp Date: Fri Jul 18 22:25:01 2014 -0500 nativeGen: detabify/dewhitespace RegClass Signed-off-by: Austin Seipp >--------------------------------------------------------------- e193380c49a2a5a25efcadbf4afb7bfb48c7034c compiler/nativeGen/RegClass.hs | 42 +++++++++++++++++------------------------- 1 file changed, 17 insertions(+), 25 deletions(-) diff --git a/compiler/nativeGen/RegClass.hs b/compiler/nativeGen/RegClass.hs index cac4e64..0c79317 100644 --- a/compiler/nativeGen/RegClass.hs +++ b/compiler/nativeGen/RegClass.hs @@ -1,41 +1,33 @@ -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - - -- | An architecture independent description of a register's class. module RegClass - ( RegClass (..) ) + ( RegClass (..) ) where -import Outputable -import Unique +import Outputable +import Unique -- | The class of a register. --- Used in the register allocator. --- We treat all registers in a class as being interchangable. +-- Used in the register allocator. +-- We treat all registers in a class as being interchangable. -- data RegClass - = RcInteger - | RcFloat - | RcDouble - | RcDoubleSSE -- x86 only: the SSE regs are a separate class - deriving Eq + = RcInteger + | RcFloat + | RcDouble + | RcDoubleSSE -- x86 only: the SSE regs are a separate class + deriving Eq instance Uniquable RegClass where - getUnique RcInteger = mkRegClassUnique 0 - getUnique RcFloat = mkRegClassUnique 1 - getUnique RcDouble = mkRegClassUnique 2 + getUnique RcInteger = mkRegClassUnique 0 + getUnique RcFloat = mkRegClassUnique 1 + getUnique RcDouble = mkRegClassUnique 2 getUnique RcDoubleSSE = mkRegClassUnique 3 instance Outputable RegClass where - ppr RcInteger = Outputable.text "I" - ppr RcFloat = Outputable.text "F" - ppr RcDouble = Outputable.text "D" - ppr RcDoubleSSE = Outputable.text "S" + ppr RcInteger = Outputable.text "I" + ppr RcFloat = Outputable.text "F" + ppr RcDouble = Outputable.text "D" + ppr RcDoubleSSE = Outputable.text "S" From git at git.haskell.org Sun Jul 20 21:57:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:19 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace X86/RegInfo (960f4e1) Message-ID: <20140720215719.251122406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/960f4e12132ff2bd374ad54c12221793762d4405/ghc >--------------------------------------------------------------- commit 960f4e12132ff2bd374ad54c12221793762d4405 Author: Austin Seipp Date: Fri Jul 18 22:23:59 2014 -0500 nativeGen: detabify/dewhitespace X86/RegInfo Signed-off-by: Austin Seipp >--------------------------------------------------------------- 960f4e12132ff2bd374ad54c12221793762d4405 compiler/nativeGen/X86/RegInfo.hs | 30 +++++++++++------------------- 1 file changed, 11 insertions(+), 19 deletions(-) diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs index 0303295..3953563 100644 --- a/compiler/nativeGen/X86/RegInfo.hs +++ b/compiler/nativeGen/X86/RegInfo.hs @@ -1,14 +1,7 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module X86.RegInfo ( - mkVirtualReg, - regDotColor + mkVirtualReg, + regDotColor ) where @@ -30,9 +23,9 @@ import X86.Regs mkVirtualReg :: Unique -> Size -> VirtualReg mkVirtualReg u size = case size of - FF32 -> VirtualRegSSE u - FF64 -> VirtualRegSSE u - FF80 -> VirtualRegD u + FF32 -> VirtualRegSSE u + FF64 -> VirtualRegSSE u + FF80 -> VirtualRegD u _other -> VirtualRegI u regDotColor :: Platform -> RealReg -> SDoc @@ -65,11 +58,10 @@ normalRegColors platform fpRegColors :: [(Reg,String)] fpRegColors = [ (fake0, "#ff00ff") - , (fake1, "#ff00aa") - , (fake2, "#aa00ff") - , (fake3, "#aa00aa") - , (fake4, "#ff0055") - , (fake5, "#5500ff") ] - - ++ zip (map regSingle [24..39]) (repeat "red") + , (fake1, "#ff00aa") + , (fake2, "#aa00ff") + , (fake3, "#aa00aa") + , (fake4, "#ff0055") + , (fake5, "#5500ff") ] + ++ zip (map regSingle [24..39]) (repeat "red") From git at git.haskell.org Sun Jul 20 21:57:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:21 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/Regs (25c4629) Message-ID: <20140720215722.F03B62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/25c4629a82af7b31f43af16a7ab0501515fc59d5/ghc >--------------------------------------------------------------- commit 25c4629a82af7b31f43af16a7ab0501515fc59d5 Author: Austin Seipp Date: Fri Jul 18 22:27:51 2014 -0500 nativeGen: detabify/dewhitespace SPARC/Regs Signed-off-by: Austin Seipp >--------------------------------------------------------------- 25c4629a82af7b31f43af16a7ab0501515fc59d5 compiler/nativeGen/SPARC/Regs.hs | 246 +++++++++++++++++++-------------------- 1 file changed, 119 insertions(+), 127 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 25c4629a82af7b31f43af16a7ab0501515fc59d5 From git at git.haskell.org Sun Jul 20 21:57:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:23 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/CodeGen/CondCode (9924de2) Message-ID: <20140720215724.079A22406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9924de2e752e738c82aa3a9c7ee4b50b00dcf3e2/ghc >--------------------------------------------------------------- commit 9924de2e752e738c82aa3a9c7ee4b50b00dcf3e2 Author: Austin Seipp Date: Fri Jul 18 22:28:40 2014 -0500 nativeGen: detabify/dewhitespace SPARC/CodeGen/CondCode Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9924de2e752e738c82aa3a9c7ee4b50b00dcf3e2 compiler/nativeGen/SPARC/CodeGen/CondCode.hs | 48 ++++++++++++---------------- 1 file changed, 20 insertions(+), 28 deletions(-) diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs index 2c3dbe6..cb10830 100644 --- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs +++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs @@ -1,15 +1,7 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SPARC.CodeGen.CondCode ( - getCondCode, - condIntCode, - condFltCode + getCondCode, + condIntCode, + condFltCode ) where @@ -86,8 +78,8 @@ condIntCode cond x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y let - code__2 = code1 `appOL` code2 `snocOL` - SUB False True src1 (RIReg src2) g0 + code__2 = code1 `appOL` code2 `snocOL` + SUB False True src1 (RIReg src2) g0 return (CondCode False cond code__2) @@ -98,19 +90,19 @@ condFltCode cond x y = do (src2, code2) <- getSomeReg y tmp <- getNewRegNat FF64 let - promote x = FxTOy FF32 FF64 x tmp - - pk1 = cmmExprType dflags x - pk2 = cmmExprType dflags y - - code__2 = - if pk1 `cmmEqType` pk2 then - code1 `appOL` code2 `snocOL` - FCMP True (cmmTypeSize pk1) src1 src2 - else if typeWidth pk1 == W32 then - code1 `snocOL` promote src1 `appOL` code2 `snocOL` - FCMP True FF64 tmp src2 - else - code1 `appOL` code2 `snocOL` promote src2 `snocOL` - FCMP True FF64 src1 tmp + promote x = FxTOy FF32 FF64 x tmp + + pk1 = cmmExprType dflags x + pk2 = cmmExprType dflags y + + code__2 = + if pk1 `cmmEqType` pk2 then + code1 `appOL` code2 `snocOL` + FCMP True (cmmTypeSize pk1) src1 src2 + else if typeWidth pk1 == W32 then + code1 `snocOL` promote src1 `appOL` code2 `snocOL` + FCMP True FF64 tmp src2 + else + code1 `appOL` code2 `snocOL` promote src2 `snocOL` + FCMP True FF64 src1 tmp return (CondCode True cond code__2) From git at git.haskell.org Sun Jul 20 21:57:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:26 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/CodeGen/Sanity (5ef0050) Message-ID: <20140720215726.A02D02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ef0050c200e09f2a673ba5bda6eb2ad4d59e0cc/ghc >--------------------------------------------------------------- commit 5ef0050c200e09f2a673ba5bda6eb2ad4d59e0cc Author: Austin Seipp Date: Fri Jul 18 22:29:47 2014 -0500 nativeGen: detabify/dewhitespace SPARC/CodeGen/Sanity Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5ef0050c200e09f2a673ba5bda6eb2ad4d59e0cc compiler/nativeGen/SPARC/CodeGen/Sanity.hs | 91 +++++++++++++----------------- 1 file changed, 40 insertions(+), 51 deletions(-) diff --git a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs index 5dff9ce..8164132 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs @@ -1,22 +1,13 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - -- | One ounce of sanity checking is worth 10000000000000000 ounces --- of staring blindly at assembly code trying to find the problem.. --- +-- of staring blindly at assembly code trying to find the problem.. module SPARC.CodeGen.Sanity ( - checkBlock + checkBlock ) where import SPARC.Instr -import SPARC.Ppr () +import SPARC.Ppr () import Instruction import Cmm @@ -31,48 +22,46 @@ checkBlock :: CmmBlock -> NatBasicBlock Instr checkBlock cmm block@(BasicBlock _ instrs) - | checkBlockInstrs instrs - = block + | checkBlockInstrs instrs + = block - | otherwise - = pprPanic - ("SPARC.CodeGen: bad block\n") - ( vcat [ text " -- cmm -----------------\n" - , ppr cmm - , text " -- native code ---------\n" - , ppr block ]) + | otherwise + = pprPanic + ("SPARC.CodeGen: bad block\n") + ( vcat [ text " -- cmm -----------------\n" + , ppr cmm + , text " -- native code ---------\n" + , ppr block ]) checkBlockInstrs :: [Instr] -> Bool checkBlockInstrs ii - -- An unconditional jumps end the block. - -- There must be an unconditional jump in the block, otherwise - -- the register liveness determinator will get the liveness - -- information wrong. - -- - -- If the block ends with a cmm call that never returns - -- then there can be unreachable instructions after the jump, - -- but we don't mind here. - -- - | instr : NOP : _ <- ii - , isUnconditionalJump instr - = True - - -- All jumps must have a NOP in their branch delay slot. - -- The liveness determinator and register allocators aren't smart - -- enough to handle branch delay slots. - -- - | instr : NOP : is <- ii - , isJumpishInstr instr - = checkBlockInstrs is - - -- keep checking - | _:i2:is <- ii - = checkBlockInstrs (i2:is) - - -- this block is no good - | otherwise - = False - - + -- An unconditional jumps end the block. + -- There must be an unconditional jump in the block, otherwise + -- the register liveness determinator will get the liveness + -- information wrong. + -- + -- If the block ends with a cmm call that never returns + -- then there can be unreachable instructions after the jump, + -- but we don't mind here. + -- + | instr : NOP : _ <- ii + , isUnconditionalJump instr + = True + + -- All jumps must have a NOP in their branch delay slot. + -- The liveness determinator and register allocators aren't smart + -- enough to handle branch delay slots. + -- + | instr : NOP : is <- ii + , isJumpishInstr instr + = checkBlockInstrs is + + -- keep checking + | _:i2:is <- ii + = checkBlockInstrs (i2:is) + + -- this block is no good + | otherwise + = False From git at git.haskell.org Sun Jul 20 21:57:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:29 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/CodeGen/Amode (6babdc8) Message-ID: <20140720215729.58F692406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6babdc824319d01d4836973defecca1ae3284e97/ghc >--------------------------------------------------------------- commit 6babdc824319d01d4836973defecca1ae3284e97 Author: Austin Seipp Date: Fri Jul 18 22:29:03 2014 -0500 nativeGen: detabify/dewhitespace SPARC/CodeGen/Amode Signed-off-by: Austin Seipp >--------------------------------------------------------------- 6babdc824319d01d4836973defecca1ae3284e97 compiler/nativeGen/SPARC/CodeGen/Amode.hs | 32 ++++++++++++------------------- 1 file changed, 12 insertions(+), 20 deletions(-) diff --git a/compiler/nativeGen/SPARC/CodeGen/Amode.hs b/compiler/nativeGen/SPARC/CodeGen/Amode.hs index f0aed0d..8d9a303 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Amode.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Amode.hs @@ -1,13 +1,5 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SPARC.CodeGen.Amode ( - getAmode + getAmode ) where @@ -29,8 +21,8 @@ import OrdList -- | Generate code to reference a memory address. getAmode - :: CmmExpr -- ^ expr producing an address - -> NatM Amode + :: CmmExpr -- ^ expr producing an address + -> NatM Amode getAmode tree@(CmmRegOff _ _) = do dflags <- getDynFlags @@ -50,7 +42,7 @@ getAmode (CmmMachOp (MO_Add _) [x, CmmLit (CmmInt i _)]) = do (reg, code) <- getSomeReg x let - off = ImmInt (fromInteger i) + off = ImmInt (fromInteger i) return (Amode (AddrRegImm reg off) code) getAmode (CmmMachOp (MO_Add _) [x, y]) @@ -58,23 +50,23 @@ getAmode (CmmMachOp (MO_Add _) [x, y]) (regX, codeX) <- getSomeReg x (regY, codeY) <- getSomeReg y let - code = codeX `appOL` codeY + code = codeX `appOL` codeY return (Amode (AddrRegReg regX regY) code) getAmode (CmmLit lit) = do - let imm__2 = litToImm lit - tmp1 <- getNewRegNat II32 - tmp2 <- getNewRegNat II32 + let imm__2 = litToImm lit + tmp1 <- getNewRegNat II32 + tmp2 <- getNewRegNat II32 - let code = toOL [ SETHI (HI imm__2) tmp1 - , OR False tmp1 (RIImm (LO imm__2)) tmp2] + let code = toOL [ SETHI (HI imm__2) tmp1 + , OR False tmp1 (RIImm (LO imm__2)) tmp2] - return (Amode (AddrRegReg tmp2 g0) code) + return (Amode (AddrRegReg tmp2 g0) code) getAmode other = do (reg, code) <- getSomeReg other let - off = ImmInt 0 + off = ImmInt 0 return (Amode (AddrRegImm reg off) code) From git at git.haskell.org Sun Jul 20 21:57:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:32 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/ShortcutJump (234afe2) Message-ID: <20140720215732.0F99D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/234afe274e4477be96232b9af37f4d843f9fcf29/ghc >--------------------------------------------------------------- commit 234afe274e4477be96232b9af37f4d843f9fcf29 Author: Austin Seipp Date: Fri Jul 18 22:27:03 2014 -0500 nativeGen: detabify/dewhitespace SPARC/ShortcutJump Signed-off-by: Austin Seipp >--------------------------------------------------------------- 234afe274e4477be96232b9af37f4d843f9fcf29 compiler/nativeGen/SPARC/ShortcutJump.hs | 29 +++++++++-------------------- 1 file changed, 9 insertions(+), 20 deletions(-) diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs index 142ec6e..123a345 100644 --- a/compiler/nativeGen/SPARC/ShortcutJump.hs +++ b/compiler/nativeGen/SPARC/ShortcutJump.hs @@ -1,17 +1,9 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SPARC.ShortcutJump ( - JumpDest(..), getJumpDestBlockId, - canShortcut, - shortcutJump, - shortcutStatics, - shortBlockId + JumpDest(..), getJumpDestBlockId, + canShortcut, + shortcutJump, + shortcutStatics, + shortBlockId ) where @@ -29,8 +21,8 @@ import Unique data JumpDest - = DestBlockId BlockId - | DestImm Imm + = DestBlockId BlockId + | DestImm Imm getJumpDestBlockId :: JumpDest -> Maybe BlockId getJumpDestBlockId (DestBlockId bid) = Just bid @@ -59,9 +51,9 @@ shortcutLabel fn lab shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic shortcutStatic fn (CmmStaticLit (CmmLabel lab)) - = CmmStaticLit (CmmLabel (shortcutLabel fn lab)) + = CmmStaticLit (CmmLabel (shortcutLabel fn lab)) shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) - = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off) + = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off) -- slightly dodgy, we're ignoring the second label, but this -- works with the way we use CmmLabelDiffOff for jump tables now. shortcutStatic _ other_static @@ -75,6 +67,3 @@ shortBlockId fn blockid = Just (DestBlockId blockid') -> shortBlockId fn blockid' Just (DestImm (ImmCLbl lbl)) -> lbl _other -> panic "shortBlockId" - - - From git at git.haskell.org Sun Jul 20 21:57:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:35 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/Cond (8707e45) Message-ID: <20140720215735.3E7032406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8707e4597dc3a49a7dd659601cbe98cb451e2f05/ghc >--------------------------------------------------------------- commit 8707e4597dc3a49a7dd659601cbe98cb451e2f05 Author: Austin Seipp Date: Fri Jul 18 22:28:05 2014 -0500 nativeGen: detabify/dewhitespace SPARC/Cond Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8707e4597dc3a49a7dd659601cbe98cb451e2f05 compiler/nativeGen/SPARC/Cond.hs | 50 +++++++++++++++++----------------------- 1 file changed, 21 insertions(+), 29 deletions(-) diff --git a/compiler/nativeGen/SPARC/Cond.hs b/compiler/nativeGen/SPARC/Cond.hs index 198e4a7..da41457 100644 --- a/compiler/nativeGen/SPARC/Cond.hs +++ b/compiler/nativeGen/SPARC/Cond.hs @@ -1,39 +1,31 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SPARC.Cond ( - Cond(..), - condUnsigned, - condToSigned, - condToUnsigned + Cond(..), + condUnsigned, + condToSigned, + condToUnsigned ) where -- | Branch condition codes. data Cond - = ALWAYS - | EQQ - | GE - | GEU - | GTT - | GU - | LE - | LEU - | LTT - | LU - | NE - | NEG - | NEVER - | POS - | VC - | VS - deriving Eq + = ALWAYS + | EQQ + | GE + | GEU + | GTT + | GU + | LE + | LEU + | LTT + | LU + | NE + | NEG + | NEVER + | POS + | VC + | VS + deriving Eq condUnsigned :: Cond -> Bool From git at git.haskell.org Sun Jul 20 21:57:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:37 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/Imm (b80249d) Message-ID: <20140720215737.A409C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b80249d7af7c5588d69519d543f346fe212f4ab7/ghc >--------------------------------------------------------------- commit b80249d7af7c5588d69519d543f346fe212f4ab7 Author: Austin Seipp Date: Fri Jul 18 22:26:33 2014 -0500 nativeGen: detabify/dewhitespace SPARC/Imm Signed-off-by: Austin Seipp >--------------------------------------------------------------- b80249d7af7c5588d69519d543f346fe212f4ab7 compiler/nativeGen/SPARC/Imm.hs | 74 ++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 42 deletions(-) diff --git a/compiler/nativeGen/SPARC/Imm.hs b/compiler/nativeGen/SPARC/Imm.hs index 844a088..cb53ba4 100644 --- a/compiler/nativeGen/SPARC/Imm.hs +++ b/compiler/nativeGen/SPARC/Imm.hs @@ -1,16 +1,8 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SPARC.Imm ( - -- immediate values - Imm(..), - strImmLit, - litToImm + -- immediate values + Imm(..), + strImmLit, + litToImm ) where @@ -21,29 +13,29 @@ import CLabel import Outputable -- | An immediate value. --- Not all of these are directly representable by the machine. --- Things like ImmLit are slurped out and put in a data segment instead. +-- Not all of these are directly representable by the machine. +-- Things like ImmLit are slurped out and put in a data segment instead. -- data Imm - = ImmInt Int + = ImmInt Int - -- Sigh. - | ImmInteger Integer + -- Sigh. + | ImmInteger Integer - -- AbstractC Label (with baggage) - | ImmCLbl CLabel + -- AbstractC Label (with baggage) + | ImmCLbl CLabel - -- Simple string - | ImmLit SDoc - | ImmIndex CLabel Int - | ImmFloat Rational - | ImmDouble Rational + -- Simple string + | ImmLit SDoc + | ImmIndex CLabel Int + | ImmFloat Rational + | ImmDouble Rational - | ImmConstantSum Imm Imm - | ImmConstantDiff Imm Imm + | ImmConstantSum Imm Imm + | ImmConstantDiff Imm Imm - | LO Imm - | HI Imm + | LO Imm + | HI Imm -- | Create a ImmLit containing this string. @@ -52,24 +44,22 @@ strImmLit s = ImmLit (text s) -- | Convert a CmmLit to an Imm. --- Narrow to the width: a CmmInt might be out of --- range, but we assume that ImmInteger only contains --- in-range values. A signed value should be fine here. +-- Narrow to the width: a CmmInt might be out of +-- range, but we assume that ImmInteger only contains +-- in-range values. A signed value should be fine here. -- litToImm :: CmmLit -> Imm litToImm lit = case lit of - CmmInt i w -> ImmInteger (narrowS w i) - CmmFloat f W32 -> ImmFloat f - CmmFloat f W64 -> ImmDouble f - CmmLabel l -> ImmCLbl l - CmmLabelOff l off -> ImmIndex l off + CmmInt i w -> ImmInteger (narrowS w i) + CmmFloat f W32 -> ImmFloat f + CmmFloat f W64 -> ImmDouble f + CmmLabel l -> ImmCLbl l + CmmLabelOff l off -> ImmIndex l off - CmmLabelDiffOff l1 l2 off - -> ImmConstantSum - (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2)) - (ImmInt off) + CmmLabelDiffOff l1 l2 off + -> ImmConstantSum + (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2)) + (ImmInt off) _ -> panic "SPARC.Regs.litToImm: no match" - - From git at git.haskell.org Sun Jul 20 21:57:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:40 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/Instr (ef07ff7) Message-ID: <20140720215740.425882406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef07ff7bea9cde7d27f579081016013419a9b991/ghc >--------------------------------------------------------------- commit ef07ff7bea9cde7d27f579081016013419a9b991 Author: Austin Seipp Date: Fri Jul 18 22:27:25 2014 -0500 nativeGen: detabify/dewhitespace SPARC/Instr Signed-off-by: Austin Seipp >--------------------------------------------------------------- ef07ff7bea9cde7d27f579081016013419a9b991 compiler/nativeGen/SPARC/Instr.hs | 587 +++++++++++++++++++------------------- 1 file changed, 289 insertions(+), 298 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ef07ff7bea9cde7d27f579081016013419a9b991 From git at git.haskell.org Sun Jul 20 21:57:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:43 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/CodeGen/Expand (085713f) Message-ID: <20140720215743.650862406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/085713f46cdfdc2e3e9d75a9c8c96fbd80f88f71/ghc >--------------------------------------------------------------- commit 085713f46cdfdc2e3e9d75a9c8c96fbd80f88f71 Author: Austin Seipp Date: Fri Jul 18 22:29:21 2014 -0500 nativeGen: detabify/dewhitespace SPARC/CodeGen/Expand Signed-off-by: Austin Seipp >--------------------------------------------------------------- 085713f46cdfdc2e3e9d75a9c8c96fbd80f88f71 compiler/nativeGen/SPARC/CodeGen/Expand.hs | 181 +++++++++++++---------------- 1 file changed, 83 insertions(+), 98 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 085713f46cdfdc2e3e9d75a9c8c96fbd80f88f71 From git at git.haskell.org Sun Jul 20 21:57:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:45 +0000 (UTC) Subject: [commit: ghc] master: Add PolyKinds extension to Data.Monoid (18b2c46) Message-ID: <20140720215745.BE6372406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18b2c46773eccb974bdd042a2f400edd23e193d7/ghc >--------------------------------------------------------------- commit 18b2c46773eccb974bdd042a2f400edd23e193d7 Author: Alexander Berntsen Date: Fri Jul 18 23:53:48 2014 -0500 Add PolyKinds extension to Data.Monoid Summary: Carl Howells pointed out[0] that the `Monoid` instance for `Data.Proxy.Proxy` is only defined for types with kind *. This is a very mild change. Furthermore, Edward Kmett revealed[1] that it was supposed to be there all along -- the extension simply got lost in commit 1d1ff77aaa09efaddc8cfe0dcf92d6763297cf11, as pointed out by Adam Vogt[2]. This used to be correct in GHC 7.6, so this commit fixes a regression. This addresses #9317. [0] . [1] . [2] . Signed-off-by: Alexander Berntsen Test Plan: See [0] Reviewers: austin, hvr, ekmett Reviewed By: austin, hvr, ekmett Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D70 >--------------------------------------------------------------- 18b2c46773eccb974bdd042a2f400edd23e193d7 libraries/base/Data/Monoid.hs | 1 + libraries/base/changelog.md | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs index b71176b..5889954 100644 --- a/libraries/base/Data/Monoid.hs +++ b/libraries/base/Data/Monoid.hs @@ -3,6 +3,7 @@ {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PolyKinds #-} ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 46006b1..06c9fa5 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -14,6 +14,10 @@ * Add `Control.Monad.(<$!>)` as a strict version of `(<$>)` + * The `Data.Monoid` module now has the `PolyKinds` extension + enabled, so that the `Monoid` instance for `Proxy` are polykinded + like `Proxy` itself is. + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 From git at git.haskell.org Sun Jul 20 21:57:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:48 +0000 (UTC) Subject: [commit: ghc] master: Make GHCi permissions checks ignore root user. (fb936e0) Message-ID: <20140720215749.F14FB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb936e0db55b0522ddcabd39833c99c7c2871170/ghc >--------------------------------------------------------------- commit fb936e0db55b0522ddcabd39833c99c7c2871170 Author: Mathieu Boespflug Date: Fri Jul 18 23:55:18 2014 -0500 Make GHCi permissions checks ignore root user. Summary: As a security precaution, GHCi helpfully refuses to run a .ghci file if it is owned by another user. But if the that other user is root, then arguably GHCi should not refuse to interpret the file, because if root really was malicious, then the user would be having a bad day anyways. This means that .ghci files installed in a global location, say under /usr/local/, can now be read. Fixes #9324 Test Plan: ``` $ sudo touch .ghci $ ghci ``` Notice that the warning about the file being owned by someone else is now gone. Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, carter, nomeata, relrod Projects: #ghc Differential Revision: https://phabricator.haskell.org/D75 >--------------------------------------------------------------- fb936e0db55b0522ddcabd39833c99c7c2871170 ghc/InteractiveUI.hs | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index ef48c34..c66b025 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -586,8 +586,9 @@ nextInputLine show_prompt is_tty fileLoop stdin -- NOTE: We only read .ghci files if they are owned by the current user, --- and aren't world writable. Otherwise, we could be accidentally --- running code planted by a malicious third party. +-- and aren't world writable (files owned by root are ok, see #9324). +-- Otherwise, we could be accidentally running code planted by +-- a malicious third party. -- Furthermore, We only read ./.ghci if . is owned by the current user -- and isn't writable by anyone else. I think this is sufficient: we @@ -602,18 +603,14 @@ checkPerms name = handleIO (\_ -> return False) $ do st <- getFileStatus name me <- getRealUserID - if fileOwner st /= me then do - putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!" - return False - else do - let mode = System.Posix.fileMode st - if (groupWriteMode == (mode `intersectFileModes` groupWriteMode)) - || (otherWriteMode == (mode `intersectFileModes` otherWriteMode)) - then do - putStrLn $ "*** WARNING: " ++ name ++ - " is writable by someone else, IGNORING!" - return False - else return True + let mode = System.Posix.fileMode st + ok = (fileOwner st == me || fileOwner st == 0) && + groupWriteMode /= mode `intersectFileModes` groupWriteMode && + otherWriteMode /= mode `intersectFileModes` otherWriteMode + unless ok $ + putStrLn $ "*** WARNING: " ++ name ++ + " is writable by someone else, IGNORING!" + return ok #endif incrementLineNo :: InputT GHCi () From git at git.haskell.org Sun Jul 20 21:57:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:51 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/CodeGen/Base (8a8bc420) Message-ID: <20140720215751.213B42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a8bc4202a7b43c252d9c57fe53385f6882bac79/ghc >--------------------------------------------------------------- commit 8a8bc4202a7b43c252d9c57fe53385f6882bac79 Author: Austin Seipp Date: Fri Jul 18 22:30:25 2014 -0500 nativeGen: detabify/dewhitespace SPARC/CodeGen/Base Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8a8bc4202a7b43c252d9c57fe53385f6882bac79 compiler/nativeGen/SPARC/CodeGen/Base.hs | 80 ++++++++++++++------------------ 1 file changed, 34 insertions(+), 46 deletions(-) diff --git a/compiler/nativeGen/SPARC/CodeGen/Base.hs b/compiler/nativeGen/SPARC/CodeGen/Base.hs index 45b7801..270fd69 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Base.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Base.hs @@ -1,22 +1,14 @@ - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SPARC.CodeGen.Base ( - InstrBlock, - CondCode(..), - ChildCode64(..), - Amode(..), + InstrBlock, + CondCode(..), + ChildCode64(..), + Amode(..), - Register(..), - setSizeOfRegister, + Register(..), + setSizeOfRegister, - getRegisterReg, - mangleIndexTree + getRegisterReg, + mangleIndexTree ) where @@ -39,25 +31,25 @@ import OrdList -------------------------------------------------------------------------------- -- | 'InstrBlock's are the insn sequences generated by the insn selectors. --- They are really trees of insns to facilitate fast appending, where a --- left-to-right traversal yields the insns in the correct order. +-- They are really trees of insns to facilitate fast appending, where a +-- left-to-right traversal yields the insns in the correct order. -- type InstrBlock - = OrdList Instr + = OrdList Instr -- | Condition codes passed up the tree. -- data CondCode - = CondCode Bool Cond InstrBlock + = CondCode Bool Cond InstrBlock -- | a.k.a "Register64" --- Reg is the lower 32-bit temporary which contains the result. --- Use getHiVRegFromLo to find the other VRegUnique. +-- Reg is the lower 32-bit temporary which contains the result. +-- Use getHiVRegFromLo to find the other VRegUnique. -- --- Rules of this simplified insn selection game are therefore that --- the returned Reg may be modified +-- Rules of this simplified insn selection game are therefore that +-- the returned Reg may be modified -- data ChildCode64 = ChildCode64 @@ -67,35 +59,35 @@ data ChildCode64 -- | Holds code that references a memory address. data Amode - = Amode - -- the AddrMode we can use in the instruction - -- that does the real load\/store. - AddrMode + = Amode + -- the AddrMode we can use in the instruction + -- that does the real load\/store. + AddrMode - -- other setup code we have to run first before we can use the - -- above AddrMode. - InstrBlock + -- other setup code we have to run first before we can use the + -- above AddrMode. + InstrBlock -------------------------------------------------------------------------------- -- | Code to produce a result into a register. --- If the result must go in a specific register, it comes out as Fixed. --- Otherwise, the parent can decide which register to put it in. +-- If the result must go in a specific register, it comes out as Fixed. +-- Otherwise, the parent can decide which register to put it in. -- data Register - = Fixed Size Reg InstrBlock - | Any Size (Reg -> InstrBlock) + = Fixed Size Reg InstrBlock + | Any Size (Reg -> InstrBlock) -- | Change the size field in a Register. setSizeOfRegister - :: Register -> Size -> Register + :: Register -> Size -> Register setSizeOfRegister reg size = case reg of - Fixed _ reg code -> Fixed size reg code - Any _ codefn -> Any size codefn + Fixed _ reg code -> Fixed size reg code + Any _ codefn -> Any size codefn -------------------------------------------------------------------------------- @@ -103,7 +95,7 @@ setSizeOfRegister reg size getRegisterReg :: Platform -> CmmReg -> Reg getRegisterReg _ (CmmLocal (LocalReg u pk)) - = RegVirtual $ mkVirtualReg u (cmmTypeSize pk) + = RegVirtual $ mkVirtualReg u (cmmTypeSize pk) getRegisterReg platform (CmmGlobal mid) = case globalRegMaybe platform mid of @@ -118,12 +110,8 @@ getRegisterReg platform (CmmGlobal mid) mangleIndexTree :: DynFlags -> CmmExpr -> CmmExpr mangleIndexTree dflags (CmmRegOff reg off) - = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType dflags reg) + = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] + where width = typeWidth (cmmRegType dflags reg) mangleIndexTree _ _ - = panic "SPARC.CodeGen.Base.mangleIndexTree: no match" - - - - + = panic "SPARC.CodeGen.Base.mangleIndexTree: no match" From git at git.haskell.org Sun Jul 20 21:57:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:54 +0000 (UTC) Subject: [commit: ghc] master: utils: detabify/dewhitespace Digraph (3c5fc8e) Message-ID: <20140720215754.23B7A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c5fc8eac2c0b0e34abde8eb53fddc6555546f28/ghc >--------------------------------------------------------------- commit 3c5fc8eac2c0b0e34abde8eb53fddc6555546f28 Author: Austin Seipp Date: Fri Jul 18 22:31:13 2014 -0500 utils: detabify/dewhitespace Digraph Signed-off-by: Austin Seipp >--------------------------------------------------------------- 3c5fc8eac2c0b0e34abde8eb53fddc6555546f28 compiler/utils/Digraph.lhs | 37 +++++++++++++++---------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs index d22380f..35782ba 100644 --- a/compiler/utils/Digraph.lhs +++ b/compiler/utils/Digraph.lhs @@ -4,13 +4,6 @@ \begin{code} {-# LANGUAGE CPP, ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module Digraph( Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices, @@ -78,10 +71,10 @@ Note [Nodes, keys, vertices] * A 'node' is a big blob of client-stuff * Each 'node' has a unique (client) 'key', but the latter - is in Ord and has fast comparison + is in Ord and has fast comparison * Digraph then maps each 'key' to a Vertex (Int) which is - arranged densely in 0.n + arranged densely in 0.n \begin{code} data Graph node = Graph { @@ -97,7 +90,7 @@ type Node key payload = (payload, key, [key]) -- The keys are ordered -- The [key] are the dependencies of the node; -- it's ok to have extra keys in the dependencies that - -- are not the key of any Node in the graph + -- are not the key of any Node in the graph emptyGraph :: Graph a emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing) @@ -168,18 +161,18 @@ reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_verte \begin{code} type WorkItem key payload - = (Node key payload, -- Tip of the path - [payload]) -- Rest of the path; - -- [a,b,c] means c depends on b, b depends on a + = (Node key payload, -- Tip of the path + [payload]) -- Rest of the path; + -- [a,b,c] means c depends on b, b depends on a -- | Find a reasonably short cycle a->b->c->a, in a strongly -- connected component. The input nodes are presumed to be -- a SCC, so you can start anywhere. findCycle :: forall payload key. Ord key => [Node key payload] -- The nodes. The dependencies can - -- contain extra keys, which are ignored - -> Maybe [payload] -- A cycle, starting with node - -- so each depends on the next + -- contain extra keys, which are ignored + -> Maybe [payload] -- A cycle, starting with node + -- so each depends on the next findCycle graph = go Set.empty (new_work root_deps []) [] where @@ -195,14 +188,14 @@ findCycle graph -- 'go' implements Dijkstra's algorithm, more or less - go :: Set.Set key -- Visited - -> [WorkItem key payload] -- Work list, items length n - -> [WorkItem key payload] -- Work list, items length n+1 - -> Maybe [payload] -- Returned cycle + go :: Set.Set key -- Visited + -> [WorkItem key payload] -- Work list, items length n + -> [WorkItem key payload] -- Work list, items length n+1 + -> Maybe [payload] -- Returned cycle -- Invariant: in a call (go visited ps qs), -- visited = union (map tail (ps ++ qs)) - go _ [] [] = Nothing -- No cycles + go _ [] [] = Nothing -- No cycles go visited [] qs = go visited qs [] go visited (((payload,key,deps), path) : ps) qs | key == root_key = Just (root_payload : reverse path) @@ -211,7 +204,7 @@ findCycle graph | otherwise = go (Set.insert key visited) ps (new_qs ++ qs) where - new_qs = new_work deps (payload : path) + new_qs = new_work deps (payload : path) new_work :: [key] -> [payload] -> [WorkItem key payload] new_work deps path = [ (n, path) | Just n <- map (`Map.lookup` env) deps ] From git at git.haskell.org Sun Jul 20 21:57:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:56 +0000 (UTC) Subject: [commit: ghc] master: types: detabify/dewhitespace Kind (893a4bf) Message-ID: <20140720215800.13CEC24071@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/893a4bf1ceb484dc20f5145ef9ae255c1f69db9b/ghc >--------------------------------------------------------------- commit 893a4bf1ceb484dc20f5145ef9ae255c1f69db9b Author: Austin Seipp Date: Fri Jul 18 22:32:13 2014 -0500 types: detabify/dewhitespace Kind Signed-off-by: Austin Seipp >--------------------------------------------------------------- 893a4bf1ceb484dc20f5145ef9ae255c1f69db9b compiler/types/Kind.lhs | 29 +++++++++++------------------ 1 file changed, 11 insertions(+), 18 deletions(-) diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs index e4dc783..0498282 100644 --- a/compiler/types/Kind.lhs +++ b/compiler/types/Kind.lhs @@ -4,19 +4,12 @@ \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module Kind ( -- * Main data type SuperKind, Kind, typeKind, - -- Kinds - anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind, + -- Kinds + anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind, mkArrowKind, mkArrowKinds, -- Kind constructors... @@ -24,9 +17,9 @@ module Kind ( unliftedTypeKindTyCon, constraintKindTyCon, -- Super Kinds - superKind, superKindTyCon, + superKind, superKindTyCon, - pprKind, pprParendKind, + pprKind, pprParendKind, -- ** Deconstructing Kinds kindAppResult, synTyConResKind, @@ -67,9 +60,9 @@ import FastString \end{code} %************************************************************************ -%* * - Functions over Kinds -%* * +%* * + Functions over Kinds +%* * %************************************************************************ Note [Kind Constraint and kind *] @@ -212,7 +205,7 @@ isSubOpenTypeKindKey uniq || uniq == constraintKindTyConKey -- Needed for error (Num a) "blah" -- and so that (Ord a -> Eq a) is well-kinded -- and so that (# Eq a, Ord b #) is well-kinded - -- See Note [Kind Constraint and kind *] + -- See Note [Kind Constraint and kind *] -- | Is this a kind (i.e. a type-of-types)? isKind :: Kind -> Bool @@ -287,11 +280,11 @@ defaultKind_maybe :: Kind -> Maybe Kind -- simple (* or *->* etc). So generic type variables (other than -- built-in constants like 'error') always have simple kinds. This is important; -- consider --- f x = True +-- f x = True -- We want f to get type --- f :: forall (a::*). a -> Bool +-- f :: forall (a::*). a -> Bool -- Not --- f :: forall (a::ArgKind). a -> Bool +-- f :: forall (a::ArgKind). a -> Bool -- because that would allow a call like (f 3#) as well as (f True), -- and the calling conventions differ. -- This defaulting is done in TcMType.zonkTcTyVarBndr. From git at git.haskell.org Sun Jul 20 21:57:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:57:59 +0000 (UTC) Subject: [commit: ghc] master: Adding more parser exports and some documentation. (00dd05e) Message-ID: <20140720215800.8336B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00dd05e44e4a9c7e7ddd7d99fffd1d937eeb26ad/ghc >--------------------------------------------------------------- commit 00dd05e44e4a9c7e7ddd7d99fffd1d937eeb26ad Author: Andrew Gibiansky Date: Fri Jul 18 23:54:26 2014 -0500 Adding more parser exports and some documentation. Summary: Add a few exports to be generated by the Happy parser module. Add documentation showing how to use the Happy parser. Test Plan: Validate Reviewers: carter, austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D71 >--------------------------------------------------------------- 00dd05e44e4a9c7e7ddd7d99fffd1d937eeb26ad compiler/parser/Parser.y.pp | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index a3c68c3..d592510 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -16,8 +16,25 @@ -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details -module Parser ( parseModule, parseStmt, parseIdentifier, parseType, - parseHeader ) where +-- | This module provides the generated Happy parser for Haskell. It exports +-- a number of parsers which may be used in any library that uses the GHC API. +-- A common usage pattern is to initialize the parser state with a given string +-- and then parse that string: +-- +-- @ +-- runParser :: DynFlags -> String -> P a -> ParseResult a +-- runParser flags str parser = unP parser parseState +-- where +-- filename = "\" +-- location = mkRealSrcLoc (mkFastString filename) 1 1 +-- buffer = stringToStringBuffer str +-- parseState = mkPState flags buffer location in +-- @ +module Parser (parseModule, parseImport, parseStatement, + parseDeclaration, parseExpression, parseTypeSignature, + parseFullStmt, parseStmt, parseIdentifier, + parseType, parseHeader) where + import HsSyn import RdrHsSyn @@ -363,12 +380,20 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } %monad { P } { >>= } { return } %lexer { lexer } { L _ ITeof } +%tokentype { (Located Token) } + +-- Exported parsers %name parseModule module +%name parseImport importdecl +%name parseStatement stmt +%name parseDeclaration topdecl +%name parseExpression exp +%name parseTypeSignature sigdecl +%name parseFullStmt stmt %name parseStmt maybe_stmt %name parseIdentifier identifier %name parseType ctype %partial parseHeader header -%tokentype { (Located Token) } %% ----------------------------------------------------------------------------- From git at git.haskell.org Sun Jul 20 21:58:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:58:02 +0000 (UTC) Subject: [commit: ghc] master: rts: drop unused 'SpinLockCount' typedef (80868ec) Message-ID: <20140720215802.197142406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80868ec8e6483fcc2a70754ebc5e3d3d7522a088/ghc >--------------------------------------------------------------- commit 80868ec8e6483fcc2a70754ebc5e3d3d7522a088 Author: Sergei Trofimovich Date: Fri Jul 18 23:55:46 2014 -0500 rts: drop unused 'SpinLockCount' typedef Summary: Signed-off-by: Sergei Trofimovich Test Plan: git grep, git log -SSpinLockCount, build test Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D76 >--------------------------------------------------------------- 80868ec8e6483fcc2a70754ebc5e3d3d7522a088 includes/rts/SpinLock.h | 2 -- 1 file changed, 2 deletions(-) diff --git a/includes/rts/SpinLock.h b/includes/rts/SpinLock.h index b6eccce..b54d678 100644 --- a/includes/rts/SpinLock.h +++ b/includes/rts/SpinLock.h @@ -34,8 +34,6 @@ typedef struct SpinLock_ typedef StgWord SpinLock; #endif -typedef StgWord SpinLockCount; - #if defined(PROF_SPIN) // PROF_SPIN enables counting the number of times we spin on a lock From git at git.haskell.org Sun Jul 20 21:58:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:58:04 +0000 (UTC) Subject: [commit: ghc] master: fix inconsistency in exported functions from TcSplice.lhs/lhs-boot files when GHCI is not defined (d996a1b) Message-ID: <20140720215804.7F0CA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d996a1bb4db84727fbf1a8e9461a032e04e544e7/ghc >--------------------------------------------------------------- commit d996a1bb4db84727fbf1a8e9461a032e04e544e7 Author: Karel Gardas Date: Fri Jul 18 23:54:52 2014 -0500 fix inconsistency in exported functions from TcSplice.lhs/lhs-boot files when GHCI is not defined Summary: This patch fixes inconsistency in exported functions from TcSplice.lhs and TcSplice.lhs-boot files. It looks like only GHC HEAD is sensitive to it and complains about it while bootstraping another HEAD. At least this is what happening on Solaris/AMD64 builder machine where GHC 7.9.20140620 is used as a boostrap compiler. The failure does not happen on another builders. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D74 >--------------------------------------------------------------- d996a1bb4db84727fbf1a8e9461a032e04e544e7 compiler/typecheck/TcSplice.lhs-boot | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcSplice.lhs-boot b/compiler/typecheck/TcSplice.lhs-boot index ea3848d..fd19dee 100644 --- a/compiler/typecheck/TcSplice.lhs-boot +++ b/compiler/typecheck/TcSplice.lhs-boot @@ -5,7 +5,6 @@ module TcSplice where import HsSyn ( HsSplice, HsBracket, HsQuasiQuote, HsExpr, LHsType, LHsExpr, LPat, LHsDecl ) import HsExpr ( PendingRnSplice ) -import Id ( Id ) import Name ( Name ) import RdrName ( RdrName ) import TcRnTypes( TcM, TcId ) @@ -13,6 +12,7 @@ import TcType ( TcRhoType ) import Annotations ( Annotation, CoreAnnTarget ) #ifdef GHCI +import Id ( Id ) import qualified Language.Haskell.TH as TH #endif @@ -28,20 +28,20 @@ tcTypedBracket :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId) -tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id) - runQuasiQuoteDecl :: HsQuasiQuote RdrName -> TcM [LHsDecl RdrName] runQuasiQuoteExpr :: HsQuasiQuote RdrName -> TcM (LHsExpr RdrName) runQuasiQuoteType :: HsQuasiQuote RdrName -> TcM (LHsType RdrName) runQuasiQuotePat :: HsQuasiQuote RdrName -> TcM (LPat RdrName) runAnnotation :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation +#ifdef GHCI +tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id) + runMetaE :: LHsExpr Id -> TcM (LHsExpr RdrName) runMetaP :: LHsExpr Id -> TcM (LPat RdrName) runMetaT :: LHsExpr Id -> TcM (LHsType RdrName) runMetaD :: LHsExpr Id -> TcM [LHsDecl RdrName] -#ifdef GHCI lookupThName_maybe :: TH.Name -> TcM (Maybe Name) runQuasi :: TH.Q a -> TcM a #endif From git at git.haskell.org Sun Jul 20 21:58:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:58:07 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: detabify/dewhitespace SPARC/CodeGen/Gen32 (2ff9b90) Message-ID: <20140720215807.2BFA12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ff9b90cd4472a2e915b33e870391b474e632f75/ghc >--------------------------------------------------------------- commit 2ff9b90cd4472a2e915b33e870391b474e632f75 Author: Austin Seipp Date: Fri Jul 18 22:30:08 2014 -0500 nativeGen: detabify/dewhitespace SPARC/CodeGen/Gen32 Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2ff9b90cd4472a2e915b33e870391b474e632f75 compiler/nativeGen/SPARC/CodeGen/Gen32.hs | 630 +++++++++++++++--------------- 1 file changed, 309 insertions(+), 321 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2ff9b90cd4472a2e915b33e870391b474e632f75 From git at git.haskell.org Sun Jul 20 21:58:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:58:09 +0000 (UTC) Subject: [commit: ghc] master: Data.List: Unterse/Obvious comment regarding CPP (e0d4386) Message-ID: <20140720215809.C6F5B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0d4386e23a1f67d03fbe67f37ed112830858680/ghc >--------------------------------------------------------------- commit e0d4386e23a1f67d03fbe67f37ed112830858680 Author: Alexander Berntsen Date: Fri Jul 18 23:56:00 2014 -0500 Data.List: Unterse/Obvious comment regarding CPP Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D77 >--------------------------------------------------------------- e0d4386e23a1f67d03fbe67f37ed112830858680 libraries/base/Data/List.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index a5e52e5..2cd9a3b 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -216,7 +216,7 @@ import GHC.Real import GHC.List import GHC.Base -infix 5 \\ -- comment to fool cpp +infix 5 \\ -- comment to fool cpp: https://www.haskell.org/ghc/docs/latest/html/users_guide/options-phases.html#cpp-string-gaps -- ----------------------------------------------------------------------------- -- List functions From git at git.haskell.org Sun Jul 20 21:58:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 21:58:11 +0000 (UTC) Subject: [commit: ghc] master: driver: use absolute paths in ld scripts (#7452) (021b797) Message-ID: <20140720215812.045452406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/021b7978d14799bae779907faf7490cfd21b3f46/ghc >--------------------------------------------------------------- commit 021b7978d14799bae779907faf7490cfd21b3f46 Author: Austin Seipp Date: Sun Jul 20 10:13:15 2014 -0500 driver: use absolute paths in ld scripts (#7452) Patch contributed by slowmo. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 021b7978d14799bae779907faf7490cfd21b3f46 compiler/main/DriverPipeline.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 11427e2..49126fe 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2166,7 +2166,9 @@ joinObjectFiles dflags o_files output_fn = do if ldIsGnuLd then do script <- newTempName dflags "ldscript" - writeFile script $ "INPUT(" ++ unwords o_files ++ ")" + cwd <- getCurrentDirectory + let o_files_abs = map (cwd ) o_files + writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")" ld_r [SysTools.FileOption "" script] ccInfo else if sLdSupportsFilelist mySettings then do From git at git.haskell.org Sun Jul 20 23:26:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 23:26:05 +0000 (UTC) Subject: [commit: ghc] master: utils: delete obsolete heap-view program (2b860ef) Message-ID: <20140720232605.C04312406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b860efdb62fc8f764e83b723594af4fcaba684c/ghc >--------------------------------------------------------------- commit 2b860efdb62fc8f764e83b723594af4fcaba684c Author: Austin Seipp Date: Sun Jul 20 18:24:11 2014 -0500 utils: delete obsolete heap-view program Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2b860efdb62fc8f764e83b723594af4fcaba684c utils/heap-view/Graph.lhs | 165 --------------------- utils/heap-view/HaskXLib.c | 297 -------------------------------------- utils/heap-view/HpView.lhs | 296 ------------------------------------- utils/heap-view/HpView2.lhs | 225 ----------------------------- utils/heap-view/MAIL | 67 --------- utils/heap-view/Makefile | 31 ---- utils/heap-view/Makefile.original | 48 ------ utils/heap-view/Parse.lhs | 92 ------------ utils/heap-view/README | 62 -------- utils/heap-view/common-bits | 35 ----- 10 files changed, 1318 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2b860efdb62fc8f764e83b723594af4fcaba684c From git at git.haskell.org Sun Jul 20 23:26:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 23:26:08 +0000 (UTC) Subject: [commit: ghc] master: utils: remove old pvm scripts (ad785f6) Message-ID: <20140720232608.A4E082406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad785f692cc5a35a1357432594fbe997b6e2bbe7/ghc >--------------------------------------------------------------- commit ad785f692cc5a35a1357432594fbe997b6e2bbe7 Author: Austin Seipp Date: Sun Jul 20 18:25:49 2014 -0500 utils: remove old pvm scripts Signed-off-by: Austin Seipp >--------------------------------------------------------------- ad785f692cc5a35a1357432594fbe997b6e2bbe7 utils/pvm/README | 4 ---- utils/pvm/debugger.emacs | 37 ------------------------------------- utils/pvm/debugger2 | 48 ------------------------------------------------ 3 files changed, 89 deletions(-) diff --git a/utils/pvm/README b/utils/pvm/README deleted file mode 100644 index 5ab58dd..0000000 --- a/utils/pvm/README +++ /dev/null @@ -1,4 +0,0 @@ -"debugger2" is our hacked version of the one that -comes with PVM 3.3.7. - -Less sure about "debugger.emacs"... diff --git a/utils/pvm/debugger.emacs b/utils/pvm/debugger.emacs deleted file mode 100644 index ee053ca..0000000 --- a/utils/pvm/debugger.emacs +++ /dev/null @@ -1,37 +0,0 @@ -#!/bin/csh -f -# -# debugger.csh -# -# this script is invoked by the pvmd when a task is spawned with -# the PvmTaskDebug flag set. it execs an xterm with script -# debugger2 running inside. -# -# 06 Apr 1993 Manchek -# - -if ($#argv < 1) then - echo "usage: debugger command [args]" - exit 1 -endif - -# scratch file for debugger commands - -set TEMPCMD=gdb$$.cmd -set TEMPLISP=gdb$$.el - -# default debugger and flags - -# -# run the debugger -# - -echo run $argv[2-] > $TEMPCMD -echo "(gdb "'"'"$argv[1] -q -x $TEMPCMD"'")' > $TEMPLISP - -emacs -l $TEMPLISP - -#rm -f $TEMPCMD $TEMPLISP - -exit 0 - - diff --git a/utils/pvm/debugger2 b/utils/pvm/debugger2 deleted file mode 100644 index 7cdf8b9..0000000 --- a/utils/pvm/debugger2 +++ /dev/null @@ -1,48 +0,0 @@ -#!/bin/csh -f -# -# debugger2.csh -# -# this script is invoked in an xterm by the generic debugger script. -# it starts the debugger and waits when it exits to prevent the -# window from closing. -# -# it expects the pvmd to set envar PVM_ARCH. -# -# 06 Apr 1993 Manchek -# - -set noglob - -# scratch file for debugger commands - -set TEMPCMD=/tmp/debugger2.$$ - -# default debugger and flags - -set DBCMD="gdb" -set DBFF="-q -x $TEMPCMD" - -# -# try to pick the debugger by arch name -# - -# -# run the debugger -# - -echo run $argv[2-] > $TEMPCMD -$DBCMD $DBFF $argv[1] - -#$DBCMD $argv[1] - -#rm -f $TEMPCMD - -# -# wait to go away -# - -#reset -#sleep 1 -rm -f $TEMPCMD -exit 0 - From git at git.haskell.org Sun Jul 20 23:27:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 20 Jul 2014 23:27:54 +0000 (UTC) Subject: [commit: ghc] master: vagrant: move files around (828e641) Message-ID: <20140720232754.777472406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/828e641e02a05896c53c005ef3c82db7f3797bb7/ghc >--------------------------------------------------------------- commit 828e641e02a05896c53c005ef3c82db7f3797bb7 Author: Austin Seipp Date: Sun Jul 20 18:27:46 2014 -0500 vagrant: move files around Signed-off-by: Austin Seipp >--------------------------------------------------------------- 828e641e02a05896c53c005ef3c82db7f3797bb7 Vagrantfile | 12 ++++++------ {vagrant => utils/vagrant}/bootstrap-deb.sh | 0 {vagrant => utils/vagrant}/bootstrap-rhel.sh | 0 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Vagrantfile b/Vagrantfile index 9c11601..9f6f1a0 100644 --- a/Vagrantfile +++ b/Vagrantfile @@ -4,27 +4,27 @@ MACHINES = { "ubuntu1204-i386" => { :box => "chef/ubuntu-12.04-i386", - :provision => "vagrant/bootstrap-deb.sh" + :provision => "utils/vagrant/bootstrap-deb.sh" }, "ubuntu1204-amd64" => { :box => "chef/ubuntu-12.04", - :provision => "vagrant/bootstrap-deb.sh" + :provision => "utils/vagrant/bootstrap-deb.sh" }, "centos65-i386" => { :box => "chef/centos-6.5-i386", - :provision => "vagrant/bootstrap-rhel.sh" + :provision => "utils/vagrant/bootstrap-rhel.sh" }, "centos65-amd64" => { :box => "chef/centos-6.5", - :provision => "vagrant/bootstrap-rhel.sh" + :provision => "utils/vagrant/bootstrap-rhel.sh" }, "debian74-i386" => { :box => "chef/debian-7.4-i386", - :provision => "vagrant/bootstrap-deb.sh" + :provision => "utils/vagrant/bootstrap-deb.sh" }, "debian74-amd64" => { :box => "chef/debian-7.4", - :provision => "vagrant/bootstrap-deb.sh" + :provision => "utils/vagrant/bootstrap-deb.sh" } } diff --git a/vagrant/bootstrap-deb.sh b/utils/vagrant/bootstrap-deb.sh similarity index 100% rename from vagrant/bootstrap-deb.sh rename to utils/vagrant/bootstrap-deb.sh diff --git a/vagrant/bootstrap-rhel.sh b/utils/vagrant/bootstrap-rhel.sh similarity index 100% rename from vagrant/bootstrap-rhel.sh rename to utils/vagrant/bootstrap-rhel.sh From git at git.haskell.org Mon Jul 21 07:22:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 07:22:36 +0000 (UTC) Subject: [commit: ghc] master: Revert "travis: Install process via cabal" (d3277f4) Message-ID: <20140721072236.4D7032406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d3277f4f02aa93aac2715894f56a894e9ad86501/ghc >--------------------------------------------------------------- commit d3277f4f02aa93aac2715894f56a894e9ad86501 Author: Joachim Breitner Date: Mon Jul 21 09:21:48 2014 +0200 Revert "travis: Install process via cabal" This reverts commit c41b716d82b1722f909979d02a76e21e9b68886c. With the Cabal bump reverted, this should build again, and we aim to keep it buildable like this. >--------------------------------------------------------------- d3277f4f02aa93aac2715894f56a894e9ad86501 .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8b64940..57153b6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -20,8 +20,8 @@ before_install: install: - sudo apt-get update - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - - sudo cabal update - - sudo cabal install --global happy alex process + - cabal update + - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs From git at git.haskell.org Mon Jul 21 08:41:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 08:41:13 +0000 (UTC) Subject: [commit: ghc] master: Typos in note (4dd7ae6) Message-ID: <20140721084113.2BC712406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4dd7ae620d7b2edc5b03d6f5bd0985006e9448e3/ghc >--------------------------------------------------------------- commit 4dd7ae620d7b2edc5b03d6f5bd0985006e9448e3 Author: Gabor Greif Date: Mon Jul 21 10:39:35 2014 +0200 Typos in note >--------------------------------------------------------------- 4dd7ae620d7b2edc5b03d6f5bd0985006e9448e3 compiler/types/Coercion.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index 2f499b7..38f38ed 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -1799,13 +1799,13 @@ Note [Computing a coercion kind and role] To compute a coercion's kind is straightforward: see coercionKind. But to compute a coercion's role, in the case for NthCo we need its kind as well. So if we have two separate functions (one for kinds -and one for roles) we can get exponentially bad behaviour, sinc each -NthCo node makes a seaprate call to coercionKind, which traverses the +and one for roles) we can get exponentially bad behaviour, since each +NthCo node makes a separate call to coercionKind, which traverses the sub-tree again. This was part of the problem in Trac #9233. Solution: compute both together; hence coercionKindRole. We keep a separate coercionKind function because it's a bit more efficient if -the kind is all you wan. +the kind is all you want. \begin{code} coercionType :: Coercion -> Type From git at git.haskell.org Mon Jul 21 09:56:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 09:56:25 +0000 (UTC) Subject: [commit: ghc] master: Make 'ghc' a wired in package. (bb06e2a) Message-ID: <20140721095625.772742406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb06e2a8ae38f0fcfbd2cdfa1f42dfa1e252c939/ghc >--------------------------------------------------------------- commit bb06e2a8ae38f0fcfbd2cdfa1f42dfa1e252c939 Author: Edward Z. Yang Date: Sat Jul 19 16:24:59 2014 +0100 Make 'ghc' a wired in package. Summary: Previously, the GHC API was "semi" wired-in: it was installed with a version number, but that version number was hard-coded into the compiler and it wasn't really possible to install other copies of the GHC API. This patch makes the GHC API more similar to existing wired-in packages such as ghc-prim, and will be helpful when we start extending the amount of information passed to -package-name. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonmar, simonpj, hvr, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D78 >--------------------------------------------------------------- bb06e2a8ae38f0fcfbd2cdfa1f42dfa1e252c939 compiler/basicTypes/Module.lhs | 2 +- compiler/ghc.cabal.in | 7 +++++++ compiler/main/Packages.lhs | 1 + 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index 080ae47..bd2d119 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -367,7 +367,7 @@ rtsPackageId = fsToPackageId (fsLit "rts") thPackageId = fsToPackageId (fsLit "template-haskell") dphSeqPackageId = fsToPackageId (fsLit "dph-seq") dphParPackageId = fsToPackageId (fsLit "dph-par") -thisGhcPackageId = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion)) +thisGhcPackageId = fsToPackageId (fsLit "ghc") interactivePackageId = fsToPackageId (fsLit "interactive") -- | This is the package Id for the current program. It is the default diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index e6f86c9..838a908 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -104,6 +104,13 @@ Library Include-Dirs: . parser utils + if impl( ghc >= 7.9 ) + -- We need to set the package name to ghc (without a version number) + -- as it's magic. But we can't set it for old versions of GHC (e.g. + -- when bootstrapping) because those versions of GHC don't understand + -- that GHC is wired-in. + GHC-Options: -package-name ghc + if flag(stage1) Include-Dirs: stage1 else diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index bb2e048..360519e 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -481,6 +481,7 @@ findWiredInPackages dflags pkgs = do basePackageId, rtsPackageId, thPackageId, + thisGhcPackageId, dphSeqPackageId, dphParPackageId ] From git at git.haskell.org Mon Jul 21 13:57:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 13:57:10 +0000 (UTC) Subject: [commit: ghc] master: [ghc-pkg] Fix #5442 by using the flag db stack to modify packages. (d7c807f) Message-ID: <20140721135710.E63FB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7c807f7975c13444e1ce79e4c36dd802321cf40/ghc >--------------------------------------------------------------- commit d7c807f7975c13444e1ce79e4c36dd802321cf40 Author: Edward Z. Yang Date: Mon Jul 21 05:50:19 2014 -0700 [ghc-pkg] Fix #5442 by using the flag db stack to modify packages. Summary: Previously, the full database stack was used for ghc-pkg to modify packages, which meant that commands like 'ghc-pkg unregister --user' worked the same as 'ghc-pkg unregister'. Since package modification is a "read and write" operation, we should use the flag db stack (which is currently used for reads) to determine which database to update. There is also a new flag --user-package-db, which lets you explicitly set the user database (as seen by --user). This was mostly added to aid in testing, but could be useful for end users as well. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonmar, hvr, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D84 >--------------------------------------------------------------- d7c807f7975c13444e1ce79e4c36dd802321cf40 docs/users_guide/7.10.1-notes.xml | 16 ++++++++++- testsuite/.gitignore | 2 +- testsuite/tests/cabal/Makefile | 54 +++++++++++++++++++++++++++++++++++++ testsuite/tests/cabal/T5442a.stdout | 5 ++++ testsuite/tests/cabal/T5442b.stderr | 1 + testsuite/tests/cabal/T5442b.stdout | 3 +++ testsuite/tests/cabal/T5442c.stderr | 1 + testsuite/tests/cabal/T5442c.stdout | 6 +++++ testsuite/tests/cabal/T5442d.stderr | 1 + testsuite/tests/cabal/T5442d.stdout | 8 ++++++ testsuite/tests/cabal/all.T | 22 +++++++++++++++ utils/ghc-pkg/Main.hs | 36 ++++++++++++++++--------- 12 files changed, 141 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d7c807f7975c13444e1ce79e4c36dd802321cf40 From git at git.haskell.org Mon Jul 21 14:12:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 14:12:57 +0000 (UTC) Subject: [commit: ghc] master: Update upstream Git repo url for `time` package (2ad04d0) Message-ID: <20140721141259.623112406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ad04d003662c048ff3a2e1d0d5cd0fa338c0242/ghc >--------------------------------------------------------------- commit 2ad04d003662c048ff3a2e1d0d5cd0fa338c0242 Author: Herbert Valerio Riedel Date: Mon Jul 21 16:10:32 2014 +0200 Update upstream Git repo url for `time` package The `time` package has recently moved its primary upstream location to https://github.com/haskell/time. This leaves `transformers` the only package used by GHC still requiring darcs2git mirroring machinery. >--------------------------------------------------------------- 2ad04d003662c048ff3a2e1d0d5cd0fa338c0242 packages | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages b/packages index faf8c5d..e3855c2 100644 --- a/packages +++ b/packages @@ -69,7 +69,7 @@ libraries/old-time - - - libraries/pretty - - https://github.com/haskell/pretty.git libraries/process - - - libraries/terminfo - - https://github.com/judah/terminfo.git -libraries/time - - http://git.haskell.org/darcs-mirrors/time.git +libraries/time - - https://github.com/haskell/time.git libraries/transformers - - http://git.haskell.org/darcs-mirrors/transformers.git libraries/unix - - ssh://git at github.com/haskell/unix.git libraries/Win32 - - https://github.com/haskell/win32.git From git at git.haskell.org Mon Jul 21 15:22:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 15:22:13 +0000 (UTC) Subject: [commit: ghc] master: docs: Remove obsolete Visual Haskell document (2c12d9e) Message-ID: <20140721152213.292CC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c12d9efa1ba2f1850c970547fe511cb4f6f6f19/ghc >--------------------------------------------------------------- commit 2c12d9efa1ba2f1850c970547fe511cb4f6f6f19 Author: Austin Seipp Date: Mon Jul 21 04:37:26 2014 -0500 docs: Remove obsolete Visual Haskell document Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2c12d9efa1ba2f1850c970547fe511cb4f6f6f19 docs/vh/Makefile | 7 -- docs/vh/vh.xml | 312 ------------------------------------------------------- 2 files changed, 319 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2c12d9efa1ba2f1850c970547fe511cb4f6f6f19 From git at git.haskell.org Mon Jul 21 15:22:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 15:22:15 +0000 (UTC) Subject: [commit: ghc] master: docs: Delete old docbook cheat sheet (c26bba8) Message-ID: <20140721152215.9446E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c26bba843f35ea843c2eafe68daf1e4545572447/ghc >--------------------------------------------------------------- commit c26bba843f35ea843c2eafe68daf1e4545572447 Author: Austin Seipp Date: Mon Jul 21 04:45:26 2014 -0500 docs: Delete old docbook cheat sheet Signed-off-by: Austin Seipp >--------------------------------------------------------------- c26bba843f35ea843c2eafe68daf1e4545572447 docs/docbook-cheat-sheet/Makefile | 9 - docs/docbook-cheat-sheet/docbook-cheat-sheet.xml | 223 ----------------------- 2 files changed, 232 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c26bba843f35ea843c2eafe68daf1e4545572447 From git at git.haskell.org Mon Jul 21 15:22:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 15:22:18 +0000 (UTC) Subject: [commit: ghc] master: arclint: update linting configuration (a9445f8) Message-ID: <20140721152218.B8F022406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9445f8facbfd579e542fa7d86f21cdf1a6e1c33/ghc >--------------------------------------------------------------- commit a9445f8facbfd579e542fa7d86f21cdf1a6e1c33 Author: Austin Seipp Date: Mon Jul 21 04:33:27 2014 -0500 arclint: update linting configuration Signed-off-by: Austin Seipp >--------------------------------------------------------------- a9445f8facbfd579e542fa7d86f21cdf1a6e1c33 .arclint | 51 ++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 48 insertions(+), 3 deletions(-) diff --git a/.arclint b/.arclint index 21ca5f0..bb16f08 100644 --- a/.arclint +++ b/.arclint @@ -14,18 +14,63 @@ }, "text": { "type": "text", - "exclude": [ "(\\.xml$)" ], + "exclude": [ "(\\.xml)", "(Makefile)", "(\\.mk)" ], "severity": { "5": "disabled" } }, "text-xml": { "type": "text", - "include": "(\\.xml$)", + "include": "(\\.xml)", "severity": { "5": "disabled", "3": "disabled" } + }, + "makefiles": { + "type": "text", + "include": [ "(Makefile)", "(\\.mk)" ], + "severity": { + "2": "disabled" + } } - } + }, + + "exclude": + [ "(^libffi-tarballs)", + "(^libraries/binary)", + "(^libraries/bytestring)", + "(^libraries/Cabal)", + "(^libraries/containers)", + "(^libraries/haskeline)", + "(^libraries/pretty)", + "(^libraries/terminfo)", + "(^libraries/transformers)", + "(^libraries/xhtml)", + "(^libraries/Win32)", + "(^libraries/primitive)", + "(^libraries/vector)", + "(^libraries/time)", + "(^libraries/random)", + "(^libraries/array)", + "(^libraries/deepseq)", + "(^libraries/directory)", + "(^libraries/filepath)", + "(^libraries/haskell98)", + "(^libraries/haskell2010)", + "(^libraries/hoopl)", + "(^libraries/hpc)", + "(^libraries/old-locale)", + "(^libraries/old-time)", + "(^libraries/process)", + "(^libraries/unix)", + "(^libraries/parallel)", + "(^libraries/stm)", + "(^libraries/dph)", + "(^utils/haddock)", + "(^nofib)", + "(^utils/hsc2hs)", + "(^libffi-tarballs)", + "(^ghc-tarballs)" + ] } From git at git.haskell.org Mon Jul 21 15:47:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 15:47:25 +0000 (UTC) Subject: [commit: ghc] master: Rename PackageId to PackageKey, distinguishing it from Cabal's PackageId. (4bebab2) Message-ID: <20140721154725.4E6272406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4bebab25e4c9a3bfccc491d4dd13c685629cd1de/ghc >--------------------------------------------------------------- commit 4bebab25e4c9a3bfccc491d4dd13c685629cd1de Author: Edward Z. Yang Date: Sat Jul 19 17:11:08 2014 +0100 Rename PackageId to PackageKey, distinguishing it from Cabal's PackageId. Summary: Previously, both Cabal and GHC defined the type PackageId, and we expected them to be roughly equivalent (but represented differently). This refactoring separates these two notions. A package ID is a user-visible identifier; it's the thing you write in a Cabal file, e.g. containers-0.9. The components of this ID are semantically meaningful, and decompose into a package name and a package vrsion. A package key is an opaque identifier used by GHC to generate linking symbols. Presently, it just consists of a package name and a package version, but pursuant to #9265 we are planning to extend it to record other information. Within a single executable, it uniquely identifies a package. It is *not* an InstalledPackageId, as the choice of a package key affects the ABI of a package (whereas an InstalledPackageId is computed after compilation.) Cabal computes a package key for the package and passes it to GHC using -package-name (now *extremely* misnamed). As an added bonus, we don't have to worry about shadowing anymore. As a follow on, we should introduce -current-package-key having the same role as -package-name, and deprecate the old flag. This commit is just renaming. The haddock submodule needed to be updated. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, simonmar, hvr, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D79 Conflicts: compiler/main/HscTypes.lhs compiler/main/Packages.lhs utils/haddock >--------------------------------------------------------------- 4bebab25e4c9a3bfccc491d4dd13c685629cd1de compiler/basicTypes/DataCon.lhs | 2 +- compiler/basicTypes/Module.lhs | 136 ++++++++++++++++++------------------ compiler/basicTypes/Module.lhs-boot | 6 +- compiler/basicTypes/Name.lhs | 2 +- compiler/basicTypes/RdrName.lhs | 2 +- compiler/cmm/CLabel.hs | 50 ++++++------- compiler/cmm/CmmParse.y | 4 +- compiler/codeGen/StgCmmCon.hs | 4 +- compiler/codeGen/StgCmmExtCode.hs | 6 +- compiler/codeGen/StgCmmHeap.hs | 2 +- compiler/codeGen/StgCmmLayout.hs | 4 +- compiler/codeGen/StgCmmMonad.hs | 2 +- compiler/codeGen/StgCmmProf.hs | 6 +- compiler/codeGen/StgCmmTicky.hs | 12 ++-- compiler/codeGen/StgCmmUtils.hs | 4 +- compiler/coreSyn/CorePrep.lhs | 4 +- compiler/deSugar/Coverage.lhs | 8 +-- compiler/deSugar/DsForeign.lhs | 4 +- compiler/deSugar/DsMeta.hs | 4 +- compiler/ghci/ByteCodeLink.lhs | 6 +- compiler/ghci/DebuggerUtils.hs | 2 +- compiler/ghci/Linker.lhs | 24 +++---- compiler/hsSyn/Convert.lhs | 4 +- compiler/iface/BinIface.hs | 4 +- compiler/iface/LoadIface.lhs | 6 +- compiler/iface/MkIface.lhs | 14 ++-- compiler/main/CodeOutput.lhs | 8 +-- compiler/main/DriverPipeline.hs | 24 +++---- compiler/main/DynFlags.hs | 10 +-- compiler/main/Finder.lhs | 22 +++--- compiler/main/GHC.hs | 16 ++--- compiler/main/GhcMake.hs | 2 +- compiler/main/HscMain.hs | 20 +++--- compiler/main/HscTypes.lhs | 22 +++--- compiler/main/InteractiveEval.hs | 2 +- compiler/main/PackageConfig.hs | 22 +++--- compiler/main/Packages.lhs | 84 +++++++++++----------- compiler/main/SysTools.lhs | 6 +- compiler/main/TidyPgm.lhs | 4 +- compiler/nativeGen/AsmCodeGen.lhs | 6 +- compiler/nativeGen/X86/CodeGen.hs | 6 +- compiler/parser/Lexer.x | 2 +- compiler/prelude/ForeignCall.lhs | 2 +- compiler/prelude/PrelNames.lhs | 18 ++--- compiler/prelude/PrimOp.lhs | 4 +- compiler/rename/RnNames.lhs | 2 +- compiler/rename/RnSource.lhs | 26 +++---- compiler/typecheck/TcEnv.lhs | 2 +- compiler/typecheck/TcErrors.lhs | 6 +- compiler/typecheck/TcGenDeriv.lhs | 8 +-- compiler/typecheck/TcRnDriver.lhs | 4 +- compiler/typecheck/TcRnTypes.lhs | 6 +- compiler/typecheck/TcSplice.lhs | 14 ++-- docs/users_guide/7.10.1-notes.xml | 21 ++++++ ghc/InteractiveUI.hs | 12 ++-- utils/haddock | 2 +- 56 files changed, 363 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 4bebab25e4c9a3bfccc491d4dd13c685629cd1de From git at git.haskell.org Mon Jul 21 16:14:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 16:14:37 +0000 (UTC) Subject: [commit: ghc] master: Documentation for substringCheck. (0acd70a) Message-ID: <20140721161440.6AB962406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0acd70ac496daac4edd15e82bddf8a59d24f3c82/ghc >--------------------------------------------------------------- commit 0acd70ac496daac4edd15e82bddf8a59d24f3c82 Author: Edward Z. Yang Date: Mon Jul 21 16:22:13 2014 +0100 Documentation for substringCheck. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 0acd70ac496daac4edd15e82bddf8a59d24f3c82 utils/ghc-pkg/Main.hs | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 390873a..a1f30f6 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -326,6 +326,28 @@ runit verbosity cli nonopts = do where splitComma "" = Nothing splitComma fs = Just $ break (==',') (tail fs) + -- | Parses a glob into a predicate which tests if a string matches + -- the glob. Returns Nothing if the string in question is not a glob. + -- At the moment, we only support globs at the beginning and/or end of + -- strings. This function respects case sensitivity. + -- + -- >>> fromJust (substringCheck "*") "anything" + -- True + -- + -- >>> fromJust (substringCheck "string") "string" + -- True + -- + -- >>> fromJust (substringCheck "*bar") "foobar" + -- True + -- + -- >>> fromJust (substringCheck "foo*") "foobar" + -- True + -- + -- >>> fromJust (substringCheck "*ooba*") "foobar" + -- True + -- + -- >>> fromJust (substringCheck "f*bar") "foobar" + -- False substringCheck :: String -> Maybe (String -> Bool) substringCheck "" = Nothing substringCheck "*" = Just (const True) From git at git.haskell.org Mon Jul 21 17:00:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 17:00:17 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal submodule to HEAD (1.21) (80ab62d) Message-ID: <20140721170017.78B2C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80ab62d0d722972ce004b860c3a15c5727189285/ghc >--------------------------------------------------------------- commit 80ab62d0d722972ce004b860c3a15c5727189285 Author: Edward Z. Yang Date: Mon Jul 21 08:51:45 2014 -0700 Update Cabal submodule to HEAD (1.21) This reverts commit f23b2129aca24beb4ece0d5915f67c448dc64ae4. >--------------------------------------------------------------- 80ab62d0d722972ce004b860c3a15c5727189285 libraries/Cabal | 2 +- libraries/bin-package-db/bin-package-db.cabal | 2 +- utils/ghc-cabal/ghc-cabal.cabal | 2 +- utils/ghctags/ghctags.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index c125342..90811eb 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit c125342d4147ffb59c88d43024ae9abfc3a9c96d +Subproject commit 90811eb4f0e06ba308e8a6e93089ff041d932952 diff --git a/libraries/bin-package-db/bin-package-db.cabal b/libraries/bin-package-db/bin-package-db.cabal index dd84f9c..e8b4fd4 100644 --- a/libraries/bin-package-db/bin-package-db.cabal +++ b/libraries/bin-package-db/bin-package-db.cabal @@ -26,5 +26,5 @@ Library build-depends: base >= 4 && < 5, binary >= 0.5 && < 0.8, - Cabal >= 1.20 && < 1.21 + Cabal >= 1.20 && < 1.22 diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index 0f13b9d..5437d63 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -18,7 +18,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 1.20 && < 1.21, + Cabal >= 1.20 && < 1.22, directory >= 1.1 && < 1.3, filepath >= 1.2 && < 1.4 diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal index 31e80b2..e9c7848 100644 --- a/utils/ghctags/ghctags.cabal +++ b/utils/ghctags/ghctags.cabal @@ -19,6 +19,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 1.20 && <1.21, + Cabal >= 1.20 && <1.22, ghc From git at git.haskell.org Mon Jul 21 17:00:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 17:00:19 +0000 (UTC) Subject: [commit: ghc] master: Always qualify on hi interface mismatch. (9960afe) Message-ID: <20140721170019.C3B332406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9960afe413c0fe18cf988c1b7e4804c449b5875a/ghc >--------------------------------------------------------------- commit 9960afe413c0fe18cf988c1b7e4804c449b5875a Author: Edward Z. Yang Date: Mon Jul 21 17:21:10 2014 +0100 Always qualify on hi interface mismatch. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 9960afe413c0fe18cf988c1b7e4804c449b5875a compiler/iface/LoadIface.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 4b3a445..04b0476 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -876,7 +876,7 @@ badIfaceFile file err hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc hiModuleNameMismatchWarn requested_mod read_mod = - withPprStyle defaultUserStyle $ + withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ -- we want the Modules below to be qualified with package names, -- so reset the PrintUnqualified setting. hsep [ ptext (sLit "Something is amiss; requested module ") From git at git.haskell.org Mon Jul 21 20:28:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Jul 2014 20:28:39 +0000 (UTC) Subject: [commit: ghc] master: Unbreak the build on FreeBSD/i386, where the default target arch is i486. (7aabfa6) Message-ID: <20140721202839.CCCCF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7aabfa6292c2469cf3250e006869273fb1b356ce/ghc >--------------------------------------------------------------- commit 7aabfa6292c2469cf3250e006869273fb1b356ce Author: Gabor Pali Date: Mon Jul 21 22:13:24 2014 +0200 Unbreak the build on FreeBSD/i386, where the default target arch is i486. The recent version of ghc-prim assumes a more modern processor as it exploits built-in atomic operations, and some of them are not yet present on i486. Hence the -march flag is explicitly set to i686 for the C compiler -- just to be in sync with the default of other distributions. >--------------------------------------------------------------- 7aabfa6292c2469cf3250e006869273fb1b356ce aclocal.m4 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index 42f760c..394e405 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -529,6 +529,9 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], i386-unknown-mingw32) $2="$$2 -march=i686" ;; + i386-portbld-freebsd*) + $2="$$2 -march=i686" + ;; i386-apple-darwin) $2="$$2 -m32" $3="$$3 -m32" From git at git.haskell.org Tue Jul 22 08:40:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 08:40:39 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9339' created Message-ID: <20140722084039.30E6D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9339 Referencing: 1c126cfb4a9067d4ac5987d9371f6920328f6f29 From git at git.haskell.org Tue Jul 22 08:40:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 08:40:42 +0000 (UTC) Subject: [commit: ghc] wip/T9339: Make last a good consumer (1c126cf) Message-ID: <20140722084042.81A0D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9339 Link : http://ghc.haskell.org/trac/ghc/changeset/1c126cfb4a9067d4ac5987d9371f6920328f6f29/ghc >--------------------------------------------------------------- commit 1c126cfb4a9067d4ac5987d9371f6920328f6f29 Author: Joachim Breitner Date: Tue Jul 22 10:37:56 2014 +0200 Make last a good consumer simply by implementing it as foldl. This fixes #9339. Thanks to David Feuer for bringing it up. >--------------------------------------------------------------- 1c126cfb4a9067d4ac5987d9371f6920328f6f29 libraries/base/GHC/List.lhs | 7 ++----- testsuite/tests/perf/should_run/T9339.hs | 4 ++++ testsuite/tests/perf/should_run/T9339.stdout | 1 + testsuite/tests/perf/should_run/all.T | 9 +++++++++ 4 files changed, 16 insertions(+), 5 deletions(-) diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index e004ded..9b6cc2e 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -83,11 +83,8 @@ last [x] = x last (_:xs) = last xs last [] = errorEmptyList "last" #else --- eliminate repeated cases -last [] = errorEmptyList "last" -last (x:xs) = last' x xs - where last' y [] = y - last' _ (y:ys) = last' y ys +-- use foldl to allow fusion +last = foldl (\_ x -> x) (errorEmptyList "last") #endif -- | Return all the elements of a list except the last one. diff --git a/testsuite/tests/perf/should_run/T9339.hs b/testsuite/tests/perf/should_run/T9339.hs new file mode 100644 index 0000000..96f5f72 --- /dev/null +++ b/testsuite/tests/perf/should_run/T9339.hs @@ -0,0 +1,4 @@ +-- Tests that `last` successfully fuses. + +main :: IO () +main = print $ last $ filter odd $ [1::Int ..10000000] diff --git a/testsuite/tests/perf/should_run/T9339.stdout b/testsuite/tests/perf/should_run/T9339.stdout new file mode 100644 index 0000000..e161ae3 --- /dev/null +++ b/testsuite/tests/perf/should_run/T9339.stdout @@ -0,0 +1 @@ +9999999 diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index a9d7c03..924f7f1 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -379,3 +379,12 @@ test('T9203', only_ways(['normal'])], compile_and_run, ['-O2']) + +test('T9339', + [stats_num_field('bytes allocated', + [ (wordsize(64), 80050760, 5) ]), + # w/o fusing last: 320005080 + # 2014-07-22: 80050760 + only_ways(['normal'])], + compile_and_run, + ['-O2']) From git at git.haskell.org Tue Jul 22 09:21:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 09:21:09 +0000 (UTC) Subject: [commit: ghc] master: Make last a good consumer (b709f0a) Message-ID: <20140722092109.261142406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b709f0a047dc036de15dc43d3b0ab88d3e32c5e6/ghc >--------------------------------------------------------------- commit b709f0a047dc036de15dc43d3b0ab88d3e32c5e6 Author: Joachim Breitner Date: Tue Jul 22 11:21:01 2014 +0200 Make last a good consumer Summary: Make last a good consumer simply by implementing it as foldl. This fixes Trac: #9339. Thanks to David Feuer for bringing it up. Test Plan: perf/should_run/T9339 + general validation Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D86 Trac Issues: #9339 >--------------------------------------------------------------- b709f0a047dc036de15dc43d3b0ab88d3e32c5e6 libraries/base/GHC/List.lhs | 7 ++----- testsuite/tests/perf/should_run/T9339.hs | 4 ++++ testsuite/tests/perf/should_run/T9339.stdout | 1 + testsuite/tests/perf/should_run/all.T | 9 +++++++++ 4 files changed, 16 insertions(+), 5 deletions(-) diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index e004ded..9b6cc2e 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -83,11 +83,8 @@ last [x] = x last (_:xs) = last xs last [] = errorEmptyList "last" #else --- eliminate repeated cases -last [] = errorEmptyList "last" -last (x:xs) = last' x xs - where last' y [] = y - last' _ (y:ys) = last' y ys +-- use foldl to allow fusion +last = foldl (\_ x -> x) (errorEmptyList "last") #endif -- | Return all the elements of a list except the last one. diff --git a/testsuite/tests/perf/should_run/T9339.hs b/testsuite/tests/perf/should_run/T9339.hs new file mode 100644 index 0000000..96f5f72 --- /dev/null +++ b/testsuite/tests/perf/should_run/T9339.hs @@ -0,0 +1,4 @@ +-- Tests that `last` successfully fuses. + +main :: IO () +main = print $ last $ filter odd $ [1::Int ..10000000] diff --git a/testsuite/tests/perf/should_run/T9339.stdout b/testsuite/tests/perf/should_run/T9339.stdout new file mode 100644 index 0000000..e161ae3 --- /dev/null +++ b/testsuite/tests/perf/should_run/T9339.stdout @@ -0,0 +1 @@ +9999999 diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index a9d7c03..8b8547e 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -379,3 +379,12 @@ test('T9203', only_ways(['normal'])], compile_and_run, ['-O2']) + +test('T9339', + [stats_num_field('bytes allocated', + [ (wordsize(64), 80050760, 5) ]), + # w/o fusing last: 320005080 + # 2014-07-22: 80050760 + only_ways(['normal'])], + compile_and_run, + ['-O2']) From git at git.haskell.org Tue Jul 22 09:21:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 09:21:17 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9339' deleted Message-ID: <20140722092117.97B382406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T9339 From git at git.haskell.org Tue Jul 22 10:48:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 10:48:33 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9156' created Message-ID: <20140722104833.780BE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9156 Referencing: 7372bce33716d83caf1f666e8225768561bdaf16 From git at git.haskell.org Tue Jul 22 10:48:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 10:48:36 +0000 (UTC) Subject: [commit: ghc] wip/T9156: Fixed issue with detection of duplicate record fields (fixes #9156) (360a6be) Message-ID: <20140722104836.521922406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9156 Link : http://ghc.haskell.org/trac/ghc/changeset/360a6be2b986bb6ffae67aaa5ca6d87d0e19a93e/ghc >--------------------------------------------------------------- commit 360a6be2b986bb6ffae67aaa5ca6d87d0e19a93e Author: Gintautas Miliauskas Date: Fri Jun 6 11:12:42 2014 +0000 Fixed issue with detection of duplicate record fields (fixes #9156) Duplicate record fields would not be detected when given a type with multiple data constructors, and the first data constructor had a record field r1 and any consecutive data constructors had multiple fields named r1. >--------------------------------------------------------------- 360a6be2b986bb6ffae67aaa5ca6d87d0e19a93e compiler/hsSyn/HsUtils.lhs | 10 ++++++++-- testsuite/tests/rename/should_compile/all.T | 2 ++ testsuite/tests/rename/should_compile/rn068.hs | 3 +++ testsuite/tests/rename/should_fail/T9156.hs | 4 ++++ testsuite/tests/rename/should_fail/T9156.stderr | 5 +++++ testsuite/tests/rename/should_fail/all.T | 1 + 6 files changed, 23 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 42838ef..4cfdfd0 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -756,8 +756,14 @@ hsConDeclsBinders cons where -- don't re-mangle the location of field names, because we don't -- have a record of the full location of the field declaration anyway - new_flds = filterOut (\f -> unLoc f `elem` flds_seen) - (map cd_fld_name flds) + new_flds = remove_seen (map cd_fld_name flds) [] + -- remove only the first occurrence of any seen field in order to + -- avoid circumventing detection of duplicate fields (#9156) + remove_seen [] _ = [] + remove_seen (x:xs) flds_used = + if unLoc x `elem` flds_seen && not (unLoc x `elem` flds_used) + then remove_seen xs (unLoc x : flds_used) + else x : remove_seen xs flds_used do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name })) = (flds_seen, L loc name : acc) diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 4ed92bd..d104df4 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -110,6 +110,8 @@ test('rn067', extra_clean(['Rn067_A.hi', 'Rn067_A.o']), multimod_compile, ['rn067', '-v0']) +test('rn068', normal, compile, ['']) + test('T1972', normal, compile, ['']) test('T2205', normal, compile, ['']) diff --git a/testsuite/tests/rename/should_compile/rn068.hs b/testsuite/tests/rename/should_compile/rn068.hs new file mode 100644 index 0000000..ec520e2 --- /dev/null +++ b/testsuite/tests/rename/should_compile/rn068.hs @@ -0,0 +1,3 @@ +module Foo where + +data A = A1 { a, b :: Int } | A2 { a, b :: Int } diff --git a/testsuite/tests/rename/should_fail/T9156.hs b/testsuite/tests/rename/should_fail/T9156.hs new file mode 100644 index 0000000..f4ffd1a --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9156.hs @@ -0,0 +1,4 @@ +module T9156 where + +data D = D1 { f1 :: Int } + | D2 { f1, f1 :: Int } diff --git a/testsuite/tests/rename/should_fail/T9156.stderr b/testsuite/tests/rename/should_fail/T9156.stderr new file mode 100644 index 0000000..361ed37 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9156.stderr @@ -0,0 +1,5 @@ + +T9156.hs:4:19: + Multiple declarations of ?f1? + Declared at: T9156.hs:3:15 + T9156.hs:4:19 diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 0f60ff6..d1bf2b6 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -114,4 +114,5 @@ test('T8448', normal, compile_fail, ['']) test('T9006', extra_clean(['T9006a.hi', 'T9006a.o']), multimod_compile_fail, ['T9006', '-v0']) +test('T9156', normal, compile_fail, ['']) test('T9177', normal, compile_fail, ['']) From git at git.haskell.org Tue Jul 22 10:48:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 10:48:38 +0000 (UTC) Subject: [commit: ghc] wip/T9156: Fixed issue with detection of duplicate record fields (fixes #9156) (7372bce) Message-ID: <20140722104838.B22622406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9156 Link : http://ghc.haskell.org/trac/ghc/changeset/7372bce33716d83caf1f666e8225768561bdaf16/ghc >--------------------------------------------------------------- commit 7372bce33716d83caf1f666e8225768561bdaf16 Author: Gintautas Miliauskas Date: Sat Jun 7 15:38:56 2014 +0000 Fixed issue with detection of duplicate record fields (fixes #9156) Summary: Duplicate record fields would not be detected when given a type with multiple data constructors, and the first data constructor had a record field r1 and any consecutive data constructors had multiple fields named r1. Test Plan: validate, new test cases Reviewers: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D87 GHC Trac: #9156 >--------------------------------------------------------------- 7372bce33716d83caf1f666e8225768561bdaf16 compiler/hsSyn/HsUtils.lhs | 34 ++++++++++++-------------- testsuite/tests/rename/should_compile/rn068.hs | 4 ++- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 4cfdfd0..38d340c 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -100,7 +100,10 @@ import FastString import Util import Bag import Outputable + import Data.Either +import Data.Function +import Data.List \end{code} @@ -747,26 +750,21 @@ hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name] -- See hsLTyClDeclBinders for what this does -- The function is boringly complicated because of the records -- And since we only have equality, we have to be a little careful -hsConDeclsBinders cons - = snd (foldl do_one ([], []) cons) - where - do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name - , con_details = RecCon flds })) - = (map unLoc new_flds ++ flds_seen, L loc name : new_flds ++ acc) - where +hsConDeclsBinders cons = go id cons + where go _ [] = [] + go remSeen (r:rs) = -- don't re-mangle the location of field names, because we don't -- have a record of the full location of the field declaration anyway - new_flds = remove_seen (map cd_fld_name flds) [] - -- remove only the first occurrence of any seen field in order to - -- avoid circumventing detection of duplicate fields (#9156) - remove_seen [] _ = [] - remove_seen (x:xs) flds_used = - if unLoc x `elem` flds_seen && not (unLoc x `elem` flds_used) - then remove_seen xs (unLoc x : flds_used) - else x : remove_seen xs flds_used - - do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name })) - = (flds_seen, L loc name : acc) + case r of + -- remove only the first occurrence of any seen field in order to + -- avoid circumventing detection of duplicate fields (#9156) + L loc (ConDecl { con_name = L _ name , con_details = RecCon flds }) -> + (L loc name) : r' ++ go remSeen' rs + where r' = remSeen (map cd_fld_name flds) + remSeen' = foldr (.) remSeen [deleteBy ((==) `on` unLoc) v | v <- r'] + L loc (ConDecl { con_name = L _ name }) -> + (L loc name) : go remSeen rs + \end{code} Note [Binders in family instances] diff --git a/testsuite/tests/rename/should_compile/rn068.hs b/testsuite/tests/rename/should_compile/rn068.hs index ec520e2..83ed851 100644 --- a/testsuite/tests/rename/should_compile/rn068.hs +++ b/testsuite/tests/rename/should_compile/rn068.hs @@ -1,3 +1,5 @@ module Foo where -data A = A1 { a, b :: Int } | A2 { a, b :: Int } +data A = A1 { a, b :: Int } + | A2 { a, b :: Int } + | A3 { a, b :: Int } From git at git.haskell.org Tue Jul 22 11:55:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 11:55:09 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9281' created Message-ID: <20140722115510.850882406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9281 Referencing: 514badce64ef11ff65e08aee08238b5f007d9af6 From git at git.haskell.org Tue Jul 22 11:55:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 11:55:13 +0000 (UTC) Subject: [commit: ghc] wip/T9281: DRAFT: Implement new integer-gmp2 from scratch (re #9281) (514badc) Message-ID: <20140722115513.586ED2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/514badce64ef11ff65e08aee08238b5f007d9af6/ghc >--------------------------------------------------------------- commit 514badce64ef11ff65e08aee08238b5f007d9af6 Author: Herbert Valerio Riedel Date: Fri Jul 18 15:02:43 2014 +0200 DRAFT: Implement new integer-gmp2 from scratch (re #9281) Summary: (preliminary commit message) This is done as a separate integer-gmp2 backend library because it turned out to become a complete rewrite from scratch. This has been tested only on Linux/x86_64 so far. The code has been written while taking into account Linux/i386 and "64-bit" Windows, but will probably need some tweaking to get right. Also, we don't do any autoconf stuff anymore, and rely on Cabal's "extra-libraries: gmp" to do the right thing (which probably won't work everywhere) Moreover, this is currently a big huge patch, which could easily be split into 2 or 3 commits. Test Plan: nofib & testsuite Reviewers: #ghc, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D82 >--------------------------------------------------------------- 514badce64ef11ff65e08aee08238b5f007d9af6 compiler/coreSyn/CorePrep.lhs | 4 + compiler/ghc.mk | 8 +- compiler/prelude/PrelNames.lhs | 9 +- compiler/prelude/TysWiredIn.lhs | 32 +- ghc.mk | 4 +- libraries/base/GHC/Real.lhs | 6 + libraries/base/base.cabal | 19 +- libraries/{ghc-prim => integer-gmp2}/.gitignore | 0 libraries/integer-gmp2/LICENSE | 30 + libraries/integer-gmp2/cbits/primops.cmm | 29 + libraries/integer-gmp2/cbits/wrappers.c | 318 ++++ libraries/integer-gmp2/integer-gmp2.cabal | 52 + .../src/GHC/Integer.hs} | 47 +- .../integer-gmp2/src/GHC/Integer/GMP2/Internals.hs | 127 ++ .../integer-gmp2/src/GHC/Integer/Logarithms.hs | 73 + .../src/GHC/Integer/Logarithms/Internals.hs | 118 ++ libraries/integer-gmp2/src/GHC/Integer/Type.hs | 1603 ++++++++++++++++++++ rules/foreachLibrary.mk | 2 + 18 files changed, 2454 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 514badce64ef11ff65e08aee08238b5f007d9af6 From git at git.haskell.org Tue Jul 22 12:05:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 12:05:57 +0000 (UTC) Subject: [commit: ghc] wip/T9156: Refactored record field duplicate code to use nested filtering functions instead of manually walking accumulator lists. (98a6e27) Message-ID: <20140722120557.387EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9156 Link : http://ghc.haskell.org/trac/ghc/changeset/98a6e277d100021580a4a7ee75fe2d30572e03db/ghc >--------------------------------------------------------------- commit 98a6e277d100021580a4a7ee75fe2d30572e03db Author: Gintautas Miliauskas Date: Sat Jun 7 15:38:56 2014 +0000 Refactored record field duplicate code to use nested filtering functions instead of manually walking accumulator lists. >--------------------------------------------------------------- 98a6e277d100021580a4a7ee75fe2d30572e03db compiler/hsSyn/HsUtils.lhs | 34 ++++++++++++-------------- testsuite/tests/rename/should_compile/rn068.hs | 4 ++- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 4cfdfd0..38d340c 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -100,7 +100,10 @@ import FastString import Util import Bag import Outputable + import Data.Either +import Data.Function +import Data.List \end{code} @@ -747,26 +750,21 @@ hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name] -- See hsLTyClDeclBinders for what this does -- The function is boringly complicated because of the records -- And since we only have equality, we have to be a little careful -hsConDeclsBinders cons - = snd (foldl do_one ([], []) cons) - where - do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name - , con_details = RecCon flds })) - = (map unLoc new_flds ++ flds_seen, L loc name : new_flds ++ acc) - where +hsConDeclsBinders cons = go id cons + where go _ [] = [] + go remSeen (r:rs) = -- don't re-mangle the location of field names, because we don't -- have a record of the full location of the field declaration anyway - new_flds = remove_seen (map cd_fld_name flds) [] - -- remove only the first occurrence of any seen field in order to - -- avoid circumventing detection of duplicate fields (#9156) - remove_seen [] _ = [] - remove_seen (x:xs) flds_used = - if unLoc x `elem` flds_seen && not (unLoc x `elem` flds_used) - then remove_seen xs (unLoc x : flds_used) - else x : remove_seen xs flds_used - - do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name })) - = (flds_seen, L loc name : acc) + case r of + -- remove only the first occurrence of any seen field in order to + -- avoid circumventing detection of duplicate fields (#9156) + L loc (ConDecl { con_name = L _ name , con_details = RecCon flds }) -> + (L loc name) : r' ++ go remSeen' rs + where r' = remSeen (map cd_fld_name flds) + remSeen' = foldr (.) remSeen [deleteBy ((==) `on` unLoc) v | v <- r'] + L loc (ConDecl { con_name = L _ name }) -> + (L loc name) : go remSeen rs + \end{code} Note [Binders in family instances] diff --git a/testsuite/tests/rename/should_compile/rn068.hs b/testsuite/tests/rename/should_compile/rn068.hs index ec520e2..83ed851 100644 --- a/testsuite/tests/rename/should_compile/rn068.hs +++ b/testsuite/tests/rename/should_compile/rn068.hs @@ -1,3 +1,5 @@ module Foo where -data A = A1 { a, b :: Int } | A2 { a, b :: Int } +data A = A1 { a, b :: Int } + | A2 { a, b :: Int } + | A3 { a, b :: Int } From git at git.haskell.org Tue Jul 22 12:24:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 12:24:27 +0000 (UTC) Subject: [commit: ghc] wip/T9156: Add a type signature to hsConDeclsBinders’s go (3630c2b) Message-ID: <20140722122427.95ED52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9156 Link : http://ghc.haskell.org/trac/ghc/changeset/3630c2bdcbe34a3ac92f5555bee9ef2a2226512d/ghc >--------------------------------------------------------------- commit 3630c2bdcbe34a3ac92f5555bee9ef2a2226512d Author: Joachim Breitner Date: Tue Jul 22 14:24:21 2014 +0200 Add a type signature to hsConDeclsBinders?s go >--------------------------------------------------------------- 3630c2bdcbe34a3ac92f5555bee9ef2a2226512d compiler/hsSyn/HsUtils.lhs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 38d340c..e12daf4 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -1,3 +1,5 @@ +> {-# LANGUAGE ScopedTypeVariables #-} + % % (c) The University of Glasgow, 1992-2006 % @@ -746,12 +748,13 @@ hsDataDefnBinders (HsDataDefn { dd_cons = cons }) = hsConDeclsBinders cons -- See Note [Binders in family instances] ------------------- -hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name] +hsConDeclsBinders :: forall name. (Eq name) => [LConDecl name] -> [Located name] -- See hsLTyClDeclBinders for what this does -- The function is boringly complicated because of the records -- And since we only have equality, we have to be a little careful hsConDeclsBinders cons = go id cons - where go _ [] = [] + where go :: ([Located name] -> [Located name]) -> [LConDecl name] -> [Located name] + go _ [] = [] go remSeen (r:rs) = -- don't re-mangle the location of field names, because we don't -- have a record of the full location of the field declaration anyway From git at git.haskell.org Tue Jul 22 14:56:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Jul 2014 14:56:33 +0000 (UTC) Subject: [commit: ghc] master: Rewrite package/module identity section (1db9983) Message-ID: <20140722145633.A381E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1db9983c76c5f5ec8a162de56a69136e2e582eb3/ghc >--------------------------------------------------------------- commit 1db9983c76c5f5ec8a162de56a69136e2e582eb3 Author: Edward Z. Yang Date: Tue Jul 22 15:55:59 2014 +0100 Rewrite package/module identity section Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 1db9983c76c5f5ec8a162de56a69136e2e582eb3 docs/backpack/backpack-impl.tex | 469 +++++++++++++++++++++++++++------------- 1 file changed, 314 insertions(+), 155 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1db9983c76c5f5ec8a162de56a69136e2e582eb3 From git at git.haskell.org Wed Jul 23 14:08:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 14:08:15 +0000 (UTC) Subject: [commit: ghc] wip/T9281: Explicitly link against `libm` (237462c) Message-ID: <20140723140815.60D342406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/237462c166a8ae7ca733bc755334c2cf47c2fc49/ghc >--------------------------------------------------------------- commit 237462c166a8ae7ca733bc755334c2cf47c2fc49 Author: Herbert Valerio Riedel Date: Wed Jul 23 16:07:40 2014 +0200 Explicitly link against `libm` This may be required on platforms such as Windows >--------------------------------------------------------------- 237462c166a8ae7ca733bc755334c2cf47c2fc49 libraries/integer-gmp2/integer-gmp2.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/integer-gmp2/integer-gmp2.cabal b/libraries/integer-gmp2/integer-gmp2.cabal index de93305..ac4ba7e 100644 --- a/libraries/integer-gmp2/integer-gmp2.cabal +++ b/libraries/integer-gmp2/integer-gmp2.cabal @@ -38,7 +38,7 @@ library -- cbits/primops.cmm cbits/wrappers.c - extra-libraries: gmp + extra-libraries: gmp m exposed-modules: GHC.Integer From git at git.haskell.org Wed Jul 23 14:22:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 14:22:53 +0000 (UTC) Subject: [commit: ghc] wip/T9281: Tweak testoutput normaliser to recognize `integer-gmp2` (8da743a) Message-ID: <20140723142253.9B3642406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/8da743a02603eb4bde9ea51e0c7c3e635d2e0d6d/ghc >--------------------------------------------------------------- commit 8da743a02603eb4bde9ea51e0c7c3e635d2e0d6d Author: Herbert Valerio Riedel Date: Wed Jul 23 16:22:27 2014 +0200 Tweak testoutput normaliser to recognize `integer-gmp2` >--------------------------------------------------------------- 8da743a02603eb4bde9ea51e0c7c3e635d2e0d6d testsuite/driver/testlib.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 126c8e4..6286d84 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1588,7 +1588,7 @@ def normalise_errmsg( str ): # We sometimes see the name of the integer-gmp package on stderr, # but this can change (either the implementation name or the # version number), so we canonicalise it here - str = re.sub('integer-[a-z]+', 'integer-impl', str) + str = re.sub('integer-[a-z0-9]+', 'integer-impl', str) return str # normalise a .prof file, so that we can reasonably compare it against From git at git.haskell.org Wed Jul 23 14:29:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 14:29:47 +0000 (UTC) Subject: [commit: ghc] master: Add a summary section. (6e9e855) Message-ID: <20140723142950.E4F972406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e9e855ffeb8863831bb1d76cea3f29e2f1d4432/ghc >--------------------------------------------------------------- commit 6e9e855ffeb8863831bb1d76cea3f29e2f1d4432 Author: Edward Z. Yang Date: Tue Jul 22 16:21:35 2014 +0100 Add a summary section. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 6e9e855ffeb8863831bb1d76cea3f29e2f1d4432 docs/backpack/backpack-impl.tex | 103 ++++++++++++++++++++++++++++++---------- 1 file changed, 77 insertions(+), 26 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index bcb6447..c34e3cb 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -506,43 +506,57 @@ on various test frameworks that a user won't care about if they are not planning on testing the code. (Cabal has a special case for this, allowing the user to write effectively multiple packages in a single Cabal file.) +\subsection{Summary} -\subsection{Cabal dependency resolution} +We can summarize all of the various schemes by describing the internal data +types that would be defined by GHC under each regime. First, we have +the shared data structures, which correspond closely to what users are +used to seeing: -Currently, when we compile a Cabal -package, Cabal goes ahead and resolves \verb|build-depends| entries with actual -implementations, which we compile against. A planned addition to the package key, -independent of Backpack, is to record the transitive dependency tree selected -during this dependency resolution process, so that we can install \pname{libfoo-1.0} -twice compiled against different versions of its dependencies. -What is the relationship to this transitive dependency tree of \emph{packages}, -with the subterms of our package identities which are \emph{modules}? Does one -subsume the other? In fact, these are separate mechanisms---two levels of indirections, -so to speak. +\begin{verbatim} + ::= containers, ... + ::= - + ::= Data.Set, ... + ::= empty, ... +\end{verbatim} -To illustrate, suppose I write a Cabal file with \verb|build-depends: foobar|. A reasonable assumption is that this translates into a -Backpack package which has \verb|include foobar|. However, this is not -actually a Paper Backpack package: Cabal's dependency solver has to -rewrite all of these package references into versioned references -\verb|include foobar-0.1|. For example, this is a pre-package: +Changing the \textbf{granularity of applicativity} modifies how we represent the +list of dependencies associated with an entity. With module applicativity, +we list module identities (not yet defined); with declaration applicativity +we actually list the original names (i.e., ids). \begin{verbatim} -package foo where - include bar + ::= , ... # Declaration applicativity + ::= , ... # Module applicativity \end{verbatim} -and this is a Paper Backpack package: +Changing the \textbf{granularity of dependency} affects how we compute +the lists of dependencies, and what entities are well defined: \begin{verbatim} -package foo-0.3[bar-0.1[baz-0.2]] where - include bar-0.1[baz-0.2] +# Package-level granularity + ::= hash( + ) + ::= : + ::= . + +# Module-level granularity + not defined + ::= hash( : + ) + ::= . + +# Declaration-level granularity + not defined + not defined + ::= hash( : . + ) \end{verbatim} -This tree is very similar to the one tracking dependencies for holes, -but we must record this tree \emph{even} when our package has no holes. -% As a final example, the full module -% identity of \m{B1} in Figure~\ref{fig:granularity} may actually be $\pname{p-0.9(q-1.0[p-0.9]:A1)}$:\m{B}. - +Notice that as we increase the granularity, the notion of a ``package'' and a ``module'' +become undefined. This is because, for example, with module-level granularity, a single +``package'' may result in several modules, each of which have different sets of +dependencies. It doesn't make much sense to refer to the package as a monolithic entity, +because the point of splitting up the dependencies was so that if a user relies only +on a single module, it has a correspondingly restricted set of dependencies. \subsection{The new scheme, formally} \begin{wrapfigure}{R}{0.5\textwidth} @@ -664,6 +678,43 @@ granularity, modules may have spurious dependencies on holes that they don't actually depend on, which means less type equalities may hold. +\subsection{Cabal dependency resolution} + +Currently, when we compile a Cabal +package, Cabal goes ahead and resolves \verb|build-depends| entries with actual +implementations, which we compile against. A planned addition to the package key, +independent of Backpack, is to record the transitive dependency tree selected +during this dependency resolution process, so that we can install \pname{libfoo-1.0} +twice compiled against different versions of its dependencies. +What is the relationship to this transitive dependency tree of \emph{packages}, +with the subterms of our package identities which are \emph{modules}? Does one +subsume the other? In fact, these are separate mechanisms---two levels of indirections, +so to speak. + +To illustrate, suppose I write a Cabal file with \verb|build-depends: foobar|. A reasonable assumption is that this translates into a +Backpack package which has \verb|include foobar|. However, this is not +actually a Paper Backpack package: Cabal's dependency solver has to +rewrite all of these package references into versioned references +\verb|include foobar-0.1|. For example, this is a pre-package: + +\begin{verbatim} +package foo where + include bar +\end{verbatim} + +and this is a Paper Backpack package: + +\begin{verbatim} +package foo-0.3[bar-0.1[baz-0.2]] where + include bar-0.1[baz-0.2] +\end{verbatim} + +This tree is very similar to the one tracking dependencies for holes, +but we must record this tree \emph{even} when our package has no holes. +% As a final example, the full module +% identity of \m{B1} in Figure~\ref{fig:granularity} may actually be $\pname{p-0.9(q-1.0[p-0.9]:A1)}$:\m{B}. + + \subsection{Implementation} In GHC's current packaging system, a single package compiles into a From git at git.haskell.org Wed Jul 23 14:29:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 14:29:50 +0000 (UTC) Subject: [commit: ghc] master: Definite compilation is a go (505358c) Message-ID: <20140723142951.07E6B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/505358c9e638e2952a052ea604c86dd43cb3f7fd/ghc >--------------------------------------------------------------- commit 505358c9e638e2952a052ea604c86dd43cb3f7fd Author: Edward Z. Yang Date: Wed Jul 23 15:29:27 2014 +0100 Definite compilation is a go Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 505358c9e638e2952a052ea604c86dd43cb3f7fd docs/backpack/backpack-impl.tex | 557 +++++++++++++++++++++++++++++----------- 1 file changed, 412 insertions(+), 145 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 505358c9e638e2952a052ea604c86dd43cb3f7fd From git at git.haskell.org Wed Jul 23 15:34:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 15:34:17 +0000 (UTC) Subject: [commit: ghc] master: Write up rename on entry (e408678) Message-ID: <20140723153417.3126D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e40867847278d149574d714f0c5417225b590c4e/ghc >--------------------------------------------------------------- commit e40867847278d149574d714f0c5417225b590c4e Author: Edward Z. Yang Date: Wed Jul 23 16:34:07 2014 +0100 Write up rename on entry Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- e40867847278d149574d714f0c5417225b590c4e docs/backpack/backpack-impl.tex | 85 ++++++++++++++++++++++++++++++++++------- 1 file changed, 71 insertions(+), 14 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index c29ec8a..abdbe06 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -750,14 +750,6 @@ to do away with full package names and versions, and instead use just a base-62 encoded hash, perhaps with the first four characters of the package name for user-friendliness. -\paragraph{Wired-in names} One annoying thing to remember is that GHC -has wired-in names, which refer to packages without any version. These -are specially treated during compilation so that they are built using -a package key that has no version or dependency information. One approach -is to continue treating these libraries specially; alternately we can -maintain a fixed table from these wired names to -package IDs. - \section{Shapeless Backpack}\label{sec:simplifying-backpack} Backpack as currently defined always requires a \emph{shaping} pass, @@ -903,7 +895,7 @@ As far as the implementation is concerned, we never have to worry about handling module variables; we only need to do extra typechecks against (renamed) interface files. -\subsection{Compiling definite packages} +\subsection{Compiling definite packages}\label{sec:compiling} % New definitions \algnewcommand\algorithmicswitch{\textbf{switch}} @@ -993,11 +985,25 @@ package q where \end{verbatim} If there is, we check the implementation to ensure that it is compatible -with the signature, and then we output a \texttt{hisig} file which, for -all declarations the signature exposes, forwards their definitions to -the original implementation file. The intent is that any code in the -current package which compiles against this signature will use this -\texttt{hisig} file, not the original one \texttt{hi} file. +with the signature. If the implementation was found in $flags_H$, we +also output a \texttt{hisig} file which, for all declarations the +signature exposes, forwards their definitions to the original +implementation file. The intent is that any code in the current package +which compiles against this signature will use this \texttt{hisig} file, +not the original one \texttt{hi} file. + +\paragraph{Sometimes \texttt{hisig} is unnecessary} +In the following package: + +\begin{verbatim} +package p where + P = ... + P :: ... +\end{verbatim} + +Paper Backpack specifies that we check the signature \m{P} against implementation +\m{P}, but otherwise no changes are made (i.e., the signature does not narrow +the implementation.) In this case, no \texttt{hisig} file is not necessary. \paragraph{Absence of an \texttt{hi} file} By default, if we find an appropriate \texttt{hi} file, we'll use it @@ -1528,6 +1534,57 @@ A\ldots but it will not be defined prior to package p. In any case, however, it would be good to emit a warning if a package cannot be compiled without mutual recursion. +\subsection{Rename on entry} + +Consider the following example: + +\begin{verbatim} +package p where + A :: [ data T = T ] + B = [ import A; x = T ] +package q where + C :: ... + A = [ data T = T ] + include p + D = [ + import qualified A + import qualified B + import C + x = B.T :: A.T + ] +\end{verbatim} + +We are interested in type-checking \pname{q}, which is an indefinite package +on account of the uninstantiated hole \m{C}. Furthermore, let's suppose that +\pname{p} has already been independently typechecked, and its interface files +installed in some global location with $\alpha_A$ used as the module identity +of \m{A}. (To simplify this example, we'll assume $\beta_{AT}=\alpha_A$.) + +The first three lines of \pname{q} type check in the normal way, but \m{D} +now poses a problem: if we load the interface file for \m{B} the normal way, +we will get a reference to type \texttt{T} with the original name $\alpha_A$.\texttt{T}, +whereas from \m{A} we have an original name \pname{q}:\m{A}.\texttt{T}. + +Let's suppose that we have already have the result of a shaping pass, which +maps our identity variables to their true identities. +Let's consider the possible options here: + +\begin{itemize} + \item We could re-typecheck \pname{p}, feeding it the correct instantiations + for its variables. However, this seems wasteful: we typechecked the + package already, and up-to-renaming, the interface files are exactly + what we need to type check our application. + \item We could make copies of all the interface files, renamed to have the + right original names. This also seems wasteful: why should we have to + create a new copy of every interface file in a library we depend on? + \item When \emph{reading in} the interface file to GHC, we could apply the + renaming according to the shaping pass and store that in memory. +\end{itemize} + +That last solution is pretty appealing, however, there are still circumstances +we need to create new interface files; these exactly mirror the cases described +in Section~\ref{sec:compiling}. + \subsection{Incremental typechecking} We want to typecheck modules incrementally, i.e., when something changes in a package, we only want to re-typecheck the modules that care about that From git at git.haskell.org Wed Jul 23 16:19:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 16:19:24 +0000 (UTC) Subject: [commit: ghc] master: Ignore tix files. (d1f17f5) Message-ID: <20140723161924.605572406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1f17f5dc71832a9cb2f6afe0efd99b76cfe53db/ghc >--------------------------------------------------------------- commit d1f17f5dc71832a9cb2f6afe0efd99b76cfe53db Author: Edward Z. Yang Date: Wed Jul 23 16:54:38 2014 +0100 Ignore tix files. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- d1f17f5dc71832a9cb2f6afe0efd99b76cfe53db libraries/base/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/.gitignore b/libraries/base/.gitignore index 3581b44..54bc34c 100644 --- a/libraries/base/.gitignore +++ b/libraries/base/.gitignore @@ -1,6 +1,7 @@ *.o *.aux *.hi +*.tix # Backup files *~ From git at git.haskell.org Wed Jul 23 18:34:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 18:34:28 +0000 (UTC) Subject: [commit: ghc] master: Duplicate word (eb795ec) Message-ID: <20140723183428.617942406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eb795ec5b051964d3a761bae7a74ad37b362dddf/ghc >--------------------------------------------------------------- commit eb795ec5b051964d3a761bae7a74ad37b362dddf Author: Gabor Greif Date: Wed Jul 23 20:32:56 2014 +0200 Duplicate word >--------------------------------------------------------------- eb795ec5b051964d3a761bae7a74ad37b362dddf docs/backpack/backpack-impl.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index abdbe06..24ddb4f 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -1565,7 +1565,7 @@ now poses a problem: if we load the interface file for \m{B} the normal way, we will get a reference to type \texttt{T} with the original name $\alpha_A$.\texttt{T}, whereas from \m{A} we have an original name \pname{q}:\m{A}.\texttt{T}. -Let's suppose that we have already have the result of a shaping pass, which +Let's suppose that we already have the result of a shaping pass, which maps our identity variables to their true identities. Let's consider the possible options here: From git at git.haskell.org Wed Jul 23 19:47:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 19:47:08 +0000 (UTC) Subject: [commit: ghc] master: Fix test for fetchNandIntArray# (c11b35f) Message-ID: <20140723194710.9FA3B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c11b35f5c5efe8f11039583c493e245bb6bcb33c/ghc >--------------------------------------------------------------- commit c11b35f5c5efe8f11039583c493e245bb6bcb33c Author: Johan Tibell Date: Wed Jul 23 13:11:15 2014 +0200 Fix test for fetchNandIntArray# The test was incorrectly testing that NAND is associative, which it isn't. >--------------------------------------------------------------- c11b35f5c5efe8f11039583c493e245bb6bcb33c .../tests/concurrent/should_run/AtomicPrimops.hs | 25 ++++++++++++++++------ 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/concurrent/should_run/AtomicPrimops.hs b/testsuite/tests/concurrent/should_run/AtomicPrimops.hs index 0c55aba..1789e26 100644 --- a/testsuite/tests/concurrent/should_run/AtomicPrimops.hs +++ b/testsuite/tests/concurrent/should_run/AtomicPrimops.hs @@ -76,6 +76,7 @@ fetchXorTest = do -- Right now we only test that they return the correct value for a -- single op on each thread. +-- | Test an associative operation. fetchOpTest :: (MByteArray -> Int -> Int -> IO ()) -> Int -> String -> IO () fetchOpTest op expected name = do @@ -87,12 +88,15 @@ fetchOpTest op expected name = do work :: MByteArray -> Int -> IO () work mba val = op mba 0 val - -- Initial value is a large prime and the two patterns are 1010... - -- and 0101... - (n0, t1pat, t2pat) - | sizeOf (undefined :: Int) == 8 = - (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999) - | otherwise = (0x0000ffff, 0x55555555, 0x99999999) +-- | Initial value and operation arguments for race test. +-- +-- Initial value is a large prime and the two patterns are 1010... +-- and 0101... +n0, t1pat, t2pat :: Int +(n0, t1pat, t2pat) + | sizeOf (undefined :: Int) == 8 = + (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999) + | otherwise = (0x0000ffff, 0x55555555, 0x99999999) fetchAndTest :: IO () fetchAndTest = fetchOpTest fetchAndIntArray expected "fetchAndTest" @@ -100,8 +104,15 @@ fetchAndTest = fetchOpTest fetchAndIntArray expected "fetchAndTest" | sizeOf (undefined :: Int) == 8 = 286331153 | otherwise = 4369 +-- | Test NAND without any race, as NAND isn't associative. fetchNandTest :: IO () -fetchNandTest = fetchOpTest fetchNandIntArray expected "fetchNandTest" +fetchNandTest = do + mba <- newByteArray (sizeOf (undefined :: Int)) + writeIntArray mba 0 n0 + fetchNandIntArray mba 0 t1pat + fetchNandIntArray mba 0 t2pat + res <- readIntArray mba 0 + assertEq expected res "fetchNandTest" where expected | sizeOf (undefined :: Int) == 8 = 7378697629770151799 | otherwise = -2576976009 From git at git.haskell.org Wed Jul 23 19:47:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 19:47:10 +0000 (UTC) Subject: [commit: ghc] master: Add missing memory fence to atomicWriteIntArray# (fc53ed5) Message-ID: <20140723194711.280782406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fc53ed5da1a2455b0da2f8ef3ec317e1a96ed83d/ghc >--------------------------------------------------------------- commit fc53ed5da1a2455b0da2f8ef3ec317e1a96ed83d Author: Johan Tibell Date: Wed Jul 23 13:12:10 2014 +0200 Add missing memory fence to atomicWriteIntArray# >--------------------------------------------------------------- fc53ed5da1a2455b0da2f8ef3ec317e1a96ed83d compiler/nativeGen/X86/CodeGen.hs | 3 ++- compiler/nativeGen/X86/Instr.hs | 3 +++ compiler/nativeGen/X86/Ppr.hs | 2 ++ 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 867dbfd..a9ff8f2 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1838,7 +1838,8 @@ genCCall dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] = do return (load_code (getRegisterReg platform use_sse2 (CmmLocal dst))) genCCall _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do - assignMem_IntCode (intSize width) addr val + code <- assignMem_IntCode (intSize width) addr val + return $ code `snocOL` MFENCE genCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = do -- On x86 we don't have enough registers to use cmpxchg with a diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 82e52df..172ce93 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -330,6 +330,7 @@ data Instr | LOCK Instr -- lock prefix | XADD Size Operand Operand -- src (r), dst (r/m) | CMPXCHG Size Operand Operand -- src (r), dst (r/m), eax implicit + | MFENCE data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2 @@ -437,6 +438,7 @@ x86_regUsageOfInstr platform instr LOCK i -> x86_regUsageOfInstr platform i XADD _ src dst -> usageMM src dst CMPXCHG _ src dst -> usageRMM src dst (OpReg eax) + MFENCE -> noUsage _other -> panic "regUsage: unrecognised instr" where @@ -606,6 +608,7 @@ x86_patchRegsOfInstr instr env LOCK i -> LOCK (x86_patchRegsOfInstr i env) XADD sz src dst -> patch2 (XADD sz) src dst CMPXCHG sz src dst -> patch2 (CMPXCHG sz) src dst + MFENCE -> instr _other -> panic "patchRegs: unrecognised instr" diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 5ae1b54..15d2967 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -890,6 +890,8 @@ pprInstr GFREE pprInstr (LOCK i) = ptext (sLit "\tlock") $$ pprInstr i +pprInstr MFENCE = ptext (sLit "\tmfence") + pprInstr (XADD size src dst) = pprSizeOpOp (sLit "xadd") size src dst pprInstr (CMPXCHG size src dst) = pprSizeOpOp (sLit "cmpxchg") size src dst From git at git.haskell.org Wed Jul 23 19:47:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Jul 2014 19:47:13 +0000 (UTC) Subject: [commit: ghc] master: X86 codegen: make LOCK a real instruction prefix (23773b2) Message-ID: <20140723194713.8644E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23773b25863a0a439d81332cb8eee14f6f2c0098/ghc >--------------------------------------------------------------- commit 23773b25863a0a439d81332cb8eee14f6f2c0098 Author: Johan Tibell Date: Wed Jul 23 12:22:37 2014 +0200 X86 codegen: make LOCK a real instruction prefix Before LOCK was a separate instruction and this led to the register allocator separating it from the instruction it was supposed to be a prefix of, leading to illegal assembly such as lock mov Fix contributed by P?LI G?bor J?nos. >--------------------------------------------------------------- 23773b25863a0a439d81332cb8eee14f6f2c0098 compiler/nativeGen/X86/CodeGen.hs | 12 ++++-------- compiler/nativeGen/X86/Instr.hs | 6 +++--- compiler/nativeGen/X86/Ppr.hs | 2 +- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 94b4c15..867dbfd 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1795,13 +1795,11 @@ genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = -- In the common case where dst_r is a virtual register the -- final move should go away, because it's the last use of arg -- and the first use of dst_r. - AMO_Add -> return $ toOL [ LOCK - , XADD size (OpReg arg) (OpAddr amode) + AMO_Add -> return $ toOL [ LOCK (XADD size (OpReg arg) (OpAddr amode)) , MOV size (OpReg arg) (OpReg dst_r) ] AMO_Sub -> return $ toOL [ NEGI size (OpReg arg) - , LOCK - , XADD size (OpReg arg) (OpAddr amode) + , LOCK (XADD size (OpReg arg) (OpAddr amode)) , MOV size (OpReg arg) (OpReg dst_r) ] AMO_And -> cmpxchg_code (\ src dst -> unitOL $ AND size src dst) @@ -1827,8 +1825,7 @@ genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = , MOV size (OpReg eax) (OpReg tmp) ] `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL - [ LOCK - , CMPXCHG size (OpReg tmp) (OpAddr amode) + [ LOCK (CMPXCHG size (OpReg tmp) (OpAddr amode)) , JXX NE lbl ] @@ -1857,8 +1854,7 @@ genCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = dst_r = getRegisterReg platform use_sse2 (CmmLocal dst) code = toOL [ MOV size (OpReg oldval) (OpReg eax) - , LOCK - , CMPXCHG size (OpReg newval) (OpAddr amode) + , LOCK (CMPXCHG size (OpReg newval) (OpAddr amode)) , MOV size (OpReg eax) (OpReg dst_r) ] return $ addr_code `appOL` newval_code newval `appOL` oldval_code oldval diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index ac91747..82e52df 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -327,7 +327,7 @@ data Instr | PREFETCH PrefetchVariant Size Operand -- prefetch Variant, addr size, address to prefetch -- variant can be NTA, Lvl0, Lvl1, or Lvl2 - | LOCK -- lock prefix + | LOCK Instr -- lock prefix | XADD Size Operand Operand -- src (r), dst (r/m) | CMPXCHG Size Operand Operand -- src (r), dst (r/m), eax implicit @@ -434,7 +434,7 @@ x86_regUsageOfInstr platform instr -- note: might be a better way to do this PREFETCH _ _ src -> mkRU (use_R src []) [] - LOCK -> noUsage + LOCK i -> x86_regUsageOfInstr platform i XADD _ src dst -> usageMM src dst CMPXCHG _ src dst -> usageRMM src dst (OpReg eax) @@ -603,7 +603,7 @@ x86_patchRegsOfInstr instr env PREFETCH lvl size src -> PREFETCH lvl size (patchOp src) - LOCK -> instr + LOCK i -> LOCK (x86_patchRegsOfInstr i env) XADD sz src dst -> patch2 (XADD sz) src dst CMPXCHG sz src dst -> patch2 (CMPXCHG sz) src dst diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 7771c02..5ae1b54 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -888,7 +888,7 @@ pprInstr GFREE -- Atomics -pprInstr LOCK = ptext (sLit "\tlock") +pprInstr (LOCK i) = ptext (sLit "\tlock") $$ pprInstr i pprInstr (XADD size src dst) = pprSizeOpOp (sLit "xadd") size src dst From git at git.haskell.org Thu Jul 24 12:46:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Jul 2014 12:46:59 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9156' deleted Message-ID: <20140724124700.0E05C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T9156 From git at git.haskell.org Thu Jul 24 12:47:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Jul 2014 12:47:02 +0000 (UTC) Subject: [commit: ghc] master: Fixed issue with detection of duplicate record fields (d294218) Message-ID: <20140724124702.B7C102406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2942184c8cc53cb3b50f78a7ecff930c3e5861f/ghc >--------------------------------------------------------------- commit d2942184c8cc53cb3b50f78a7ecff930c3e5861f Author: Gintautas Miliauskas Date: Thu Jul 24 14:45:26 2014 +0200 Fixed issue with detection of duplicate record fields Duplicate record fields would not be detected when given a type with multiple data constructors, and the first data constructor had a record field r1 and any consecutive data constructors had multiple fields named r1. This fixes #9156 and was reviewed in https://phabricator.haskell.org/D87 >--------------------------------------------------------------- d2942184c8cc53cb3b50f78a7ecff930c3e5861f compiler/hsSyn/HsUtils.lhs | 31 +++++++++++++++---------- testsuite/tests/rename/should_compile/all.T | 2 ++ testsuite/tests/rename/should_compile/rn068.hs | 5 ++++ testsuite/tests/rename/should_fail/T9156.hs | 4 ++++ testsuite/tests/rename/should_fail/T9156.stderr | 5 ++++ testsuite/tests/rename/should_fail/all.T | 1 + 6 files changed, 36 insertions(+), 12 deletions(-) diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 42838ef..e12daf4 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -1,3 +1,5 @@ +> {-# LANGUAGE ScopedTypeVariables #-} + % % (c) The University of Glasgow, 1992-2006 % @@ -100,7 +102,10 @@ import FastString import Util import Bag import Outputable + import Data.Either +import Data.Function +import Data.List \end{code} @@ -743,24 +748,26 @@ hsDataDefnBinders (HsDataDefn { dd_cons = cons }) = hsConDeclsBinders cons -- See Note [Binders in family instances] ------------------- -hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name] +hsConDeclsBinders :: forall name. (Eq name) => [LConDecl name] -> [Located name] -- See hsLTyClDeclBinders for what this does -- The function is boringly complicated because of the records -- And since we only have equality, we have to be a little careful -hsConDeclsBinders cons - = snd (foldl do_one ([], []) cons) - where - do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name - , con_details = RecCon flds })) - = (map unLoc new_flds ++ flds_seen, L loc name : new_flds ++ acc) - where +hsConDeclsBinders cons = go id cons + where go :: ([Located name] -> [Located name]) -> [LConDecl name] -> [Located name] + go _ [] = [] + go remSeen (r:rs) = -- don't re-mangle the location of field names, because we don't -- have a record of the full location of the field declaration anyway - new_flds = filterOut (\f -> unLoc f `elem` flds_seen) - (map cd_fld_name flds) + case r of + -- remove only the first occurrence of any seen field in order to + -- avoid circumventing detection of duplicate fields (#9156) + L loc (ConDecl { con_name = L _ name , con_details = RecCon flds }) -> + (L loc name) : r' ++ go remSeen' rs + where r' = remSeen (map cd_fld_name flds) + remSeen' = foldr (.) remSeen [deleteBy ((==) `on` unLoc) v | v <- r'] + L loc (ConDecl { con_name = L _ name }) -> + (L loc name) : go remSeen rs - do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name })) - = (flds_seen, L loc name : acc) \end{code} Note [Binders in family instances] diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 4ed92bd..d104df4 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -110,6 +110,8 @@ test('rn067', extra_clean(['Rn067_A.hi', 'Rn067_A.o']), multimod_compile, ['rn067', '-v0']) +test('rn068', normal, compile, ['']) + test('T1972', normal, compile, ['']) test('T2205', normal, compile, ['']) diff --git a/testsuite/tests/rename/should_compile/rn068.hs b/testsuite/tests/rename/should_compile/rn068.hs new file mode 100644 index 0000000..83ed851 --- /dev/null +++ b/testsuite/tests/rename/should_compile/rn068.hs @@ -0,0 +1,5 @@ +module Foo where + +data A = A1 { a, b :: Int } + | A2 { a, b :: Int } + | A3 { a, b :: Int } diff --git a/testsuite/tests/rename/should_fail/T9156.hs b/testsuite/tests/rename/should_fail/T9156.hs new file mode 100644 index 0000000..f4ffd1a --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9156.hs @@ -0,0 +1,4 @@ +module T9156 where + +data D = D1 { f1 :: Int } + | D2 { f1, f1 :: Int } diff --git a/testsuite/tests/rename/should_fail/T9156.stderr b/testsuite/tests/rename/should_fail/T9156.stderr new file mode 100644 index 0000000..361ed37 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9156.stderr @@ -0,0 +1,5 @@ + +T9156.hs:4:19: + Multiple declarations of ?f1? + Declared at: T9156.hs:3:15 + T9156.hs:4:19 diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 0f60ff6..d1bf2b6 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -114,4 +114,5 @@ test('T8448', normal, compile_fail, ['']) test('T9006', extra_clean(['T9006a.hi', 'T9006a.o']), multimod_compile_fail, ['T9006', '-v0']) +test('T9156', normal, compile_fail, ['']) test('T9177', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 24 14:57:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Jul 2014 14:57:58 +0000 (UTC) Subject: [commit: ghc] master: Use the right kinds on the LHS in 'deriving' clauses (6ce708c) Message-ID: <20140724145758.6B31A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ce708c916e2f14a58a4ee2b865bc9026a68d611/ghc >--------------------------------------------------------------- commit 6ce708c916e2f14a58a4ee2b865bc9026a68d611 Author: Simon Peyton Jones Date: Thu Jul 24 12:49:04 2014 +0100 Use the right kinds on the LHS in 'deriving' clauses This patch fixes Trac #9359 >--------------------------------------------------------------- 6ce708c916e2f14a58a4ee2b865bc9026a68d611 compiler/typecheck/TcDeriv.lhs | 36 +++++++++++++++++------- testsuite/tests/deriving/should_compile/T9359.hs | 12 ++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 3 files changed, 39 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index d18c21c..fa775df 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -20,7 +20,7 @@ import FamInst import TcErrors( reportAllUnsolved ) import TcValidity( validDerivPred ) import TcEnv -import TcTyClsDecls( tcFamTyPats, famTyConShape, tcAddDataFamInstCtxt ) +import TcTyClsDecls( tcFamTyPats, famTyConShape, tcAddDataFamInstCtxt, kcDataDefn ) import TcClassDcl( tcAddDeclCtxt ) -- Small helper import TcGenDeriv -- Deriv stuff import TcGenGenerics @@ -598,22 +598,38 @@ deriveInstDecl (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam ------------------------------------------------------------------ deriveFamInst :: DataFamInstDecl Name -> TcM [EarlyDerivSpec] deriveFamInst decl@(DataFamInstDecl { dfid_tycon = L _ tc_name, dfid_pats = pats - , dfid_defn = HsDataDefn { dd_derivs = Just preds } }) + , dfid_defn = defn@(HsDataDefn { dd_derivs = Just preds }) }) = tcAddDataFamInstCtxt decl $ do { fam_tc <- tcLookupTyCon tc_name - ; tcFamTyPats (famTyConShape fam_tc) pats (\_ -> return ()) $ + ; tcFamTyPats (famTyConShape fam_tc) pats (kcDataDefn defn) $ + -- kcDataDefn defn: see Note [Finding the LHS patterns] \ tvs' pats' _ -> concatMapM (deriveTyData True tvs' fam_tc pats') preds } - -- Tiresomely we must figure out the "lhs", which is awkward for type families - -- E.g. data T a b = .. deriving( Eq ) - -- Here, the lhs is (T a b) - -- data instance TF Int b = ... deriving( Eq ) - -- Here, the lhs is (TF Int b) - -- But if we just look up the tycon_name, we get is the *family* - -- tycon, but not pattern types -- they are in the *rep* tycon. deriveFamInst _ = return [] +\end{code} + +Note [Finding the LHS patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When kind polymorphism is in play, we need to be careful. Here is +Trac #9359: + data Cmp a where + Sup :: Cmp a + V :: a -> Cmp a + + data family CmpInterval (a :: Cmp k) (b :: Cmp k) :: * + data instance CmpInterval (V c) Sup = Starting c deriving( Show ) + +So CmpInterval is kind-polymorphic, but the data instance is not + CmpInterval :: forall k. Cmp k -> Cmp k -> * + data instance CmpInterval * (V (c::*)) Sup = Starting c deriving( Show ) +Hence, when deriving the type patterns in deriveFamInst, we must kind +check the RHS (the data constructor 'Starting c') as well as the LHS, +so that we correctly see the instantiation to *. + + +\begin{code} ------------------------------------------------------------------ deriveStandalone :: LDerivDecl Name -> TcM [EarlyDerivSpec] -- Standalone deriving declarations diff --git a/testsuite/tests/deriving/should_compile/T9359.hs b/testsuite/tests/deriving/should_compile/T9359.hs new file mode 100644 index 0000000..313d66e --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T9359.hs @@ -0,0 +1,12 @@ +{-# Language GADTs, PolyKinds, TypeFamilies, DataKinds #-} +module Fam where + +data Cmp a where + Sup :: Cmp a + V :: a -> Cmp a + deriving (Show, Eq) + +data family CmpInterval (a :: Cmp k) (b :: Cmp k) :: * +data instance CmpInterval (V c) Sup = Starting c + deriving( Show ) + diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index f440e80..af05006 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -51,3 +51,4 @@ test('T8950', expect_broken(8950), compile, ['']) test('T8963', normal, compile, ['']) test('T7269', normal, compile, ['']) test('T9069', normal, compile, ['']) +test('T9359', normal, compile, ['']) From git at git.haskell.org Fri Jul 25 09:29:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Jul 2014 09:29:56 +0000 (UTC) Subject: [commit: ghc] master: Check for boxed tau types in the LHS of type family instances (a997f2d) Message-ID: <20140725092956.B9AE22406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a997f2df785448648e7137a88d6b38eeb2643aa1/ghc >--------------------------------------------------------------- commit a997f2df785448648e7137a88d6b38eeb2643aa1 Author: Simon Peyton Jones Date: Fri Jul 25 10:29:35 2014 +0100 Check for boxed tau types in the LHS of type family instances Fixes Trac #9357 >--------------------------------------------------------------- a997f2df785448648e7137a88d6b38eeb2643aa1 compiler/typecheck/TcValidity.lhs | 9 ++++++++- testsuite/tests/indexed-types/should_fail/T9357.hs | 8 ++++++++ testsuite/tests/indexed-types/should_fail/T9357.stderr | 8 ++++++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 4 files changed, 25 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index b5e6d64..fcc18ce 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -1114,7 +1114,14 @@ checkValidTyFamInst mb_clsinfo fam_tc = setSrcSpan loc $ do { checkValidFamPats fam_tc tvs typats - -- The right-hand side is a tau type + -- The argument patterns, and RHS, are all boxed tau types + -- E.g Reject type family F (a :: k1) :: k2 + -- type instance F (forall a. a->a) = ... + -- type instance F Int# = ... + -- type instance F Int = forall a. a->a + -- type instance F Int = Int# + -- See Trac #9357 + ; mapM_ checkValidMonoType typats ; checkValidMonoType rhs -- We have a decidable instance unless otherwise permitted diff --git a/testsuite/tests/indexed-types/should_fail/T9357.hs b/testsuite/tests/indexed-types/should_fail/T9357.hs new file mode 100644 index 0000000..29c57f4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9357.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes, MagicHash, TypeFamilies, PolyKinds #-} + +module T9357 where +import GHC.Exts + +type family F (a :: k1) :: k2 +type instance F Int# = Int +type instance F (forall a. a->a) = Int diff --git a/testsuite/tests/indexed-types/should_fail/T9357.stderr b/testsuite/tests/indexed-types/should_fail/T9357.stderr new file mode 100644 index 0000000..4d97c31 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9357.stderr @@ -0,0 +1,8 @@ + +T9357.hs:7:15: + Illegal unlifted type: Int# + In the type instance declaration for ?F? + +T9357.hs:8:15: + Illegal polymorphic or qualified type: forall a. a -> a + In the type instance declaration for ?F? diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 2c5ae68..0851c08 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -124,3 +124,4 @@ test('T9167', normal, compile_fail, ['']) test('T9171', normal, compile_fail, ['']) test('T9097', normal, compile_fail, ['']) test('T9160', normal, compile_fail, ['']) +test('T9357', normal, compile_fail, ['']) From git at git.haskell.org Fri Jul 25 11:56:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Jul 2014 11:56:46 +0000 (UTC) Subject: [commit: ghc] master: [backpack] Rewrite compilation to be cleaner. (2070a8f) Message-ID: <20140725115646.32CE82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2070a8f3565babed12942d2fee517421ee776ad6/ghc >--------------------------------------------------------------- commit 2070a8f3565babed12942d2fee517421ee776ad6 Author: Edward Z. Yang Date: Fri Jul 25 12:56:33 2014 +0100 [backpack] Rewrite compilation to be cleaner. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 2070a8f3565babed12942d2fee517421ee776ad6 docs/backpack/backpack-impl.tex | 509 ++++++++++++++++++---------------------- 1 file changed, 222 insertions(+), 287 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2070a8f3565babed12942d2fee517421ee776ad6 From git at git.haskell.org Fri Jul 25 15:22:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Jul 2014 15:22:50 +0000 (UTC) Subject: [commit: ghc] master: Refactor FFI error messages (92587bf) Message-ID: <20140725152251.099642406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92587bfefea2b78f89bcdad27e0da5711463fd1b/ghc >--------------------------------------------------------------- commit 92587bfefea2b78f89bcdad27e0da5711463fd1b Author: Simon Peyton Jones Date: Fri Jul 25 16:22:21 2014 +0100 Refactor FFI error messages This patch was provoked by Trac #5610, which I finally got a moment to look at. In the end I added a new data type ErrUtils.Validity, data Validity = IsValid -- Everything is fine | NotValid MsgDoc -- A problem, and some indication of why with some suitable combinators, and used it where appropriate (which touches quite a few modules). The main payoff is that error messages improve for FFI type validation. >--------------------------------------------------------------- 92587bfefea2b78f89bcdad27e0da5711463fd1b compiler/main/ErrUtils.lhs | 31 ++++- compiler/rename/RnExpr.lhs | 72 +++++------ compiler/typecheck/FunDeps.lhs | 10 +- compiler/typecheck/TcDeriv.lhs | 105 ++++++++--------- compiler/typecheck/TcForeign.lhs | 131 ++++++++++----------- compiler/typecheck/TcGenGenerics.lhs | 59 +++++----- compiler/typecheck/TcType.lhs | 112 +++++++++--------- compiler/typecheck/TcValidity.lhs | 4 +- testsuite/tests/ffi/should_fail/T3066.stderr | 7 +- testsuite/tests/ffi/should_fail/T5664.stderr | 7 +- testsuite/tests/ffi/should_fail/T7506.stderr | 5 +- testsuite/tests/ffi/should_fail/ccfail001.stderr | 7 +- testsuite/tests/ffi/should_fail/ccfail002.stderr | 6 +- testsuite/tests/ffi/should_fail/ccfail003.stderr | 6 +- testsuite/tests/ffi/should_fail/ccfail004.stderr | 22 +++- testsuite/tests/ffi/should_fail/ccfail005.stderr | 6 +- testsuite/tests/safeHaskell/ghci/p6.stderr | 2 +- .../safeHaskell/safeLanguage/SafeLang08.stderr | 4 +- 18 files changed, 322 insertions(+), 274 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 92587bfefea2b78f89bcdad27e0da5711463fd1b From git at git.haskell.org Fri Jul 25 21:09:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Jul 2014 21:09:19 +0000 (UTC) Subject: [commit: ghc] master: Update test suite output (dae46da) Message-ID: <20140725210919.2407C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dae46da7de4d8c7104aea1be48586336bbd486ca/ghc >--------------------------------------------------------------- commit dae46da7de4d8c7104aea1be48586336bbd486ca Author: Joachim Breitner Date: Fri Jul 25 23:01:47 2014 +0200 Update test suite output after changes in 92587bf. This problem was noticed on ghcspeed (although only by accident, unfortunately, as a change from 0 to 1 is not reported in the summary). >--------------------------------------------------------------- dae46da7de4d8c7104aea1be48586336bbd486ca testsuite/tests/safeHaskell/ghci/p6.stderr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/safeHaskell/ghci/p6.stderr b/testsuite/tests/safeHaskell/ghci/p6.stderr index 3117708..ec7cd64 100644 --- a/testsuite/tests/safeHaskell/ghci/p6.stderr +++ b/testsuite/tests/safeHaskell/ghci/p6.stderr @@ -1,7 +1,7 @@ :12:1: Unacceptable result type in foreign declaration: - Safe Haskell is on, all FFI imports must be in the IO monad + Safe Haskell is on, all FFI imports must be in the IO monad When checking declaration: foreign import ccall safe "static sin" c_sin :: Double -> Double From git at git.haskell.org Sat Jul 26 01:08:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Jul 2014 01:08:06 +0000 (UTC) Subject: [commit: ghc] master: Module reexports, fixing #8407. (7f5c1086) Message-ID: <20140726010806.D1B342406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7f5c10864e7c26b90c7ff4ed09d00c8a09aa4349/ghc >--------------------------------------------------------------- commit 7f5c10864e7c26b90c7ff4ed09d00c8a09aa4349 Author: Edward Z. Yang Date: Fri Jul 4 17:01:08 2014 +0100 Module reexports, fixing #8407. The general approach is to add a new field to the package database, reexported-modules, which considered by the module finder as possible module declarations. Unlike declaring stub module files, multiple reexports of the same physical package at the same name do not result in an ambiguous import. Has submodule updates for Cabal and haddock. NB: When a reexport renames a module, that renaming is *not* accessible from inside the package. This is not so much a deliberate design choice as for implementation expediency (reexport resolution happens only when a package is in the package database.) TODO: Error handling when there are duplicate reexports/etc is not very well tested. Signed-off-by: Edward Z. Yang Conflicts: compiler/main/HscTypes.lhs testsuite/.gitignore utils/haddock >--------------------------------------------------------------- 7f5c10864e7c26b90c7ff4ed09d00c8a09aa4349 compiler/main/DynFlags.hs | 1 + compiler/main/Finder.lhs | 25 +++-- compiler/main/GHC.hs | 12 ++- compiler/main/HscTypes.lhs | 6 +- compiler/main/PackageConfig.hs | 4 + compiler/main/Packages.lhs | 109 ++++++++++++++++----- ghc/InteractiveUI.hs | 8 +- libraries/Cabal | 2 +- .../Distribution/InstalledPackageInfo/Binary.hs | 8 ++ testsuite/.gitignore | 8 ++ testsuite/tests/cabal/Makefile | 15 +++ testsuite/tests/cabal/all.T | 6 ++ testsuite/tests/cabal/cabal05/Makefile | 69 +++++++++++++ .../{driver/T3007/A => cabal/cabal05}/Setup.hs | 0 testsuite/tests/cabal/{cabal03 => cabal05}/all.T | 4 +- .../tests/cabal/cabal05/p/LICENSE | 0 testsuite/tests/cabal/cabal05/p/P.hs | 3 + testsuite/tests/cabal/cabal05/p/P2.hs | 1 + .../{driver/T3007/A => cabal/cabal05/p}/Setup.hs | 0 testsuite/tests/cabal/cabal05/p/p.cabal | 11 +++ .../tests/cabal/cabal05/q/LICENSE | 0 testsuite/tests/cabal/cabal05/q/Q.hs | 4 + .../{driver/T3007/A => cabal/cabal05/q}/Setup.hs | 0 testsuite/tests/cabal/cabal05/q/q.cabal | 29 ++++++ .../tests/cabal/cabal05/r/LICENSE | 0 testsuite/tests/cabal/cabal05/r/R.hs | 11 +++ .../{driver/T3007/A => cabal/cabal05/r}/Setup.hs | 0 testsuite/tests/cabal/cabal05/r/r.cabal | 32 ++++++ .../tests/cabal/cabal05/s/LICENSE | 0 testsuite/tests/cabal/cabal05/s/S.hs | 18 ++++ .../{driver/T3007/A => cabal/cabal05/s}/Setup.hs | 0 testsuite/tests/cabal/cabal05/s/s.cabal | 11 +++ testsuite/tests/cabal/ghcpkg07.stdout | 11 +++ .../{test4.pkg => recache_reexport_db/a.conf} | 20 ++-- testsuite/tests/cabal/{test4.pkg => test7a.pkg} | 20 ++-- testsuite/tests/cabal/test7b.pkg | 17 ++++ utils/ghc-cabal/ghc-cabal.cabal | 3 +- utils/ghc-pkg/Main.hs | 55 ++++++++++- utils/ghc-pkg/ghc-pkg.cabal | 4 +- utils/ghctags/ghctags.cabal | 3 +- utils/haddock | 2 +- 41 files changed, 453 insertions(+), 79 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7f5c10864e7c26b90c7ff4ed09d00c8a09aa4349 From git at git.haskell.org Sat Jul 26 09:41:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Jul 2014 09:41:36 +0000 (UTC) Subject: [commit: ghc] master: Fix build on OS X due to macro-like string in comment (9487305) Message-ID: <20140726094136.85D422406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9487305393307d5eb34069c5821c11bb98b5ec90/ghc >--------------------------------------------------------------- commit 9487305393307d5eb34069c5821c11bb98b5ec90 Author: Edward Z. Yang Date: Sat Jul 26 10:41:28 2014 +0100 Fix build on OS X due to macro-like string in comment Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 9487305393307d5eb34069c5821c11bb98b5ec90 compiler/main/Packages.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index a6ecb16..c240956e 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -864,8 +864,8 @@ mkModuleMap pkg_db ipid_map = foldr extend_modmap emptyUFM pkgids pkgids = map packageConfigId (eltsUFM pkg_db) extend_modmap pkgid modmap = addListToUFM_C (plusUFM_C merge) modmap es - where -- ASSERT(m == m' && pkg == pkg' && e == e' - -- && (e || not (v || v'))) + where -- Invariant: m == m' && pkg == pkg' && e == e' + -- && (e || not (v || v')) -- Some notes about the assert. Merging only ever occurs when -- we find a reexport. The interesting condition: -- e || not (v || v') From git at git.haskell.org Sun Jul 27 19:13:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Jul 2014 19:13:05 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Typecheck the wrapper definition of a pattern synonym, after everything in the same scope is typechecked (02d0e0b) Message-ID: <20140727191305.E7DE82406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/02d0e0b94dbee4aaf345d2413d544cacd274718e/ghc >--------------------------------------------------------------- commit 02d0e0b94dbee4aaf345d2413d544cacd274718e Author: Dr. ERDI Gergo Date: Sun Jul 27 18:46:50 2014 +0200 Typecheck the wrapper definition of a pattern synonym, after everything in the same scope is typechecked >--------------------------------------------------------------- 02d0e0b94dbee4aaf345d2413d544cacd274718e compiler/typecheck/TcBinds.lhs | 26 +++++++-- compiler/typecheck/TcPatSyn.lhs | 109 ++++++++++++++++++----------------- compiler/typecheck/TcPatSyn.lhs-boot | 6 ++ 3 files changed, 82 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 02d0e0b94dbee4aaf345d2413d544cacd274718e From git at git.haskell.org Sun Jul 27 19:13:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Jul 2014 19:13:08 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: tcLookupPatSyn: look up the PatSyn record for a given Id (21fba5d) Message-ID: <20140727191309.076F72406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/21fba5de4dc269ed5a104ac0e29e467f8168990f/ghc >--------------------------------------------------------------- commit 21fba5de4dc269ed5a104ac0e29e467f8168990f Author: Dr. ERDI Gergo Date: Sun Jul 27 21:00:15 2014 +0200 tcLookupPatSyn: look up the PatSyn record for a given Id >--------------------------------------------------------------- 21fba5de4dc269ed5a104ac0e29e467f8168990f compiler/typecheck/TcEnv.lhs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 6020797..9c9739c 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -18,8 +18,8 @@ module TcEnv( tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv, tcExtendGlobalValEnv, tcLookupLocatedGlobal, tcLookupGlobal, - tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon, - tcLookupConLike, + tcLookupField, tcLookupTyCon, tcLookupClass, + tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom, @@ -73,7 +73,8 @@ import Var import VarSet import RdrName import InstEnv -import DataCon +import DataCon ( DataCon ) +import PatSyn ( PatSyn ) import ConLike import TyCon import CoAxiom @@ -160,6 +161,13 @@ tcLookupDataCon name = do AConLike (RealDataCon con) -> return con _ -> wrongThingErr "data constructor" (AGlobal thing) name +tcLookupPatSyn :: Name -> TcM PatSyn +tcLookupPatSyn name = do + thing <- tcLookupGlobal name + case thing of + AConLike (PatSynCon ps) -> return ps + _ -> wrongThingErr "pattern synonym" (AGlobal thing) name + tcLookupConLike :: Name -> TcM ConLike tcLookupConLike name = do thing <- tcLookupGlobal name From git at git.haskell.org Sun Jul 27 19:13:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Jul 2014 19:13:11 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: When computing minimal recursive sets of bindings, don't include references in wrapper definitions for explicitly-bidirectional pattern synonyms (c586a58) Message-ID: <20140727191313.5AE012406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/c586a580caf6dc3de60cfbca4ccce8c54ae6fbee/ghc >--------------------------------------------------------------- commit c586a580caf6dc3de60cfbca4ccce8c54ae6fbee Author: Dr. ERDI Gergo Date: Sun Jul 27 21:06:44 2014 +0200 When computing minimal recursive sets of bindings, don't include references in wrapper definitions for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- c586a580caf6dc3de60cfbca4ccce8c54ae6fbee compiler/rename/RnBinds.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index b8887b0..1259edd 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -559,7 +559,7 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name , bind_fvs = fvs' } ; fvs' `seq` -- See Note [Free-variable space leak] - return (bind', [name], fvs) + return (bind', [name], fvs1) } where lookupVar = wrapLocM lookupOccRn From git at git.haskell.org Sun Jul 27 19:13:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Jul 2014 19:13:14 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add test case for explicitly-bidirectional pattern synonym (251b4a8) Message-ID: <20140727191314.6D0042406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/251b4a8e26e26844154fe17ddd251f1833be7d5b/ghc >--------------------------------------------------------------- commit 251b4a8e26e26844154fe17ddd251f1833be7d5b Author: Dr. ERDI Gergo Date: Thu Jul 10 10:13:14 2014 +0800 Add test case for explicitly-bidirectional pattern synonym >--------------------------------------------------------------- 251b4a8e26e26844154fe17ddd251f1833be7d5b testsuite/.gitignore | 1 + testsuite/tests/patsyn/should_run/all.T | 1 + testsuite/tests/patsyn/should_run/bidir-explicit.hs | 16 ++++++++++++++++ .../should_run/bidir-explicit.stdout} | 2 ++ 4 files changed, 20 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 376318d..ae004e9 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1058,6 +1058,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/parser/unicode/1744 /tests/parser/unicode/T1744 /tests/parser/unicode/utf8_024 +/tests/patsyn/should_run/bidir-explicit /tests/patsyn/should_run/eval /tests/patsyn/should_run/ex-prov /tests/patsyn/should_run/ex-prov-run diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T index f5936c6..f551da5 100644 --- a/testsuite/tests/patsyn/should_run/all.T +++ b/testsuite/tests/patsyn/should_run/all.T @@ -1,3 +1,4 @@ test('eval', normal, compile_and_run, ['']) test('match', normal, compile_and_run, ['']) test('ex-prov-run', normal, compile_and_run, ['']) +test('bidir-explicit', normal, compile_and_run, ['']) diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.hs b/testsuite/tests/patsyn/should_run/bidir-explicit.hs new file mode 100644 index 0000000..c5de877 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +module Main where + +pattern First x <- x:_ where + First x = [x] + +pattern First' x <- x:_ where + First' x = foo [x, x, x] + +foo :: [a] -> [a] +foo xs@(First x) = replicate (length xs + 1) x + +main = do + mapM_ print $ First () + putStrLn "" + mapM_ print $ First' () diff --git a/testsuite/tests/deriving/should_run/T3087.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout similarity index 75% copy from testsuite/tests/deriving/should_run/T3087.stdout copy to testsuite/tests/patsyn/should_run/bidir-explicit.stdout index 35735b4..4625e61 100644 --- a/testsuite/tests/deriving/should_run/T3087.stdout +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout @@ -1,4 +1,6 @@ () + +() () () () From git at git.haskell.org Sun Jul 27 21:36:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Jul 2014 21:36:26 +0000 (UTC) Subject: [commit: ghc] master: Implement OVERLAPPING and OVERLAPPABLE pragmas (see #9242) (97f499b) Message-ID: <20140727213626.E20C32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97f499b56c5888740ddb147fb198c28a3c06bac7/ghc >--------------------------------------------------------------- commit 97f499b56c5888740ddb147fb198c28a3c06bac7 Author: Iavor S. Diatchki Date: Sun Jul 27 13:02:37 2014 -0700 Implement OVERLAPPING and OVERLAPPABLE pragmas (see #9242) This also removes the short-lived NO_OVERLAP pragama, and renames OVERLAP to OVERLAPS. An instance may be annotated with one of 4 pragams, to control its interaction with other overlapping instances: * OVERLAPPABLE: this instance is ignored if a more specific candidate exists * OVERLAPPING: this instance is preferred over more general candidates * OVERLAPS: both OVERLAPPING and OVERLAPPABLE (i.e., the previous GHC behavior). When compiling with -XOverlappingInstances, all instance are OVERLAPS. * INCOHERENT: same as before (see manual for details). When compiling with -XIncoherentInstances, all instances are INCOHERENT. >--------------------------------------------------------------- 97f499b56c5888740ddb147fb198c28a3c06bac7 compiler/basicTypes/BasicTypes.lhs | 73 +++++++++++++++++++++++++++++--------- compiler/hsSyn/HsDecls.lhs | 18 +++++----- compiler/parser/Lexer.x | 10 +++--- compiler/parser/Parser.y.pp | 14 ++++---- compiler/typecheck/Inst.lhs | 2 +- compiler/types/InstEnv.lhs | 27 +++++++------- compiler/utils/Binary.hs | 12 ++++--- docs/users_guide/glasgow_exts.xml | 53 ++++++++++++++++----------- 8 files changed, 136 insertions(+), 73 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 97f499b56c5888740ddb147fb198c28a3c06bac7 From git at git.haskell.org Mon Jul 28 06:12:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 06:12:56 +0000 (UTC) Subject: [commit: ghc] master: Comments only (5dc0cea) Message-ID: <20140728061256.37B962406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5dc0cea716fb9585affcb0a2b0a467d0c751e541/ghc >--------------------------------------------------------------- commit 5dc0cea716fb9585affcb0a2b0a467d0c751e541 Author: Jan Stolarek Date: Mon Jul 28 08:11:58 2014 +0200 Comments only >--------------------------------------------------------------- 5dc0cea716fb9585affcb0a2b0a467d0c751e541 compiler/main/HscTypes.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index c10475a..54b0700 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -995,8 +995,8 @@ data ModGuts mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment -- These fields all describe the things **declared in this module** - mg_fix_env :: !FixityEnv, -- ^ Fixities declared in this module - -- ToDo: I'm unconvinced this is actually used anywhere + mg_fix_env :: !FixityEnv, -- ^ Fixities declared in this module. + -- Used for creating interface files. mg_tcs :: ![TyCon], -- ^ TyCons declared in this module -- (includes TyCons for classes) mg_insts :: ![ClsInst], -- ^ Class instances declared in this module From git at git.haskell.org Mon Jul 28 08:48:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 08:48:30 +0000 (UTC) Subject: [commit: nofib] master: Support higher timing precision in output parser (5bc1c75) Message-ID: <20140728084830.8F98A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5bc1c75db2c74413959772c85d43f8171fdd7b8c/nofib >--------------------------------------------------------------- commit 5bc1c75db2c74413959772c85d43f8171fdd7b8c Author: Herbert Valerio Riedel Date: Mon Jul 28 09:54:41 2014 +0200 Support higher timing precision in output parser ...and increase reported precision in nofib-analyse from `%.2f` to `%.3f` (i.e. from 10ms to 1ms granularity). See also D97. >--------------------------------------------------------------- 5bc1c75db2c74413959772c85d43f8171fdd7b8c nofib-analyse/Main.hs | 4 ++-- runstdtest/runstdtest.prl | 16 ++++++++-------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/nofib-analyse/Main.hs b/nofib-analyse/Main.hs index a1340d9..3947091 100644 --- a/nofib-analyse/Main.hs +++ b/nofib-analyse/Main.hs @@ -719,7 +719,7 @@ csv_show_results (r:rs) f stat _result_ok norm stddev | stddev = interleave "," (str prog : concat (map stddevbox boxes)) | otherwise = interleave "," (str prog : map (str.showBox) boxes) - stddevbox (BoxStdDev b s) = [str (showBox b), str (printf "%.2f" s)] + stddevbox (BoxStdDev b s) = [str (showBox b), str (printf "%.3f" s)] stddevbox b = [str (showBox b), str "0"] -- --------------------------------------------------------------------------- @@ -886,7 +886,7 @@ showBox (Percentage 100) = " 0.0%" -- pattern matching on Float is bad style, bu showBox (Percentage f) = case printf "%.1f%%" (f-100) of xs@('-':_) -> xs xs -> '+':xs -showBox (BoxFloat f) = printf "%.2f" f +showBox (BoxFloat f) = printf "%.3f" f showBox (BoxInt n) = show n showBox (BoxInteger n) = show n --showBox (BoxInt n) = show (n `div` (1024*1024)) diff --git a/runstdtest/runstdtest.prl b/runstdtest/runstdtest.prl index 3c2eddc..10a419b 100644 --- a/runstdtest/runstdtest.prl +++ b/runstdtest/runstdtest.prl @@ -426,16 +426,16 @@ sub process_stats_file { $TotMem = $1; } - if ( /^\s*INIT\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { + if ( /^\s*INIT\s+time\s*(-*\d+\.\d\d+)s\s*\(\s*(-*\d+\.\d\d+)s elapsed\)/ ) { $InitTime = $1; $InitElapsed = $2; - } elsif ( /^\s*MUT\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { + } elsif ( /^\s*MUT\s+time\s*(-*\d+\.\d\d+)s\s*\(\s*(-*\d+\.\d\d+)s elapsed\)/ ) { $MutTime = $1; $MutElapsed = $2; - } elsif ( /^\s*MUT\+GC0\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)\s+\(\s*(-*\d+\.\d\d)s\s+MUT\s+\+\s+(-*\d+\.\d\d)s\s+GC0/ ) { + } elsif ( /^\s*MUT\+GC0\s+time\s*(-*\d+\.\d\d+)s\s*\(\s*(-*\d+\.\d\d+)s elapsed\)\s+\(\s*(-*\d+\.\d\d+)s\s+MUT\s+\+\s+(-*\d+\.\d\d+)s\s+GC0/ ) { $MutTime = $3; $MutElapsed = $2; $Gc0Time = $4; $Gc0Elapsed = 0; - } elsif ( /^\s*GC\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { + } elsif ( /^\s*GC\s+time\s*(-*\d+\.\d\d+)s\s*\(\s*(-*\d+\.\d\d+)s elapsed\)/ ) { $GcTime = $1; $GcElapsed = $2; - } elsif ( /^\s*GC1\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { + } elsif ( /^\s*GC1\s+time\s*(-*\d+\.\d\d+)s\s*\(\s*(-*\d+\.\d\d+)s elapsed\)/ ) { $Gc1Time = $1; $Gc1Elapsed = $2; $GcTime = $Gc0Time + $Gc1Time; @@ -445,7 +445,7 @@ sub process_stats_file { $GcElapsed = $Gc1Elapsed; } - if (/Generation (\d+):\s*(\d+) collections,\s*\d+ parallel,\s*(-*\d+\.\d\d)s\s*,\s*(-*\d+\.\d\d)s elapsed/) { + if (/Generation (\d+):\s*(\d+) collections,\s*\d+ parallel,\s*(-*\d+\.\d\d+)s\s*,\s*(-*\d+\.\d\d+)s elapsed/) { if ($1 == 0) { $GCs += $2 * $procs; $Gc0Count += $2 * $procs; @@ -525,12 +525,12 @@ sub process_stats_file { $GCs = $1 if /^\s*([0-9]+) GCs?,$/; - if ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds total time,$/ ) { + if ( /^\s*(\d+\.\d\d+) \((\d+\.\d)\) seconds total time,$/ ) { $MutTime = $1; $MutElapsed = $2; # will fix up later $InitTime = 0; $InitElapsed = 0; # hbc doesn't report these - } elsif ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds GC time/ ) { + } elsif ( /^\s*(\d+\.\d\d+) \((\d+\.\d)\) seconds GC time/ ) { $GcTime = $1; $GcElapsed = $2; # fix up mutator time now From git at git.haskell.org Mon Jul 28 08:48:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 08:48:44 +0000 (UTC) Subject: [commit: ghc] master: Increase precision of timings reported by RTS (57ed410) Message-ID: <20140728084844.321142406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/57ed4101687651ba3de59fb75355f4b83ffdca75/ghc >--------------------------------------------------------------- commit 57ed4101687651ba3de59fb75355f4b83ffdca75 Author: Herbert Valerio Riedel Date: Sat Jul 26 11:05:22 2014 +0200 Increase precision of timings reported by RTS Summary: Today's hardware is much faster, so it makes sense to report timings with more precision, and possibly help reduce rounding-induced fluctuations in the nofib statistics. This commit increases the precision of all timings previously reported with a granularity of 10ms to 1ms. For instance, the `+RTS -S` output is now rendered as: Alloc Copied Live GC GC TOT TOT Page Flts bytes bytes bytes user elap user elap 641936 59944 158120 0.000 0.000 0.013 0.001 0 0 (Gen: 0) 517672 60840 158464 0.000 0.000 0.013 0.002 0 0 (Gen: 0) 517256 58800 156424 0.005 0.005 0.019 0.007 0 0 (Gen: 1) 670208 9520 158728 0.000 0.000 0.019 0.008 0 0 (Gen: 0) ... Tot time (elapsed) Avg pause Max pause Gen 0 24 colls, 0 par 0.002s 0.002s 0.0001s 0.0002s Gen 1 3 colls, 0 par 0.011s 0.011s 0.0038s 0.0055s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.001s ( 0.001s elapsed) MUT time 0.005s ( 0.006s elapsed) GC time 0.014s ( 0.014s elapsed) EXIT time 0.001s ( 0.001s elapsed) Total time 0.032s ( 0.020s elapsed) Note that this change also requires associated changes in the nofib submodule. Test Plan: tested with modified nofib Reviewers: simonmar, nomeata, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D97 >--------------------------------------------------------------- 57ed4101687651ba3de59fb75355f4b83ffdca75 nofib | 2 +- rts/Stats.c | 40 ++++++++++++++++++++-------------------- 2 files changed, 21 insertions(+), 21 deletions(-) diff --git a/nofib b/nofib index d98f703..5bc1c75 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit d98f7038d1111e515db9cc27d5d3bbe237e6e14f +Subproject commit 5bc1c75db2c74413959772c85d43f8171fdd7b8c diff --git a/rts/Stats.c b/rts/Stats.c index c3d963c..894e9d2 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -173,8 +173,8 @@ initStats1 (void) nat i; if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) { - statsPrintf(" Alloc Copied Live GC GC TOT TOT Page Flts\n"); - statsPrintf(" bytes bytes bytes user elap user elap\n"); + statsPrintf(" Alloc Copied Live GC GC TOT TOT Page Flts\n"); + statsPrintf(" bytes bytes bytes user elap user elap\n"); } GC_coll_cpu = (Time *)stgMallocBytes( @@ -380,7 +380,7 @@ stat_endGC (Capability *cap, gc_thread *gct, statsPrintf("%9" FMT_SizeT " %9" FMT_SizeT " %9" FMT_SizeT, alloc*sizeof(W_), copied*sizeof(W_), live*sizeof(W_)); - statsPrintf(" %5.2f %5.2f %7.2f %7.2f %4" FMT_Word " %4" FMT_Word " (Gen: %2d)\n", + statsPrintf(" %6.3f %6.3f %8.3f %8.3f %4" FMT_Word " %4" FMT_Word " (Gen: %2d)\n", TimeToSecondsDbl(gc_cpu), TimeToSecondsDbl(gc_elapsed), TimeToSecondsDbl(cpu), @@ -604,7 +604,7 @@ stat_exit (void) if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) { statsPrintf("%9" FMT_SizeT " %9.9s %9.9s", (W_)alloc*sizeof(W_), "", ""); - statsPrintf(" %5.2f %5.2f\n\n", 0.0, 0.0); + statsPrintf(" %6.3f %6.3f\n\n", 0.0, 0.0); } for (i = 0; i < RtsFlags.GcFlags.generations; i++) { @@ -654,10 +654,10 @@ stat_exit (void) (size_t)(peak_mblocks_allocated * BLOCKS_PER_MBLOCK * BLOCK_SIZE_W - hw_alloc_blocks * BLOCK_SIZE_W) / (1024 * 1024 / sizeof(W_))); /* Print garbage collections in each gen */ - statsPrintf(" Tot time (elapsed) Avg pause Max pause\n"); + statsPrintf(" Tot time (elapsed) Avg pause Max pause\n"); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { gen = &generations[g]; - statsPrintf(" Gen %2d %5d colls, %5d par %5.2fs %5.2fs %3.4fs %3.4fs\n", + statsPrintf(" Gen %2d %5d colls, %5d par %6.3fs %6.3fs %3.4fs %3.4fs\n", gen->no, gen->collections, gen->par_collections, @@ -704,23 +704,23 @@ stat_exit (void) } #endif - statsPrintf(" INIT time %6.2fs (%6.2fs elapsed)\n", + statsPrintf(" INIT time %7.3fs (%7.3fs elapsed)\n", TimeToSecondsDbl(init_cpu), TimeToSecondsDbl(init_elapsed)); - statsPrintf(" MUT time %6.2fs (%6.2fs elapsed)\n", + statsPrintf(" MUT time %7.3fs (%7.3fs elapsed)\n", TimeToSecondsDbl(mut_cpu), TimeToSecondsDbl(mut_elapsed)); - statsPrintf(" GC time %6.2fs (%6.2fs elapsed)\n", + statsPrintf(" GC time %7.3fs (%7.3fs elapsed)\n", TimeToSecondsDbl(gc_cpu), TimeToSecondsDbl(gc_elapsed)); #ifdef PROFILING - statsPrintf(" RP time %6.2fs (%6.2fs elapsed)\n", + statsPrintf(" RP time %7.3fs (%7.3fs elapsed)\n", TimeToSecondsDbl(RP_tot_time), TimeToSecondsDbl(RPe_tot_time)); - statsPrintf(" PROF time %6.2fs (%6.2fs elapsed)\n", + statsPrintf(" PROF time %7.3fs (%7.3fs elapsed)\n", TimeToSecondsDbl(HC_tot_time), TimeToSecondsDbl(HCe_tot_time)); #endif - statsPrintf(" EXIT time %6.2fs (%6.2fs elapsed)\n", + statsPrintf(" EXIT time %7.3fs (%7.3fs elapsed)\n", TimeToSecondsDbl(exit_cpu), TimeToSecondsDbl(exit_elapsed)); - statsPrintf(" Total time %6.2fs (%6.2fs elapsed)\n\n", + statsPrintf(" Total time %7.3fs (%7.3fs elapsed)\n\n", TimeToSecondsDbl(tot_cpu), TimeToSecondsDbl(tot_elapsed)); #ifndef THREADED_RTS statsPrintf(" %%GC time %5.1f%% (%.1f%% elapsed)\n\n", @@ -779,17 +779,17 @@ stat_exit (void) " ,(\"max_bytes_used\", \"%ld\")\n" " ,(\"num_byte_usage_samples\", \"%ld\")\n" " ,(\"peak_megabytes_allocated\", \"%lu\")\n" - " ,(\"init_cpu_seconds\", \"%.2f\")\n" - " ,(\"init_wall_seconds\", \"%.2f\")\n" - " ,(\"mutator_cpu_seconds\", \"%.2f\")\n" - " ,(\"mutator_wall_seconds\", \"%.2f\")\n" - " ,(\"GC_cpu_seconds\", \"%.2f\")\n" - " ,(\"GC_wall_seconds\", \"%.2f\")\n" + " ,(\"init_cpu_seconds\", \"%.3f\")\n" + " ,(\"init_wall_seconds\", \"%.3f\")\n" + " ,(\"mutator_cpu_seconds\", \"%.3f\")\n" + " ,(\"mutator_wall_seconds\", \"%.3f\")\n" + " ,(\"GC_cpu_seconds\", \"%.3f\")\n" + " ,(\"GC_wall_seconds\", \"%.3f\")\n" " ]\n"; } else { fmt1 = "< Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba00258bfb2dd5108ccc353d5dbeefc748dd5235/ghc >--------------------------------------------------------------- commit ba00258bfb2dd5108ccc353d5dbeefc748dd5235 Author: Edward Z. Yang Date: Sun Jul 27 00:19:28 2014 +0100 Support ghc-pkg --ipid to query package ID. Summary: Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: hvr, simonmar, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D98 >--------------------------------------------------------------- ba00258bfb2dd5108ccc353d5dbeefc748dd5235 docs/users_guide/packages.xml | 22 ++++++++- testsuite/tests/cabal/T5442d.stderr | 2 +- testsuite/tests/cabal/ghcpkg01.stderr | 2 +- testsuite/tests/cabal/ghcpkg05.stderr | 2 +- utils/ghc-pkg/Main.hs | 90 ++++++++++++++++++++++------------- 5 files changed, 80 insertions(+), 38 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ba00258bfb2dd5108ccc353d5dbeefc748dd5235 From git at git.haskell.org Mon Jul 28 10:55:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 10:55:17 +0000 (UTC) Subject: [commit: ghc] master: Add reexported modules to the list of IPID fields. (546029e) Message-ID: <20140728105517.C140F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/546029e4da13592b2f503805c16b7fdfc6c89725/ghc >--------------------------------------------------------------- commit 546029e4da13592b2f503805c16b7fdfc6c89725 Author: Edward Z. Yang Date: Mon Jul 28 03:55:05 2014 -0700 Add reexported modules to the list of IPID fields. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 546029e4da13592b2f503805c16b7fdfc6c89725 docs/users_guide/packages.xml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml index 0e20717..3aaacea 100644 --- a/docs/users_guide/packages.xml +++ b/docs/users_guide/packages.xml @@ -1467,6 +1467,25 @@ haddock-html: /usr/share/doc/ghc/html/libraries/unix + reexported-modules + reexported-modulesreexport specification + + + Modules reexported by this package. This list takes + the form of pkg:OldName as NewName + (A at orig-pkg-0.1-HASH): the first portion of the + string is the user-written reexport specification (possibly + omitting the package qualifier and the renaming), while the + parenthetical is the original package which exposed the + module under are particular name. Reexported modules have + a relaxed overlap constraint: it's permissible for two + packages to reexport the same module as the same name if the + reexported moduleis identical. + + + + + trusted trustedpackage specification From git at git.haskell.org Mon Jul 28 14:26:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:26:26 +0000 (UTC) Subject: [commit: ghc] master: Don't call installed package IDs 'package IDs'; they're different. (a62c345) Message-ID: <20140728142626.DD6672406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a62c3454e29fc3a90077d56749b4d9d9b8b5db9c/ghc >--------------------------------------------------------------- commit a62c3454e29fc3a90077d56749b4d9d9b8b5db9c Author: Edward Z. Yang Date: Mon Jul 28 15:26:07 2014 +0100 Don't call installed package IDs 'package IDs'; they're different. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a62c3454e29fc3a90077d56749b4d9d9b8b5db9c docs/users_guide/packages.xml | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml index 3aaacea..7a2543d 100644 --- a/docs/users_guide/packages.xml +++ b/docs/users_guide/packages.xml @@ -183,7 +183,7 @@ exposed-modules: Network.BSD, Exposes a package like , but the - package is named by its ID rather than by name. This is a + package is named by its installed package ID rather than by name. This is a more robust way to name packages, and can be used to select packages that would otherwise be shadowed. Cabal passes flags to GHC. @@ -528,12 +528,11 @@ _ZCMain_main_closure - Package IDs, dependencies, and broken packages + Installed package IDs, dependencies, and broken packages Each installed package has a unique identifier (the - “installed package ID”, or just “package - ID” for short) , which distinguishes it from all other - installed packages on the system. To see the package IDs + “installed package ID”), which distinguishes it from all other + installed packages on the system. To see the installed package IDs associated with each installed package, use ghc-pkg list -v: @@ -549,10 +548,10 @@ using cache: /usr/lib/ghc-6.12.1/package.conf.d/package.cache - The string in parentheses after the package name is the package + The string in parentheses after the package name is the installed package ID: it normally begins with the package name and version, and ends in a hash string derived from the compiled package. - Dependencies between packages are expressed in terms of package + Dependencies between packages are expressed in terms of installed package IDs, rather than just packages and versions. For example, take a look at the dependencies of the haskell98 package: @@ -570,14 +569,14 @@ depends: array-0.2.0.1-9cbf76a576b6ee9c1f880cf171a0928d - The purpose of the package ID is to detect problems caused by + The purpose of the installed package ID is to detect problems caused by re-installing a package without also recompiling the packages that depend on it. Recompiling dependencies is necessary, because the newly compiled package may have a different ABI (Application Binary Interface) than the previous version, even if both packages were built from the same source code using the - same compiler. With package IDs, a recompiled - package will have a different package ID from the previous + same compiler. With installed package IDs, a recompiled + package will have a different installed package ID from the previous version, so packages that depended on the previous version are now orphaned - one of their dependencies is not satisfied. Packages that are broken in this way are shown in @@ -692,7 +691,7 @@ haskell98-1.0.1.0 packages. A package specifier that matches all version of the package can also be written pkg-*, to make it clearer that multiple packages are being matched. To match - against the package ID instead of just package name and version, + against the installed package ID instead of just package name and version, pass the flag. @@ -1060,7 +1059,7 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf Causes ghc-pkg to interpret arguments - as package IDs (e.g., an identifier like + as installed package IDs (e.g., an identifier like unix-2.3.1.0-de7803f1a8cd88d2161b29b083c94240 ). This is useful if providing just the package name and version are ambiguous (in old versions of GHC, this @@ -1308,7 +1307,7 @@ haddock-html: /usr/share/doc/ghc/html/libraries/unix idpackage specification - The package ID. It is up to you to choose a suitable + The installed package ID. It is up to you to choose a suitable one. From git at git.haskell.org Mon Jul 28 14:34:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:29 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace EventLog.c (34d7d25) Message-ID: <20140728143429.EB77A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34d7d2587e5e30d573e38a52cfaa811b2aa59f82/ghc >--------------------------------------------------------------- commit 34d7d2587e5e30d573e38a52cfaa811b2aa59f82 Author: Austin Seipp Date: Mon Jul 21 10:28:02 2014 -0500 rts: delint/detab/dewhitespace EventLog.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 34d7d2587e5e30d573e38a52cfaa811b2aa59f82 rts/eventlog/EventLog.c | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c index 4fd4b44..0080da6 100644 --- a/rts/eventlog/EventLog.c +++ b/rts/eventlog/EventLog.c @@ -248,7 +248,8 @@ initEventLogging(void) // We don't have a FMT* symbol for pid_t, so we go via Word64 // to be sure of not losing range. It would be nicer to have a // FMT* symbol or similar, though. - sprintf(event_log_filename, "%s.%" FMT_Word64 ".eventlog", prog, (StgWord64)event_log_pid); + sprintf(event_log_filename, "%s.%" FMT_Word64 ".eventlog", + prog, (StgWord64)event_log_pid); } stgFree(prog); @@ -303,8 +304,9 @@ initEventLogging(void) break; case EVENT_STOP_THREAD: // (cap, thread, status) - eventTypes[t].size = - sizeof(EventThreadID) + sizeof(StgWord16) + sizeof(EventThreadID); + eventTypes[t].size = sizeof(EventThreadID) + + sizeof(StgWord16) + + sizeof(EventThreadID); break; case EVENT_STARTUP: // (cap_count) @@ -403,8 +405,9 @@ initEventLogging(void) break; case EVENT_TASK_CREATE: // (taskId, cap, tid) - eventTypes[t].size = - sizeof(EventTaskId) + sizeof(EventCapNo) + sizeof(EventKernelThreadId); + eventTypes[t].size = sizeof(EventTaskId) + + sizeof(EventCapNo) + + sizeof(EventKernelThreadId); break; case EVENT_TASK_MIGRATE: // (taskId, cap, new_cap) From git at git.haskell.org Mon Jul 28 14:34:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:33 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Itimer.c (d72f3ad) Message-ID: <20140728143433.F0EFA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d72f3ad4627be5194c45227009fb1fa28ca826e3/ghc >--------------------------------------------------------------- commit d72f3ad4627be5194c45227009fb1fa28ca826e3 Author: Austin Seipp Date: Mon Jul 21 10:31:39 2014 -0500 rts: delint/detab/dewhitespace Itimer.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- d72f3ad4627be5194c45227009fb1fa28ca826e3 rts/posix/Itimer.c | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:34:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:36 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace TTY.c (875f4c8) Message-ID: <20140728143437.110362406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/875f4c8519345f83cdf179fa6c4c972440647192/ghc >--------------------------------------------------------------- commit 875f4c8519345f83cdf179fa6c4c972440647192 Author: Austin Seipp Date: Mon Jul 21 10:38:21 2014 -0500 rts: delint/detab/dewhitespace TTY.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 875f4c8519345f83cdf179fa6c4c972440647192 rts/posix/TTY.c | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/rts/posix/TTY.c b/rts/posix/TTY.c index d39ef37..2ce822a 100644 --- a/rts/posix/TTY.c +++ b/rts/posix/TTY.c @@ -27,8 +27,9 @@ static void *saved_termios[3] = {NULL,NULL,NULL}; void* __hscore_get_saved_termios(int fd) { - return (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ? - saved_termios[fd] : NULL; + return (0 <= fd && + fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ? + saved_termios[fd] : NULL; } void @@ -48,18 +49,19 @@ resetTerminalSettings (void) // more details, including the reason we termporarily disable // SIGTTOU here. { - int fd; - sigset_t sigset, old_sigset; - sigemptyset(&sigset); - sigaddset(&sigset, SIGTTOU); - sigprocmask(SIG_BLOCK, &sigset, &old_sigset); - for (fd = 0; fd <= 2; fd++) { - struct termios* ts = (struct termios*)__hscore_get_saved_termios(fd); - if (ts != NULL) { - tcsetattr(fd,TCSANOW,ts); - } - } - sigprocmask(SIG_SETMASK, &old_sigset, NULL); + int fd; + sigset_t sigset, old_sigset; + sigemptyset(&sigset); + sigaddset(&sigset, SIGTTOU); + sigprocmask(SIG_BLOCK, &sigset, &old_sigset); + for (fd = 0; fd <= 2; fd++) { + struct termios* ts = + (struct termios*)__hscore_get_saved_termios(fd); + if (ts != NULL) { + tcsetattr(fd,TCSANOW,ts); + } + } + sigprocmask(SIG_SETMASK, &old_sigset, NULL); } #endif } From git at git.haskell.org Mon Jul 28 14:34:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:41 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace GetEnv.c (426f2ac) Message-ID: <20140728143441.A20402406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/426f2acaef9e9117c136126daa0923089260160a/ghc >--------------------------------------------------------------- commit 426f2acaef9e9117c136126daa0923089260160a Author: Austin Seipp Date: Mon Jul 21 10:29:04 2014 -0500 rts: delint/detab/dewhitespace GetEnv.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 426f2acaef9e9117c136126daa0923089260160a rts/posix/GetEnv.c | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:34:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:46 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace OSMem.c (b1fb531) Message-ID: <20140728143446.793602406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1fb531e0ca0123563e233fe1f4c41e3ce5d84f1/ghc >--------------------------------------------------------------- commit b1fb531e0ca0123563e233fe1f4c41e3ce5d84f1 Author: Austin Seipp Date: Mon Jul 21 10:34:08 2014 -0500 rts: delint/detab/dewhitespace OSMem.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- b1fb531e0ca0123563e233fe1f4c41e3ce5d84f1 rts/posix/OSMem.c | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 69140a9..8a6a85e 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -108,10 +108,12 @@ my_mmap (void *addr, W_ size) if(err) { // don't know what the error codes mean exactly, assume it's // not our problem though. - errorBelch("memory allocation failed (requested %" FMT_Word " bytes)", size); + errorBelch("memory allocation failed (requested %" FMT_Word " bytes)", + size); stg_exit(EXIT_FAILURE); } else { - vm_protect(mach_task_self(),(vm_address_t)ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE); + vm_protect(mach_task_self(), (vm_address_t)ret, size, FALSE, + VM_PROT_READ|VM_PROT_WRITE); } #elif linux_HOST_OS ret = mmap(addr, size, PROT_READ | PROT_WRITE, @@ -210,7 +212,9 @@ osGetMBlocks(nat n) if (((W_)ret & MBLOCK_MASK) != 0) { // misaligned block! #if 0 // defined(DEBUG) - errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request); + errorBelch("warning: getMBlock: misaligned block %p returned " + "when allocating %d megablock(s) at %p", + ret, n, next_request); #endif // unmap this block... @@ -289,7 +293,8 @@ StgWord64 getPhysicalMemorySize (void) long ret = sysconf(_SC_PHYS_PAGES); if (ret == -1) { #if defined(DEBUG) - errorBelch("warning: getPhysicalMemorySize: cannot get physical memory size"); + errorBelch("warning: getPhysicalMemorySize: cannot get " + "physical memory size"); #endif return 0; } From git at git.haskell.org Mon Jul 28 14:34:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:50 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace GetTime.c (cebd37f) Message-ID: <20140728143450.7921D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cebd37f31bccd1f8038132a69a133b44b9b13648/ghc >--------------------------------------------------------------- commit cebd37f31bccd1f8038132a69a133b44b9b13648 Author: Austin Seipp Date: Mon Jul 21 10:31:15 2014 -0500 rts: delint/detab/dewhitespace GetTime.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- cebd37f31bccd1f8038132a69a133b44b9b13648 rts/posix/GetTime.c | 43 +++++++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/rts/posix/GetTime.c b/rts/posix/GetTime.c index 380e229..3e0e1ca 100644 --- a/rts/posix/GetTime.c +++ b/rts/posix/GetTime.c @@ -50,7 +50,11 @@ void initializeTimer() Time getProcessCPUTime(void) { -#if !defined(BE_CONSERVATIVE) && defined(HAVE_CLOCK_GETTIME) && defined (_SC_CPUTIME) && defined(CLOCK_PROCESS_CPUTIME_ID) && defined(HAVE_SYSCONF) +#if !defined(BE_CONSERVATIVE) && \ + defined(HAVE_CLOCK_GETTIME) && \ + defined(_SC_CPUTIME) && \ + defined(CLOCK_PROCESS_CPUTIME_ID) && \ + defined(HAVE_SYSCONF) static int checked_sysconf = 0; static int sysconf_result = 0; @@ -129,7 +133,7 @@ Time getProcessCPUTime(void) #if !defined(THREADED_RTS) && USE_PAPI long long usec; if ((usec = PAPI_get_virt_usec()) < 0) { - barf("PAPI_get_virt_usec: %lld", usec); + barf("PAPI_get_virt_usec: %lld", usec); } return USToTime(usec); #else @@ -152,22 +156,22 @@ void getProcessTimes(Time *user, Time *elapsed) if (ClockFreq == 0) { #if defined(HAVE_SYSCONF) - long ticks; - ticks = sysconf(_SC_CLK_TCK); - if ( ticks == -1 ) { - sysErrorBelch("sysconf"); - stg_exit(EXIT_FAILURE); - } - ClockFreq = ticks; -#elif defined(CLK_TCK) /* defined by POSIX */ - ClockFreq = CLK_TCK; + long ticks; + ticks = sysconf(_SC_CLK_TCK); + if ( ticks == -1 ) { + sysErrorBelch("sysconf"); + stg_exit(EXIT_FAILURE); + } + ClockFreq = ticks; +#elif defined(CLK_TCK) /* defined by POSIX */ + ClockFreq = CLK_TCK; #elif defined(HZ) - ClockFreq = HZ; + ClockFreq = HZ; #elif defined(CLOCKS_PER_SEC) - ClockFreq = CLOCKS_PER_SEC; + ClockFreq = CLOCKS_PER_SEC; #else - errorBelch("can't get clock resolution"); - stg_exit(EXIT_FAILURE); + errorBelch("can't get clock resolution"); + stg_exit(EXIT_FAILURE); #endif } @@ -184,11 +188,15 @@ Time getThreadCPUTime(void) #if USE_PAPI long long usec; if ((usec = PAPI_get_virt_usec()) < 0) { - barf("PAPI_get_virt_usec: %lld", usec); + barf("PAPI_get_virt_usec: %lld", usec); } return USToTime(usec); -#elif !defined(BE_CONSERVATIVE) && defined(HAVE_CLOCK_GETTIME) && defined (_SC_THREAD_CPUTIME) && defined(CLOCK_THREAD_CPUTIME_ID) && defined(HAVE_SYSCONF) +#elif !defined(BE_CONSERVATIVE) && \ + defined(HAVE_CLOCK_GETTIME) && \ + defined(_SC_CPUTIME) && \ + defined(CLOCK_PROCESS_CPUTIME_ID) && \ + defined(HAVE_SYSCONF) { static int checked_sysconf = 0; static int sysconf_result = 0; @@ -239,4 +247,3 @@ getPageFaults(void) return(t.ru_majflt); #endif } - From git at git.haskell.org Mon Jul 28 14:34:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:55 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace OSThreads.c (3e0e489) Message-ID: <20140728143455.9D3022406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3e0e489eec632a3a464eb2da166057f59fb9a274/ghc >--------------------------------------------------------------- commit 3e0e489eec632a3a464eb2da166057f59fb9a274 Author: Austin Seipp Date: Mon Jul 21 10:35:42 2014 -0500 rts: delint/detab/dewhitespace OSThreads.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 3e0e489eec632a3a464eb2da166057f59fb9a274 rts/posix/OSThreads.c | 39 +++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c index 13a176c..e627bab 100644 --- a/rts/posix/OSThreads.c +++ b/rts/posix/OSThreads.c @@ -18,7 +18,7 @@ #if defined(freebsd_HOST_OS) /* Inclusion of system headers usually requires __BSD_VISIBLE on FreeBSD, * because of some specific types, like u_char, u_int, etc. */ -#define __BSD_VISIBLE 1 +#define __BSD_VISIBLE 1 #endif #include "Rts.h" @@ -175,7 +175,7 @@ newThreadLocalKey (ThreadLocalKey *key) { int r; if ((r = pthread_key_create(key, NULL)) != 0) { - barf("newThreadLocalKey: %s", strerror(r)); + barf("newThreadLocalKey: %s", strerror(r)); } } @@ -194,7 +194,7 @@ setThreadLocalVar (ThreadLocalKey *key, void *value) { int r; if ((r = pthread_setspecific(*key,value)) != 0) { - barf("setThreadLocalVar: %s", strerror(r)); + barf("setThreadLocalVar: %s", strerror(r)); } } @@ -203,7 +203,7 @@ freeThreadLocalKey (ThreadLocalKey *key) { int r; if ((r = pthread_key_delete(*key)) != 0) { - barf("freeThreadLocalKey: %s", strerror(r)); + barf("freeThreadLocalKey: %s", strerror(r)); } } @@ -222,7 +222,7 @@ forkOS_createThread ( HsStablePtr entry ) { pthread_t tid; int result = pthread_create(&tid, NULL, - forkOS_createThreadWrapper, (void*)entry); + forkOS_createThreadWrapper, (void*)entry); if(!result) pthread_detach(tid); return result; @@ -278,32 +278,33 @@ setThreadAffinity (nat n, nat m GNUC3_ATTRIBUTE(__unused__)) policy.affinity_tag = n; thread_policy_set(mach_thread_self(), - THREAD_AFFINITY_POLICY, - (thread_policy_t) &policy, - THREAD_AFFINITY_POLICY_COUNT); + THREAD_AFFINITY_POLICY, + (thread_policy_t) &policy, + THREAD_AFFINITY_POLICY_COUNT); } #elif defined(HAVE_SYS_CPUSET_H) /* FreeBSD 7.1+ */ void setThreadAffinity(nat n, nat m) { - nat nproc; - cpuset_t cs; - nat i; + nat nproc; + cpuset_t cs; + nat i; - nproc = getNumberOfProcessors(); - CPU_ZERO(&cs); + nproc = getNumberOfProcessors(); + CPU_ZERO(&cs); - for (i = n; i < nproc; i += m) - CPU_SET(i, &cs); + for (i = n; i < nproc; i += m) + CPU_SET(i, &cs); - cpuset_setaffinity(CPU_LEVEL_WHICH, CPU_WHICH_TID, -1, sizeof(cpuset_t), &cs); + cpuset_setaffinity(CPU_LEVEL_WHICH, CPU_WHICH_TID, + -1, sizeof(cpuset_t), &cs); } #else void setThreadAffinity (nat n GNUC3_ATTRIBUTE(__unused__), - nat m GNUC3_ATTRIBUTE(__unused__)) + nat m GNUC3_ATTRIBUTE(__unused__)) { } #endif @@ -340,7 +341,9 @@ KernelThreadId kernelThreadId (void) return pthread_getthreadid_np(); // Check for OS X >= 10.6 (see #7356) -#elif defined(darwin_HOST_OS) && !(defined(__MAC_OS_X_VERSION_MIN_REQUIRED) && __MAC_OS_X_VERSION_MIN_REQUIRED < 1060) +#elif defined(darwin_HOST_OS) && \ + !(defined(__MAC_OS_X_VERSION_MIN_REQUIRED) && \ + __MAC_OS_X_VERSION_MIN_REQUIRED < 1060) uint64_t ktid; pthread_threadid_np(NULL, &ktid); return ktid; From git at git.haskell.org Mon Jul 28 14:34:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:34:59 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/GetEnv.c (20b506d) Message-ID: <20140728143504.0D1932406F@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/20b506d888c5976f93960dcafa9dc9f4bcff8071/ghc >--------------------------------------------------------------- commit 20b506d888c5976f93960dcafa9dc9f4bcff8071 Author: Austin Seipp Date: Mon Jul 21 19:43:34 2014 -0500 rts: delint/detab/dewhitespace win32/GetEnv.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 20b506d888c5976f93960dcafa9dc9f4bcff8071 rts/win32/GetEnv.c | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:35:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:03 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/ConsoleHandler.c (ab24d0b) Message-ID: <20140728143504.43FA32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab24d0b13c763ad7a17886e861085b364b3bc497/ghc >--------------------------------------------------------------- commit ab24d0b13c763ad7a17886e861085b364b3bc497 Author: Austin Seipp Date: Mon Jul 21 19:43:19 2014 -0500 rts: delint/detab/dewhitespace win32/ConsoleHandler.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- ab24d0b13c763ad7a17886e861085b364b3bc497 rts/win32/ConsoleHandler.c | 147 +++++++++++++++++++++++---------------------- 1 file changed, 74 insertions(+), 73 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ab24d0b13c763ad7a17886e861085b364b3bc497 From git at git.haskell.org Mon Jul 28 14:35:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:08 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Signals.c (386ec24) Message-ID: <20140728143508.D05282406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/386ec24a382d22fc9ff07cdd0911325287e7e0b1/ghc >--------------------------------------------------------------- commit 386ec24a382d22fc9ff07cdd0911325287e7e0b1 Author: Austin Seipp Date: Mon Jul 21 10:42:20 2014 -0500 rts: delint/detab/dewhitespace Signals.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 386ec24a382d22fc9ff07cdd0911325287e7e0b1 rts/posix/Signals.c | 107 +++++++++++++++++++++++++++------------------------- 1 file changed, 56 insertions(+), 51 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 386ec24a382d22fc9ff07cdd0911325287e7e0b1 From git at git.haskell.org Mon Jul 28 14:35:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:12 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/AsyncIO.c (3021fb7) Message-ID: <20140728143512.1916C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3021fb70a9287e489c2e78805fb43c85b19f8e56/ghc >--------------------------------------------------------------- commit 3021fb70a9287e489c2e78805fb43c85b19f8e56 Author: Austin Seipp Date: Mon Jul 21 19:40:48 2014 -0500 rts: delint/detab/dewhitespace win32/AsyncIO.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 3021fb70a9287e489c2e78805fb43c85b19f8e56 rts/win32/AsyncIO.c | 292 +++++++++++++++++++++++++++------------------------- 1 file changed, 154 insertions(+), 138 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3021fb70a9287e489c2e78805fb43c85b19f8e56 From git at git.haskell.org Mon Jul 28 14:35:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:16 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/AsyncIO.h (fdcc699) Message-ID: <20140728143516.9109E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fdcc6991e13f33aca4f4a2f3bf1a4559ebcd8c25/ghc >--------------------------------------------------------------- commit fdcc6991e13f33aca4f4a2f3bf1a4559ebcd8c25 Author: Austin Seipp Date: Mon Jul 21 19:41:20 2014 -0500 rts: delint/detab/dewhitespace win32/AsyncIO.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- fdcc6991e13f33aca4f4a2f3bf1a4559ebcd8c25 rts/win32/AsyncIO.h | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/rts/win32/AsyncIO.h b/rts/win32/AsyncIO.h index 8d99c0a..67d5110 100644 --- a/rts/win32/AsyncIO.h +++ b/rts/win32/AsyncIO.h @@ -10,10 +10,10 @@ extern unsigned int addIORequest(int fd, - int forWriting, - int isSock, - int len, - char* buf); + int forWriting, + int isSock, + int len, + char* buf); extern unsigned int addDelayRequest(int usecs); extern unsigned int addDoProcRequest(void* proc, void* param); extern int startupAsyncIO(void); From git at git.haskell.org Mon Jul 28 14:35:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:21 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Signals.h (22308d7) Message-ID: <20140728143521.6A9EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22308d70c437d3ca29a1e1e6e35e7f0589ac2f2d/ghc >--------------------------------------------------------------- commit 22308d70c437d3ca29a1e1e6e35e7f0589ac2f2d Author: Austin Seipp Date: Mon Jul 21 10:38:47 2014 -0500 rts: delint/detab/dewhitespace Signals.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 22308d70c437d3ca29a1e1e6e35e7f0589ac2f2d rts/posix/Signals.h | 1 - 1 file changed, 1 deletion(-) diff --git a/rts/posix/Signals.h b/rts/posix/Signals.h index 387d688..3100d39 100644 --- a/rts/posix/Signals.h +++ b/rts/posix/Signals.h @@ -31,4 +31,3 @@ extern StgInt *signal_handlers; #include "EndPrivate.h" #endif /* POSIX_SIGNALS_H */ - From git at git.haskell.org Mon Jul 28 14:35:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:26 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Select.c (ded5ea8) Message-ID: <20140728143526.50A842406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ded5ea89d1954c51fee9100f0204a0a0938178e8/ghc >--------------------------------------------------------------- commit ded5ea89d1954c51fee9100f0204a0a0938178e8 Author: Austin Seipp Date: Mon Jul 21 10:45:01 2014 -0500 rts: delint/detab/dewhitespace Select.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- ded5ea89d1954c51fee9100f0204a0a0938178e8 rts/posix/Select.c | 167 ++++++++++++++++++++++++++++------------------------- 1 file changed, 87 insertions(+), 80 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ded5ea89d1954c51fee9100f0204a0a0938178e8 From git at git.haskell.org Mon Jul 28 14:35:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:29 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/AwaitEvent.c (b64958b) Message-ID: <20140728143529.E32762406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b64958b4304eba7492881cc0eb9b07d15db584a4/ghc >--------------------------------------------------------------- commit b64958b4304eba7492881cc0eb9b07d15db584a4 Author: Austin Seipp Date: Mon Jul 21 19:41:44 2014 -0500 rts: delint/detab/dewhitespace win32/AwaitEvent.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- b64958b4304eba7492881cc0eb9b07d15db584a4 rts/win32/AwaitEvent.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/win32/AwaitEvent.c b/rts/win32/AwaitEvent.c index af9c658..feae4c8 100644 --- a/rts/win32/AwaitEvent.c +++ b/rts/win32/AwaitEvent.c @@ -50,8 +50,8 @@ awaitEvent(rtsBool wait) // - the run-queue is now non- empty } while (wait - && sched_state == SCHED_RUNNING - && emptyRunQueue(&MainCapability) + && sched_state == SCHED_RUNNING + && emptyRunQueue(&MainCapability) ); } #endif From git at git.haskell.org Mon Jul 28 14:35:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:34 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/WorkQueue.c (9e8d258) Message-ID: <20140728143534.A2C032406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e8d2580f0a7498664ded1ff7cdae6bca07b8dda/ghc >--------------------------------------------------------------- commit 9e8d2580f0a7498664ded1ff7cdae6bca07b8dda Author: Austin Seipp Date: Mon Jul 21 19:57:32 2014 -0500 rts: delint/detab/dewhitespace win32/WorkQueue.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9e8d2580f0a7498664ded1ff7cdae6bca07b8dda rts/win32/WorkQueue.c | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/rts/win32/WorkQueue.c b/rts/win32/WorkQueue.c index b676072..a995f45 100644 --- a/rts/win32/WorkQueue.c +++ b/rts/win32/WorkQueue.c @@ -18,9 +18,9 @@ newSemaphore(int initCount, int max) { Semaphore s; s = CreateSemaphore ( NULL, /* LPSECURITY_ATTRIBUTES (default) */ - initCount, /* LONG lInitialCount */ - max, /* LONG lMaxCount */ - NULL); /* LPCTSTR (anonymous / no object name) */ + initCount, /* LONG lInitialCount */ + max, /* LONG lMaxCount */ + NULL); /* LPCTSTR (anonymous / no object name) */ if ( NULL == s) { queue_error_rc("newSemaphore", GetLastError()); return NULL; @@ -116,9 +116,10 @@ GetWork ( WorkQueue* pq, void** ppw ) } /* Block waiting for work item to become available */ - if ( (rc = WaitForSingleObject( pq->workAvailable, INFINITE)) != WAIT_OBJECT_0 ) { + if ( (rc = WaitForSingleObject( pq->workAvailable, INFINITE)) + != WAIT_OBJECT_0 ) { queue_error_rc("GetWork.WaitForSingleObject(workAvailable)", - ( (WAIT_FAILED == rc) ? GetLastError() : rc)); + ( (WAIT_FAILED == rc) ? GetLastError() : rc)); return FALSE; } @@ -181,9 +182,10 @@ SubmitWork ( WorkQueue* pq, void* pw ) } /* Block waiting for work item to become available */ - if ( (rc = WaitForSingleObject( pq->roomAvailable, INFINITE)) != WAIT_OBJECT_0 ) { + if ( (rc = WaitForSingleObject( pq->roomAvailable, INFINITE)) + != WAIT_OBJECT_0 ) { queue_error_rc("SubmitWork.WaitForSingleObject(workAvailable)", - ( (WAIT_FAILED == rc) ? GetLastError() : rc)); + ( (WAIT_FAILED == rc) ? GetLastError() : rc)); return FALSE; } @@ -205,7 +207,7 @@ SubmitWork ( WorkQueue* pq, void* pw ) static void queue_error_rc( char* loc, - DWORD err) + DWORD err) { fprintf(stderr, "%s failed: return code = 0x%lx\n", loc, err); fflush(stderr); @@ -215,10 +217,9 @@ queue_error_rc( char* loc, static void queue_error( char* loc, - char* reason) + char* reason) { fprintf(stderr, "%s failed: %s\n", loc, reason); fflush(stderr); return; } - From git at git.haskell.org Mon Jul 28 14:35:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:38 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/GetTime.c (59b6ea8) Message-ID: <20140728143538.DDF042406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59b6ea8d7535164b7ed9dd514468fb701b9f8ce8/ghc >--------------------------------------------------------------- commit 59b6ea8d7535164b7ed9dd514468fb701b9f8ce8 Author: Austin Seipp Date: Mon Jul 21 19:43:56 2014 -0500 rts: delint/detab/dewhitespace win32/GetTime.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 59b6ea8d7535164b7ed9dd514468fb701b9f8ce8 rts/win32/GetTime.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/rts/win32/GetTime.c b/rts/win32/GetTime.c index bfab43a..514def6 100644 --- a/rts/win32/GetTime.c +++ b/rts/win32/GetTime.c @@ -40,8 +40,8 @@ getProcessCPUTime(void) FILETIME creationTime, exitTime, userTime, kernelTime = {0,0}; if (!GetProcessTimes(GetCurrentProcess(), &creationTime, - &exitTime, &kernelTime, &userTime)) { - return 0; + &exitTime, &kernelTime, &userTime)) { + return 0; } return fileTimeToRtsTime(userTime); @@ -106,8 +106,8 @@ getThreadCPUTime(void) FILETIME creationTime, exitTime, userTime, kernelTime = {0,0}; if (!GetThreadTimes(GetCurrentThread(), &creationTime, - &exitTime, &kernelTime, &userTime)) { - return 0; + &exitTime, &kernelTime, &userTime)) { + return 0; } return fileTimeToRtsTime(userTime); From git at git.haskell.org Mon Jul 28 14:35:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:43 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/IOManager.c (36bbec0) Message-ID: <20140728143543.C980C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36bbec02726b995aede9e906a4a9f9a3887f4a49/ghc >--------------------------------------------------------------- commit 36bbec02726b995aede9e906a4a9f9a3887f4a49 Author: Austin Seipp Date: Mon Jul 21 19:52:22 2014 -0500 rts: delint/detab/dewhitespace win32/IOManager.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 36bbec02726b995aede9e906a4a9f9a3887f4a49 rts/win32/IOManager.c | 495 ++++++++++++++++++++++++++------------------------ 1 file changed, 261 insertions(+), 234 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 36bbec02726b995aede9e906a4a9f9a3887f4a49 From git at git.haskell.org Mon Jul 28 14:35:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:48 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/ThrIOManager.c (9aa9d17) Message-ID: <20140728143548.494222406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9aa9d17f5aeafd565f3ca88b2bb37795c060fc80/ghc >--------------------------------------------------------------- commit 9aa9d17f5aeafd565f3ca88b2bb37795c060fc80 Author: Austin Seipp Date: Mon Jul 21 19:56:11 2014 -0500 rts: delint/detab/dewhitespace win32/ThrIOManager.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9aa9d17f5aeafd565f3ca88b2bb37795c060fc80 rts/win32/ThrIOManager.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rts/win32/ThrIOManager.c b/rts/win32/ThrIOManager.c index c497401..3f50e53 100644 --- a/rts/win32/ThrIOManager.c +++ b/rts/win32/ThrIOManager.c @@ -151,9 +151,9 @@ ioManagerStart (void) // Make sure the IO manager thread is running Capability *cap; if (io_manager_event == INVALID_HANDLE_VALUE) { - cap = rts_lock(); - rts_evalIO(&cap,ensureIOManagerIsRunning_closure,NULL); - rts_unlock(cap); + cap = rts_lock(); + rts_evalIO(&cap, ensureIOManagerIsRunning_closure, NULL); + rts_unlock(cap); } } #endif From git at git.haskell.org Mon Jul 28 14:35:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:52 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/OSThreads.c (43345dd) Message-ID: <20140728143552.C12A32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43345dda2b2cfe8397c1fabfe8468a686e065f98/ghc >--------------------------------------------------------------- commit 43345dda2b2cfe8397c1fabfe8468a686e065f98 Author: Austin Seipp Date: Mon Jul 21 19:55:30 2014 -0500 rts: delint/detab/dewhitespace win32/OSThreads.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 43345dda2b2cfe8397c1fabfe8468a686e065f98 rts/win32/OSThreads.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/rts/win32/OSThreads.c b/rts/win32/OSThreads.c index 7183313..78d6c73 100644 --- a/rts/win32/OSThreads.c +++ b/rts/win32/OSThreads.c @@ -291,7 +291,8 @@ interruptOSThread (OSThreadId id) sysErrorBelch("interruptOSThread: OpenThread"); stg_exit(EXIT_FAILURE); } - pCSIO = (PCSIO) GetProcAddress(GetModuleHandle(TEXT("Kernel32.dll")), "CancelSynchronousIo"); + pCSIO = (PCSIO) GetProcAddress(GetModuleHandle(TEXT("Kernel32.dll")), + "CancelSynchronousIo"); if ( NULL != pCSIO ) { pCSIO(hdl); } else { From git at git.haskell.org Mon Jul 28 14:35:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:35:57 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/OSMem.c (976c55c) Message-ID: <20140728143557.C32472406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/976c55c27ebfbe4444014efdbe5c7edfceb78717/ghc >--------------------------------------------------------------- commit 976c55c27ebfbe4444014efdbe5c7edfceb78717 Author: Austin Seipp Date: Mon Jul 21 19:55:00 2014 -0500 rts: delint/detab/dewhitespace win32/OSMem.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 976c55c27ebfbe4444014efdbe5c7edfceb78717 rts/win32/OSMem.c | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/rts/win32/OSMem.c b/rts/win32/OSMem.c index 082b8de..d970072 100644 --- a/rts/win32/OSMem.c +++ b/rts/win32/OSMem.c @@ -17,14 +17,14 @@ #endif typedef struct alloc_rec_ { - char* base; /* non-aligned base address, directly from VirtualAlloc */ - W_ size; /* Size in bytes */ + char* base; // non-aligned base address, directly from VirtualAlloc + W_ size; // Size in bytes struct alloc_rec_* next; } alloc_rec; typedef struct block_rec_ { - char* base; /* base address, non-MBLOCK-aligned */ - W_ size; /* size in bytes */ + char* base; // base address, non-MBLOCK-aligned + W_ size; // size in bytes struct block_rec_* next; } block_rec; @@ -89,19 +89,20 @@ insertFree(char* alloc_base, W_ alloc_size) { for( ; it!=0 && it->basenext) {} if(it!=0 && alloc_base+alloc_size == it->base) { - if(prev->base + prev->size == alloc_base) { /* Merge it, alloc, prev */ + if(prev->base + prev->size == alloc_base) { /* Merge it, alloc, prev */ prev->size += alloc_size + it->size; prev->next = it->next; stgFree(it); - } else { /* Merge it, alloc */ + } else { /* Merge it, alloc */ it->base = alloc_base; it->size += alloc_size; } - } else if(prev->base + prev->size == alloc_base) { /* Merge alloc, prev */ + } else if(prev->base + prev->size == alloc_base) { /* Merge alloc, prev */ prev->size += alloc_size; - } else { /* Merge none */ + } else { /* Merge none */ block_rec* rec; - rec = (block_rec*)stgMallocBytes(sizeof(block_rec),"getMBlocks: insertFree"); + rec = (block_rec*)stgMallocBytes(sizeof(block_rec), + "getMBlocks: insertFree"); rec->base=alloc_base; rec->size=alloc_size; rec->next = it; @@ -139,7 +140,8 @@ findFreeBlocks(nat n) { char* need_base; block_rec* next; int new_size; - need_base = (char*)(((W_)it->base) & ((W_)~MBLOCK_MASK)) + MBLOCK_SIZE; + need_base = + (char*)(((W_)it->base) & ((W_)~MBLOCK_MASK)) + MBLOCK_SIZE; next = (block_rec*)stgMallocBytes( sizeof(block_rec) , "getMBlocks: findFreeBlocks: splitting"); @@ -305,7 +307,9 @@ void osReleaseFreeMemory(void) if (fb->base != a->base) { block_rec *new_fb; - new_fb = (block_rec *)stgMallocBytes(sizeof(block_rec),"osReleaseFreeMemory"); + new_fb = + (block_rec *)stgMallocBytes(sizeof(block_rec), + "osReleaseFreeMemory"); new_fb->base = fb->base; new_fb->size = a->base - fb->base; new_fb->next = fb; @@ -317,7 +321,8 @@ void osReleaseFreeMemory(void) /* Now we can free the alloc */ prev_a->next = a->next; if(!VirtualFree((void *)a->base, 0, MEM_RELEASE)) { - sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE failed"); + sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE " + "failed"); stg_exit(EXIT_FAILURE); } stgFree(a); @@ -389,7 +394,8 @@ StgWord64 getPhysicalMemorySize (void) status.dwLength = sizeof(status); if (!GlobalMemoryStatusEx(&status)) { #if defined(DEBUG) - errorBelch("warning: getPhysicalMemorySize: cannot get physical memory size"); + errorBelch("warning: getPhysicalMemorySize: cannot get physical " + "memory size"); #endif return 0; } @@ -405,8 +411,8 @@ void setExecutable (void *p, W_ len, rtsBool exec) exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE, &dwOldProtect) == 0) { - sysErrorBelch("setExecutable: failed to protect 0x%p; old protection: %lu\n", - p, (unsigned long)dwOldProtect); + sysErrorBelch("setExecutable: failed to protect 0x%p; old protection: " + "%lu\n", p, (unsigned long)dwOldProtect); stg_exit(EXIT_FAILURE); } } From git at git.haskell.org Mon Jul 28 14:36:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:02 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/WorkQueue.h (316c0d5) Message-ID: <20140728143602.984C12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/316c0d5217685be2838f626f7bdfacb78196b7ab/ghc >--------------------------------------------------------------- commit 316c0d5217685be2838f626f7bdfacb78196b7ab Author: Austin Seipp Date: Mon Jul 21 19:56:34 2014 -0500 rts: delint/detab/dewhitespace win32/WorkQueue.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 316c0d5217685be2838f626f7bdfacb78196b7ab rts/win32/WorkQueue.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:36:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:06 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace win32/IOManager.h (94fba59) Message-ID: <20140728143607.A850F2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/94fba5993db85291674c5c58e64a0b484ee369d4/ghc >--------------------------------------------------------------- commit 94fba5993db85291674c5c58e64a0b484ee369d4 Author: Austin Seipp Date: Mon Jul 21 19:44:23 2014 -0500 rts: delint/detab/dewhitespace win32/IOManager.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 94fba5993db85291674c5c58e64a0b484ee369d4 rts/win32/IOManager.h | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/rts/win32/IOManager.h b/rts/win32/IOManager.h index 866e950..30fad49 100644 --- a/rts/win32/IOManager.h +++ b/rts/win32/IOManager.h @@ -29,10 +29,10 @@ * */ typedef void (*CompletionProc)(unsigned int requestID, - int fd, - int len, - void* buf, - int errCode); + int fd, + int len, + void* buf, + int errCode); /* * Asynchronous procedure calls executed by a worker thread @@ -43,16 +43,16 @@ typedef int (*DoProcProc)(void *param); typedef union workData { struct { - int fd; - int len; - char *buf; + int fd; + int len; + char *buf; } ioData; struct { - int usecs; + int usecs; } delayData; struct { - DoProcProc proc; - void* param; + DoProcProc proc; + void* param; } procData; } WorkData; @@ -89,18 +89,18 @@ extern void ShutdownIOManager ( rtsBool wait_threads ); * will invoke upon completion. */ extern int AddDelayRequest ( unsigned int usecs, - CompletionProc onCompletion); + CompletionProc onCompletion); extern int AddIORequest ( int fd, - BOOL forWriting, - BOOL isSocket, - int len, - char* buffer, - CompletionProc onCompletion); + BOOL forWriting, + BOOL isSocket, + int len, + char* buffer, + CompletionProc onCompletion); extern int AddProcRequest ( void* proc, - void* data, - CompletionProc onCompletion); + void* data, + CompletionProc onCompletion); extern void abandonWorkRequest ( int reqID ); From git at git.haskell.org Mon Jul 28 14:36:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:10 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Hash.c (7ee0b63) Message-ID: <20140728143610.A04C42406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ee0b63a71994c5e1c55e7a0f52e6cb81c908571/ghc >--------------------------------------------------------------- commit 7ee0b63a71994c5e1c55e7a0f52e6cb81c908571 Author: Austin Seipp Date: Mon Jul 21 20:26:26 2014 -0500 rts: delint/detab/dewhitespace Hash.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7ee0b63a71994c5e1c55e7a0f52e6cb81c908571 rts/Hash.c | 124 ++++++++++++++++++++++++++++++------------------------------- 1 file changed, 62 insertions(+), 62 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7ee0b63a71994c5e1c55e7a0f52e6cb81c908571 From git at git.haskell.org Mon Jul 28 14:36:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:13 +0000 (UTC) Subject: [commit: ghc] master: rts: detab/dewhitespace FileLock.c (a4aa6be) Message-ID: <20140728143613.DD3822406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4aa6bebecdd498799399ddc0d37755aa637cd7c/ghc >--------------------------------------------------------------- commit a4aa6bebecdd498799399ddc0d37755aa637cd7c Author: Austin Seipp Date: Mon Jul 21 20:24:28 2014 -0500 rts: detab/dewhitespace FileLock.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- a4aa6bebecdd498799399ddc0d37755aa637cd7c rts/FileLock.c | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:36:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:17 +0000 (UTC) Subject: [commit: ghc] master: rts: delint Messages.c (1c89c96) Message-ID: <20140728143619.681C12406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c89c96bd5118d14c003128839b8b67c4c6d90f1/ghc >--------------------------------------------------------------- commit 1c89c96bd5118d14c003128839b8b67c4c6d90f1 Author: Austin Seipp Date: Mon Jul 21 20:29:03 2014 -0500 rts: delint Messages.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1c89c96bd5118d14c003128839b8b67c4c6d90f1 rts/Messages.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/rts/Messages.c b/rts/Messages.c index 82d8699..5a67bf3 100644 --- a/rts/Messages.c +++ b/rts/Messages.c @@ -166,8 +166,8 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg) StgClosure *bh = UNTAG_CLOSURE(msg->bh); StgTSO *owner; - debugTraceCap(DEBUG_sched, cap, "message: thread %d blocking on blackhole %p", - (W_)msg->tso->id, msg->bh); + debugTraceCap(DEBUG_sched, cap, "message: thread %d blocking on " + "blackhole %p", (W_)msg->tso->id, msg->bh); info = bh->header.info; @@ -210,7 +210,8 @@ loop: #ifdef THREADED_RTS if (owner->cap != cap) { sendMessage(cap, owner->cap, (Message*)msg); - debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", owner->cap->no); + debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", + owner->cap->no); return 1; } #endif @@ -273,7 +274,8 @@ loop: #ifdef THREADED_RTS if (owner->cap != cap) { sendMessage(cap, owner->cap, (Message*)msg); - debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", owner->cap->no); + debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", + owner->cap->no); return 1; } #endif From git at git.haskell.org Mon Jul 28 14:36:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:21 +0000 (UTC) Subject: [commit: ghc] master: rts: detab/dewhitespace Messages.c (f2a3f53) Message-ID: <20140728143621.EB5E52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f2a3f539a6fc1a92b4f1d7f01b51c8b69a63fb77/ghc >--------------------------------------------------------------- commit f2a3f539a6fc1a92b4f1d7f01b51c8b69a63fb77 Author: Austin Seipp Date: Mon Jul 21 20:27:41 2014 -0500 rts: detab/dewhitespace Messages.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- f2a3f539a6fc1a92b4f1d7f01b51c8b69a63fb77 rts/Messages.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/rts/Messages.c b/rts/Messages.c index c5988f8..82d8699 100644 --- a/rts/Messages.c +++ b/rts/Messages.c @@ -44,7 +44,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg) recordClosureMutated(from_cap,(StgClosure*)msg); if (to_cap->running_task == NULL) { - to_cap->running_task = myTask(); + to_cap->running_task = myTask(); // precond for releaseCapability_() releaseCapability_(to_cap,rtsFalse); } else { @@ -342,5 +342,3 @@ loop: return NULL; // not blocked } - - From git at git.haskell.org Mon Jul 28 14:36:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:25 +0000 (UTC) Subject: [commit: ghc] master: rts: delint FileLock.c (2e1a0ba) Message-ID: <20140728143625.B86282406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2e1a0ba1229446fb0c40ff48d4790eeec4029018/ghc >--------------------------------------------------------------- commit 2e1a0ba1229446fb0c40ff48d4790eeec4029018 Author: Austin Seipp Date: Mon Jul 21 20:25:00 2014 -0500 rts: delint FileLock.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2e1a0ba1229446fb0c40ff48d4790eeec4029018 rts/FileLock.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/rts/FileLock.c b/rts/FileLock.c index 3a05204..cd2dc1d 100644 --- a/rts/FileLock.c +++ b/rts/FileLock.c @@ -44,8 +44,9 @@ static int cmpLocks(StgWord w1, StgWord w2) static int hashLock(HashTable *table, StgWord w) { Lock *l = (Lock *)w; + StgWord key = l->inode ^ (l->inode >> 32) ^ l->device ^ (l->device >> 32); // Just xor all 32-bit words of inode and device, hope this is good enough. - return hashWord(table, l->inode ^ (l->inode >> 32) ^ l->device ^ (l->device >> 32)); + return hashWord(table, key); } void From git at git.haskell.org Mon Jul 28 14:36:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:30 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Arena.c (4f5966b) Message-ID: <20140728143630.A201D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f5966b3edd62997552d2ebe371542861ed81405/ghc >--------------------------------------------------------------- commit 4f5966b3edd62997552d2ebe371542861ed81405 Author: Austin Seipp Date: Mon Jul 21 20:21:54 2014 -0500 rts: delint/detab/dewhitespace Arena.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4f5966b3edd62997552d2ebe371542861ed81405 rts/Arena.c | 47 +++++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/rts/Arena.c b/rts/Arena.c index 361c6c4..813e60e 100644 --- a/rts/Arena.c +++ b/rts/Arena.c @@ -27,8 +27,8 @@ // Each arena struct is allocated using malloc(). struct _Arena { bdescr *current; - StgWord *free; // ptr to next free byte in current block - StgWord *lim; // limit (== last free byte + 1) + StgWord *free; // ptr to next free byte in current block + StgWord *lim; // limit (== last free byte + 1) }; // We like to keep track of how many blocks we've allocated for @@ -74,26 +74,26 @@ arenaAlloc( Arena *arena, size_t size ) size_w = B_TO_W(size); if ( arena->free + size_w < arena->lim ) { - // enough room in the current block... - p = arena->free; - arena->free += size_w; - return p; + // enough room in the current block... + p = arena->free; + arena->free += size_w; + return p; } else { - // allocate a fresh block... - req_blocks = (W_)BLOCK_ROUND_UP(size) / BLOCK_SIZE; - bd = allocGroup_lock(req_blocks); - arena_blocks += req_blocks; + // allocate a fresh block... + req_blocks = (W_)BLOCK_ROUND_UP(size) / BLOCK_SIZE; + bd = allocGroup_lock(req_blocks); + arena_blocks += req_blocks; - bd->gen_no = 0; - bd->gen = NULL; + bd->gen_no = 0; + bd->gen = NULL; bd->dest_no = 0; - bd->flags = 0; - bd->free = bd->start; - bd->link = arena->current; - arena->current = bd; - arena->free = bd->free + size_w; - arena->lim = bd->free + bd->blocks * BLOCK_SIZE_W; - return bd->start; + bd->flags = 0; + bd->free = bd->start; + bd->link = arena->current; + arena->current = bd; + arena->free = bd->free + size_w; + arena->lim = bd->free + bd->blocks * BLOCK_SIZE_W; + return bd->start; } } @@ -104,10 +104,10 @@ arenaFree( Arena *arena ) bdescr *bd, *next; for (bd = arena->current; bd != NULL; bd = next) { - next = bd->link; - arena_blocks -= bd->blocks; - ASSERT(arena_blocks >= 0); - freeGroup_lock(bd); + next = bd->link; + arena_blocks -= bd->blocks; + ASSERT(arena_blocks >= 0); + freeGroup_lock(bd); } stgFree(arena); } @@ -117,4 +117,3 @@ arenaBlocks( void ) { return arena_blocks; } - From git at git.haskell.org Mon Jul 28 14:36:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:34 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace OldARMAtomic.c (48cae79) Message-ID: <20140728143634.56A952406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48cae7919a93a7aaa414ae380f022e4243c285ed/ghc >--------------------------------------------------------------- commit 48cae7919a93a7aaa414ae380f022e4243c285ed Author: Austin Seipp Date: Mon Jul 21 20:29:31 2014 -0500 rts: delint/detab/dewhitespace OldARMAtomic.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 48cae7919a93a7aaa414ae380f022e4243c285ed rts/OldARMAtomic.c | 1 - 1 file changed, 1 deletion(-) diff --git a/rts/OldARMAtomic.c b/rts/OldARMAtomic.c index b2c52fc..a28d2bc 100644 --- a/rts/OldARMAtomic.c +++ b/rts/OldARMAtomic.c @@ -53,4 +53,3 @@ void arm_atomic_spin_unlock() #endif /* arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv6) */ #endif /* defined(THREADED_RTS) */ - From git at git.haskell.org Mon Jul 28 14:36:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:38 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Globals.h (4a09baa) Message-ID: <20140728143639.835FC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a09baa8124ea0efc6000ef240727b0a98dac9e2/ghc >--------------------------------------------------------------- commit 4a09baa8124ea0efc6000ef240727b0a98dac9e2 Author: Austin Seipp Date: Mon Jul 21 20:25:32 2014 -0500 rts: delint/detab/dewhitespace Globals.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4a09baa8124ea0efc6000ef240727b0a98dac9e2 rts/Globals.h | 1 - 1 file changed, 1 deletion(-) diff --git a/rts/Globals.h b/rts/Globals.h index 445072c..395d240 100644 --- a/rts/Globals.h +++ b/rts/Globals.h @@ -16,4 +16,3 @@ RTS_PRIVATE void initGlobalStore(void); RTS_PRIVATE void exitGlobalStore(void); #endif - From git at git.haskell.org Mon Jul 28 14:36:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:42 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Papi.c (42f3bdf) Message-ID: <20140728143642.6248B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/42f3bdf3267c2cb3f741de1550507c88c860673f/ghc >--------------------------------------------------------------- commit 42f3bdf3267c2cb3f741de1550507c88c860673f Author: Austin Seipp Date: Mon Jul 21 20:30:16 2014 -0500 rts: delint/detab/dewhitespace Papi.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 42f3bdf3267c2cb3f741de1550507c88c860673f rts/Papi.c | 74 +++++++++++++++++++++++++++++++------------------------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/rts/Papi.c b/rts/Papi.c index 62f5d0d..3da612e 100644 --- a/rts/Papi.c +++ b/rts/Papi.c @@ -64,7 +64,7 @@ struct _papi_events { #define PAPI_CHECK(CALL) \ if((papi_error=(CALL)) != PAPI_OK) { \ debugBelch("PAPI function failed in module %s at line %d with error code %d\n", \ - __FILE__,__LINE__,papi_error); \ + __FILE__,__LINE__,papi_error); \ } /* While PAPI reporting is going on this flag is on */ @@ -130,24 +130,24 @@ init_countable_events(void) #define PAPI_ADD_EVENT(EVENT) papi_add_event(#EVENT,EVENT) if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_BRANCH) { - PAPI_ADD_EVENT(FR_BR); - PAPI_ADD_EVENT(FR_BR_MIS); - /* Docs are wrong? Opteron does not count indirect branch misses exclusively */ - PAPI_ADD_EVENT(FR_BR_MISCOMPARE); + PAPI_ADD_EVENT(FR_BR); + PAPI_ADD_EVENT(FR_BR_MIS); + /* Docs are wrong? Opteron does not count indirect branch misses exclusively */ + PAPI_ADD_EVENT(FR_BR_MISCOMPARE); } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_STALLS) { - PAPI_ADD_EVENT(FR_DISPATCH_STALLS); - PAPI_ADD_EVENT(FR_DISPATCH_STALLS_BR); - PAPI_ADD_EVENT(FR_DISPATCH_STALLS_FULL_LS); + PAPI_ADD_EVENT(FR_DISPATCH_STALLS); + PAPI_ADD_EVENT(FR_DISPATCH_STALLS_BR); + PAPI_ADD_EVENT(FR_DISPATCH_STALLS_FULL_LS); } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L1) { - PAPI_ADD_EVENT(PAPI_L1_DCA); - PAPI_ADD_EVENT(PAPI_L1_DCM); + PAPI_ADD_EVENT(PAPI_L1_DCA); + PAPI_ADD_EVENT(PAPI_L1_DCM); } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L2) { - PAPI_ADD_EVENT(PAPI_L2_DCA); - PAPI_ADD_EVENT(PAPI_L2_DCM); + PAPI_ADD_EVENT(PAPI_L2_DCA); + PAPI_ADD_EVENT(PAPI_L2_DCM); } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CB_EVENTS) { - PAPI_ADD_EVENT(DC_L2_REFILL_MOES); - PAPI_ADD_EVENT(DC_SYS_REFILL_MOES); - PAPI_ADD_EVENT(FR_BR_MIS); + PAPI_ADD_EVENT(DC_L2_REFILL_MOES); + PAPI_ADD_EVENT(DC_SYS_REFILL_MOES); + PAPI_ADD_EVENT(FR_BR_MIS); } else if (RtsFlags.PapiFlags.eventType==PAPI_USER_EVENTS) { nat i; char *name; @@ -167,24 +167,24 @@ init_countable_events(void) papi_add_event(name, code); } } else { - // PAPI_ADD_EVENT(PAPI_L1_DCA); // L1 data cache accesses - // PAPI_ADD_EVENT(PAPI_L1_ICR); // L1 instruction cache reads - // PAPI_ADD_EVENT(PAPI_L1_ICM); // L1 instruction cache misses - // PAPI_ADD_EVENT(PAPI_L1_STM); // L1 store misses - // PAPI_ADD_EVENT(PAPI_L1_DCM); // L1 data cache misses - // PAPI_ADD_EVENT(PAPI_L1_LDM); // L1 load misses - // PAPI_ADD_EVENT(PAPI_L2_TCM); // L2 cache misses - // PAPI_ADD_EVENT(PAPI_L2_STM); // L2 store misses - // PAPI_ADD_EVENT(PAPI_L2_DCW); // L2 data cache writes - // PAPI_ADD_EVENT(PAPI_L2_DCR); // L2 data cache reads - // PAPI_ADD_EVENT(PAPI_L2_TCW); // L2 cache writes - // PAPI_ADD_EVENT(PAPI_L2_TCR); // L2 cache reads - // PAPI_ADD_EVENT(PAPI_CA_CLN); // exclusive access to clean cache line - // PAPI_ADD_EVENT(PAPI_TLB_DM); // TLB misses + // PAPI_ADD_EVENT(PAPI_L1_DCA); // L1 data cache accesses + // PAPI_ADD_EVENT(PAPI_L1_ICR); // L1 instruction cache reads + // PAPI_ADD_EVENT(PAPI_L1_ICM); // L1 instruction cache misses + // PAPI_ADD_EVENT(PAPI_L1_STM); // L1 store misses + // PAPI_ADD_EVENT(PAPI_L1_DCM); // L1 data cache misses + // PAPI_ADD_EVENT(PAPI_L1_LDM); // L1 load misses + // PAPI_ADD_EVENT(PAPI_L2_TCM); // L2 cache misses + // PAPI_ADD_EVENT(PAPI_L2_STM); // L2 store misses + // PAPI_ADD_EVENT(PAPI_L2_DCW); // L2 data cache writes + // PAPI_ADD_EVENT(PAPI_L2_DCR); // L2 data cache reads + // PAPI_ADD_EVENT(PAPI_L2_TCW); // L2 cache writes + // PAPI_ADD_EVENT(PAPI_L2_TCR); // L2 cache reads + // PAPI_ADD_EVENT(PAPI_CA_CLN); // exclusive access to clean cache line + // PAPI_ADD_EVENT(PAPI_TLB_DM); // TLB misses PAPI_ADD_EVENT(PAPI_TOT_INS); // Total instructions PAPI_ADD_EVENT(PAPI_TOT_CYC); // Total instructions - // PAPI_ADD_EVENT(PAPI_CA_SHR); // exclusive access to shared cache line - // PAPI_ADD_EVENT(PAPI_RES_STL); // Cycles stalled on any resource + // PAPI_ADD_EVENT(PAPI_CA_SHR); // exclusive access to shared cache line + // PAPI_ADD_EVENT(PAPI_RES_STL); // Cycles stalled on any resource } @@ -219,16 +219,16 @@ papi_report(long_long counters[]) } if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_BRANCH) { - PAPI_REPORT_PCT(counters,FR_BR_MIS,FR_BR); - PAPI_REPORT_PCT(counters,FR_BR_MISCOMPARE,FR_BR); + PAPI_REPORT_PCT(counters,FR_BR_MIS,FR_BR); + PAPI_REPORT_PCT(counters,FR_BR_MISCOMPARE,FR_BR); } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L1) { - PAPI_REPORT_PCT(counters,PAPI_L1_DCM,PAPI_L1_DCA); + PAPI_REPORT_PCT(counters,PAPI_L1_DCM,PAPI_L1_DCA); } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L2) { - PAPI_REPORT_PCT(counters,PAPI_L2_DCM,PAPI_L2_DCA); + PAPI_REPORT_PCT(counters,PAPI_L2_DCM,PAPI_L2_DCA); } } @@ -310,10 +310,10 @@ papi_add_events(int EventSet) nat i; for(i=0;i Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de5a4db7857d40406f212abfcce5f96c26fe9532/ghc >--------------------------------------------------------------- commit de5a4db7857d40406f212abfcce5f96c26fe9532 Author: Austin Seipp Date: Mon Jul 21 20:32:40 2014 -0500 rts: delint/detab/dewhitespace RetainerSet.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- de5a4db7857d40406f212abfcce5f96c26fe9532 rts/RetainerSet.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:36:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:51 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace RtsDllMain.c (f81154f) Message-ID: <20140728143651.7B1172406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f81154f7c7c155ee0f9df344865cd4498af92214/ghc >--------------------------------------------------------------- commit f81154f7c7c155ee0f9df344865cd4498af92214 Author: Austin Seipp Date: Mon Jul 21 20:35:30 2014 -0500 rts: delint/detab/dewhitespace RtsDllMain.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- f81154f7c7c155ee0f9df344865cd4498af92214 rts/RtsDllMain.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rts/RtsDllMain.c b/rts/RtsDllMain.c index 06c5655..b3b10f0 100644 --- a/rts/RtsDllMain.c +++ b/rts/RtsDllMain.c @@ -21,8 +21,8 @@ BOOL WINAPI DllMain ( HINSTANCE hInstance STG_UNUSED , DWORD reason - , LPVOID reserved STG_UNUSED - ) + , LPVOID reserved STG_UNUSED + ) { /* * Note: the DllMain() doesn't call startupHaskell() for you, @@ -33,7 +33,7 @@ DllMain ( HINSTANCE hInstance STG_UNUSED switch (reason) { // shutdownHaskelAndExit() is already being called, - // so I don't think we need this. BL 2009/11/17 + // so I don't think we need this. BL 2009/11/17 //case DLL_PROCESS_DETACH: shutdownHaskell(); } From git at git.haskell.org Mon Jul 28 14:36:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:36:55 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace Papi.h (a0fa13b) Message-ID: <20140728143655.9F6DB2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a0fa13b9ab6cdb63fc26bd5b7aba2bd89e4466e4/ghc >--------------------------------------------------------------- commit a0fa13b9ab6cdb63fc26bd5b7aba2bd89e4466e4 Author: Austin Seipp Date: Mon Jul 21 20:32:02 2014 -0500 rts: delint/detab/dewhitespace Papi.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- a0fa13b9ab6cdb63fc26bd5b7aba2bd89e4466e4 rts/Papi.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:37:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:00 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace PosixSource.h (7113370) Message-ID: <20140728143700.8CE082406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7113370469cb37198fada17033bb9ef7d328509a/ghc >--------------------------------------------------------------- commit 7113370469cb37198fada17033bb9ef7d328509a Author: Austin Seipp Date: Mon Jul 21 20:32:26 2014 -0500 rts: delint/detab/dewhitespace PosixSource.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7113370469cb37198fada17033bb9ef7d328509a rts/PosixSource.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:37:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:05 +0000 (UTC) Subject: [commit: ghc] master: rts: delint Papi.c (ad36b1a) Message-ID: <20140728143705.43E9B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad36b1ad09be7eb7276850ff02e69484672ea3eb/ghc >--------------------------------------------------------------- commit ad36b1ad09be7eb7276850ff02e69484672ea3eb Author: Austin Seipp Date: Mon Jul 21 20:31:53 2014 -0500 rts: delint Papi.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- ad36b1ad09be7eb7276850ff02e69484672ea3eb rts/Papi.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/rts/Papi.c b/rts/Papi.c index 3da612e..a36157f 100644 --- a/rts/Papi.c +++ b/rts/Papi.c @@ -61,9 +61,10 @@ struct _papi_events { #define BIG_STRING_LEN 512 -#define PAPI_CHECK(CALL) \ - if((papi_error=(CALL)) != PAPI_OK) { \ - debugBelch("PAPI function failed in module %s at line %d with error code %d\n", \ +#define PAPI_CHECK(CALL) \ + if((papi_error=(CALL)) != PAPI_OK) { \ + debugBelch("PAPI function failed in module %s at line %d " \ + "with error code %d\n", \ __FILE__,__LINE__,papi_error); \ } @@ -132,7 +133,8 @@ init_countable_events(void) if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_BRANCH) { PAPI_ADD_EVENT(FR_BR); PAPI_ADD_EVENT(FR_BR_MIS); - /* Docs are wrong? Opteron does not count indirect branch misses exclusively */ + // Docs are wrong? Opteron does not count indirect branch + // misses exclusively PAPI_ADD_EVENT(FR_BR_MISCOMPARE); } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_STALLS) { PAPI_ADD_EVENT(FR_DISPATCH_STALLS); From git at git.haskell.org Mon Jul 28 14:37:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:10 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace RetainerSet.c (ee0fd62) Message-ID: <20140728143710.2B7282406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ee0fd621a2d966ffc5ce3a2400abf757cf2a8f73/ghc >--------------------------------------------------------------- commit ee0fd621a2d966ffc5ce3a2400abf757cf2a8f73 Author: Austin Seipp Date: Mon Jul 21 20:34:06 2014 -0500 rts: delint/detab/dewhitespace RetainerSet.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- ee0fd621a2d966ffc5ce3a2400abf757cf2a8f73 rts/RetainerSet.c | 200 +++++++++++++++++++++++++++--------------------------- 1 file changed, 100 insertions(+), 100 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ee0fd621a2d966ffc5ce3a2400abf757cf2a8f73 From git at git.haskell.org Mon Jul 28 14:37:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:13 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace StgRun.h (d765359) Message-ID: <20140728143713.EEB142406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d76535983f4dd6fe3f239c6a5b3439440de86ea2/ghc >--------------------------------------------------------------- commit d76535983f4dd6fe3f239c6a5b3439440de86ea2 Author: Austin Seipp Date: Mon Jul 21 20:36:05 2014 -0500 rts: delint/detab/dewhitespace StgRun.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- d76535983f4dd6fe3f239c6a5b3439440de86ea2 rts/StgRun.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:37:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:18 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace RtsDllMain.h (60c6bd4) Message-ID: <20140728143718.B96432406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60c6bd4ab8b99398037f8a66786415e29f3e47fa/ghc >--------------------------------------------------------------- commit 60c6bd4ab8b99398037f8a66786415e29f3e47fa Author: Austin Seipp Date: Mon Jul 21 20:35:35 2014 -0500 rts: delint/detab/dewhitespace RtsDllMain.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 60c6bd4ab8b99398037f8a66786415e29f3e47fa rts/RtsDllMain.h | 2 -- 1 file changed, 2 deletions(-) diff --git a/rts/RtsDllMain.h b/rts/RtsDllMain.h index d781127..4b9480d 100644 --- a/rts/RtsDllMain.h +++ b/rts/RtsDllMain.h @@ -1,4 +1,3 @@ - #include "Rts.h" #ifdef HAVE_WINDOWS_H @@ -14,4 +13,3 @@ DllMain ( HINSTANCE hInstance , LPVOID reserved ); #endif - From git at git.haskell.org Mon Jul 28 14:37:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:22 +0000 (UTC) Subject: [commit: ghc] master: rts: delint/detab/dewhitespace ThreadLabels.c (a6fc4bd) Message-ID: <20140728143722.0ECA62406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6fc4bdb77b3773a6f2a33f8032eab15b22b8e0b/ghc >--------------------------------------------------------------- commit a6fc4bdb77b3773a6f2a33f8032eab15b22b8e0b Author: Austin Seipp Date: Mon Jul 21 20:36:35 2014 -0500 rts: delint/detab/dewhitespace ThreadLabels.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- a6fc4bdb77b3773a6f2a33f8032eab15b22b8e0b rts/ThreadLabels.c | 1 - 1 file changed, 1 deletion(-) diff --git a/rts/ThreadLabels.c b/rts/ThreadLabels.c index 8838042..981a5d9 100644 --- a/rts/ThreadLabels.c +++ b/rts/ThreadLabels.c @@ -82,4 +82,3 @@ labelThread(Capability *cap STG_UNUSED, #endif traceThreadLabel(cap, tso, label); } - From git at git.haskell.org Mon Jul 28 14:37:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:26 +0000 (UTC) Subject: [commit: ghc] master: rts: detab/dewhitespace WSDeque.c (952f622) Message-ID: <20140728143726.F293C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/952f622c0cc91b1c904bfc359a864f39503aa50d/ghc >--------------------------------------------------------------- commit 952f622c0cc91b1c904bfc359a864f39503aa50d Author: Austin Seipp Date: Mon Jul 21 20:38:46 2014 -0500 rts: detab/dewhitespace WSDeque.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 952f622c0cc91b1c904bfc359a864f39503aa50d rts/WSDeque.c | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:37:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:31 +0000 (UTC) Subject: [commit: ghc] master: add Solaris' linker warning messages filtering into link phase (524f15d) Message-ID: <20140728143731.9F19A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/524f15de1262d387ccd8075b68ed310ce5305068/ghc >--------------------------------------------------------------- commit 524f15de1262d387ccd8075b68ed310ce5305068 Author: Karel Gardas Date: Mon Jul 28 07:49:40 2014 -0500 add Solaris' linker warning messages filtering into link phase Summary: Solaris ld emits harmless warning messages about unresolved symbol in case of compiling into shared library when we do not link against all the required libs. That is the case of GHC which does not link against RTS library explicitly in order to be able to chose the library later based on binary application linking parameters. The warnings look like: Undefined first referenced symbol in file stg_ap_n_fast ./T2386_Lib.o stg_upd_frame_info ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o newCAF ./T2386_Lib.o stg_bh_upd_frame_info ./T2386_Lib.o stg_ap_ppp_fast ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o stg_ap_p_fast ./T2386_Lib.o stg_ap_pp_fast ./T2386_Lib.o ld: warning: symbol referencing errors this is actually coming from T2386 testcase. The emitting of those warnings is also a reason why so many TH testcases fail on Solaris. The patch provides filter which filters out only linker warnings. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D94 >--------------------------------------------------------------- 524f15de1262d387ccd8075b68ed310ce5305068 compiler/main/SysTools.lhs | 52 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 1 deletion(-) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 3b25c91..adb8d31 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -825,7 +825,57 @@ runLink dflags args = do args1 = map Option (getOpts dflags opt_l) args2 = args0 ++ args1 ++ args ++ linkargs mb_env <- getGccEnv args2 - runSomethingFiltered dflags id "Linker" p args2 mb_env + runSomethingFiltered dflags ld_filter "Linker" p args2 mb_env + where + ld_filter = case (platformOS (targetPlatform dflags)) of + OSSolaris2 -> sunos_ld_filter + _ -> id +{- + SunOS/Solaris ld emits harmless warning messages about unresolved + symbol in case of compiling into shared library when we do not + link against all the required libs. That is the case of GHC which + does not link against RTS library explicitly in order to be able to + chose the library later based on binary application linking + parameters. The warnings look like: + +Undefined first referenced + symbol in file +stg_ap_n_fast ./T2386_Lib.o +stg_upd_frame_info ./T2386_Lib.o +templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o +templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o +templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o +templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o +newCAF ./T2386_Lib.o +stg_bh_upd_frame_info ./T2386_Lib.o +stg_ap_ppp_fast ./T2386_Lib.o +templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o +stg_ap_p_fast ./T2386_Lib.o +stg_ap_pp_fast ./T2386_Lib.o +ld: warning: symbol referencing errors + + this is actually coming from T2386 testcase. The emitting of those + warnings is also a reason why so many TH testcases fail on Solaris. + + Following filter code is SunOS/Solaris linker specific and should + filter out only linker warnings. Please note that the logic is a + little bit more complex due to simple reason that we need to preserve + any other linker emitted messages. If there are any. Simply speaking + if we see "Undefined" and later "ld: warning:..." then we omit all + text between (including) the marks. Otherwise we copy whole output. +-} + sunos_ld_filter :: String -> String + sunos_ld_filter = unlines . sunos_ld_filter' . lines + sunos_ld_filter' x = if (undefined_found x && ld_warning_found x) + then (ld_prefix x) ++ (ld_postfix x) + else x + breakStartsWith x y = break (isPrefixOf x) y + ld_prefix = fst . breakStartsWith "Undefined" + undefined_found = not . null . snd . breakStartsWith "Undefined" + ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors" + ld_postfix = tail . snd . ld_warn_break + ld_warning_found = not . null . snd . ld_warn_break + runLibtool :: DynFlags -> [Option] -> IO () runLibtool dflags args = do From git at git.haskell.org Mon Jul 28 14:37:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:37 +0000 (UTC) Subject: [commit: ghc] master: rts: add Emacs 'Local Variables' to every .c file (39b5c1c) Message-ID: <20140728143737.49FDC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/39b5c1cbd8950755de400933cecca7b8deb4ffcd/ghc >--------------------------------------------------------------- commit 39b5c1cbd8950755de400933cecca7b8deb4ffcd Author: Austin Seipp Date: Mon Jul 21 23:08:31 2014 -0500 rts: add Emacs 'Local Variables' to every .c file This will hopefully help ensure some basic consistency in the forward by overriding buffer variables. In particular, it sets the wrap length, the offset to 4, and turns off tabs. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 39b5c1cbd8950755de400933cecca7b8deb4ffcd rts/Adjustor.c | 8 ++++++++ rts/Apply.h | 8 ++++++++ rts/Arena.c | 8 ++++++++ rts/Arena.h | 8 ++++++++ rts/AutoApply.h | 8 ++++++++ rts/AwaitEvent.h | 8 ++++++++ rts/BeginPrivate.h | 8 ++++++++ rts/Capability.c | 8 ++++++++ rts/Capability.h | 8 ++++++++ rts/CheckUnload.c | 8 ++++++++ rts/CheckUnload.h | 8 ++++++++ rts/ClosureFlags.c | 8 ++++++++ rts/Disassembler.c | 8 ++++++++ rts/Disassembler.h | 8 ++++++++ rts/EndPrivate.h | 8 ++++++++ rts/FileLock.c | 8 ++++++++ rts/FileLock.h | 8 ++++++++ rts/GetEnv.h | 8 ++++++++ rts/GetTime.h | 8 ++++++++ rts/Globals.c | 8 ++++++++ rts/Globals.h | 8 ++++++++ rts/Hash.c | 8 ++++++++ rts/Hash.h | 8 ++++++++ rts/Hpc.c | 8 ++++++++ rts/HsFFI.c | 8 ++++++++ rts/Inlines.c | 8 ++++++++ rts/Interpreter.c | 8 ++++++++ rts/Interpreter.h | 8 ++++++++ rts/LdvProfile.c | 8 ++++++++ rts/LdvProfile.h | 8 ++++++++ rts/Linker.c | 8 ++++++++ rts/LinkerInternals.h | 8 ++++++++ rts/Messages.c | 8 ++++++++ rts/Messages.h | 8 ++++++++ rts/OldARMAtomic.c | 8 ++++++++ rts/Papi.c | 8 ++++++++ rts/Papi.h | 8 ++++++++ rts/PosixSource.h | 8 ++++++++ rts/Prelude.h | 8 ++++++++ rts/Printer.c | 8 ++++++++ rts/Printer.h | 8 ++++++++ rts/ProfHeap.c | 8 ++++++++ rts/ProfHeap.h | 8 ++++++++ rts/Profiling.c | 8 ++++++++ rts/Profiling.h | 8 ++++++++ rts/Proftimer.c | 8 ++++++++ rts/Proftimer.h | 8 ++++++++ rts/RaiseAsync.c | 8 ++++++++ rts/RaiseAsync.h | 8 ++++++++ rts/RetainerProfile.c | 8 ++++++++ rts/RetainerProfile.h | 8 ++++++++ rts/RetainerSet.c | 8 ++++++++ rts/RetainerSet.h | 8 ++++++++ rts/RtsAPI.c | 8 ++++++++ rts/RtsDllMain.c | 8 ++++++++ rts/RtsDllMain.h | 8 ++++++++ rts/RtsFlags.c | 8 ++++++++ rts/RtsFlags.h | 8 ++++++++ rts/RtsMain.c | 8 ++++++++ rts/RtsMessages.c | 8 ++++++++ rts/RtsSignals.h | 8 ++++++++ rts/RtsStartup.c | 8 ++++++++ rts/RtsUtils.c | 8 ++++++++ rts/RtsUtils.h | 8 ++++++++ rts/STM.c | 8 ++++++++ rts/STM.h | 8 ++++++++ rts/Schedule.c | 8 ++++++++ rts/Schedule.h | 8 ++++++++ rts/Sparks.c | 8 ++++++++ rts/Sparks.h | 8 ++++++++ rts/Stable.c | 8 ++++++++ rts/Stable.h | 8 ++++++++ rts/Stats.c | 8 ++++++++ rts/Stats.h | 8 ++++++++ rts/StgCRun.c | 8 ++++++++ rts/StgPrimFloat.c | 8 ++++++++ rts/StgPrimFloat.h | 8 ++++++++ rts/StgRun.h | 8 ++++++++ rts/Task.c | 8 ++++++++ rts/Task.h | 8 ++++++++ rts/ThreadLabels.c | 8 ++++++++ rts/ThreadLabels.h | 8 ++++++++ rts/ThreadPaused.c | 8 ++++++++ rts/ThreadPaused.h | 8 ++++++++ rts/Threads.c | 8 ++++++++ rts/Threads.h | 8 ++++++++ rts/Ticker.h | 8 ++++++++ rts/Ticky.c | 8 ++++++++ rts/Ticky.h | 8 ++++++++ rts/Timer.c | 8 ++++++++ rts/Timer.h | 8 ++++++++ rts/Trace.c | 8 ++++++++ rts/Trace.h | 8 ++++++++ rts/Updates.h | 8 ++++++++ rts/WSDeque.c | 8 ++++++++ rts/WSDeque.h | 8 ++++++++ rts/Weak.c | 8 ++++++++ rts/Weak.h | 8 ++++++++ rts/eventlog/EventLog.c | 8 ++++++++ rts/eventlog/EventLog.h | 8 ++++++++ rts/hooks/FlagDefaults.c | 8 ++++++++ rts/hooks/MallocFail.c | 8 ++++++++ rts/hooks/OnExit.c | 8 ++++++++ rts/hooks/OutOfHeap.c | 8 ++++++++ rts/hooks/StackOverflow.c | 8 ++++++++ rts/posix/Clock.h | 8 ++++++++ rts/posix/GetEnv.c | 8 ++++++++ rts/posix/GetTime.c | 8 ++++++++ rts/posix/Itimer.c | 8 ++++++++ rts/posix/Itimer.h | 8 ++++++++ rts/posix/OSMem.c | 8 ++++++++ rts/posix/OSThreads.c | 8 ++++++++ rts/posix/Select.c | 8 ++++++++ rts/posix/Select.h | 8 ++++++++ rts/posix/Signals.c | 8 ++++++++ rts/posix/Signals.h | 8 ++++++++ rts/posix/TTY.c | 8 ++++++++ rts/posix/TTY.h | 8 ++++++++ rts/sm/BlockAlloc.c | 8 ++++++++ rts/sm/BlockAlloc.h | 8 ++++++++ rts/sm/Compact.c | 8 ++++++++ rts/sm/Compact.h | 8 ++++++++ rts/sm/Evac.c | 8 ++++++++ rts/sm/Evac.h | 8 ++++++++ rts/sm/GC.c | 8 ++++++++ rts/sm/GC.h | 8 ++++++++ rts/sm/GCAux.c | 8 ++++++++ rts/sm/GCTDecl.h | 8 ++++++++ rts/sm/GCThread.h | 8 ++++++++ rts/sm/GCUtils.c | 8 ++++++++ rts/sm/GCUtils.h | 8 ++++++++ rts/sm/MBlock.c | 8 ++++++++ rts/sm/MarkStack.h | 8 ++++++++ rts/sm/MarkWeak.c | 8 ++++++++ rts/sm/MarkWeak.h | 8 ++++++++ rts/sm/OSMem.h | 8 ++++++++ rts/sm/Sanity.c | 8 ++++++++ rts/sm/Sanity.h | 8 ++++++++ rts/sm/Scav.c | 8 ++++++++ rts/sm/Scav.h | 8 ++++++++ rts/sm/Storage.c | 8 ++++++++ rts/sm/Storage.h | 8 ++++++++ rts/sm/Sweep.c | 8 ++++++++ rts/sm/Sweep.h | 8 ++++++++ rts/win32/AsyncIO.c | 8 ++++++++ rts/win32/AsyncIO.h | 8 ++++++++ rts/win32/AwaitEvent.c | 8 ++++++++ rts/win32/ConsoleHandler.c | 8 ++++++++ rts/win32/ConsoleHandler.h | 8 ++++++++ rts/win32/GetEnv.c | 8 ++++++++ rts/win32/GetTime.c | 8 ++++++++ rts/win32/IOManager.c | 8 ++++++++ rts/win32/IOManager.h | 8 ++++++++ rts/win32/OSMem.c | 8 ++++++++ rts/win32/OSThreads.c | 8 ++++++++ rts/win32/ThrIOManager.c | 8 ++++++++ rts/win32/Ticker.c | 8 ++++++++ rts/win32/WorkQueue.c | 8 ++++++++ rts/win32/WorkQueue.h | 8 ++++++++ rts/win32/seh_excn.c | 8 ++++++++ rts/win32/seh_excn.h | 8 ++++++++ 161 files changed, 1288 insertions(+) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 39b5c1cbd8950755de400933cecca7b8deb4ffcd From git at git.haskell.org Mon Jul 28 14:37:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:42 +0000 (UTC) Subject: [commit: ghc] master: do not link with -lrt on Solaris for threaded way (cc37175) Message-ID: <20140728143742.6E40E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc3717597597c031dd8402c443f40f76d432c044/ghc >--------------------------------------------------------------- commit cc3717597597c031dd8402c443f40f76d432c044 Author: Karel Gardas Date: Mon Jul 28 07:49:12 2014 -0500 do not link with -lrt on Solaris for threaded way Summary: This patch removes linking with rt library on Solaris for threaded way. The reason is simple it casuses few ffi related tests failures and also is not needed anymore. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D95 >--------------------------------------------------------------- cc3717597597c031dd8402c443f40f76d432c044 compiler/main/DynFlags.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0a18be4..1bb9f2c 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1215,7 +1215,6 @@ wayOptl platform WayThreaded = -- the problems are our fault or theirs, but it seems that using the -- alternative 1:1 threading library libthr works around it: OSFreeBSD -> ["-lthr"] - OSSolaris2 -> ["-lrt"] OSOpenBSD -> ["-pthread"] OSNetBSD -> ["-pthread"] _ -> [] From git at git.haskell.org Mon Jul 28 14:37:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:45 +0000 (UTC) Subject: [commit: ghc] master: rts: detab/dewhitespace WSDeque.h (cf2980c) Message-ID: <20140728143745.6EF082406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf2980cb94a6c30f0f2693af26d1297d8f67f505/ghc >--------------------------------------------------------------- commit cf2980cb94a6c30f0f2693af26d1297d8f67f505 Author: Austin Seipp Date: Mon Jul 21 20:38:38 2014 -0500 rts: detab/dewhitespace WSDeque.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- cf2980cb94a6c30f0f2693af26d1297d8f67f505 rts/WSDeque.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jul 28 14:37:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:49 +0000 (UTC) Subject: [commit: ghc] master: rts: detab/dewhitespace ThreadPaused.c (95378c2) Message-ID: <20140728143749.559EF2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/95378c2af5a2e091dda44302bdd8ebc7c585248d/ghc >--------------------------------------------------------------- commit 95378c2af5a2e091dda44302bdd8ebc7c585248d Author: Austin Seipp Date: Mon Jul 21 20:37:16 2014 -0500 rts: detab/dewhitespace ThreadPaused.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 95378c2af5a2e091dda44302bdd8ebc7c585248d rts/ThreadPaused.c | 118 ++++++++++++++++++++++++++--------------------------- 1 file changed, 59 insertions(+), 59 deletions(-) diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c index 0507880..b757a00 100644 --- a/rts/ThreadPaused.c +++ b/rts/ThreadPaused.c @@ -100,7 +100,7 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) switch (get_ret_itbl((StgClosure *)frame)->i.type) { case UPDATE_FRAME: - { + { if (adjacent_update_frames > 0) { TICK_UPD_SQUEEZED(); } @@ -110,9 +110,9 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) continue; } - default: + default: // we're not in a gap... check whether this is the end of a gap - // (an update frame can't be the end of a gap). + // (an update frame can't be the end of a gap). if (adjacent_update_frames > 1) { gap = updateAdjacentFrames(cap, tso, (StgUpdateFrame*)(frame - sizeofW(StgUpdateFrame)), @@ -120,9 +120,9 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) } adjacent_update_frames = 0; - frame += stack_frame_sizeW((StgClosure *)frame); - continue; - } + frame += stack_frame_sizeW((StgClosure *)frame); + continue; + } } if (adjacent_update_frames > 1) { @@ -155,26 +155,26 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) // indicates unused // { - StgWord8 *sp; - StgWord8 *gap_start, *next_gap_start, *gap_end; - nat chunk_size; + StgWord8 *sp; + StgWord8 *gap_start, *next_gap_start, *gap_end; + nat chunk_size; - next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame); - sp = next_gap_start; + next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame); + sp = next_gap_start; while ((StgPtr)gap > tso->stackobj->sp) { - // we're working in *bytes* now... - gap_start = next_gap_start; - gap_end = gap_start - gap->gap_size * sizeof(W_); + // we're working in *bytes* now... + gap_start = next_gap_start; + gap_end = gap_start - gap->gap_size * sizeof(W_); - gap = gap->next_gap; - next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame); + gap = gap->next_gap; + next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame); - chunk_size = gap_end - next_gap_start; - sp -= chunk_size; - memmove(sp, next_gap_start, chunk_size); - } + chunk_size = gap_end - next_gap_start; + sp -= chunk_size; + memmove(sp, next_gap_start, chunk_size); + } tso->stackobj->sp = (StgPtr)sp; } @@ -220,9 +220,9 @@ threadPaused(Capability *cap, StgTSO *tso) while ((P_)frame < stack_end) { info = get_ret_itbl(frame); - switch (info->i.type) { + switch (info->i.type) { - case UPDATE_FRAME: + case UPDATE_FRAME: // If we've already marked this frame, then stop here. if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) { @@ -234,9 +234,9 @@ threadPaused(Capability *cap, StgTSO *tso) goto end; } - SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info); + SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info); - bh = ((StgUpdateFrame *)frame)->updatee; + bh = ((StgUpdateFrame *)frame)->updatee; bh_info = bh->header.info; #ifdef THREADED_RTS @@ -277,29 +277,29 @@ threadPaused(Capability *cap, StgTSO *tso) && ((StgInd*)bh)->indirectee != (StgClosure*)tso) { - debugTrace(DEBUG_squeeze, - "suspending duplicate work: %ld words of stack", + debugTrace(DEBUG_squeeze, + "suspending duplicate work: %ld words of stack", (long)((StgPtr)frame - tso->stackobj->sp)); - // If this closure is already an indirection, then - // suspend the computation up to this point. - // NB. check raiseAsync() to see what happens when - // we're in a loop (#2783). - suspendComputation(cap,tso,(StgUpdateFrame*)frame); + // If this closure is already an indirection, then + // suspend the computation up to this point. + // NB. check raiseAsync() to see what happens when + // we're in a loop (#2783). + suspendComputation(cap,tso,(StgUpdateFrame*)frame); - // Now drop the update frame, and arrange to return - // the value to the frame underneath: + // Now drop the update frame, and arrange to return + // the value to the frame underneath: tso->stackobj->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2; tso->stackobj->sp[1] = (StgWord)bh; ASSERT(bh->header.info != &stg_TSO_info); tso->stackobj->sp[0] = (W_)&stg_enter_info; - // And continue with threadPaused; there might be - // yet more computation to suspend. + // And continue with threadPaused; there might be + // yet more computation to suspend. frame = (StgClosure *)(tso->stackobj->sp + 2); prev_was_update_frame = rtsFalse; continue; - } + } // zero out the slop so that the sanity checker can tell @@ -333,43 +333,43 @@ threadPaused(Capability *cap, StgTSO *tso) // We pretend that bh has just been created. LDV_RECORD_CREATE(bh); - frame = (StgClosure *) ((StgUpdateFrame *)frame + 1); - if (prev_was_update_frame) { - words_to_squeeze += sizeofW(StgUpdateFrame); - weight += weight_pending; - weight_pending = 0; - } - prev_was_update_frame = rtsTrue; - break; + frame = (StgClosure *) ((StgUpdateFrame *)frame + 1); + if (prev_was_update_frame) { + words_to_squeeze += sizeofW(StgUpdateFrame); + weight += weight_pending; + weight_pending = 0; + } + prev_was_update_frame = rtsTrue; + break; case UNDERFLOW_FRAME: case STOP_FRAME: - goto end; - - // normal stack frames; do nothing except advance the pointer - default: - { - nat frame_size = stack_frame_sizeW(frame); - weight_pending += frame_size; - frame = (StgClosure *)((StgPtr)frame + frame_size); - prev_was_update_frame = rtsFalse; - } - } + goto end; + + // normal stack frames; do nothing except advance the pointer + default: + { + nat frame_size = stack_frame_sizeW(frame); + weight_pending += frame_size; + frame = (StgClosure *)((StgPtr)frame + frame_size); + prev_was_update_frame = rtsFalse; + } + } } end: debugTrace(DEBUG_squeeze, - "words_to_squeeze: %d, weight: %d, squeeze: %s", - words_to_squeeze, weight, + "words_to_squeeze: %d, weight: %d, squeeze: %s", + words_to_squeeze, weight, ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze) ? "YES" : "NO"); // Should we squeeze or not? Arbitrary heuristic: we squeeze if // the number of words we have to shift down is less than the // number of stack words we squeeze away by doing so. if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue && - ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) { + ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) { // threshold above bumped from 5 to 8 as a result of #2797 - stackSqueeze(cap, tso, (StgPtr)frame); + stackSqueeze(cap, tso, (StgPtr)frame); tso->flags |= TSO_SQUEEZED; // This flag tells threadStackOverflow() that the stack was // squeezed, because it may not need to be expanded. From git at git.haskell.org Mon Jul 28 14:37:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:54 +0000 (UTC) Subject: [commit: ghc] master: Do not check permissions when running find on Windows. (003bcf2) Message-ID: <20140728143754.4D9CD2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/003bcf20c20391fdd61789ba24269b0f508a3d2f/ghc >--------------------------------------------------------------- commit 003bcf20c20391fdd61789ba24269b0f508a3d2f Author: niklas Date: Thu Jul 24 23:08:24 2014 +0200 Do not check permissions when running find on Windows. Fixes #9363. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 003bcf20c20391fdd61789ba24269b0f508a3d2f aclocal.m4 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index 394e405..fbd82d9 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -2069,7 +2069,11 @@ AC_DEFUN([FIND_LLVM_PROG],[ IFS=":;" for p in ${PATH}; do if test -d "${p}"; then - $1=`${FindCmd} "${p}" -type f -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' -or -type l -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' | ${SortCmd} -n | tail -1` + if test "$windows" = YES; then + $1=`${FindCmd} "${p}" -type f -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' -or -type l -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' | ${SortCmd} -n | tail -1` + else + $1=`${FindCmd} "${p}" -type f -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' -or -type l -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' | ${SortCmd} -n | tail -1` + fi if test -n "$$1"; then break fi @@ -2100,7 +2104,7 @@ AC_DEFUN([FIND_GCC],[ $1="$CC" else FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([$1], [$2], [$3]) - # From Xcode 5 on, OS X command line tools do not include gcc + # From Xcode 5 on/, OS X command line tools do not include gcc # anymore. Use clang. if test -z "$$1" then From git at git.haskell.org Mon Jul 28 14:37:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:37:57 +0000 (UTC) Subject: [commit: ghc] master: Don't clean away inplace/mingw and inplace/perl. (b126ad3) Message-ID: <20140728143757.CDF0B2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b126ad3f59a62f91b2e2d92ec9d51d245861b655/ghc >--------------------------------------------------------------- commit b126ad3f59a62f91b2e2d92ec9d51d245861b655 Author: niklas Date: Thu Jul 24 22:02:39 2014 +0200 Don't clean away inplace/mingw and inplace/perl. Fixes #9362. Signed-off-by: Austin Seipp >--------------------------------------------------------------- b126ad3f59a62f91b2e2d92ec9d51d245861b655 ghc.mk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghc.mk b/ghc.mk index e9d7e83..a1d304e 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1235,7 +1235,8 @@ clean_files : $(call removeFiles,$(CLEAN_FILES)) # this is here since CLEAN_FILES can't handle folders $(call removeTrees,includes/dist-derivedconstants) - $(call removeTrees,inplace) + $(call removeTrees,inplace/bin) + $(call removeTrees,inplace/lib) .PHONY: clean_libraries clean_libraries: $(patsubst %,clean_libraries/%_dist-install,$(PACKAGES_STAGE1) $(PACKAGES_STAGE2)) From git at git.haskell.org Mon Jul 28 14:38:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:38:01 +0000 (UTC) Subject: [commit: ghc] master: driver: Fix usage of '$0' in ghcii.sh (#8873) (8240312) Message-ID: <20140728143801.9116E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8240312ae37a4a1cb89adf13289ac48d7e2aa1d8/ghc >--------------------------------------------------------------- commit 8240312ae37a4a1cb89adf13289ac48d7e2aa1d8 Author: Austin Seipp Date: Mon Jul 28 07:53:32 2014 -0500 driver: Fix usage of '$0' in ghcii.sh (#8873) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8240312ae37a4a1cb89adf13289ac48d7e2aa1d8 driver/ghci/ghc.mk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver/ghci/ghc.mk b/driver/ghci/ghc.mk index 4c5c09e..ba6984c 100644 --- a/driver/ghci/ghc.mk +++ b/driver/ghci/ghc.mk @@ -22,7 +22,7 @@ install_driver_ghci: $(call removeFiles, "$(WRAPPER)") $(CREATE_SCRIPT) "$(WRAPPER)" echo '#!$(SHELL)' >> "$(WRAPPER)" - echo 'exec "$(bindir)/ghc-$(ProjectVersion)" --interactive $${1+"$$@"}' >> "$(WRAPPER)" + echo 'exec "$(bindir)/ghc-$(ProjectVersion)" --interactive "$$@"' >> "$(WRAPPER)" $(EXECUTABLE_FILE) "$(WRAPPER)" $(call removeFiles,"$(DESTDIR)$(bindir)/ghci") $(LN_S) ghci-$(ProjectVersion) "$(DESTDIR)$(bindir)/ghci" @@ -57,7 +57,7 @@ install_driver_ghcii: $(call INSTALL_DIR,$(DESTDIR)$(bindir)) $(call removeFiles,"$(GHCII_SCRIPT)") echo "#!$(SHELL)" >> $(GHCII_SCRIPT) - echo 'exec "$$0"/../ghc --interactive $${1+"$$@"}' >> $(GHCII_SCRIPT) + echo 'exec "$$(dirname "$$0")"/ghc --interactive "$$@"' >> $(GHCII_SCRIPT) $(EXECUTABLE_FILE) $(GHCII_SCRIPT) cp $(GHCII_SCRIPT) $(GHCII_SCRIPT_VERSIONED) $(EXECUTABLE_FILE) $(GHCII_SCRIPT_VERSIONED) From git at git.haskell.org Mon Jul 28 14:38:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:38:05 +0000 (UTC) Subject: [commit: ghc] master: Add Functor, Applicative, Monad instances for First, Last (9a7440c) Message-ID: <20140728143806.13A612406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a7440c0dc038a19432e86923ac30ade7bcea3e7/ghc >--------------------------------------------------------------- commit 9a7440c0dc038a19432e86923ac30ade7bcea3e7 Author: Ben Gamari Date: Mon Jul 28 07:50:28 2014 -0500 Add Functor, Applicative, Monad instances for First, Last Summary: This was proposed in 2011 [1] with no serious objections although wasn't implemented until it was again mentioned in 2014 [2]. [1] http://www.haskell.org/pipermail/libraries/2011-January/015552.html [2] http://www.haskell.org/pipermail/libraries/2014-June/023228.html Test Plan: None Reviewers: austin Reviewed By: austin Subscribers: hvr, phaskell, simonmar, relrod, carter, ekmett Differential Revision: https://phabricator.haskell.org/D81 >--------------------------------------------------------------- 9a7440c0dc038a19432e86923ac30ade7bcea3e7 libraries/base/Control/Applicative.hs | 11 ++++++++++- libraries/base/Data/Monoid.hs | 14 ++++++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs index 4e77479..81ce513 100644 --- a/libraries/base/Control/Applicative.hs +++ b/libraries/base/Control/Applicative.hs @@ -54,7 +54,7 @@ import Control.Monad (liftM, ap, MonadPlus(..)) import Control.Monad.ST.Safe (ST) import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST) import Data.Functor ((<$>), (<$)) -import Data.Monoid (Monoid(..)) +import Data.Monoid (Monoid(..), First(..), Last(..)) import Data.Proxy import Text.ParserCombinators.ReadP (ReadP) @@ -281,6 +281,15 @@ instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where empty = WrapArrow zeroArrow WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v) +-- Added in base-4.8.0.0 +instance Applicative First where + pure x = First (Just x) + First x <*> First y = First (x <*> y) + +instance Applicative Last where + pure x = Last (Just x) + Last x <*> Last y = Last (x <*> y) + -- | Lists, but with an 'Applicative' functor based on zipping, so that -- -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@ diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs index 5889954..2100518 100644 --- a/libraries/base/Data/Monoid.hs +++ b/libraries/base/Data/Monoid.hs @@ -252,6 +252,13 @@ instance Monoid (First a) where r@(First (Just _)) `mappend` _ = r First Nothing `mappend` r = r +instance Functor First where + fmap f (First x) = First (fmap f x) + +instance Monad First where + return x = First (Just x) + First x >>= m = First (x >>= getFirst . m) + -- | Maybe monoid returning the rightmost non-Nothing value. newtype Last a = Last { getLast :: Maybe a } deriving (Eq, Ord, Read, Show, Generic, Generic1) @@ -261,6 +268,13 @@ instance Monoid (Last a) where _ `mappend` r@(Last (Just _)) = r r `mappend` Last Nothing = r +instance Functor Last where + fmap f (Last x) = Last (fmap f x) + +instance Monad Last where + return x = Last (Just x) + Last x >>= m = Last (x >>= getLast . m) + {- {-------------------------------------------------------------------- Testing From git at git.haskell.org Mon Jul 28 14:38:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:38:11 +0000 (UTC) Subject: [commit: ghc] master: use GHC-7.8.3's values for thread block reason (fixes #9333) (4ee8c27) Message-ID: <20140728143811.A0A672406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4ee8c27302e6bb3892e7c47a7111b0683d032c07/ghc >--------------------------------------------------------------- commit 4ee8c27302e6bb3892e7c47a7111b0683d032c07 Author: Jost Berthold Date: Mon Jul 28 07:50:13 2014 -0500 use GHC-7.8.3's values for thread block reason (fixes #9333) Summary: For now, BlockedOnMVar and BlockedOnMVarRead are not distinguished. Making the distinction would mean to change an exported datatype (API change). Code for this change is included but commented out. The patch adds a test for the threadstatus, which retrieves status BlockedOnMVar for two threads blocked on writing and reading an MVar. Test Plan: ran validate, including the new test Reviewers: simonmar, austin, ezyang Reviewed By: austin, ezyang Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D83 >--------------------------------------------------------------- 4ee8c27302e6bb3892e7c47a7111b0683d032c07 libraries/base/GHC/Conc/Sync.lhs | 18 +++++++----- testsuite/.gitignore | 1 + testsuite/tests/concurrent/should_run/all.T | 5 +++- .../concurrent/should_run/threadstatus-9333.hs | 33 ++++++++++++++++++++++ .../concurrent/should_run/threadstatus-9333.stdout | 9 ++++++ 5 files changed, 58 insertions(+), 8 deletions(-) diff --git a/libraries/base/GHC/Conc/Sync.lhs b/libraries/base/GHC/Conc/Sync.lhs index 713e0b5..bd60ebd 100644 --- a/libraries/base/GHC/Conc/Sync.lhs +++ b/libraries/base/GHC/Conc/Sync.lhs @@ -448,7 +448,11 @@ runSparks = IO loop data BlockReason = BlockedOnMVar - -- ^blocked on on 'MVar' + -- ^blocked on 'MVar' + {- possibly (see 'threadstatus' below): + | BlockedOnMVarRead + -- ^blocked on reading an empty 'MVar' + -} | BlockedOnBlackHole -- ^blocked on a computation in progress by another thread | BlockedOnException @@ -480,15 +484,15 @@ threadStatus (ThreadId t) = IO $ \s -> case threadStatus# t s of (# s', stat, _cap, _locked #) -> (# s', mk_stat (I# stat) #) where - -- NB. keep these in sync with includes/Constants.h + -- NB. keep these in sync with includes/rts/Constants.h mk_stat 0 = ThreadRunning mk_stat 1 = ThreadBlocked BlockedOnMVar - mk_stat 2 = ThreadBlocked BlockedOnMVar -- XXX distinguish? - mk_stat 3 = ThreadBlocked BlockedOnBlackHole - mk_stat 7 = ThreadBlocked BlockedOnSTM + mk_stat 2 = ThreadBlocked BlockedOnBlackHole + mk_stat 6 = ThreadBlocked BlockedOnSTM + mk_stat 10 = ThreadBlocked BlockedOnForeignCall mk_stat 11 = ThreadBlocked BlockedOnForeignCall - mk_stat 12 = ThreadBlocked BlockedOnForeignCall - mk_stat 13 = ThreadBlocked BlockedOnException + mk_stat 12 = ThreadBlocked BlockedOnException + mk_stat 14 = ThreadBlocked BlockedOnMVar -- possibly: BlockedOnMVarRead -- NB. these are hardcoded in rts/PrimOps.cmm mk_stat 16 = ThreadFinished mk_stat 17 = ThreadDied diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 6bb7948..71fa8d0 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -359,6 +359,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/concurrent/should_run/throwto003 /tests/concurrent/should_run/tryReadMVar1 /tests/concurrent/should_run/tryReadMVar2 +/tests/concurrent/should_run/threadstatus-9333 /tests/cpranal/should_run/CPRRepeat /tests/deSugar/should_run/DsLambdaCase /tests/deSugar/should_run/DsMultiWayIf diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 0a66892..017dba1 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -83,12 +83,15 @@ test('tryReadMVar2', normal, compile_and_run, ['']) test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) +# test uses 2 threads and yield, scheduling can vary with threaded2 +test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) + # ----------------------------------------------------------------------------- # These tests we only do for a full run def f( name, opts ): if config.fast: - opts.skip = 1 + opts.skip = 1 setTestOpts(f) diff --git a/testsuite/tests/concurrent/should_run/threadstatus-9333.hs b/testsuite/tests/concurrent/should_run/threadstatus-9333.hs new file mode 100644 index 0000000..73cd6b8 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/threadstatus-9333.hs @@ -0,0 +1,33 @@ +-- test for threadstatus, checking (mvar read, mvar block reasons) +-- created together with fixing GHC ticket #9333 + +module Main where + +import Control.Concurrent +import GHC.Conc +import GHC.Conc.Sync + +main = do + -- create MVars to block on + v1 <- newMVar "full" + v2 <- newEmptyMVar + -- create a thread which fills both MVars + parent <- myThreadId + putStrLn "p: forking child thread" + child <- forkIO $ + do putStrLn "c: filling full MVar" -- should block + putMVar v1 "filled full var" + yield + putStrLn "c: filling empty MVar (expect parent to be blocked)" + stat2 <- threadStatus parent + putStrLn ("c: parent is " ++ show stat2) + putMVar v2 "filled empty var" + yield + putStrLn "p: emptying full MVar (expect child to be blocked on it)" + stat1 <- threadStatus child + putStrLn ("p: child is " ++ show stat1) + s1 <- takeMVar v1 -- should unblock child + putStrLn ("p: from MVar: " ++ s1) + putStrLn "p: reading empty MVar" + s2 <- readMVar v2 -- should block + putStrLn ("p: from MVar: " ++ s2) diff --git a/testsuite/tests/concurrent/should_run/threadstatus-9333.stdout b/testsuite/tests/concurrent/should_run/threadstatus-9333.stdout new file mode 100644 index 0000000..7b4f788 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/threadstatus-9333.stdout @@ -0,0 +1,9 @@ +p: forking child thread +c: filling full MVar +p: emptying full MVar (expect child to be blocked on it) +p: child is ThreadBlocked BlockedOnMVar +p: from MVar: full +p: reading empty MVar +c: filling empty MVar (expect parent to be blocked) +c: parent is ThreadBlocked BlockedOnMVar +p: from MVar: filled empty var From git at git.haskell.org Mon Jul 28 14:38:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:38:16 +0000 (UTC) Subject: [commit: ghc] master: Avoid to pass a socket to setmode/isatty in Windows (b9be82d) Message-ID: <20140728143816.618202406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b9be82d438d5b3926dbe30c8296ca8c36e8eff52/ghc >--------------------------------------------------------------- commit b9be82d438d5b3926dbe30c8296ca8c36e8eff52 Author: Isamu Mogi Date: Mon Jul 28 07:49:55 2014 -0500 Avoid to pass a socket to setmode/isatty in Windows Summary: In Windows, a socket is not a file descriptor. So passing it to setmode/isatty causes an error that returns EABF and triggers invalid parameter handler. Test Plan: 1. Add WinDbg as a postmortem debugger (C:\>windbg -I) 2. Pass a socket to GHC.IO.Device.IODevice.isTerminal / GHC.IO.FD.fdToHandle' (Executing 'cabal update' calls each functions with the socket in cabal-install 1.20.0.1) 3. WinDbg pops up and outputs error message: "Invalid parameter passed to C runtime function." 4. Apply the patch 5. Redo step 2 6. WinDbg doesn't pop up Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D92 >--------------------------------------------------------------- b9be82d438d5b3926dbe30c8296ca8c36e8eff52 libraries/base/GHC/IO/FD.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 7b30504..1134e95 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -261,7 +261,7 @@ mkFD fd iomode mb_stat is_socket is_nonblock = do _other_type -> return () #ifdef mingw32_HOST_OS - _ <- setmode fd True -- unconditionally set binary mode + unless is_socket $ setmode fd True >> return () #endif return (FD{ fdFD = fd, @@ -414,7 +414,8 @@ foreign import ccall safe "fdReady" isTerminal :: FD -> IO Bool isTerminal fd = #if defined(mingw32_HOST_OS) - is_console (fdFD fd) >>= return.toBool + if fdIsSocket fd then return False + else is_console (fdFD fd) >>= return.toBool #else c_isatty (fdFD fd) >>= return.toBool #endif From git at git.haskell.org Mon Jul 28 14:38:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:38:19 +0000 (UTC) Subject: [commit: ghc] master: base: make System.IO.openTempFile generate less predictable names (f510c7c) Message-ID: <20140728143819.71BA52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f510c7cac5b2e9afe0ebde2766a671c59137f3cc/ghc >--------------------------------------------------------------- commit f510c7cac5b2e9afe0ebde2766a671c59137f3cc Author: Sergei Trofimovich Date: Mon Jul 28 07:59:36 2014 -0500 base: make System.IO.openTempFile generate less predictable names It basically changes prefix ++ getpid() ++ seq_no ++ suffix for prefix ++ rand() ++ rand() ++ suffix Which make any call to 'openTempFile' finish without loops. Bug-report: https://ghc.haskell.org/trac/ghc/ticket/9058 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp >--------------------------------------------------------------- f510c7cac5b2e9afe0ebde2766a671c59137f3cc libraries/base/System/IO.hs | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index 004ff54..60514e1 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -464,9 +464,7 @@ openBinaryTempFileWithDefaultPermissions tmp_dir template openTempFile' :: String -> FilePath -> String -> Bool -> CMode -> IO (FilePath, Handle) -openTempFile' loc tmp_dir template binary mode = do - pid <- c_getpid - findTempName pid +openTempFile' loc tmp_dir template binary mode = findTempName where -- We split off the last extension, so we can use .foo.ext files -- for temporary files (hidden on Unix OSes). Unfortunately we're @@ -485,10 +483,13 @@ openTempFile' loc tmp_dir template binary mode = do -- beginning with '.' as the second component. _ -> error "bug in System.IO.openTempFile" - findTempName x = do + findTempName = do + rs <- rand_string + let filename = prefix ++ rs ++ suffix + filepath = tmp_dir `combine` filename r <- openNewFile filepath binary mode case r of - FileExists -> findTempName (x + 1) + FileExists -> findTempName OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) NewFileCreated fd -> do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-} @@ -501,9 +502,6 @@ openTempFile' loc tmp_dir template binary mode = do return (filepath, h) where - filename = prefix ++ show x ++ suffix - filepath = tmp_dir `combine` filename - -- XXX bits copied from System.FilePath, since that's not available here combine a b | null b = a @@ -511,6 +509,16 @@ openTempFile' loc tmp_dir template binary mode = do | last a == pathSeparator = a ++ b | otherwise = a ++ [pathSeparator] ++ b +-- int rand(void) from , limited by RAND_MAX (small value, 32768) +foreign import ccall "rand" c_rand :: IO CInt + +-- build large digit-alike number +rand_string :: IO String +rand_string = do + r1 <- c_rand + r2 <- c_rand + return $ show r1 ++ show r2 + data OpenNewFileResult = NewFileCreated CInt | FileExists From git at git.haskell.org Mon Jul 28 14:38:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:38:24 +0000 (UTC) Subject: [commit: ghc] master: Fix validate fallout (b1f4356) Message-ID: <20140728143824.421FA2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1f43562dfd4be70377b360c0c377d81345ada2b/ghc >--------------------------------------------------------------- commit b1f43562dfd4be70377b360c0c377d81345ada2b Author: Austin Seipp Date: Mon Jul 28 09:29:08 2014 -0500 Fix validate fallout Signed-off-by: Austin Seipp >--------------------------------------------------------------- b1f43562dfd4be70377b360c0c377d81345ada2b libraries/base/System/IO.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index 60514e1..5cd0351 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -241,7 +241,6 @@ import GHC.IO.Handle import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn ) import GHC.IO.Exception ( userError ) import GHC.IO.Encoding -import GHC.Num import Text.Read import GHC.Show import GHC.MVar From git at git.haskell.org Mon Jul 28 14:38:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 14:38:29 +0000 (UTC) Subject: [commit: ghc] master: rts: Detab OSThreads.c (c1336f7) Message-ID: <20140728143829.1BF652406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1336f71dbd80b66643e65fc7d5df0cc8fe9942b/ghc >--------------------------------------------------------------- commit c1336f71dbd80b66643e65fc7d5df0cc8fe9942b Author: Austin Seipp Date: Mon Jul 28 09:34:02 2014 -0500 rts: Detab OSThreads.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- c1336f71dbd80b66643e65fc7d5df0cc8fe9942b rts/win32/OSThreads.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/win32/OSThreads.c b/rts/win32/OSThreads.c index d246628..9f434d6 100644 --- a/rts/win32/OSThreads.c +++ b/rts/win32/OSThreads.c @@ -292,7 +292,7 @@ interruptOSThread (OSThreadId id) stg_exit(EXIT_FAILURE); } pCSIO = (PCSIO) GetProcAddress(GetModuleHandle(TEXT("Kernel32.dll")), - "CancelSynchronousIo"); + "CancelSynchronousIo"); if ( NULL != pCSIO ) { pCSIO(hdl); } else { From git at git.haskell.org Mon Jul 28 15:13:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Jul 2014 15:13:59 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add test case for explicitly-bidirectional pattern synonym (67d6e49) Message-ID: <20140728151359.182AE2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/67d6e496c39f2f341632e09b7135509492b106a7/ghc >--------------------------------------------------------------- commit 67d6e496c39f2f341632e09b7135509492b106a7 Author: Dr. ERDI Gergo Date: Mon Jul 28 17:10:22 2014 +0200 Add test case for explicitly-bidirectional pattern synonym >--------------------------------------------------------------- 67d6e496c39f2f341632e09b7135509492b106a7 testsuite/.gitignore | 1 + testsuite/tests/patsyn/should_run/all.T | 1 + testsuite/tests/patsyn/should_run/bidir-explicit.hs | 16 ++++++++++++++++ .../should_run/bidir-explicit.stdout} | 2 ++ 4 files changed, 20 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 376318d..ae004e9 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1058,6 +1058,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/parser/unicode/1744 /tests/parser/unicode/T1744 /tests/parser/unicode/utf8_024 +/tests/patsyn/should_run/bidir-explicit /tests/patsyn/should_run/eval /tests/patsyn/should_run/ex-prov /tests/patsyn/should_run/ex-prov-run diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T index f5936c6..f551da5 100644 --- a/testsuite/tests/patsyn/should_run/all.T +++ b/testsuite/tests/patsyn/should_run/all.T @@ -1,3 +1,4 @@ test('eval', normal, compile_and_run, ['']) test('match', normal, compile_and_run, ['']) test('ex-prov-run', normal, compile_and_run, ['']) +test('bidir-explicit', normal, compile_and_run, ['']) diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.hs b/testsuite/tests/patsyn/should_run/bidir-explicit.hs new file mode 100644 index 0000000..2cade57 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +module Main where + +pattern First x <- x:_ where + First x = [x] + +pattern First' x <- x:_ where + First' x = foo [x, x, x] + +foo :: [a] -> [a] +foo xs@(First' x) = replicate (length xs + 1) x + +main = do + mapM_ print $ First () + putStrLn "" + mapM_ print $ First' () diff --git a/testsuite/tests/deriving/should_run/T3087.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout similarity index 75% copy from testsuite/tests/deriving/should_run/T3087.stdout copy to testsuite/tests/patsyn/should_run/bidir-explicit.stdout index 35735b4..4625e61 100644 --- a/testsuite/tests/deriving/should_run/T3087.stdout +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout @@ -1,4 +1,6 @@ () + +() () () () From git at git.haskell.org Tue Jul 29 07:51:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 07:51:05 +0000 (UTC) Subject: [commit: ghc] master: getCoerbileInsts: Move the two NT-unwrapping instances together (b6d5229) Message-ID: <20140729075106.064F92406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6d52294cd009ef620ad9d74ab88e0822e685919/ghc >--------------------------------------------------------------- commit b6d52294cd009ef620ad9d74ab88e0822e685919 Author: Joachim Breitner Date: Tue Jul 29 09:49:34 2014 +0200 getCoerbileInsts: Move the two NT-unwrapping instances together and fix the numbering in the comments. Thank to SPJ for noticing. Nothing deep in here, just a insufficent copy?n?pasting in revision 7e78faf0. Incidentially, 7e78faf0 did a better job updating the comments than the code :-). >--------------------------------------------------------------- b6d52294cd009ef620ad9d74ab88e0822e685919 compiler/typecheck/TcInteract.lhs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 42e0465..2590d35 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -1948,7 +1948,7 @@ getCoercibleInst loc ty1 ty2 = do ev_term <- deferTcSForAllEq Representational loc (tvs1,body1) (tvs2,body2) return $ GenInst [] ev_term - -- Coercible NT a (see case 4 in [Coercible Instances]) + -- Coercible NT a (see case 3 in [Coercible Instances]) | Just (tc,tyArgs) <- splitTyConApp_maybe ty1, Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs, dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon @@ -1960,7 +1960,19 @@ getCoercibleInst loc ty1 ty2 = do coercionToTcCoercion ntCo `mkTcTransCo` mkTcCoVarCo local_var return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo) - -- Coercible (D ty1 ty2) (D ty1' ty2') (see case 2 in [Coercible Instances]) + -- Coercible a NT (see case 3 in [Coercible Instances]) + | Just (tc,tyArgs) <- splitTyConApp_maybe ty2, + Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs, + dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon + = do markDataConsAsUsed rdr_env tc + ct_ev <- requestCoercible loc ty1 concTy + local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred ty1 concTy + let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev))) + tcCo = TcLetCo binds $ + mkTcCoVarCo local_var `mkTcTransCo` mkTcSymCo (coercionToTcCoercion ntCo) + return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo) + + -- Coercible (D ty1 ty2) (D ty1' ty2') (see case 4 in [Coercible Instances]) | Just (tc1,tyArgs1) <- splitTyConApp_maybe ty1, Just (tc2,tyArgs2) <- splitTyConApp_maybe ty2, tc1 == tc2, @@ -1991,18 +2003,6 @@ getCoercibleInst loc ty1 ty2 = do tcCo = TcLetCo binds (mkTcTyConAppCo Representational tc1 arg_cos) return $ GenInst (catMaybes arg_new) (EvCoercion tcCo) - -- Coercible a NT (see case 3 in [Coercible Instances]) - | Just (tc,tyArgs) <- splitTyConApp_maybe ty2, - Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs, - dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon - = do markDataConsAsUsed rdr_env tc - ct_ev <- requestCoercible loc ty1 concTy - local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred ty1 concTy - let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev))) - tcCo = TcLetCo binds $ - mkTcCoVarCo local_var `mkTcTransCo` mkTcSymCo (coercionToTcCoercion ntCo) - return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo) - -- Cannot solve this one | otherwise = return NoInstance From git at git.haskell.org Tue Jul 29 09:18:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 09:18:18 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add test cases for explicitly-bidirectional pattern synonym (4b5cdba) Message-ID: <20140729091818.9BA332406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/4b5cdba6e7a065a64fd10a3c8f0aaacd5d0f0188/ghc >--------------------------------------------------------------- commit 4b5cdba6e7a065a64fd10a3c8f0aaacd5d0f0188 Author: Dr. ERDI Gergo Date: Tue Jul 29 08:25:40 2014 +0200 Add test cases for explicitly-bidirectional pattern synonym >--------------------------------------------------------------- 4b5cdba6e7a065a64fd10a3c8f0aaacd5d0f0188 testsuite/.gitignore | 2 ++ testsuite/tests/patsyn/should_run/all.T | 2 ++ testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs | 10 ++++++++++ .../should_run/bidir-explicit-scope.stdout} | 0 testsuite/tests/patsyn/should_run/bidir-explicit.hs | 7 +++++++ .../T3207.stdout => patsyn/should_run/bidir-explicit.stdout} | 0 6 files changed, 21 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 376318d..7b4395e 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1058,6 +1058,8 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/parser/unicode/1744 /tests/parser/unicode/T1744 /tests/parser/unicode/utf8_024 +/tests/patsyn/should_run/bidir-explicit +/tests/patsyn/should_run/bidir-explicit-scope /tests/patsyn/should_run/eval /tests/patsyn/should_run/ex-prov /tests/patsyn/should_run/ex-prov-run diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T index f5936c6..b3c6b74 100644 --- a/testsuite/tests/patsyn/should_run/all.T +++ b/testsuite/tests/patsyn/should_run/all.T @@ -1,3 +1,5 @@ test('eval', normal, compile_and_run, ['']) test('match', normal, compile_and_run, ['']) test('ex-prov-run', normal, compile_and_run, ['']) +test('bidir-explicit', normal, compile_and_run, ['']) +test('bidir-explicit-scope', normal, compile_and_run, ['']) diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs new file mode 100644 index 0000000..390bbb0 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PatternSynonyms #-} +module Main where + +pattern First x <- x:_ where + First x = foo [x, x, x] + +foo :: [a] -> [a] +foo xs@(First x) = replicate (length xs + 1) x + +main = mapM_ print $ First () diff --git a/testsuite/tests/deriving/should_run/T3087.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout similarity index 100% copy from testsuite/tests/deriving/should_run/T3087.stdout copy to testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.hs b/testsuite/tests/patsyn/should_run/bidir-explicit.hs new file mode 100644 index 0000000..d295191 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +module Main where + +pattern First x <- x:_ where + First x = [x] + +main = mapM_ print $ First () diff --git a/testsuite/tests/codeGen/should_run/T3207.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout similarity index 100% copy from testsuite/tests/codeGen/should_run/T3207.stdout copy to testsuite/tests/patsyn/should_run/bidir-explicit.stdout From git at git.haskell.org Tue Jul 29 09:18:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 09:18:20 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Refactor PatSynBind so that we can pass around PSBs instead of several arguments (6fc547d) Message-ID: <20140729091820.EE3A52406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/6fc547d6fb0283ffa50fc90fa972d87755853c09/ghc >--------------------------------------------------------------- commit 6fc547d6fb0283ffa50fc90fa972d87755853c09 Author: Dr. ERDI Gergo Date: Tue Jul 29 11:16:45 2014 +0200 Refactor PatSynBind so that we can pass around PSBs instead of several arguments >--------------------------------------------------------------- 6fc547d6fb0283ffa50fc90fa972d87755853c09 compiler/hsSyn/HsBinds.lhs | 51 ++++++++++++++++---------------- compiler/hsSyn/HsUtils.lhs | 14 +++++---- compiler/rename/RnBinds.lhs | 31 ++++++++++++-------- compiler/typecheck/TcBinds.lhs | 33 +++++++++------------ compiler/typecheck/TcHsSyn.lhs | 17 +++++------ compiler/typecheck/TcPatSyn.lhs | 56 +++++++++++++++++++----------------- compiler/typecheck/TcPatSyn.lhs-boot | 11 ++----- 7 files changed, 109 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 6fc547d6fb0283ffa50fc90fa972d87755853c09 From git at git.haskell.org Tue Jul 29 09:28:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 09:28:41 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Refactor PatSynBind so that we can pass around PSBs instead of several arguments (4e1629a) Message-ID: <20140729092841.C7CA02406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/4e1629adc0725cac208ca2eaa377e322415fa873/ghc >--------------------------------------------------------------- commit 4e1629adc0725cac208ca2eaa377e322415fa873 Author: Dr. ERDI Gergo Date: Tue Jul 29 11:27:26 2014 +0200 Refactor PatSynBind so that we can pass around PSBs instead of several arguments >--------------------------------------------------------------- 4e1629adc0725cac208ca2eaa377e322415fa873 compiler/hsSyn/HsBinds.lhs | 51 ++++++++++++++++---------------- compiler/hsSyn/HsUtils.lhs | 14 +++++---- compiler/rename/RnBinds.lhs | 54 ++++++++++++++++++++-------------- compiler/typecheck/TcBinds.lhs | 33 +++++++++------------ compiler/typecheck/TcHsSyn.lhs | 17 +++++------ compiler/typecheck/TcPatSyn.lhs | 56 +++++++++++++++++++----------------- compiler/typecheck/TcPatSyn.lhs-boot | 11 ++----- 7 files changed, 122 insertions(+), 114 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4e1629adc0725cac208ca2eaa377e322415fa873 From git at git.haskell.org Tue Jul 29 09:28:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 09:28:45 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add note about renaming of pattern synonym wrappers (a9c7f64) Message-ID: <20140729092845.54C2A2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/a9c7f64de332584105fa427f53e15faf6f8a4015/ghc >--------------------------------------------------------------- commit a9c7f64de332584105fa427f53e15faf6f8a4015 Author: Dr. ERDI Gergo Date: Tue Jul 29 11:28:33 2014 +0200 Add note about renaming of pattern synonym wrappers >--------------------------------------------------------------- a9c7f64de332584105fa427f53e15faf6f8a4015 compiler/rename/RnBinds.lhs | 27 +++++++++++++++++++++++++++ compiler/typecheck/TcBinds.lhs | 1 + 2 files changed, 28 insertions(+) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 4efd847..0f9f44a 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -582,6 +582,7 @@ rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name ; fvs' `seq` -- See Note [Free-variable space leak] return (bind', [name], fvs1) + -- See Note [Pattern synonym wrappers don't yield dependencies] } where lookupVar = wrapLocM lookupOccRn @@ -592,6 +593,32 @@ rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name 2 (ptext (sLit "Use -XPatternSynonyms to enable this extension")) {- +Note [Pattern synonym wrappers don't yield dependencies] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When renaming a pattern synonym that has an explicit wrapper, +references in the wrapper definition should not be used when +calculating dependencies. For example, consider the following pattern +synonym definition: + +pattern P x <- C1 x where + P x = f (C1 x) + +f (P x) = C2 x + +In this case, 'P' needs to be typechecked in two passes: + +1. Typecheck the pattern definition of 'P', which fully determines the +type of 'P'. This step doesn't require knowing anything about 'f', +since the wrapper definition is not looked at. + +2. Typecheck the wrapper definition, which needs the typechecked +definition of 'f' to be in scope. + +This behaviour is implemented in 'tcValBinds', but it crucially +depends on 'P' not being put in a recursive group with 'f' (which +would make it look like a recursive pattern synonym a la 'pattern P = +P' which is unsound and rejected). -} diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 8fb97b6..936502e 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -318,6 +318,7 @@ tcValBinds top_lvl binds sigs thing_inside ; tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ do { (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do { thing <- thing_inside + -- See Note [Pattern synonym wrappers don't yield dependencies] ; patsyn_wrappers <- mapM tc_patsyn_wrapper patsyns ; let extra_binds = [ (NonRecursive, wrapper) | wrapper <- patsyn_wrappers ] ; return (extra_binds, thing) } From git at git.haskell.org Tue Jul 29 09:34:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 09:34:06 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add user documentation for explicitly-bidirectional pattern synonyms (9b39096) Message-ID: <20140729093406.F1A9D2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/9b390965c432faf0cc9aba3a14e1be3bee37e73b/ghc >--------------------------------------------------------------- commit 9b390965c432faf0cc9aba3a14e1be3bee37e73b Author: Dr. ERDI Gergo Date: Tue Jul 29 11:33:57 2014 +0200 Add user documentation for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- 9b390965c432faf0cc9aba3a14e1be3bee37e73b docs/users_guide/glasgow_exts.xml | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index f1d7b94..123ab53 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -987,9 +987,15 @@ Which enables us to rewrite our functions in a much cleaner style: In this case, Head x cannot be used in expressions, only patterns, since it wouldn't specify a value for the xs on the -right-hand side. +right-hand side. We can give an explicit inversion of a pattern +synonym using the following syntax: + + pattern Head x <- x:xs where + Head x = [x] + + The syntax and semantics of pattern synonyms are elaborated in the following subsections. @@ -1008,6 +1014,10 @@ bidirectional. The syntax for unidirectional pattern synonyms is: and the syntax for bidirectional pattern synonyms is: pattern Name args = pat + or + + pattern Name args <- pat where + Name args = expr Either prefix or infix syntax can be used. @@ -1020,11 +1030,12 @@ bidirectional. The syntax for unidirectional pattern synonyms is: The variables in the left-hand side of the definition are bound by - the pattern on the right-hand side. For bidirectional pattern - synonyms, all the variables of the right-hand side must also occur - on the left-hand side; also, wildcard patterns and view patterns are - not allowed. For unidirectional pattern synonyms, there is no - restriction on the right-hand side pattern. + the pattern on the right-hand side. For implicitly bidirectional + pattern synonyms, all the variables of the right-hand side must also + occur on the left-hand side; also, wildcard patterns and view + patterns are not allowed. For unidirectional and + explicitly-bidirectional pattern synonyms, there is no restriction + on the right-hand side pattern. From git at git.haskell.org Tue Jul 29 12:15:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 12:15:14 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' created Message-ID: <20140729121514.E6D462406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/travis Referencing: 03e12f4ba34b3c7865d6bd0752dcf7a92e765e32 From git at git.haskell.org Tue Jul 29 12:15:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 12:15:17 +0000 (UTC) Subject: [commit: ghc] wip/travis: Add new validate flag: --fastest (03e12f4) Message-ID: <20140729121517.4FD1C2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/03e12f4ba34b3c7865d6bd0752dcf7a92e765e32/ghc >--------------------------------------------------------------- commit 03e12f4ba34b3c7865d6bd0752dcf7a92e765e32 Author: Joachim Breitner Date: Tue Jul 29 14:14:17 2014 +0200 Add new validate flag: --fastest This tries to further reduce the time and space it takes to build GHC. The main use for that would be building on travis, but other users might also exist. >--------------------------------------------------------------- 03e12f4ba34b3c7865d6bd0752dcf7a92e765e32 .travis.yml | 8 +------- mk/validate-settings.mk | 20 +++++++++++++++++--- validate | 18 +++++++++++++++--- 3 files changed, 33 insertions(+), 13 deletions(-) diff --git a/.travis.yml b/.travis.yml index 57153b6..22fe266 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,13 +24,7 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. - # do not build docs - - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk - - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/validate.mk - - echo 'BUILD_DOCBOOK_PS = NO' >> mk/validate.mk - - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/validate.mk # do not build dynamic libraries - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=2 PATH=~/.cabal/bin:$PATH ./validate --fastest --no-dph diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index cac938d..5366a0e 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -5,7 +5,11 @@ WERROR = -Werror SRC_CC_WARNING_OPTS = SRC_HC_WARNING_OPTS = +ifneq "$(ValidateSpeed)" "FASTEST" +HADDOCK_DOCS = NO +else HADDOCK_DOCS = YES +endif ##################### # Warnings @@ -39,12 +43,17 @@ utils/hpc_dist-install_EXTRA_HC_OPTS += -fwarn-tabs SRC_HC_OPTS += -H64m -O0 GhcStage1HcOpts += -O -GhcStage2HcOpts += -O -dcore-lint +GhcStage2HcOpts += -O # Using -O (rather than -O0) here bringes my validate down from 22mins to 16 mins. # Compiling stage2 takes longer, but we gain a faster haddock, faster # running of the tests, and faster building of the utils to be installed -GhcLibHcOpts += -O -dcore-lint +GhcLibHcOpts += -O + +ifneq "$(ValidateSpeed)" "FASTEST" +GhcStage2HcOpts += -dcore-lint +GhcLibHcOpts += -dcore-lint +endif # We define DefaultFastGhcLibWays in this style so that the value is # correct even if the user alters DYNAMIC_GHC_PROGRAMS. @@ -53,7 +62,7 @@ GhcLibHcOpts += -O -dcore-lint DefaultFastGhcLibWays = $(if $(filter $(DYNAMIC_GHC_PROGRAMS),YES),v dyn,v) DefaultProfGhcLibWays = $(if $(filter $(GhcProfiled),YES),p,) -ifeq "$(ValidateSpeed)" "FAST" +ifneq (,$(filter $(ValidateSpeed),FAST FASTEST)) GhcLibWays = $(DefaultFastGhcLibWays) else GhcLibWays := $(filter v dyn,$(GhcLibWays)) @@ -74,6 +83,11 @@ InstallExtraPackages = YES # validating. BUILD_DOCBOOK_PS = NO BUILD_DOCBOOK_PDF = NO +ifneq "$(ValidateSpeed)" "FASTEST" +BUILD_DOCBOOK_HTML = NO +else +BUILD_DOCBOOK_HTML = YES +endif ifeq "$(ValidateHpc)" "YES" GhcStage2HcOpts += -fhpc -hpcdir $(TOP)/testsuite/hpc_output/ diff --git a/validate b/validate index cabb86c..29294bd 100755 --- a/validate +++ b/validate @@ -20,6 +20,8 @@ Flags: HTML generated here: testsuite/hpc_output/hpc_index.html --normal Default settings --fast Omit dyn way, omit binary distribution + --fastest like --fast, but do not lint, do not run performance tests, + do not build documentation --slow Build stage2 with -DDEBUG. 2008-07-01: 14% slower than the default. --no-dph: Skip building libraries/dph and running associated tests. @@ -57,6 +59,9 @@ do --slow) speed=SLOW ;; + --fastest) + speed=FASTEST + ;; --fast) speed=FAST ;; @@ -148,9 +153,9 @@ $make -j$threads check_packages post-build # ----------------------------------------------------------------------------- -# Build and test a binary distribution (not --fast) +# Build and test a binary distribution (not --fast or --fastest) -if [ $speed != "FAST" ]; then +if [ $speed != "FAST" -a $speed != "FASTEST" ]; then $make binary-dist-prep $make test_bindist TEST_PREP=YES @@ -184,6 +189,8 @@ then rm -f $HPCTIXFILE fi +SKIP_PERF_TESTS=NO + case "$speed" in SLOW) MAKE_TEST_TARGET=fulltest @@ -197,9 +204,14 @@ FAST) MAKE_TEST_TARGET=test BINDIST="BINDIST=NO" ;; +FASTEST) + MAKE_TEST_TARGET=test + BINDIST="BINDIST=NO" + SKIP_PERF_TESTS=YES + ;; esac -$make $MAKE_TEST_TARGET stage=2 $BINDIST THREADS=$threads 2>&1 | tee testlog +$make $MAKE_TEST_TARGET stage=2 $BINDIST SKIP_PERF_TESTS=$SKIP_PERF_TESTS THREADS=$threads 2>&1 | tee testlog check_packages post-testsuite From git at git.haskell.org Tue Jul 29 14:24:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:12 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Typechecker support for explicitly-bidirectional pattern synonyms (0279a7d) Message-ID: <20140729142412.E4C1D240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/0279a7d327a3b962ffa93a95d47ea5d9ee31e25c/ghc >--------------------------------------------------------------- commit 0279a7d327a3b962ffa93a95d47ea5d9ee31e25c Author: Dr. ERDI Gergo Date: Sun Jul 6 23:49:43 2014 +0800 Typechecker support for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- 0279a7d327a3b962ffa93a95d47ea5d9ee31e25c compiler/typecheck/TcPatSyn.lhs | 39 +++++++++++++++++++++++---------------- 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index 82fa999..d72acba 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -205,16 +205,27 @@ tcPatSynWrapper lname lpat dir args univ_tvs ex_tvs theta pat_ty (ImplicitBidirectional, Nothing) -> cannotInvertPatSynErr lpat (ImplicitBidirectional, Just lexpr) -> - fmap Just $ tc_pat_syn_wrapper_from_expr lname lexpr args univ_tvs ex_tvs theta pat_ty } - -tc_pat_syn_wrapper_from_expr :: Located Name - -> LHsExpr Name - -> [Var] - -> [TyVar] -> [TyVar] - -> ThetaType - -> Type - -> TcM (Id, LHsBinds Id) -tc_pat_syn_wrapper_from_expr (L loc name) lexpr args univ_tvs ex_tvs theta pat_ty + fmap Just $ mkWrapper $ \wrapper_lname args' -> + do { let wrapper_args = map (noLoc . VarPat . Var.varName) args' + wrapper_match = mkMatch wrapper_args lexpr EmptyLocalBinds + bind = mkTopFunBind Generated wrapper_lname [wrapper_match] + ; return bind } + (ExplicitBidirectional mg, _) -> + fmap Just $ mkWrapper $ \wrapper_lname _args' -> + return FunBind{ fun_id = wrapper_lname + , fun_infix = False + , fun_matches = mg + , fun_co_fn = idHsWrapper + , bind_fvs = placeHolderNames + , fun_tick = Nothing } } + where + mkWrapper = mkPatSynWrapper lname args univ_tvs ex_tvs theta pat_ty + +mkPatSynWrapper :: Located Name + -> [Var] -> [TyVar] -> [TyVar] -> ThetaType -> Type + -> (Located Name -> [Var] -> TcM (HsBind Name)) + -> TcM (Id, LHsBinds Id) +mkPatSynWrapper (L loc name) args univ_tvs ex_tvs theta pat_ty mk_bind = do { let qtvs = univ_tvs ++ ex_tvs ; (subst, wrapper_tvs) <- tcInstSkolTyVars qtvs ; let wrapper_theta = substTheta subst theta @@ -227,21 +238,17 @@ tc_pat_syn_wrapper_from_expr (L loc name) lexpr args univ_tvs ex_tvs theta pat_t ; let wrapper_lname = L loc wrapper_name wrapper_id = mkExportedLocalId VanillaId wrapper_name wrapper_sigma - ; let wrapper_args = map (noLoc . VarPat . Var.varName) args' - wrapper_match = mkMatch wrapper_args lexpr EmptyLocalBinds - bind = mkTopFunBind Generated wrapper_lname [wrapper_match] - lbind = noLoc bind + ; bind <- mk_bind wrapper_lname args' ; let sig = TcSigInfo{ sig_id = wrapper_id , sig_tvs = map (\tv -> (Nothing, tv)) wrapper_tvs , sig_theta = wrapper_theta , sig_tau = wrapper_tau , sig_loc = loc } - ; (wrapper_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig lbind + ; (wrapper_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (noLoc bind) ; traceTc "tcPatSynDecl wrapper" $ ppr wrapper_binds ; traceTc "tcPatSynDecl wrapper type" $ ppr (varType wrapper_id) ; return (wrapper_id, wrapper_binds) } - \end{code} Note [As-patterns in pattern synonym definitions] From git at git.haskell.org Tue Jul 29 14:24:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:15 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Typecheck the wrapper definition of a pattern synonym, after everything in the same scope is typechecked (6a78503) Message-ID: <20140729142415.86D7B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/6a78503e4a55d1ad50f2dd1b6116c883d3013ad5/ghc >--------------------------------------------------------------- commit 6a78503e4a55d1ad50f2dd1b6116c883d3013ad5 Author: Dr. ERDI Gergo Date: Sun Jul 27 18:46:50 2014 +0200 Typecheck the wrapper definition of a pattern synonym, after everything in the same scope is typechecked >--------------------------------------------------------------- 6a78503e4a55d1ad50f2dd1b6116c883d3013ad5 compiler/typecheck/TcBinds.lhs | 26 +++++++-- compiler/typecheck/TcPatSyn.lhs | 109 ++++++++++++++++++----------------- compiler/typecheck/TcPatSyn.lhs-boot | 6 ++ 3 files changed, 82 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 6a78503e4a55d1ad50f2dd1b6116c883d3013ad5 From git at git.haskell.org Tue Jul 29 14:24:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:17 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add renamer support for explicitly-bidirectional pattern synonyms (d84a5cc) Message-ID: <20140729142418.08B84240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/d84a5cc930ee99c3b4d89594162234304a57e2f5/ghc >--------------------------------------------------------------- commit d84a5cc930ee99c3b4d89594162234304a57e2f5 Author: Dr. ERDI Gergo Date: Mon Jul 7 19:25:29 2014 +0800 Add renamer support for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- d84a5cc930ee99c3b4d89594162234304a57e2f5 compiler/rename/RnBinds.lhs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index e65d317..b8887b0 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -523,7 +523,7 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name = do { pattern_synonym_ok <- xoptM Opt_PatternSynonyms ; unless pattern_synonym_ok (addErr patternSynonymErr) - ; ((pat', details'), fvs) <- rnPat PatSyn pat $ \pat' -> do + ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported -- from the left-hand side @@ -539,12 +539,16 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name -- ; checkPrecMatch -- TODO ; return (InfixPatSyn name1 name2, mkFVs (map unLoc [name1, name2])) } ; return ((pat', details'), fvs) } - ; dir' <- case dir of - Unidirectional -> return Unidirectional - ImplicitBidirectional -> return ImplicitBidirectional + ; (dir', fvs2) <- case dir of + Unidirectional -> return (Unidirectional, emptyFVs) + ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) + ExplicitBidirectional mg -> + do { (mg', fvs) <- rnMatchGroup PatSyn rnLExpr mg + ; return (ExplicitBidirectional mg', fvs) } ; mod <- getModule - ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs + ; let fvs = fvs1 `plusFV` fvs2 + fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs -- Keep locally-defined Names -- As well as dependency analysis, we need these for the -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan From git at git.haskell.org Tue Jul 29 14:24:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:20 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: New parser for pattern synonym declarations: (12644c3) Message-ID: <20140729142420.88A87240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/12644c3c0216edfcff33266f4f250e0c52004352/ghc >--------------------------------------------------------------- commit 12644c3c0216edfcff33266f4f250e0c52004352 Author: Dr. ERDI Gergo Date: Sun Jul 6 17:33:00 2014 +0800 New parser for pattern synonym declarations: Like splitCon for constructor definitions, the left-hand side of a pattern declaration is parsed as a single pattern which is then split into a ConName and argument variable names >--------------------------------------------------------------- 12644c3c0216edfcff33266f4f250e0c52004352 compiler/parser/Parser.y.pp | 14 ++++++++------ compiler/parser/RdrHsSyn.lhs | 21 ++++++++++++++++++++- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 3fff097..9321e03 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -848,17 +848,19 @@ role : VARID { L1 $ Just $ getVARID $1 } -- Glasgow extension: pattern synonyms pattern_synonym_decl :: { LHsDecl RdrName } - : 'pattern' con vars0 patsyn_token pat { LL . ValD $ mkPatSynBind $2 (PrefixPatSyn $3) $5 $4 } - | 'pattern' varid conop varid patsyn_token pat { LL . ValD $ mkPatSynBind $3 (InfixPatSyn $2 $4) $6 $5 } + : 'pattern' pat '=' pat + {% do { (name, args) <- splitPatSyn $2 + ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional + }} + | 'pattern' pat '<-' pat + {% do { (name, args) <- splitPatSyn $2 + ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional + }} vars0 :: { [Located RdrName] } : {- empty -} { [] } | varid vars0 { $1 : $2 } -patsyn_token :: { HsPatSynDir RdrName } - : '<-' { Unidirectional } - | '=' { ImplicitBidirectional } - ----------------------------------------------------------------------------- -- Nested declarations diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 93a98d0..ed29fe0 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -16,7 +16,7 @@ module RdrHsSyn ( mkTySynonym, mkTyFamInstEqn, mkTyFamInst, mkFamDecl, - splitCon, mkInlinePragma, + splitCon, splitPatSyn, mkInlinePragma, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -428,6 +428,25 @@ splitCon ty mk_rest [L _ (HsRecTy flds)] = RecCon flds mk_rest ts = PrefixCon ts +splitPatSyn :: LPat RdrName + -> P (Located RdrName, HsPatSynDetails (Located RdrName)) +splitPatSyn (L _ (ParPat pat)) = splitPatSyn pat +splitPatSyn pat@(L loc (ConPatIn con details)) = do + details' <- case details of + PrefixCon pats -> liftM PrefixPatSyn (mapM patVar pats) + InfixCon pat1 pat2 -> liftM2 InfixPatSyn (patVar pat1) (patVar pat2) + RecCon{} -> parseErrorSDoc loc $ + text "record syntax not supported for pattern synonym declarations:" $$ ppr pat + return (con, details') + where + patVar :: LPat RdrName -> P (Located RdrName) + patVar (L loc (VarPat v)) = return $ L loc v + patVar (L _ (ParPat pat)) = patVar pat + patVar pat@(L loc _) = parseErrorSDoc loc $ + text "Pattern synonym arguments must be variable names:" $$ ppr pat +splitPatSyn pat@(L loc _) = parseErrorSDoc loc $ + text "invalid pattern synonym declaration:" $$ ppr pat + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] From git at git.haskell.org Tue Jul 29 14:24:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:22 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: tcLookupPatSyn: look up the PatSyn record for a given Id (25c2eeb) Message-ID: <20140729142423.02521240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/25c2eebc4ad0c1dc4f4c371f39bd5336546ec094/ghc >--------------------------------------------------------------- commit 25c2eebc4ad0c1dc4f4c371f39bd5336546ec094 Author: Dr. ERDI Gergo Date: Sun Jul 27 21:00:15 2014 +0200 tcLookupPatSyn: look up the PatSyn record for a given Id >--------------------------------------------------------------- 25c2eebc4ad0c1dc4f4c371f39bd5336546ec094 compiler/typecheck/TcEnv.lhs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index d9a4122..f4c7c10 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -18,8 +18,8 @@ module TcEnv( tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv, tcExtendGlobalValEnv, tcLookupLocatedGlobal, tcLookupGlobal, - tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon, - tcLookupConLike, + tcLookupField, tcLookupTyCon, tcLookupClass, + tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom, @@ -73,7 +73,8 @@ import Var import VarSet import RdrName import InstEnv -import DataCon +import DataCon ( DataCon ) +import PatSyn ( PatSyn ) import ConLike import TyCon import CoAxiom @@ -160,6 +161,13 @@ tcLookupDataCon name = do AConLike (RealDataCon con) -> return con _ -> wrongThingErr "data constructor" (AGlobal thing) name +tcLookupPatSyn :: Name -> TcM PatSyn +tcLookupPatSyn name = do + thing <- tcLookupGlobal name + case thing of + AConLike (PatSynCon ps) -> return ps + _ -> wrongThingErr "pattern synonym" (AGlobal thing) name + tcLookupConLike :: Name -> TcM ConLike tcLookupConLike name = do thing <- tcLookupGlobal name From git at git.haskell.org Tue Jul 29 14:24:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:25 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add parser support for explicitly bidirectional pattern synonyms (40e7774) Message-ID: <20140729142425.63EA4240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/40e77740270ee3bc9d7241aa3fe9d4c6f1695859/ghc >--------------------------------------------------------------- commit 40e77740270ee3bc9d7241aa3fe9d4c6f1695859 Author: Dr. ERDI Gergo Date: Sun Jul 6 22:13:50 2014 +0800 Add parser support for explicitly bidirectional pattern synonyms >--------------------------------------------------------------- 40e77740270ee3bc9d7241aa3fe9d4c6f1695859 compiler/hsSyn/HsBinds.lhs | 18 ++++++++++-------- compiler/parser/Parser.y.pp | 10 ++++++++++ compiler/parser/RdrHsSyn.lhs | 42 +++++++++++++++++++++++++++++++++++++----- compiler/typecheck/TcHsSyn.lhs | 3 +++ 4 files changed, 60 insertions(+), 13 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 2261a89..54d5746 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -441,15 +441,18 @@ ppr_monobind (PatSynBind{ patsyn_id = L _ psyn, patsyn_args = details, patsyn_def = pat, patsyn_dir = dir }) = ppr_lhs <+> ppr_rhs where - ppr_lhs = ptext (sLit "pattern") <+> ppr_details details + ppr_lhs = ptext (sLit "pattern") <+> ppr_details ppr_simple syntax = syntax <+> ppr pat - ppr_details (InfixPatSyn v1 v2) = hsep [ppr v1, pprInfixOcc psyn, ppr v2] - ppr_details (PrefixPatSyn vs) = hsep (pprPrefixOcc psyn : map ppr vs) + (is_infix, ppr_details) = case details of + InfixPatSyn v1 v2 -> (True, hsep [ppr v1, pprInfixOcc psyn, ppr v2]) + PrefixPatSyn vs -> (False, hsep (pprPrefixOcc psyn : map ppr vs)) ppr_rhs = case dir of - Unidirectional -> ppr_simple (ptext (sLit "<-")) - ImplicitBidirectional -> ppr_simple equals + Unidirectional -> ppr_simple (ptext (sLit "<-")) + ImplicitBidirectional -> ppr_simple equals + ExplicitBidirectional mg -> ppr_simple (ptext (sLit "<-")) <+> ptext (sLit "where") $$ + (nest 2 $ pprFunBind psyn is_infix mg) ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars , abs_exports = exports, abs_binds = val_binds @@ -785,10 +788,9 @@ instance Traversable HsPatSynDetails where traverse f (InfixPatSyn left right) = InfixPatSyn <$> f left <*> f right traverse f (PrefixPatSyn args) = PrefixPatSyn <$> traverse f args -data HsPatSynDirLR idL idR +data HsPatSynDir id = Unidirectional | ImplicitBidirectional + | ExplicitBidirectional (MatchGroup id (LHsExpr id)) deriving (Data, Typeable) - -type HsPatSynDir id = HsPatSynDirLR id id \end{code} diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 9321e03..72dfc88 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -856,6 +856,16 @@ pattern_synonym_decl :: { LHsDecl RdrName } {% do { (name, args) <- splitPatSyn $2 ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional }} + | 'pattern' pat '<-' pat where_decls + {% do { (name, args) <- splitPatSyn $2 + ; mg <- toPatSynMatchGroup name $5 + ; return $ LL . ValD $ + mkPatSynBind name args $4 (ExplicitBidirectional mg) + }} + +where_decls :: { Located (OrdList (LHsDecl RdrName)) } + : 'where' '{' decls '}' { $3 } + | 'where' vocurly decls close { $3 } vars0 :: { [Located RdrName] } : {- empty -} { [] } diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index ed29fe0..84a284f 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -16,7 +16,8 @@ module RdrHsSyn ( mkTySynonym, mkTyFamInstEqn, mkTyFamInst, mkFamDecl, - splitCon, splitPatSyn, mkInlinePragma, + splitCon, mkInlinePragma, + splitPatSyn, toPatSynMatchGroup, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -435,18 +436,49 @@ splitPatSyn pat@(L loc (ConPatIn con details)) = do details' <- case details of PrefixCon pats -> liftM PrefixPatSyn (mapM patVar pats) InfixCon pat1 pat2 -> liftM2 InfixPatSyn (patVar pat1) (patVar pat2) - RecCon{} -> parseErrorSDoc loc $ - text "record syntax not supported for pattern synonym declarations:" $$ ppr pat + RecCon{} -> recordPatSynErr loc pat return (con, details') where patVar :: LPat RdrName -> P (Located RdrName) patVar (L loc (VarPat v)) = return $ L loc v patVar (L _ (ParPat pat)) = patVar pat - patVar pat@(L loc _) = parseErrorSDoc loc $ - text "Pattern synonym arguments must be variable names:" $$ ppr pat + patVar (L loc pat) = parseErrorSDoc loc $ + text "Pattern synonym arguments must be variable names:" $$ + ppr pat splitPatSyn pat@(L loc _) = parseErrorSDoc loc $ text "invalid pattern synonym declaration:" $$ ppr pat +recordPatSynErr :: SrcSpan -> LPat RdrName -> P a +recordPatSynErr loc pat = + parseErrorSDoc loc $ + text "record syntax not supported for pattern synonym declarations:" $$ + ppr pat + +toPatSynMatchGroup :: Located RdrName -> Located (OrdList (LHsDecl RdrName)) -> P (MatchGroup RdrName (LHsExpr RdrName)) +toPatSynMatchGroup (L _ patsyn_name) (L _ decls) = + do { matches <- mapM fromDecl (fromOL decls) + ; return $ mkMatchGroup FromSource matches } + where + fromDecl (L loc decl@(ValD (PatBind pat@(L _ (ConPatIn (L _ name) details)) rhs _ _ _))) = + do { unless (name == patsyn_name) $ + wrongNameBindingErr loc decl + ; match <- case details of + PrefixCon pats -> return $ Match pats Nothing rhs + InfixCon pat1 pat2 -> return $ Match [pat1, pat2] Nothing rhs + RecCon{} -> recordPatSynErr loc pat + ; return $ L loc match } + fromDecl (L loc decl) = extraDeclErr loc decl + + extraDeclErr loc decl = + parseErrorSDoc loc $ + text "pattern synonym 'where' clause must contain a single binding:" $$ + ppr decl + + wrongNameBindingErr loc decl = + parseErrorSDoc loc $ + text "pattern synonym 'where' clause must bind the pattern synonym's name" <+> + quotes (ppr patsyn_name) $$ ppr decl + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index f90cfca..1a48fe8 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -489,6 +489,9 @@ zonkPatSynDetails env = traverse (wrapLocM $ zonkIdBndr env) zonkPatSynDir :: ZonkEnv -> HsPatSynDir TcId -> TcM (ZonkEnv, HsPatSynDir Id) zonkPatSynDir env Unidirectional = return (env, Unidirectional) zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional) +zonkPatSynDir env (ExplicitBidirectional mg) = do + mg' <- zonkMatchGroup env zonkLExpr mg + return (env, ExplicitBidirectional mg') zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags zonkSpecPrags _ IsDefaultMethod = return IsDefaultMethod From git at git.haskell.org Tue Jul 29 14:24:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:27 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: When computing minimal recursive sets of bindings, don't include references in wrapper definitions for explicitly-bidirectional pattern synonyms (32bf8a5) Message-ID: <20140729142428.28E50240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/32bf8a5f148cb590e522320b26c0367ecedc015e/ghc >--------------------------------------------------------------- commit 32bf8a5f148cb590e522320b26c0367ecedc015e Author: Dr. ERDI Gergo Date: Sun Jul 27 21:06:44 2014 +0200 When computing minimal recursive sets of bindings, don't include references in wrapper definitions for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- 32bf8a5f148cb590e522320b26c0367ecedc015e compiler/rename/RnBinds.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index b8887b0..1259edd 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -559,7 +559,7 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name , bind_fvs = fvs' } ; fvs' `seq` -- See Note [Free-variable space leak] - return (bind', [name], fvs) + return (bind', [name], fvs1) } where lookupVar = wrapLocM lookupOccRn From git at git.haskell.org Tue Jul 29 14:24:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:31 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add test cases for explicitly-bidirectional pattern synonym (f3262fe) Message-ID: <20140729142431.3D3A6240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/f3262fe82ce7d810809beecabd4257522db4cc55/ghc >--------------------------------------------------------------- commit f3262fe82ce7d810809beecabd4257522db4cc55 Author: Dr. ERDI Gergo Date: Tue Jul 29 08:25:40 2014 +0200 Add test cases for explicitly-bidirectional pattern synonym >--------------------------------------------------------------- f3262fe82ce7d810809beecabd4257522db4cc55 testsuite/.gitignore | 2 ++ testsuite/tests/patsyn/should_run/all.T | 2 ++ testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs | 10 ++++++++++ .../should_run/bidir-explicit-scope.stdout} | 0 testsuite/tests/patsyn/should_run/bidir-explicit.hs | 7 +++++++ .../T3207.stdout => patsyn/should_run/bidir-explicit.stdout} | 0 6 files changed, 21 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 71fa8d0..e7bb6d5 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1068,6 +1068,8 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/parser/unicode/1744 /tests/parser/unicode/T1744 /tests/parser/unicode/utf8_024 +/tests/patsyn/should_run/bidir-explicit +/tests/patsyn/should_run/bidir-explicit-scope /tests/patsyn/should_run/eval /tests/patsyn/should_run/ex-prov /tests/patsyn/should_run/ex-prov-run diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T index f5936c6..b3c6b74 100644 --- a/testsuite/tests/patsyn/should_run/all.T +++ b/testsuite/tests/patsyn/should_run/all.T @@ -1,3 +1,5 @@ test('eval', normal, compile_and_run, ['']) test('match', normal, compile_and_run, ['']) test('ex-prov-run', normal, compile_and_run, ['']) +test('bidir-explicit', normal, compile_and_run, ['']) +test('bidir-explicit-scope', normal, compile_and_run, ['']) diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs new file mode 100644 index 0000000..390bbb0 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PatternSynonyms #-} +module Main where + +pattern First x <- x:_ where + First x = foo [x, x, x] + +foo :: [a] -> [a] +foo xs@(First x) = replicate (length xs + 1) x + +main = mapM_ print $ First () diff --git a/testsuite/tests/deriving/should_run/T3087.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout similarity index 100% copy from testsuite/tests/deriving/should_run/T3087.stdout copy to testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.hs b/testsuite/tests/patsyn/should_run/bidir-explicit.hs new file mode 100644 index 0000000..d295191 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/bidir-explicit.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +module Main where + +pattern First x <- x:_ where + First x = [x] + +main = mapM_ print $ First () diff --git a/testsuite/tests/codeGen/should_run/T3207.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout similarity index 100% copy from testsuite/tests/codeGen/should_run/T3207.stdout copy to testsuite/tests/patsyn/should_run/bidir-explicit.stdout From git at git.haskell.org Tue Jul 29 14:24:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:33 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Refactor PatSynBind so that we can pass around PSBs instead of several arguments (893a261) Message-ID: <20140729142434.54863240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/893a261c8c15783c8f86c74f4e8c57df9c44a155/ghc >--------------------------------------------------------------- commit 893a261c8c15783c8f86c74f4e8c57df9c44a155 Author: Dr. ERDI Gergo Date: Tue Jul 29 11:27:26 2014 +0200 Refactor PatSynBind so that we can pass around PSBs instead of several arguments >--------------------------------------------------------------- 893a261c8c15783c8f86c74f4e8c57df9c44a155 compiler/hsSyn/HsBinds.lhs | 51 ++++++++++++++-------------- compiler/hsSyn/HsUtils.lhs | 14 ++++---- compiler/rename/RnBinds.lhs | 54 +++++++++++++++++------------- compiler/typecheck/TcBinds.lhs | 27 +++++---------- compiler/typecheck/TcHsSyn.lhs | 17 +++++----- compiler/typecheck/TcPatSyn.lhs | 64 ++++++++++++++++++++---------------- compiler/typecheck/TcPatSyn.lhs-boot | 13 ++------ utils/ghctags/Main.hs | 2 +- 8 files changed, 124 insertions(+), 118 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 893a261c8c15783c8f86c74f4e8c57df9c44a155 From git at git.haskell.org Tue Jul 29 14:24:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:36 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add note about renaming of pattern synonym wrappers (3219ed9) Message-ID: <20140729142437.577A2240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/3219ed9629a75b3b8b6757ee3ab5a8acc70f6900/ghc >--------------------------------------------------------------- commit 3219ed9629a75b3b8b6757ee3ab5a8acc70f6900 Author: Dr. ERDI Gergo Date: Tue Jul 29 11:28:33 2014 +0200 Add note about renaming of pattern synonym wrappers >--------------------------------------------------------------- 3219ed9629a75b3b8b6757ee3ab5a8acc70f6900 compiler/rename/RnBinds.lhs | 27 +++++++++++++++++++++++++++ compiler/typecheck/TcBinds.lhs | 1 + 2 files changed, 28 insertions(+) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 4efd847..0f9f44a 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -582,6 +582,7 @@ rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name ; fvs' `seq` -- See Note [Free-variable space leak] return (bind', [name], fvs1) + -- See Note [Pattern synonym wrappers don't yield dependencies] } where lookupVar = wrapLocM lookupOccRn @@ -592,6 +593,32 @@ rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name 2 (ptext (sLit "Use -XPatternSynonyms to enable this extension")) {- +Note [Pattern synonym wrappers don't yield dependencies] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When renaming a pattern synonym that has an explicit wrapper, +references in the wrapper definition should not be used when +calculating dependencies. For example, consider the following pattern +synonym definition: + +pattern P x <- C1 x where + P x = f (C1 x) + +f (P x) = C2 x + +In this case, 'P' needs to be typechecked in two passes: + +1. Typecheck the pattern definition of 'P', which fully determines the +type of 'P'. This step doesn't require knowing anything about 'f', +since the wrapper definition is not looked at. + +2. Typecheck the wrapper definition, which needs the typechecked +definition of 'f' to be in scope. + +This behaviour is implemented in 'tcValBinds', but it crucially +depends on 'P' not being put in a recursive group with 'f' (which +would make it look like a recursive pattern synonym a la 'pattern P = +P' which is unsound and rejected). -} diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index bbbed51..83a9591 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -318,6 +318,7 @@ tcValBinds top_lvl binds sigs thing_inside ; tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ do { (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do { thing <- thing_inside + -- See Note [Pattern synonym wrappers don't yield dependencies] ; patsyn_wrappers <- mapM tcPatSynWrapper patsyns ; let extra_binds = [ (NonRecursive, wrapper) | wrapper <- patsyn_wrappers ] ; return (extra_binds, thing) } From git at git.haskell.org Tue Jul 29 14:24:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:39 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms: Add user documentation for explicitly-bidirectional pattern synonyms (535b37c) Message-ID: <20140729142440.577EA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pattern-synonyms Link : http://ghc.haskell.org/trac/ghc/changeset/535b37cbb5a11dd4c9d8260d1d00f4cb993af0e9/ghc >--------------------------------------------------------------- commit 535b37cbb5a11dd4c9d8260d1d00f4cb993af0e9 Author: Dr. ERDI Gergo Date: Tue Jul 29 11:33:57 2014 +0200 Add user documentation for explicitly-bidirectional pattern synonyms >--------------------------------------------------------------- 535b37cbb5a11dd4c9d8260d1d00f4cb993af0e9 docs/users_guide/glasgow_exts.xml | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 7b49a55..ff7f3ea 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -987,9 +987,15 @@ Which enables us to rewrite our functions in a much cleaner style: In this case, Head x cannot be used in expressions, only patterns, since it wouldn't specify a value for the xs on the -right-hand side. +right-hand side. We can give an explicit inversion of a pattern +synonym using the following syntax: + + pattern Head x <- x:xs where + Head x = [x] + + The syntax and semantics of pattern synonyms are elaborated in the following subsections. @@ -1008,6 +1014,10 @@ bidirectional. The syntax for unidirectional pattern synonyms is: and the syntax for bidirectional pattern synonyms is: pattern Name args = pat + or + + pattern Name args <- pat where + Name args = expr Either prefix or infix syntax can be used. @@ -1020,11 +1030,12 @@ bidirectional. The syntax for unidirectional pattern synonyms is: The variables in the left-hand side of the definition are bound by - the pattern on the right-hand side. For bidirectional pattern - synonyms, all the variables of the right-hand side must also occur - on the left-hand side; also, wildcard patterns and view patterns are - not allowed. For unidirectional pattern synonyms, there is no - restriction on the right-hand side pattern. + the pattern on the right-hand side. For implicitly bidirectional + pattern synonyms, all the variables of the right-hand side must also + occur on the left-hand side; also, wildcard patterns and view + patterns are not allowed. For unidirectional and + explicitly-bidirectional pattern synonyms, there is no restriction + on the right-hand side pattern. From git at git.haskell.org Tue Jul 29 14:24:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:24:42 +0000 (UTC) Subject: [commit: ghc] wip/pattern-synonyms's head updated: Add user documentation for explicitly-bidirectional pattern synonyms (535b37c) Message-ID: <20140729142442.EFEEF240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/pattern-synonyms' now includes: 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 From git at git.haskell.org Tue Jul 29 14:30:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 14:30:18 +0000 (UTC) Subject: [commit: ghc] master's head updated: Add user documentation for explicitly-bidirectional pattern synonyms (535b37c) Message-ID: <20140729143018.77A9B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 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 From git at git.haskell.org Tue Jul 29 21:11:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Jul 2014 21:11:48 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: Add user documentation for explicitly-bidirectional pattern synonyms (535b37c) Message-ID: <20140729211148.40834240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: 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 From git at git.haskell.org Wed Jul 30 05:13:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 05:13:05 +0000 (UTC) Subject: [commit: ghc] master: Fix variable name typo from commit 3021fb (6640635) Message-ID: <20140730051305.6F296240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6640635e6e2654f0acd8f10e0d02a8bd1c8296ff/ghc >--------------------------------------------------------------- commit 6640635e6e2654f0acd8f10e0d02a8bd1c8296ff Author: Niklas Larsson Date: Wed Jul 30 03:48:19 2014 +0200 Fix variable name typo from commit 3021fb Signed-off-by: Austin Seipp >--------------------------------------------------------------- 6640635e6e2654f0acd8f10e0d02a8bd1c8296ff rts/win32/AsyncIO.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/win32/AsyncIO.c b/rts/win32/AsyncIO.c index 265f93c..412f31b 100644 --- a/rts/win32/AsyncIO.c +++ b/rts/win32/AsyncIO.c @@ -286,7 +286,7 @@ start: unsigned int rID = completedTable[i].reqID; prev = NULL; - for(tso = blocking_queue_hd; tso != END_TSO_QUEUE; + for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = tso->_link) { switch(tso->why_blocked) { From git at git.haskell.org Wed Jul 30 08:14:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:06 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T8968' deleted Message-ID: <20140730081406.CED5B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T8968 From git at git.haskell.org Wed Jul 30 08:14:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:25 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T8584' created Message-ID: <20140730081425.89AF9240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T8584 Referencing: 0b32cc85166e9bf3dda310382a19ae81fc313477 From git at git.haskell.org Wed Jul 30 08:14:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:27 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Update baseline shift/reduce conflict number (fc3fd30) Message-ID: <20140730081428.025EE240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/fc3fd30817668e156b23483a09d2ef640fca861f/ghc >--------------------------------------------------------------- commit fc3fd30817668e156b23483a09d2ef640fca861f Author: Dr. ERDI Gergo Date: Wed Jul 2 19:18:43 2014 +0800 Update baseline shift/reduce conflict number >--------------------------------------------------------------- fc3fd30817668e156b23483a09d2ef640fca861f compiler/parser/Parser.y.pp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 72dfc88..3de21a3 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -72,6 +72,12 @@ import Control.Monad ( mplus ) {- ----------------------------------------------------------------------------- +25 June 2014 + +Conflicts: 47 shift/reduce + 1 reduce/reduce + +----------------------------------------------------------------------------- 12 October 2012 Conflicts: 43 shift/reduce From git at git.haskell.org Wed Jul 30 08:14:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:30 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Renamer for PatSynSigs: handle type variable bindings (e7af47f) Message-ID: <20140730081430.D5F41240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/e7af47fab14442367227b703062fc2767e35a912/ghc >--------------------------------------------------------------- commit e7af47fab14442367227b703062fc2767e35a912 Author: Dr. ERDI Gergo Date: Sun Jul 20 12:49:21 2014 +0800 Renamer for PatSynSigs: handle type variable bindings >--------------------------------------------------------------- e7af47fab14442367227b703062fc2767e35a912 compiler/rename/RnBinds.lhs | 49 +++++++++++++++++++++++++++++---------------- 1 file changed, 32 insertions(+), 17 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 0f9f44a..807a05c 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -35,7 +35,7 @@ import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts ) import HsSyn import TcRnMonad import TcEvidence ( emptyTcEvBinds ) -import RnTypes ( bindSigTyVarsFV, rnHsSigType, rnLHsType, checkPrecMatch, rnContext ) +import RnTypes import RnPat import RnNames import RnEnv @@ -832,22 +832,37 @@ renameSig ctxt sig@(MinimalSig bf) return (MinimalSig new_bf, emptyFVs) renameSig ctxt sig@(PatSynSig v args ty prov req) - = do v' <- lookupSigOccRn ctxt sig v - let doc = quotes (ppr v) - rn_type = rnHsSigType doc - (ty', fvs1) <- rn_type ty - (args', fvs2) <- case args of - PrefixPatSyn tys -> - do (tys, fvs) <- unzip <$> mapM rn_type tys - return (PrefixPatSyn tys, plusFVs fvs) - InfixPatSyn left right -> - do (left', fvs1) <- rn_type left - (right', fvs2) <- rn_type right - return (InfixPatSyn left' right', fvs1 `plusFV` fvs2) - (prov', fvs3) <- rnContext (TypeSigCtx doc) prov - (req', fvs4) <- rnContext (TypeSigCtx doc) req - let fvs = plusFVs [fvs1, fvs2, fvs3, fvs4] - return (PatSynSig v' args' ty' prov' req', fvs) + = do { v' <- lookupSigOccRn ctxt sig v + ; let doc = TypeSigCtx $ quotes (ppr v) + ; loc <- getSrcSpanM + + ; let (ty_kvs, ty_tvs) = extractHsTysRdrTyVars (ty:unLoc req) + ; let ty_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ty_tvs + + ; bindHsTyVars doc Nothing ty_kvs ty_tv_bndrs $ \ _new_tyvars -> do + { (req', fvs1) <- rnContext doc req + ; (ty', fvs2) <- rnLHsType doc ty + + ; let (arg_tys, rnArgs) = case args of + PrefixPatSyn tys -> + let rnArgs = do + (tys', fvs) <- mapFvRn (rnLHsType doc) tys + return (PrefixPatSyn tys', fvs) + in (tys, rnArgs) + InfixPatSyn ty1 ty2 -> + let rnArgs = do + (ty1', fvs1) <- rnLHsType doc ty1 + (ty2', fvs2) <- rnLHsType doc ty2 + return (InfixPatSyn ty1' ty2', fvs1 `plusFV` fvs2) + in ([ty1, ty2], rnArgs) + ; let (arg_kvs, arg_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) + ; let arg_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ arg_tvs + + ; bindHsTyVars doc Nothing arg_kvs arg_tv_bndrs $ \ _new_tyvars -> do + { (prov', fvs3) <- rnContext doc prov + ; (args', fvs4) <- rnArgs + + ; return (PatSynSig v' args' ty' prov' req', plusFVs [fvs1, fvs2, fvs3, fvs4]) }}} ppr_sig_bndrs :: [Located RdrName] -> SDoc ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs) From git at git.haskell.org Wed Jul 30 08:14:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:32 +0000 (UTC) Subject: [commit: ghc] wip/T8584: PatSynSig: Add type variable binders (941c6d4) Message-ID: <20140730081432.E50AA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/941c6d48fed69e93c46dbefa892ca23eb99a99d5/ghc >--------------------------------------------------------------- commit 941c6d48fed69e93c46dbefa892ca23eb99a99d5 Author: Dr. ERDI Gergo Date: Mon Jul 21 19:40:34 2014 +0800 PatSynSig: Add type variable binders >--------------------------------------------------------------- 941c6d48fed69e93c46dbefa892ca23eb99a99d5 compiler/hsSyn/HsBinds.lhs | 8 ++++---- compiler/hsSyn/HsTypes.lhs | 19 +++++++++++++------ compiler/parser/RdrHsSyn.lhs | 10 ++++++---- compiler/rename/RnBinds.lhs | 17 +++++++++-------- 4 files changed, 32 insertions(+), 22 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index a90ea66..673a269 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -549,12 +549,12 @@ data Sig name TypeSig [Located name] (LHsType name) -- | A pattern synonym type signature - -- @pattern (Eq b) => P a b :: (Num a) => T a + -- @pattern type forall b. (Eq b) => P a b :: forall a. (Num a) => T a | PatSynSig (Located name) (HsPatSynDetails (LHsType name)) (LHsType name) -- Type - (LHsContext name) -- Provided context - (LHsContext name) -- Required contex + (HsExplicitFlag, LHsTyVarBndrs name, LHsContext name) -- Provided context + (HsExplicitFlag, LHsTyVarBndrs name, LHsContext name) -- Required contex -- | A type signature for a default method inside a class -- @@ -710,7 +710,7 @@ ppr_sig (SpecSig var ty inl) = pragBrackets (pprSpec (unLoc var) (ppr ty) i ppr_sig (InlineSig var inl) = pragBrackets (ppr inl <+> pprPrefixOcc (unLoc var)) ppr_sig (SpecInstSig ty) = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty) ppr_sig (MinimalSig bf) = pragBrackets (pprMinimalSig bf) -ppr_sig (PatSynSig name arg_tys ty prov req) +ppr_sig (PatSynSig name arg_tys ty (_, _, prov) (_, _, req)) = pprPatSynSig (unLoc name) False args (ppr ty) (pprCtx prov) (pprCtx req) where args = fmap ppr arg_tys diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 52b919e..bb5694c 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -31,7 +31,7 @@ module HsTypes ( hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, - splitHsFunType, splitLHsForAllTy, + splitHsFunType, splitLHsForAllTyFlag, splitLHsForAllTy, splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy, -- Printing @@ -476,15 +476,22 @@ splitLHsInstDeclTy_maybe inst_ty = do (cls, tys) <- splitLHsClassTy_maybe ty return (tvs, cxt, cls, tys) +splitLHsForAllTyFlag + :: LHsType name + -> (HsExplicitFlag, LHsTyVarBndrs name, HsContext name, LHsType name) +splitLHsForAllTyFlag poly_ty + = case unLoc poly_ty of + HsParTy ty -> splitLHsForAllTyFlag ty + HsForAllTy flag tvs cxt ty -> (flag, tvs, unLoc cxt, ty) + _ -> (Implicit, emptyHsQTvs, [], poly_ty) + -- The type vars should have been computed by now, even if they were implicit + splitLHsForAllTy :: LHsType name -> (LHsTyVarBndrs name, HsContext name, LHsType name) splitLHsForAllTy poly_ty - = case unLoc poly_ty of - HsParTy ty -> splitLHsForAllTy ty - HsForAllTy _ tvs cxt ty -> (tvs, unLoc cxt, ty) - _ -> (emptyHsQTvs, [], poly_ty) - -- The type vars should have been computed by now, even if they were implicit + = let (_, tvs, cxt, ty) = splitLHsForAllTyFlag poly_ty + in (tvs, cxt, ty) splitHsClassTy_maybe :: HsType name -> Maybe (name, [LHsType name]) splitHsClassTy_maybe ty = fmap (\(L _ n, tys) -> (n, tys)) $ splitLHsClassTy_maybe (noLoc ty) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index c6ddc7d..fdf6c23 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -491,7 +491,9 @@ toPatSynMatchGroup (L _ patsyn_name) (L _ decls) = -- and (Eq a) and (Num b) as the provided and required thetas (respectively) splitPatSynSig :: LHsType RdrName -> LHsType RdrName - -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, LHsContext RdrName, LHsContext RdrName) + -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, + (HsExplicitFlag, LHsTyVarBndrs RdrName, LHsContext RdrName), + (HsExplicitFlag, LHsTyVarBndrs RdrName, LHsContext RdrName)) splitPatSynSig lty1 lty2 = do (name, details) <- splitCon pat_ty details' <- case details of @@ -499,10 +501,10 @@ splitPatSynSig lty1 lty2 = do InfixCon ty1 ty2 -> return $ InfixPatSyn ty1 ty2 RecCon{} -> parseErrorSDoc (getLoc lty1) $ text "record syntax not supported for pattern synonym declarations:" $$ ppr lty1 - return (name, details', res_ty, prov', req') + return (name, details', res_ty, (ex_flag, ex_tvs, prov'), (univ_flag, univ_tvs, req')) where - (_, prov, pat_ty) = splitLHsForAllTy lty1 - (_, req, res_ty) = splitLHsForAllTy lty2 + (ex_flag, ex_tvs, prov, pat_ty) = splitLHsForAllTyFlag lty1 + (univ_flag, univ_tvs, req, res_ty) = splitLHsForAllTyFlag lty2 prov' = L (getLoc lty1) prov req' = L (getLoc lty2) req diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 807a05c..f649e27 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -831,15 +831,15 @@ renameSig ctxt sig@(MinimalSig bf) = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf return (MinimalSig new_bf, emptyFVs) -renameSig ctxt sig@(PatSynSig v args ty prov req) +renameSig ctxt sig@(PatSynSig v args ty (ex_flag, _ex_tvs, prov) (univ_flag, _univ_tvs, req)) = do { v' <- lookupSigOccRn ctxt sig v ; let doc = TypeSigCtx $ quotes (ppr v) ; loc <- getSrcSpanM - ; let (ty_kvs, ty_tvs) = extractHsTysRdrTyVars (ty:unLoc req) - ; let ty_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ty_tvs + ; let (univ_kvs, univ_tvs) = extractHsTysRdrTyVars (ty:unLoc req) + ; let univ_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ univ_tvs - ; bindHsTyVars doc Nothing ty_kvs ty_tv_bndrs $ \ _new_tyvars -> do + ; bindHsTyVars doc Nothing univ_kvs univ_tv_bndrs $ \ univ_tyvars -> do { (req', fvs1) <- rnContext doc req ; (ty', fvs2) <- rnLHsType doc ty @@ -855,14 +855,15 @@ renameSig ctxt sig@(PatSynSig v args ty prov req) (ty2', fvs2) <- rnLHsType doc ty2 return (InfixPatSyn ty1' ty2', fvs1 `plusFV` fvs2) in ([ty1, ty2], rnArgs) - ; let (arg_kvs, arg_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) - ; let arg_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ arg_tvs + ; let (ex_kvs, ex_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) + ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs - ; bindHsTyVars doc Nothing arg_kvs arg_tv_bndrs $ \ _new_tyvars -> do + ; bindHsTyVars doc Nothing ex_kvs ex_tv_bndrs $ \ ex_tyvars -> do { (prov', fvs3) <- rnContext doc prov ; (args', fvs4) <- rnArgs - ; return (PatSynSig v' args' ty' prov' req', plusFVs [fvs1, fvs2, fvs3, fvs4]) }}} + ; return (PatSynSig v' args' ty' (ex_flag, ex_tyvars, prov') (univ_flag, univ_tyvars, req'), + plusFVs [fvs1, fvs2, fvs3, fvs4]) }}} ppr_sig_bndrs :: [Located RdrName] -> SDoc ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs) From git at git.haskell.org Wed Jul 30 08:14:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:35 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Add parser for pattern synonym type signatures. Syntax is of the form (85d5f79) Message-ID: <20140730081435.8A9FA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/85d5f79ee04fc6b882a597bb098525f34f5d0b7c/ghc >--------------------------------------------------------------- commit 85d5f79ee04fc6b882a597bb098525f34f5d0b7c Author: Dr. ERDI Gergo Date: Mon Jul 14 18:18:44 2014 +0800 Add parser for pattern synonym type signatures. Syntax is of the form pattern type Eq a => P a T b :: Num b => R a b which declares a pattern synonym called P, with argument types a, T, and b. >--------------------------------------------------------------- 85d5f79ee04fc6b882a597bb098525f34f5d0b7c compiler/hsSyn/HsBinds.lhs | 1 + compiler/hsSyn/HsTypes.lhs | 2 +- compiler/parser/Parser.y.pp | 9 +++++++-- compiler/parser/RdrHsSyn.lhs | 29 ++++++++++++++++++++++++++++- 4 files changed, 37 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 04a7222..a90ea66 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -723,6 +723,7 @@ pprPatSynSig :: (OutputableBndr a) => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> Maybe SDoc -> Maybe SDoc -> SDoc pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta = sep [ ptext (sLit "pattern") + , ptext (sLit "type") , thetaOpt prov_theta, name_and_args , colon , thetaOpt req_theta, rhs_ty diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 08a0eef..52b919e 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -31,7 +31,7 @@ module HsTypes ( hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, - splitHsFunType, + splitHsFunType, splitLHsForAllTy, splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy, -- Printing diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 3de21a3..f24599c 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -856,8 +856,7 @@ role : VARID { L1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl RdrName } : 'pattern' pat '=' pat {% do { (name, args) <- splitPatSyn $2 - ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional - }} + ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional }} | 'pattern' pat '<-' pat {% do { (name, args) <- splitPatSyn $2 ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional @@ -873,6 +872,11 @@ where_decls :: { Located (OrdList (LHsDecl RdrName)) } : 'where' '{' decls '}' { $3 } | 'where' vocurly decls close { $3 } +pattern_synonym_sig :: { LSig RdrName } + : 'pattern' 'type' ctype '::' ctype + {% do { (name, details, ty, prov, req) <- splitPatSynSig $3 $5 + ; return . LL $ PatSynSig name details ty prov req }} + vars0 :: { [Located RdrName] } : {- empty -} { [] } | varid vars0 { $1 : $2 } @@ -1482,6 +1486,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } { LL $ toOL [ LL $ SigD (TypeSig ($1 : reverse (unLoc $3)) $5) ] } | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | n <- unLoc $3 ] } + | pattern_synonym_sig { LL . unitOL $ LL . SigD . unLoc $ $1 } | '{-# INLINE' activation qvar '#-}' { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) } | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}' diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 84a284f..c6ddc7d 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -17,7 +17,7 @@ module RdrHsSyn ( mkTyFamInst, mkFamDecl, splitCon, mkInlinePragma, - splitPatSyn, toPatSynMatchGroup, + splitPatSyn, splitPatSynSig, toPatSynMatchGroup, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -479,6 +479,33 @@ toPatSynMatchGroup (L _ patsyn_name) (L _ decls) = text "pattern synonym 'where' clause must bind the pattern synonym's name" <+> quotes (ppr patsyn_name) $$ ppr decl +-- Given two types like +-- Eq a => P a T b +-- and +-- Num b => R a b +-- +-- This returns +-- P as the name, +-- PrefixPatSyn [a, T, b] as the details, +-- R a b as the result type, +-- and (Eq a) and (Num b) as the provided and required thetas (respectively) +splitPatSynSig :: LHsType RdrName + -> LHsType RdrName + -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, LHsContext RdrName, LHsContext RdrName) +splitPatSynSig lty1 lty2 = do + (name, details) <- splitCon pat_ty + details' <- case details of + PrefixCon tys -> return $ PrefixPatSyn tys + InfixCon ty1 ty2 -> return $ InfixPatSyn ty1 ty2 + RecCon{} -> parseErrorSDoc (getLoc lty1) $ + text "record syntax not supported for pattern synonym declarations:" $$ ppr lty1 + return (name, details', res_ty, prov', req') + where + (_, prov, pat_ty) = splitLHsForAllTy lty1 + (_, req, res_ty) = splitLHsForAllTy lty2 + prov' = L (getLoc lty1) prov + req' = L (getLoc lty2) req + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] From git at git.haskell.org Wed Jul 30 08:14:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:37 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Split tcPatSynDecl into inferring function and general workhorse function (d178ddd) Message-ID: <20140730081437.D7D89240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/d178ddd28979510f18f89683855360cf46cb7486/ghc >--------------------------------------------------------------- commit d178ddd28979510f18f89683855360cf46cb7486 Author: Dr. ERDI Gergo Date: Sun Jul 27 14:10:34 2014 +0200 Split tcPatSynDecl into inferring function and general workhorse function >--------------------------------------------------------------- d178ddd28979510f18f89683855360cf46cb7486 compiler/typecheck/TcBinds.lhs | 4 ++-- compiler/typecheck/TcPatSyn.lhs | 11 +++++++++-- compiler/typecheck/TcPatSyn.lhs-boot | 4 ++-- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 83a9591..0b62807 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -16,7 +16,7 @@ module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds, import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun ) import {-# SOURCE #-} TcExpr ( tcMonoExpr ) -import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynWrapper ) +import {-# SOURCE #-} TcPatSyn ( tcInferPatSynDecl, tcPatSynWrapper ) import DynFlags import HsSyn @@ -419,7 +419,7 @@ tc_single :: forall thing. -> LHsBind Name -> TcM thing -> TcM (LHsBinds TcId, thing) tc_single _top_lvl _sig_fn _prag_fn (L _ (PatSynBind psb)) thing_inside - = do { (pat_syn, aux_binds) <- tcPatSynDecl psb + = do { (pat_syn, aux_binds) <- tcInferPatSynDecl psb ; let tything = AConLike (PatSynCon pat_syn) implicit_ids = (patSynMatcher pat_syn) : diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index b5fbc29..40efbfe 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -7,7 +7,7 @@ \begin{code} {-# LANGUAGE CPP #-} -module TcPatSyn (tcPatSynDecl, tcPatSynWrapper) where +module TcPatSyn (tcInferPatSynDecl, tcPatSynWrapper) where import HsSyn import TcPat @@ -40,13 +40,20 @@ import TypeRep \end{code} \begin{code} +tcInferPatSynDecl :: PatSynBind Name Name + -> TcM (PatSyn, LHsBinds Id) +tcInferPatSynDecl psb + = do { pat_ty <- newFlexiTyVarTy openTypeKind + ; tcPatSynDecl psb pat_ty } + tcPatSynDecl :: PatSynBind Name Name + -> TcType -> TcM (PatSyn, LHsBinds Id) tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, psb_def = lpat, psb_dir = dir } + pat_ty = do { traceTc "tcPatSynDecl {" $ ppr name $$ ppr lpat ; tcCheckPatSynPat lpat - ; pat_ty <- newFlexiTyVarTy openTypeKind ; let (arg_names, is_infix) = case details of PrefixPatSyn names -> (map unLoc names, False) diff --git a/compiler/typecheck/TcPatSyn.lhs-boot b/compiler/typecheck/TcPatSyn.lhs-boot index 700137c..0f77400 100644 --- a/compiler/typecheck/TcPatSyn.lhs-boot +++ b/compiler/typecheck/TcPatSyn.lhs-boot @@ -7,8 +7,8 @@ import HsSyn ( PatSynBind, LHsBinds ) import TcRnTypes ( TcM ) import PatSyn ( PatSyn ) -tcPatSynDecl :: PatSynBind Name Name - -> TcM (PatSyn, LHsBinds Id) +tcInferPatSynDecl :: PatSynBind Name Name + -> TcM (PatSyn, LHsBinds Id) tcPatSynWrapper :: PatSynBind Name Name -> TcM (LHsBinds Id) From git at git.haskell.org Wed Jul 30 08:14:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:40 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Add TcPatSynInfo to store the typechecked representation of a pattern synonym type signature (bd99480) Message-ID: <20140730081440.3BEAC240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/bd994800ad901ca551e3d68d1a4e6fd39c69e80c/ghc >--------------------------------------------------------------- commit bd994800ad901ca551e3d68d1a4e6fd39c69e80c Author: Dr. ERDI Gergo Date: Wed Jul 30 10:07:30 2014 +0200 Add TcPatSynInfo to store the typechecked representation of a pattern synonym type signature >--------------------------------------------------------------- bd994800ad901ca551e3d68d1a4e6fd39c69e80c compiler/typecheck/TcBinds.lhs | 43 +++++++++++++--- compiler/typecheck/TcClassDcl.lhs | 4 +- compiler/typecheck/TcPat.lhs | 11 +++++ compiler/typecheck/TcPatSyn.lhs | 96 ++++++++++++++++++++++++++---------- compiler/typecheck/TcPatSyn.lhs-boot | 7 +++ 5 files changed, 127 insertions(+), 34 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bd994800ad901ca551e3d68d1a4e6fd39c69e80c From git at git.haskell.org Wed Jul 30 08:14:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 08:14:42 +0000 (UTC) Subject: [commit: ghc] wip/T8584: universially-bound tyvars are in scope when renaming existentially-bound tyvars in a pattern synonym signature (0b32cc8) Message-ID: <20140730081442.ABBA6240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/0b32cc85166e9bf3dda310382a19ae81fc313477/ghc >--------------------------------------------------------------- commit 0b32cc85166e9bf3dda310382a19ae81fc313477 Author: Dr. ERDI Gergo Date: Mon Jul 28 16:42:30 2014 +0200 universially-bound tyvars are in scope when renaming existentially-bound tyvars in a pattern synonym signature >--------------------------------------------------------------- 0b32cc85166e9bf3dda310382a19ae81fc313477 compiler/rename/RnBinds.lhs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index f649e27..666a270 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -56,6 +56,7 @@ import Data.List ( partition, sort ) import Maybes ( orElse ) import Control.Monad import Data.Traversable ( traverse ) +import Util ( filterOut ) \end{code} -- ToDo: Put the annotations into the monad, so that they arrive in the proper @@ -855,10 +856,14 @@ renameSig ctxt sig@(PatSynSig v args ty (ex_flag, _ex_tvs, prov) (univ_flag, _un (ty2', fvs2) <- rnLHsType doc ty2 return (InfixPatSyn ty1' ty2', fvs1 `plusFV` fvs2) in ([ty1, ty2], rnArgs) + ; let (ex_kvs, ex_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) - ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs + ex_kvs' = filterOut (`elem` univ_kvs) ex_kvs + ex_tvs' = filterOut (`elem` univ_tvs) ex_tvs + + ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs' - ; bindHsTyVars doc Nothing ex_kvs ex_tv_bndrs $ \ ex_tyvars -> do + ; bindHsTyVars doc Nothing ex_kvs' ex_tv_bndrs $ \ ex_tyvars -> do { (prov', fvs3) <- rnContext doc prov ; (args', fvs4) <- rnArgs From git at git.haskell.org Wed Jul 30 10:46:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 10:46:18 +0000 (UTC) Subject: [commit: ghc] wip/travis: Add new validate flag: --fastest (dba4217) Message-ID: <20140730104619.1A9D1240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/dba4217ece6198d9a4728db4bdc5f380af4d219f/ghc >--------------------------------------------------------------- commit dba4217ece6198d9a4728db4bdc5f380af4d219f Author: Joachim Breitner Date: Tue Jul 29 14:14:17 2014 +0200 Add new validate flag: --fastest This tries to further reduce the time and space it takes to build GHC. The main use for that would be building on travis, but other users might also exist. >--------------------------------------------------------------- dba4217ece6198d9a4728db4bdc5f380af4d219f .travis.yml | 8 +------- mk/validate-settings.mk | 20 +++++++++++++++++--- validate | 18 +++++++++++++++--- 3 files changed, 33 insertions(+), 13 deletions(-) diff --git a/.travis.yml b/.travis.yml index 57153b6..22fe266 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,13 +24,7 @@ install: - cabal install happy alex script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. - # do not build docs - - echo 'HADDOCK_DOCS = NO' >> mk/validate.mk - - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/validate.mk - - echo 'BUILD_DOCBOOK_PS = NO' >> mk/validate.mk - - echo 'BUILD_DOCBOOK_PDF = NO' >> mk/validate.mk # do not build dynamic libraries - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=2 PATH=~/.cabal/bin:$PATH ./validate --fastest --no-dph diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index cac938d..5366a0e 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -5,7 +5,11 @@ WERROR = -Werror SRC_CC_WARNING_OPTS = SRC_HC_WARNING_OPTS = +ifneq "$(ValidateSpeed)" "FASTEST" +HADDOCK_DOCS = NO +else HADDOCK_DOCS = YES +endif ##################### # Warnings @@ -39,12 +43,17 @@ utils/hpc_dist-install_EXTRA_HC_OPTS += -fwarn-tabs SRC_HC_OPTS += -H64m -O0 GhcStage1HcOpts += -O -GhcStage2HcOpts += -O -dcore-lint +GhcStage2HcOpts += -O # Using -O (rather than -O0) here bringes my validate down from 22mins to 16 mins. # Compiling stage2 takes longer, but we gain a faster haddock, faster # running of the tests, and faster building of the utils to be installed -GhcLibHcOpts += -O -dcore-lint +GhcLibHcOpts += -O + +ifneq "$(ValidateSpeed)" "FASTEST" +GhcStage2HcOpts += -dcore-lint +GhcLibHcOpts += -dcore-lint +endif # We define DefaultFastGhcLibWays in this style so that the value is # correct even if the user alters DYNAMIC_GHC_PROGRAMS. @@ -53,7 +62,7 @@ GhcLibHcOpts += -O -dcore-lint DefaultFastGhcLibWays = $(if $(filter $(DYNAMIC_GHC_PROGRAMS),YES),v dyn,v) DefaultProfGhcLibWays = $(if $(filter $(GhcProfiled),YES),p,) -ifeq "$(ValidateSpeed)" "FAST" +ifneq (,$(filter $(ValidateSpeed),FAST FASTEST)) GhcLibWays = $(DefaultFastGhcLibWays) else GhcLibWays := $(filter v dyn,$(GhcLibWays)) @@ -74,6 +83,11 @@ InstallExtraPackages = YES # validating. BUILD_DOCBOOK_PS = NO BUILD_DOCBOOK_PDF = NO +ifneq "$(ValidateSpeed)" "FASTEST" +BUILD_DOCBOOK_HTML = NO +else +BUILD_DOCBOOK_HTML = YES +endif ifeq "$(ValidateHpc)" "YES" GhcStage2HcOpts += -fhpc -hpcdir $(TOP)/testsuite/hpc_output/ diff --git a/validate b/validate index cabb86c..29294bd 100755 --- a/validate +++ b/validate @@ -20,6 +20,8 @@ Flags: HTML generated here: testsuite/hpc_output/hpc_index.html --normal Default settings --fast Omit dyn way, omit binary distribution + --fastest like --fast, but do not lint, do not run performance tests, + do not build documentation --slow Build stage2 with -DDEBUG. 2008-07-01: 14% slower than the default. --no-dph: Skip building libraries/dph and running associated tests. @@ -57,6 +59,9 @@ do --slow) speed=SLOW ;; + --fastest) + speed=FASTEST + ;; --fast) speed=FAST ;; @@ -148,9 +153,9 @@ $make -j$threads check_packages post-build # ----------------------------------------------------------------------------- -# Build and test a binary distribution (not --fast) +# Build and test a binary distribution (not --fast or --fastest) -if [ $speed != "FAST" ]; then +if [ $speed != "FAST" -a $speed != "FASTEST" ]; then $make binary-dist-prep $make test_bindist TEST_PREP=YES @@ -184,6 +189,8 @@ then rm -f $HPCTIXFILE fi +SKIP_PERF_TESTS=NO + case "$speed" in SLOW) MAKE_TEST_TARGET=fulltest @@ -197,9 +204,14 @@ FAST) MAKE_TEST_TARGET=test BINDIST="BINDIST=NO" ;; +FASTEST) + MAKE_TEST_TARGET=test + BINDIST="BINDIST=NO" + SKIP_PERF_TESTS=YES + ;; esac -$make $MAKE_TEST_TARGET stage=2 $BINDIST THREADS=$threads 2>&1 | tee testlog +$make $MAKE_TEST_TARGET stage=2 $BINDIST SKIP_PERF_TESTS=$SKIP_PERF_TESTS THREADS=$threads 2>&1 | tee testlog check_packages post-testsuite From git at git.haskell.org Wed Jul 30 10:46:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 10:46:21 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: Add new validate flag: --fastest (dba4217) Message-ID: <20140730104621.6FF06240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: 6640635 Fix variable name typo from commit 3021fb dba4217 Add new validate flag: --fastest From git at git.haskell.org Wed Jul 30 12:03:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 12:03:33 +0000 (UTC) Subject: [commit: ghc] wip/travis: Fix haddock logic of --fastest (eb0fc5d) Message-ID: <20140730120334.233C7240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/eb0fc5d968b8782a03e6179a2efa7ff849316d22/ghc >--------------------------------------------------------------- commit eb0fc5d968b8782a03e6179a2efa7ff849316d22 Author: Joachim Breitner Date: Wed Jul 30 14:03:28 2014 +0200 Fix haddock logic of --fastest >--------------------------------------------------------------- eb0fc5d968b8782a03e6179a2efa7ff849316d22 mk/validate-settings.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index 5366a0e..1b45bf9 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -5,7 +5,7 @@ WERROR = -Werror SRC_CC_WARNING_OPTS = SRC_HC_WARNING_OPTS = -ifneq "$(ValidateSpeed)" "FASTEST" +ifeq "$(ValidateSpeed)" "FASTEST" HADDOCK_DOCS = NO else HADDOCK_DOCS = YES From git at git.haskell.org Wed Jul 30 12:57:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Jul 2014 12:57:01 +0000 (UTC) Subject: [commit: ghc] wip/travis: Fix more logic of --fastest (42dcf9e) Message-ID: <20140730125701.A4207240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/42dcf9e6573e1ce9cab5cf1df9adca27e3cd1d04/ghc >--------------------------------------------------------------- commit 42dcf9e6573e1ce9cab5cf1df9adca27e3cd1d04 Author: Joachim Breitner Date: Wed Jul 30 14:56:50 2014 +0200 Fix more logic of --fastest >--------------------------------------------------------------- 42dcf9e6573e1ce9cab5cf1df9adca27e3cd1d04 mk/validate-settings.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index 1b45bf9..743ccab 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -83,7 +83,7 @@ InstallExtraPackages = YES # validating. BUILD_DOCBOOK_PS = NO BUILD_DOCBOOK_PDF = NO -ifneq "$(ValidateSpeed)" "FASTEST" +ifeq "$(ValidateSpeed)" "FASTEST" BUILD_DOCBOOK_HTML = NO else BUILD_DOCBOOK_HTML = YES From git at git.haskell.org Thu Jul 31 02:11:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 02:11:10 +0000 (UTC) Subject: [commit: ghc] master: Make mod73 test insensitive to minor variations (#9325) (b06e83d) Message-ID: <20140731021110.DA35E240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b06e83dee5f7ec32efb4c424b0450a6c55359239/ghc >--------------------------------------------------------------- commit b06e83dee5f7ec32efb4c424b0450a6c55359239 Author: Reid Barton Date: Wed Jul 30 21:44:42 2014 -0400 Make mod73 test insensitive to minor variations (#9325) >--------------------------------------------------------------- b06e83dee5f7ec32efb4c424b0450a6c55359239 testsuite/tests/module/all.T | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index 926cbb5..cb5ce2f 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -91,7 +91,16 @@ test('mod69', normal, compile_fail, ['']) test('mod70', normal, compile_fail, ['']) test('mod71', normal, compile_fail, ['']) test('mod72', normal, compile_fail, ['']) -test('mod73', normal, compile_fail, ['']) + +# The order of suggestions in the output for test mod73 +# is subject to variation depending on the optimization level +# that GHC was built with (and probably minor changes to GHC too). +# This seems okay since there is unsafePerformIO under the hood +# in FastString. Allow any order with an extra normaliser. (See #9325.) +def normalise_mod73_error(x): + return x.replace('LT','XX',1).replace('EQ','XX',1).replace('GT','XX',1) +test('mod73', normalise_errmsg_fun(normalise_mod73_error), compile_fail, ['']) + test('mod74', normal, compile_fail, ['']) test('mod75', normal, compile, ['']) test('mod76', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 31 02:11:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 02:11:13 +0000 (UTC) Subject: [commit: ghc] master: Add .gitignore line for stage=1 testsuite generated file (a2439c7) Message-ID: <20140731021113.59E14240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2439c7e3620b0ace73c74ca024a0f2c0046c54a/ghc >--------------------------------------------------------------- commit a2439c7e3620b0ace73c74ca024a0f2c0046c54a Author: Reid Barton Date: Wed Jul 30 22:10:43 2014 -0400 Add .gitignore line for stage=1 testsuite generated file >--------------------------------------------------------------- a2439c7e3620b0ace73c74ca024a0f2c0046c54a testsuite/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index e7bb6d5..5653182 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -53,6 +53,7 @@ tmp.d *.so *bindisttest_install___dir_bin_ghc.mk *bindisttest_install___dir_bin_ghc.exe.mk +mk/ghcconfig_*_inplace_bin_ghc-stage1.mk mk/ghcconfig_*_inplace_bin_ghc-stage2.mk mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk *.imports From git at git.haskell.org Thu Jul 31 07:55:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 07:55:47 +0000 (UTC) Subject: [commit: ghc] master: comment update (1837b2f) Message-ID: <20140731075547.754AA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1837b2f38ec3442dcc4e7fd4bc67207fc2064e65/ghc >--------------------------------------------------------------- commit 1837b2f38ec3442dcc4e7fd4bc67207fc2064e65 Author: Simon Marlow Date: Tue Jul 22 12:02:45 2014 +0100 comment update >--------------------------------------------------------------- 1837b2f38ec3442dcc4e7fd4bc67207fc2064e65 compiler/cmm/Cmm.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index e21efc1..9e9bae9 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -80,10 +80,7 @@ data GenCmmDecl d h g -- registers will be correct in generated C-- code, but -- not in hand-written C-- code. However, -- splitAtProcPoints calculates correct liveness - -- information for CmmProc's. Right now only the LLVM - -- back-end relies on correct liveness information and - -- for that back-end we always call splitAtProcPoints, so - -- all is good. + -- information for CmmProcs. g -- Control-flow graph for the procedure's code | CmmData -- Static data From git at git.haskell.org Thu Jul 31 07:55:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 07:55:50 +0000 (UTC) Subject: [commit: ghc] master: Allow multiple entry points when allocating recursive groups (#9303) (da70f9e) Message-ID: <20140731075550.75D60240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da70f9ef49a545707dc32db9662441b9c8845fba/ghc >--------------------------------------------------------------- commit da70f9ef49a545707dc32db9662441b9c8845fba Author: Simon Marlow Date: Tue Jul 22 12:04:32 2014 +0100 Allow multiple entry points when allocating recursive groups (#9303) Summary: In this example we ended up with some code that was only reachable via an info table, because a branch had been optimised away by the native code generator. The register allocator then got confused because it was only considering the first block of the proc to be an entry point, when actually any of the info tables are entry points. Test Plan: validate Reviewers: simonpj, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D88 >--------------------------------------------------------------- da70f9ef49a545707dc32db9662441b9c8845fba compiler/nativeGen/RegAlloc/Linear/Main.hs | 48 ++++++++++++------------- compiler/nativeGen/RegAlloc/Liveness.hs | 26 ++++++++------ testsuite/tests/codeGen/should_compile/T9303.hs | 10 ++++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 4 files changed, 50 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 da70f9ef49a545707dc32db9662441b9c8845fba From git at git.haskell.org Thu Jul 31 07:58:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 07:58:07 +0000 (UTC) Subject: [commit: ghc] master: Comments and minor refactoring (49333bf) Message-ID: <20140731075807.183A0240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/49333bf58d1dfda83021d69908dc2aea4980d867/ghc >--------------------------------------------------------------- commit 49333bf58d1dfda83021d69908dc2aea4980d867 Author: Simon Peyton Jones Date: Thu Jul 31 08:57:13 2014 +0100 Comments and minor refactoring - Better comments about Generalised Newtype Deriving See Note [Bindings for Generalised Newtype Deriving] - Refactor the interface between TcDeriv and TcGenDeriv, to reduce the size of the interface of the latter. >--------------------------------------------------------------- 49333bf58d1dfda83021d69908dc2aea4980d867 compiler/typecheck/TcDeriv.lhs | 80 +++++++++++++++++++-------------------- compiler/typecheck/TcGenDeriv.lhs | 61 ++++++++++++++++++++--------- 2 files changed, 82 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 49333bf58d1dfda83021d69908dc2aea4980d867 From git at git.haskell.org Thu Jul 31 07:58:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 07:58:09 +0000 (UTC) Subject: [commit: ghc] master: Comments and white space (ab8f254) Message-ID: <20140731075809.A8083240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab8f2544ac2fe5fac0b482ab6da3eef004f4e6f5/ghc >--------------------------------------------------------------- commit ab8f2544ac2fe5fac0b482ab6da3eef004f4e6f5 Author: Simon Peyton Jones Date: Tue Jul 29 22:01:59 2014 +0100 Comments and white space >--------------------------------------------------------------- ab8f2544ac2fe5fac0b482ab6da3eef004f4e6f5 compiler/typecheck/TcSMonad.lhs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 9b73fe6..9891f77 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1281,8 +1281,7 @@ getUntouchables = wrapTcS TcM.getUntouchables getGivenInfo :: TcS a -> TcS (Bool, [TcTyVar], a) -- See Note [inert_fsks and inert_no_eqs] getGivenInfo thing_inside - = do { - ; updInertTcS reset_vars -- Set inert_fsks and inert_no_eqs to initial values + = do { updInertTcS reset_vars -- Set inert_fsks and inert_no_eqs to initial values ; res <- thing_inside -- Run thing_inside ; is <- getTcSInerts -- Get new values of inert_fsks and inert_no_eqs ; return (inert_no_eqs (inert_cans is), inert_fsks is, res) } @@ -1716,7 +1715,7 @@ as an Irreducible (see Note [Equalities with incompatible kinds] in TcCanonical), and will do no harm. \begin{code} -xCtEvidence :: CtEvidence -- Original flavor +xCtEvidence :: CtEvidence -- Original evidence -> XEvTerm -- Instructions about how to manipulate evidence -> TcS [CtEvidence] From git at git.haskell.org Thu Jul 31 07:58:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 07:58:12 +0000 (UTC) Subject: [commit: ghc] master: Compiler perf has improved a bit (6fa6caa) Message-ID: <20140731075812.EE750240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6fa6caad0cb4ba99b2c0b444b0583190e743dd63/ghc >--------------------------------------------------------------- commit 6fa6caad0cb4ba99b2c0b444b0583190e743dd63 Author: Simon Peyton Jones Date: Thu Jul 31 08:57:35 2014 +0100 Compiler perf has improved a bit >--------------------------------------------------------------- 6fa6caad0cb4ba99b2c0b444b0583190e743dd63 testsuite/tests/perf/compiler/all.T | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 9a67aa5..5921554 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -366,10 +366,12 @@ test('T5321Fun', test('T5321FD', [ only_ways(['normal']), # no optimisation for this one compiler_stats_num_field('bytes allocated', - [(wordsize(32), 240302920, 10), + [(wordsize(32), 211699816, 10), # prev: 213380256 # 2012-10-08: 240302920 (x86/Linux) # (increase due to new codegen) + # 2014-07-31: 211699816 (Windows) (-11%) + # (due to better optCoercion, 5e7406d9, #9233) (wordsize(64), 426960992, 10)]) # prev: 418306336 # 29/08/2012: 492905640 @@ -432,7 +434,9 @@ test('T6048', test('T9020', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(32), 381360728, 10), + [(wordsize(32), 343005716, 10), + # Original: 381360728 + # 2014-07-31: 343005716 (Windows) (general round of updates) (wordsize(64), 728263536, 10)]) # prev: 795469104 # 2014-07-17: 728263536 (general round of updates) From git at git.haskell.org Thu Jul 31 13:05:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 13:05:16 +0000 (UTC) Subject: [commit: ghc] master: [backpack] Package selection (a0ff1eb) Message-ID: <20140731130516.9F3D3240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a0ff1eb3c0745230cd70525853ca741e08a1f34d/ghc >--------------------------------------------------------------- commit a0ff1eb3c0745230cd70525853ca741e08a1f34d Author: Edward Z. Yang Date: Thu Jul 31 14:05:02 2014 +0100 [backpack] Package selection Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a0ff1eb3c0745230cd70525853ca741e08a1f34d docs/backpack/backpack-impl.tex | 625 ++++++++++++++++++++++++++-------------- 1 file changed, 412 insertions(+), 213 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a0ff1eb3c0745230cd70525853ca741e08a1f34d From git at git.haskell.org Thu Jul 31 14:49:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 14:49:54 +0000 (UTC) Subject: [commit: ghc] master: Comments and white space (0be7c2c) Message-ID: <20140731144954.D5D44240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0be7c2cf1aa7c7747d27fb985e032ea2eeeb718e/ghc >--------------------------------------------------------------- commit 0be7c2cf1aa7c7747d27fb985e032ea2eeeb718e Author: Simon Peyton Jones Date: Mon Jul 28 14:21:04 2014 +0100 Comments and white space >--------------------------------------------------------------- 0be7c2cf1aa7c7747d27fb985e032ea2eeeb718e compiler/types/FamInstEnv.lhs | 28 +++++++++++++++------------- compiler/types/TyCon.lhs | 16 +++++++++++----- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs index fcf7cb4..870113f 100644 --- a/compiler/types/FamInstEnv.lhs +++ b/compiler/types/FamInstEnv.lhs @@ -644,7 +644,7 @@ lookupFamInstEnvConflicts envs fam_inst@(FamInst { fi_axiom = new_axiom }) (ppr tpl_tvs <+> ppr tpl_tys) ) -- Unification will break badly if the variables overlap -- They shouldn't because we allocate separate uniques for them - if compatibleBranches (coAxiomSingleBranch old_axiom) (new_branch) + if compatibleBranches (coAxiomSingleBranch old_axiom) new_branch then Nothing else Just noSubst -- Note [Family instance overlap conflicts] @@ -672,7 +672,7 @@ Note [Family instance overlap conflicts] -- Might be a one-way match or a unifier type MatchFun = FamInst -- The FamInst template -> TyVarSet -> [Type] -- fi_tvs, fi_tys of that FamInst - -> [Type] -- Target to match against + -> [Type] -- Target to match against -> Maybe TvSubst lookup_fam_inst_env' -- The worker, local to this module @@ -732,9 +732,9 @@ lookup_fam_inst_env -- The worker, local to this module -- Precondition: the tycon is saturated (or over-saturated) -lookup_fam_inst_env match_fun (pkg_ie, home_ie) fam tys = - lookup_fam_inst_env' match_fun home_ie fam tys ++ - lookup_fam_inst_env' match_fun pkg_ie fam tys +lookup_fam_inst_env match_fun (pkg_ie, home_ie) fam tys + = lookup_fam_inst_env' match_fun home_ie fam tys + ++ lookup_fam_inst_env' match_fun pkg_ie fam tys \end{code} @@ -750,16 +750,18 @@ which you can't do in Haskell!): Then looking up (F (Int,Bool) Char) will return a FamInstMatch (FPair, [Int,Bool,Char]) - The "extra" type argument [Char] just stays on the end. -Because of eta-reduction of data family instances (see -Note [Eta reduction for data family axioms] in TcInstDecls), we must -handle data families and type families separately here. All instances -of a type family must have the same arity, so we can precompute the split -between the match_tys and the overflow tys. This is done in pre_rough_split_tys. -For data instances, though, we need to re-split for each instance, because -the breakdown might be different. +We handle data families and type families separately here: + + * For type families, all instances of a type family must have the + same arity, so we can precompute the split between the match_tys + and the overflow tys. This is done in pre_rough_split_tys. + + * For data families instances, though, we need to re-split for each + instance, because the breakdown might be different for each + instance. Why? Because of eta reduction; see Note [Eta reduction + for data family axioms] \begin{code} diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index c39f9d1..a500a62 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -183,6 +183,9 @@ See also Note [Wrappers for data instance tycons] in MkId.lhs It has an AlgTyConParent of FamInstTyCon T [Int] ax_ti +* The axiom ax_ti may be eta-reduced; see + Note [Eta reduction for data family axioms] in TcInstDcls + * The data contructor T2 has a wrapper (which is what the source-level "T2" invokes): @@ -576,11 +579,14 @@ data TyConParent -- 3) A 'CoTyCon' identifying the representation -- type with the type instance family | FamInstTyCon -- See Note [Data type families] - (CoAxiom Unbranched) -- The coercion constructor, - -- always of kind T ty1 ty2 ~ R:T a b c - -- where T is the family TyCon, - -- and R:T is the representation TyCon (ie this one) - -- and a,b,c are the tyConTyVars of this TyCon + (CoAxiom Unbranched) -- The coercion axiom. + -- Generally of kind T ty1 ty2 ~ R:T a b c + -- where T is the family TyCon, + -- and R:T is the representation TyCon (ie this one) + -- and a,b,c are the tyConTyVars of this TyCon + -- + -- BUT may be eta-reduced; see TcInstDcls + -- Note [Eta reduction for data family axioms] -- Cached fields of the CoAxiom, but adjusted to -- use the tyConTyVars of this TyCon From git at git.haskell.org Thu Jul 31 14:49:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 14:49:57 +0000 (UTC) Subject: [commit: ghc] master: Add a fast-path in TcInteract.kickOutRewritable (7381cee) Message-ID: <20140731144957.E2B85240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7381cee923526535dfc9e9599e47f61390a51305/ghc >--------------------------------------------------------------- commit 7381cee923526535dfc9e9599e47f61390a51305 Author: Simon Peyton Jones Date: Thu Jul 31 13:49:32 2014 +0100 Add a fast-path in TcInteract.kickOutRewritable >--------------------------------------------------------------- 7381cee923526535dfc9e9599e47f61390a51305 compiler/typecheck/TcInteract.lhs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 2590d35..33249f4 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -753,12 +753,16 @@ kickOutRewritable :: CtEvidence -- Flavour of the equality that is -> InertCans -> TcS (Int, InertCans) kickOutRewritable new_ev new_tv - (IC { inert_eqs = tv_eqs - , inert_dicts = dictmap - , inert_funeqs = funeqmap - , inert_irreds = irreds - , inert_insols = insols - , inert_no_eqs = no_eqs }) + inert_cans@(IC { inert_eqs = tv_eqs + , inert_dicts = dictmap + , inert_funeqs = funeqmap + , inert_irreds = irreds + , inert_insols = insols + , inert_no_eqs = no_eqs }) + | new_tv `elemVarEnv` tv_eqs -- Fast path: there is at least one equality for tv + -- so kick-out will do nothing + = return (0, inert_cans) + | otherwise = do { traceTcS "kickOutRewritable" $ vcat [ text "tv = " <+> ppr new_tv , ptext (sLit "Kicked out =") <+> ppr kicked_out] From git at git.haskell.org Thu Jul 31 14:50:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 14:50:00 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #9380 (dc7d3c2) Message-ID: <20140731145000.AD03B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dc7d3c2d437b310d26b05033d1b34601e1914d00/ghc >--------------------------------------------------------------- commit dc7d3c2d437b310d26b05033d1b34601e1914d00 Author: Simon Peyton Jones Date: Thu Jul 31 13:48:46 2014 +0100 Test Trac #9380 >--------------------------------------------------------------- dc7d3c2d437b310d26b05033d1b34601e1914d00 testsuite/tests/gadt/T9380.hs | 68 +++++++++++++++++++++++++++++++++++++++ testsuite/tests/gadt/T9380.stdout | 3 ++ testsuite/tests/gadt/all.T | 1 + 3 files changed, 72 insertions(+) diff --git a/testsuite/tests/gadt/T9380.hs b/testsuite/tests/gadt/T9380.hs new file mode 100644 index 0000000..ebc0217 --- /dev/null +++ b/testsuite/tests/gadt/T9380.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +module Main where + +import Foreign +import Unsafe.Coerce + +data M = A | B deriving (Show, Eq) + +newtype S (a :: M) = S Int + +data SomeS = forall a . SomeS (S a) + +data V0 :: M -> * where + V0A :: Int -> V0 A + V0B :: Double -> V0 B + +data V1 :: M -> * where + V1A :: Int -> V1 A + V1B :: Double -> V1 B + V1a :: () -> V1 a + +viewV0 :: S a -> V0 a +viewV0 (S i) + | even i = unsafeCoerce $ V0A 1 + | otherwise = unsafeCoerce $ V0B 2 + +viewV1 :: S a -> V1 a +viewV1 (S i) + | even i = unsafeCoerce $ V1A 1 + | otherwise = unsafeCoerce $ V1B 2 + + +typeOf :: S a -> M +typeOf (S i) = if even i then A else B + +cast :: M -> SomeS -> S a +cast ty (SomeS s@(S i)) + | ty == typeOf s = S i + | otherwise = error "cast" + +test0 :: IO () +test0 = + let s = cast A (SomeS (S 0)) + in case viewV0 s of + V0A{} -> putStrLn "test0 - A" + V0B{} -> putStrLn "test0 - B" + +test1 :: IO () +test1 = + let s = cast A (SomeS (S 2)) :: S A + in case viewV0 s of + V0A{} -> putStrLn "test1 - A" + +test2 :: IO () +test2 = + let s = cast A (SomeS (S 4)) + in case viewV1 s of + V1A{} -> putStrLn "test2 - A" + V1B{} -> putStrLn "test2 - B" + V1a{} -> putStrLn "test2 - O_o" + +main = do + test0 -- no ouput at all + test1 -- A + test2 -- O_o \ No newline at end of file diff --git a/testsuite/tests/gadt/T9380.stdout b/testsuite/tests/gadt/T9380.stdout new file mode 100644 index 0000000..0a5a466 --- /dev/null +++ b/testsuite/tests/gadt/T9380.stdout @@ -0,0 +1,3 @@ +test0 - A +test1 - A +test2 - A diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 52a8812..4a42bb7 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -123,3 +123,4 @@ test('T7321', test('T7974', normal, compile, ['']) test('T7558', normal, compile_fail, ['']) test('T9096', normal, compile, ['']) +test('T9380', normal, compile_and_run, ['']) From git at git.haskell.org Thu Jul 31 14:50:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 14:50:03 +0000 (UTC) Subject: [commit: ghc] master: Add comments about the {-# INCOHERENT #-} for Typeable (f a) (bfaa179) Message-ID: <20140731145003.B9F98240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bfaa17998ed0cb8b22132d8e824b274ac5f038cc/ghc >--------------------------------------------------------------- commit bfaa17998ed0cb8b22132d8e824b274ac5f038cc Author: Simon Peyton Jones Date: Thu Jul 31 14:01:32 2014 +0100 Add comments about the {-# INCOHERENT #-} for Typeable (f a) C.f. Trac #9242 >--------------------------------------------------------------- bfaa17998ed0cb8b22132d8e824b274ac5f038cc libraries/base/Data/Typeable/Internal.hs | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 93b64ef..7c12cea 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -264,13 +264,29 @@ type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a -- | Kind-polymorphic Typeable instance for type application instance {-# INCOHERENT #-} (Typeable s, Typeable a) => Typeable (s a) where + -- See Note [The apparent incoherence of Typable] typeRep# = \_ -> rep -- Note [Memoising typeOf] where !ty1 = typeRep# (proxy# :: Proxy# s) !ty2 = typeRep# (proxy# :: Proxy# a) !rep = ty1 `mkAppTy` ty2 -{- Note [Memoising typeOf] -~~~~~~~~~~~~~~~~~~~~~~~~~~ + +{- Note [The apparent incoherence of Typable] See Trac #9242 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The reason we have INCOHERENT here is because we also have instances + instance Typeable (x::Nat) + instance Typeable (y::Symbol) +If we have + [Wanted] Typeable (a :: Nat) + +we should pick the (x::Nat) instance, even though the instance +matching rules would worry that 'a' might later be instantiated to +(f b), for some f and b. But we type theorists know that there are no +type constructors f of kind blah -> Nat, so this can never happen and +it's safe to pick the second instance. + +Note [Memoising typeOf] +~~~~~~~~~~~~~~~~~~~~~~~ See #3245, #9203 IMPORTANT: we don't want to recalculate the TypeRep once per call with @@ -447,6 +463,7 @@ isomorphic to (lifted) `[()]` and `Symbol` is isomorphic to `[Char]`. -} instance KnownNat n => Typeable (n :: Nat) where + -- See Note [The apparent incoherence of Typable] -- See #9203 for an explanation of why this is written as `\_ -> rep`. typeRep# = \_ -> rep where @@ -464,6 +481,7 @@ instance KnownNat n => Typeable (n :: Nat) where instance KnownSymbol s => Typeable (s :: Symbol) where + -- See Note [The apparent incoherence of Typable] -- See #9203 for an explanation of why this is written as `\_ -> rep`. typeRep# = \_ -> rep where From git at git.haskell.org Thu Jul 31 14:50:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 14:50:06 +0000 (UTC) Subject: [commit: ghc] master: Comments only (fe2d807) Message-ID: <20140731145006.475F1240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe2d80768641f66eca8a86c69d3a3bc5f04f88ee/ghc >--------------------------------------------------------------- commit fe2d80768641f66eca8a86c69d3a3bc5f04f88ee Author: Simon Peyton Jones Date: Thu Jul 31 13:49:47 2014 +0100 Comments only >--------------------------------------------------------------- fe2d80768641f66eca8a86c69d3a3bc5f04f88ee compiler/typecheck/TcCanonical.lhs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs index 43cbb2c..d58d5db 100644 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@ -1186,6 +1186,9 @@ canEqTyVar2 dflags ev swapped tv1 xi2 co2 ; case mb of Nothing -> return () Just new_ev -> emitInsoluble (mkNonCanonical new_ev) + -- If we have a ~ [a], it is not canonical, and in particular + -- we don't want to rewrite existing inerts with it, otherwise + -- we'd risk divergence in the constraint solver ; return Stop } where xi1 = mkTyVarTy tv1 From git at git.haskell.org Thu Jul 31 14:50:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 14:50:09 +0000 (UTC) Subject: [commit: ghc] master: Complete work on new OVERLAPPABLE/OVERLAPPING pragmas (Trac #9242) (1ae5fa4) Message-ID: <20140731145009.A7902240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ae5fa451f4f554e0d652d55f9312a585188ce13/ghc >--------------------------------------------------------------- commit 1ae5fa451f4f554e0d652d55f9312a585188ce13 Author: Simon Peyton Jones Date: Thu Jul 31 15:49:14 2014 +0100 Complete work on new OVERLAPPABLE/OVERLAPPING pragmas (Trac #9242) * Deprecate -XOverlappingInstances * Update test suite. Several tests even had entirely unnecessary uses of -XOverlappingInstances * Update user manual with a careful description of the instance resolution story * Fix an outright bug in the handling of duplidate instances in GHCi, which are meant to silently overwrite the earlier duplicate. The logic was right for family instances but was both more complicated, and plain wrong, for class instances. (If you are interested, the bug was that we were eliminating the duplicate from the InstEnv, but not from the [ClsInst] held in tcg_insts.) Test is ghci044a. >--------------------------------------------------------------- 1ae5fa451f4f554e0d652d55f9312a585188ce13 compiler/basicTypes/BasicTypes.lhs | 76 ++++++++------- compiler/main/DynFlags.hs | 4 +- compiler/main/HscTypes.lhs | 15 +-- compiler/typecheck/Inst.lhs | 69 ++++++-------- compiler/typecheck/TcRnTypes.lhs | 3 + compiler/types/FamInstEnv.lhs | 31 +++--- compiler/types/InstEnv.lhs | 106 ++++++++++++++------- docs/users_guide/glasgow_exts.xml | 57 ++++++----- testsuite/tests/deriving/should_compile/T4966.hs | 5 +- .../tests/deriving/should_compile/T4966.stderr | 2 +- testsuite/tests/generics/Uniplate/GUniplate.hs | 6 +- .../tests/ghci.debugger/scripts/print019.stderr | 4 +- testsuite/tests/ghci/prog007/C.hs | 2 - testsuite/tests/ghci/scripts/all.T | 1 + testsuite/tests/ghci/scripts/ghci044.script | 19 ++-- testsuite/tests/ghci/scripts/ghci044.stderr | 17 ++-- testsuite/tests/ghci/scripts/ghci044a.hs | 9 ++ testsuite/tests/ghci/scripts/ghci044a.script | 9 ++ testsuite/tests/ghci/scripts/ghci044a.stdout | 2 + testsuite/tests/ghci/scripts/ghci047.script | 6 +- .../tests/indexed-types/should_compile/Gentle.hs | 2 +- .../should_compile/IndTypesPerfMerge.hs | 2 +- .../indexed-types/should_compile/NonLinearLHS.hs | 2 +- testsuite/tests/indexed-types/should_fail/T4246.hs | 6 +- testsuite/tests/indexed-types/should_fail/T4485.hs | 9 +- .../tests/indexed-types/should_fail/T4485.stderr | 19 ++-- testsuite/tests/indexed-types/should_fail/T5439.hs | 1 - .../tests/indexed-types/should_fail/T5439.stderr | 12 +-- testsuite/tests/perf/compiler/T5321FD.hs | 2 +- testsuite/tests/perf/compiler/T5321Fun.hs | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 2 +- testsuite/tests/safeHaskell/ghci/p13.script | 3 +- testsuite/tests/safeHaskell/ghci/p13.stderr | 9 +- .../safeHaskell/safeInfered/UnsafeInfered08_A.hs | 1 + .../safeHaskell/safeLanguage/SafeLang10.stderr | 4 +- .../tests/safeHaskell/safeLanguage/SafeLang10_B.hs | 5 +- testsuite/tests/simplCore/should_compile/T5359b.hs | 1 - .../tests/simplCore/should_compile/T5359b.stderr | 2 +- .../tests/simplCore/should_compile/simpl007.hs | 4 +- testsuite/tests/th/T4135a.hs | 2 +- testsuite/tests/typecheck/should_compile/FD4.hs | 1 - .../typecheck/should_compile/LoopOfTheDay3.hs | 2 +- testsuite/tests/typecheck/should_compile/Makefile | 4 +- testsuite/tests/typecheck/should_compile/T1470.hs | 10 +- testsuite/tests/typecheck/should_compile/T3018.hs | 2 +- testsuite/tests/typecheck/should_compile/T3108.hs | 14 +-- testsuite/tests/typecheck/should_compile/Tc173a.hs | 5 +- testsuite/tests/typecheck/should_compile/Tc173b.hs | 1 + testsuite/tests/typecheck/should_compile/tc176.hs | 6 +- testsuite/tests/typecheck/should_compile/tc179.hs | 7 +- .../typecheck/should_fail/LongWayOverlapping.hs | 1 - .../should_fail/LongWayOverlapping.stderr | 2 +- testsuite/tests/typecheck/should_fail/T2307.hs | 2 +- testsuite/tests/typecheck/should_fail/T5051.hs | 4 +- testsuite/tests/typecheck/should_fail/T5051.stderr | 2 +- testsuite/tests/typecheck/should_fail/T5095.hs | 4 +- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail121.hs | 6 +- .../tests/typecheck/should_fail/tcfail121.stderr | 6 +- testsuite/tests/typecheck/should_fail/tcfail202.hs | 2 +- 60 files changed, 332 insertions(+), 284 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1ae5fa451f4f554e0d652d55f9312a585188ce13 From git at git.haskell.org Thu Jul 31 16:58:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 16:58:46 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment (c97f853) Message-ID: <20140731165846.A7A18240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c97f8533e740672b336bf26e102a2ee483b3c9a8/ghc >--------------------------------------------------------------- commit c97f8533e740672b336bf26e102a2ee483b3c9a8 Author: Gabor Greif Date: Thu Jul 31 18:56:50 2014 +0200 Typo in comment >--------------------------------------------------------------- c97f8533e740672b336bf26e102a2ee483b3c9a8 compiler/types/TyCon.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index a500a62..65b5645 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -728,7 +728,7 @@ which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s]) Note [Newtype eta] ~~~~~~~~~~~~~~~~~~ Consider - newtype Parser a = MkParser (IO a) derriving( Monad ) + newtype Parser a = MkParser (IO a) deriving Monad Are these two types equal (to Core)? Monad Parser Monad IO From git at git.haskell.org Thu Jul 31 20:37:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 20:37:20 +0000 (UTC) Subject: [commit: ghc] master: Fix up ghci044 (fd47e26) Message-ID: <20140731203720.77826240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fd47e261af27a4ce274b6bd253721cff06225914/ghc >--------------------------------------------------------------- commit fd47e261af27a4ce274b6bd253721cff06225914 Author: Simon Peyton Jones Date: Thu Jul 31 21:37:01 2014 +0100 Fix up ghci044 >--------------------------------------------------------------- fd47e261af27a4ce274b6bd253721cff06225914 testsuite/tests/ghci/scripts/ghci044.script | 2 ++ testsuite/tests/ghci/scripts/ghci044.stdout | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/testsuite/tests/ghci/scripts/ghci044.script b/testsuite/tests/ghci/scripts/ghci044.script index b89ede3..d6f12ad 100644 --- a/testsuite/tests/ghci/scripts/ghci044.script +++ b/testsuite/tests/ghci/scripts/ghci044.script @@ -10,4 +10,6 @@ instance {-# OVERLAPPABLE #-} C a => C [a] where f xs = "Third" f [5::Int] -- Should be fine instance {-# OVERLAPPABLE #-} C a => C [a] where f xs = "Fourth" f [6::Int] -- Should be fine too, overrides +instance C Bool where { f _ = "Bool" } +f [True] -- Should be fine too, overrides diff --git a/testsuite/tests/ghci/scripts/ghci044.stdout b/testsuite/tests/ghci/scripts/ghci044.stdout new file mode 100644 index 0000000..eadd22f --- /dev/null +++ b/testsuite/tests/ghci/scripts/ghci044.stdout @@ -0,0 +1,4 @@ +"First" +"First" +"First" +"Fourth" From git at git.haskell.org Thu Jul 31 23:31:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Jul 2014 23:31:23 +0000 (UTC) Subject: [commit: ghc] master: Minor wordsmithing of comments (bdf0ef0) Message-ID: <20140731233123.2B957240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bdf0ef0e523d9f2c4116532a811e84857cece6b2/ghc >--------------------------------------------------------------- commit bdf0ef0e523d9f2c4116532a811e84857cece6b2 Author: Gabor Greif Date: Fri Aug 1 01:29:10 2014 +0200 Minor wordsmithing of comments >--------------------------------------------------------------- bdf0ef0e523d9f2c4116532a811e84857cece6b2 compiler/main/SysTools.lhs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index adb8d31..1c1c52c 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -832,10 +832,10 @@ runLink dflags args = do _ -> id {- SunOS/Solaris ld emits harmless warning messages about unresolved - symbol in case of compiling into shared library when we do not + symbols in case of compiling into shared library when we do not link against all the required libs. That is the case of GHC which does not link against RTS library explicitly in order to be able to - chose the library later based on binary application linking + choose the library later based on binary application linking parameters. The warnings look like: Undefined first referenced @@ -859,10 +859,10 @@ ld: warning: symbol referencing errors Following filter code is SunOS/Solaris linker specific and should filter out only linker warnings. Please note that the logic is a - little bit more complex due to simple reason that we need to preserve + little bit more complex due to the simple reason that we need to preserve any other linker emitted messages. If there are any. Simply speaking if we see "Undefined" and later "ld: warning:..." then we omit all - text between (including) the marks. Otherwise we copy whole output. + text between (including) the marks. Otherwise we copy the whole output. -} sunos_ld_filter :: String -> String sunos_ld_filter = unlines . sunos_ld_filter' . lines