From git at git.haskell.org Sun Jul 1 11:35:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 1 Jul 2018 11:35:59 +0000 (UTC) Subject: [commit: ghc] master: testsuite: remove unused scc001 target (b4e6483) Message-ID: <20180701113559.933363ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4e64839a95d024252950f07e3da50c3d4087882/ghc >--------------------------------------------------------------- commit b4e64839a95d024252950f07e3da50c3d4087882 Author: Ömer Sinan Ağacan Date: Sun Jul 1 14:31:27 2018 +0300 testsuite: remove unused scc001 target >--------------------------------------------------------------- b4e64839a95d024252950f07e3da50c3d4087882 testsuite/tests/profiling/should_run/Makefile | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/testsuite/tests/profiling/should_run/Makefile b/testsuite/tests/profiling/should_run/Makefile index 33d8d9a..d52bda1 100644 --- a/testsuite/tests/profiling/should_run/Makefile +++ b/testsuite/tests/profiling/should_run/Makefile @@ -4,25 +4,6 @@ include $(TOP)/mk/test.mk DECIMAL_REGEXP = [0-9]\+.[0-9]\+ -define scc001Test - grep -q '^ *$1 \+Main \+[0-9]\+ \+1 \+$(DECIMAL_REGEXP) \+$(DECIMAL_REGEXP) \+$(DECIMAL_REGEXP) \+$(DECIMAL_REGEXP)$$' scc001.prof || { echo 'No single-entry for $1 found in profile'; grep '^ *$1 ' scc001.prof; true; } -endef - -define scc001Rule - rm -f scc001.hi scc001.o scc001 - @echo Compiling with $1 - '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make scc001 -prof -fprof-auto -rtsopts $1 - ./scc001 +RTS -p - $(call scc001Test,f) - $(call scc001Test,g) - $(call scc001Test,h) -endef - -.PHONY: scc001 -scc001: - $(call scc001Rule,-O0) - $(call scc001Rule,-O) - .PHONY: T11489 T11489: $(RM) T11489 From git at git.haskell.org Wed Jul 4 06:08:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jul 2018 06:08:45 +0000 (UTC) Subject: [commit: ghc] master: RtClosureInspect: add some docs, remove unused stuff (6cb189d) Message-ID: <20180704060845.186FE3ABA6@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6cb189d1d465d18879b6a4b107fbdce53b2ebf56/ghc >--------------------------------------------------------------- commit 6cb189d1d465d18879b6a4b107fbdce53b2ebf56 Author: Ömer Sinan Ağacan Date: Wed Jul 4 09:08:16 2018 +0300 RtClosureInspect: add some docs, remove unused stuff Details are not documented, only the high-level functions Reviewers: simonpj, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4911 >--------------------------------------------------------------- 6cb189d1d465d18879b6a4b107fbdce53b2ebf56 compiler/ghci/RtClosureInspect.hs | 129 +++++++++++++++++--------------------- 1 file changed, 58 insertions(+), 71 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 025efe8..81bdb61 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -8,20 +8,19 @@ -- ----------------------------------------------------------------------------- module RtClosureInspect( - cvObtainTerm, -- :: HscEnv -> Int -> Bool -> Maybe Type -> HValue -> IO Term + -- * Entry points and types + cvObtainTerm, cvReconstructType, improveRTTIType, - Term(..), - isTerm, isSuspension, isPrim, isFun, isFunLike, isNewtypeWrap, - isFullyEvaluated, isFullyEvaluatedTerm, - termType, mapTermType, termTyCoVars, - foldTerm, TermFold(..), foldTermM, TermFoldM(..), idTermFold, - pprTerm, cPprTerm, cPprTermBase, CustomTermPrinter, --- unsafeDeepSeq, + -- * Utils + isFullyEvaluatedTerm, + termType, mapTermType, termTyCoVars, + foldTerm, TermFold(..), + cPprTerm, cPprTermBase, - constrClosToName, isConstr, isIndirection + constrClosToName -- exported to use in test T4891 ) where #include "HsVersions.h" @@ -102,28 +101,6 @@ data Term = Term { ty :: RttiType ty :: RttiType , wrapped_term :: Term } -isTerm, isSuspension, isPrim, isFun, isFunLike, isNewtypeWrap :: Term -> Bool -isTerm Term{} = True -isTerm _ = False -isSuspension Suspension{} = True -isSuspension _ = False -isPrim Prim{} = True -isPrim _ = False -isNewtypeWrap NewtypeWrap{} = True -isNewtypeWrap _ = False - -isFun Suspension{ctype=FUN} = True -isFun Suspension{ctype=FUN_1_0} = True -isFun Suspension{ctype=FUN_0_1} = True -isFun Suspension{ctype=FUN_2_0} = True -isFun Suspension{ctype=FUN_1_1} = True -isFun Suspension{ctype=FUN_0_2} = True -isFun Suspension{ctype=FUN_STATIC} = True -isFun _ = False - -isFunLike s at Suspension{ty=ty} = isFun s || isFunTy ty -isFunLike _ = False - termType :: Term -> RttiType termType t = ty t @@ -142,40 +119,12 @@ instance Outputable (Term) where -- Runtime Closure information functions ---------------------------------------- -isConstr, isIndirection, isThunk :: GenClosure a -> Bool -isConstr ConstrClosure{} = True -isConstr _ = False - -isIndirection IndClosure{} = True -isIndirection _ = False - +isThunk :: GenClosure a -> Bool isThunk ThunkClosure{} = True isThunk APClosure{} = True isThunk APStackClosure{} = True isThunk _ = False -isFullyEvaluated :: a -> IO Bool -isFullyEvaluated a = do - closure <- getClosureData a - if isConstr closure - then do are_subs_evaluated <- amapM isFullyEvaluated (ptrArgs closure) - return$ and are_subs_evaluated - else return False - where amapM f = sequence . map (\(Box x) -> f x) - --- TODO: Fix it. Probably the otherwise case is failing, trace/debug it -{- -unsafeDeepSeq :: a -> b -> b -unsafeDeepSeq = unsafeDeepSeq1 2 - where unsafeDeepSeq1 0 a b = seq a $! b - unsafeDeepSeq1 i a b -- 1st case avoids infinite loops for non reducible thunks - | not (isConstr tipe) = seq a $! unsafeDeepSeq1 (i-1) a b - -- | unsafePerformIO (isFullyEvaluated a) = b - | otherwise = case unsafePerformIO (getClosureData a) of - closure -> foldl' (flip unsafeDeepSeq) b (ptrs closure) - where tipe = unsafePerformIO (getClosureType a) --} - -- Lookup the name in a constructor closure constrClosToName :: HscEnv -> Closure -> IO (Either String Name) constrClosToName hsc_env ConstrClosure{pkg=pkg,modl=mod,name=occ} = do @@ -266,7 +215,6 @@ termTyCoVars = foldTerm TermFold { ---------------------------------- type Precedence = Int -type TermPrinter = Precedence -> Term -> SDoc type TermPrinterM m = Precedence -> Term -> m SDoc app_prec,cons_prec, max_prec ::Int @@ -274,10 +222,6 @@ max_prec = 10 app_prec = max_prec cons_prec = 5 -- TODO Extract this info from GHC itself -pprTerm :: TermPrinter -> TermPrinter -pprTerm y p t | Just doc <- pprTermM (\p -> Just . y p) p t = doc -pprTerm _ _ _ = panic "pprTerm" - pprTermM, ppr_termM, pprNewtypeWrap :: Monad m => TermPrinterM m -> TermPrinterM m pprTermM y p t = pprDeeper `liftM` ppr_termM y p t @@ -591,9 +535,26 @@ addConstraint actual expected = do -- TOMDO: what about the coercion? -- we should consider family instances --- Type & Term reconstruction ------------------------------- -cvObtainTerm :: HscEnv -> Int -> Bool -> RttiType -> HValue -> IO Term + +-- | Term reconstruction +-- +-- Given a pointer to a heap object (`HValue`) and its type, build a `Term` +-- representation of the object. Subterms (objects in the payload) are also +-- built up to the given `max_depth`. After `max_depth` any subterms will appear +-- as `Suspension`s. Any thunks found while traversing the object will be forced +-- based on `force` parameter. +-- +-- Types of terms will be refined based on constructors we find during term +-- reconstruction. See `cvReconstructType` for an overview of how type +-- reconstruction works. +-- +cvObtainTerm + :: HscEnv + -> Int -- ^ How many times to recurse for subterms + -> Bool -- ^ Force thunks + -> RttiType -- ^ Type of the object to reconstruct + -> HValue -- ^ Object to reconstruct + -> IO Term cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do -- we quantify existential tyvars as universal, -- as this is needed to be able to manipulate @@ -814,9 +775,35 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 moveBytes = r * 8 --- Fast, breadth-first Type reconstruction ------------------------------------------- -cvReconstructType :: HscEnv -> Int -> GhciType -> HValue -> IO (Maybe Type) +-- | Fast, breadth-first Type reconstruction +-- +-- Given a heap object (`HValue`) and its (possibly polymorphic) type (usually +-- obtained in GHCi), try to reconstruct a more monomorphic type of the object. +-- This is used for improving type information in debugger. For example, if we +-- have a polymorphic function: +-- +-- sumNumList :: Num a => [a] -> a +-- sumNumList [] = 0 +-- sumNumList (x : xs) = x + sumList xs +-- +-- and add a breakpoint to it: +-- +-- ghci> break sumNumList +-- ghci> sumNumList ([0 .. 9] :: [Int]) +-- +-- ghci shows us more precise types than just `a`s: +-- +-- Stopped in Main.sumNumList, debugger.hs:3:23-39 +-- _result :: Int = _ +-- x :: Int = 0 +-- xs :: [Int] = _ +-- +cvReconstructType + :: HscEnv + -> Int -- ^ How many times to recurse for subterms + -> GhciType -- ^ Type to refine + -> HValue -- ^ Refine the type using this value + -> IO (Maybe Type) cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do traceTR (text "RTTI started with initial type " <> ppr old_ty) let sigma_old_ty@(old_tvs, _) = quantifyType old_ty From git at git.haskell.org Wed Jul 4 06:12:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jul 2018 06:12:48 +0000 (UTC) Subject: [commit: ghc] master: Fix nptr field alignment in RtClosureInspect (15bb4e0) Message-ID: <20180704061248.6EE9C3ABA6@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15bb4e0b6c08b1f8f5511f04af14242f13833ed1/ghc >--------------------------------------------------------------- commit 15bb4e0b6c08b1f8f5511f04af14242f13833ed1 Author: Ömer Sinan Ağacan Date: Wed Jul 4 09:12:01 2018 +0300 Fix nptr field alignment in RtClosureInspect `extractSubTerms` (which is extracting pointer and non-pointer fields of a closure) was computing the alignment incorrectly when aligning a 64-bit value (e.g. a Double) on i386 by aligning it to 64-bits instead of to word size (32-bits). This is documented in `mkVirtHeapOffsetsWithPadding`: > Align the start offset (eg, 2-byte value should be 2-byte aligned). > But not more than to a word. Fixes #15061 Test Plan: Validated on both 32-bit and 64-bit. 32-bit fails with various unrelated stat failures, but no actual test failures. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15061 Differential Revision: https://phabricator.haskell.org/D4906 >--------------------------------------------------------------- 15bb4e0b6c08b1f8f5511f04af14242f13833ed1 compiler/ghci/RtClosureInspect.hs | 11 +++++++---- testsuite/tests/ghci.debugger/scripts/all.T | 3 +-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 81bdb61..d540983 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -742,11 +742,14 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 dflags <- getDynFlags let word_size = wORD_SIZE dflags size_b = primRepSizeB dflags rep - -- Fields are always aligned. - !aligned_idx = roundUpTo arr_i size_b + -- Align the start offset (eg, 2-byte value should be 2-byte + -- aligned). But not more than to a word. The offset calculation + -- should be the same with the offset calculation in + -- StgCmmLayout.mkVirtHeapOffsetsWithPadding. + !aligned_idx = roundUpTo arr_i (min word_size size_b) !new_arr_i = aligned_idx + size_b ws | size_b < word_size = - [index size_b array aligned_idx word_size] + [index size_b aligned_idx word_size] | otherwise = let (q, r) = size_b `quotRem` word_size in ASSERT( r == 0 ) @@ -761,7 +764,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 (error "unboxedTupleTerm: no HValue for unboxed tuple") terms -- Extract a sub-word sized field from a word - index item_size_b array index_b word_size = + index item_size_b index_b word_size = (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes where mask :: Word diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 88acdb0..f2e2658 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -22,8 +22,7 @@ test('print019', extra_files(['../Test.hs']), ghci_script, ['print019.script']) test('print020', extra_files(['../HappyTest.hs']), ghci_script, ['print020.script']) test('print021', normal, ghci_script, ['print021.script']) test('print022', - [when(arch('powerpc64'), expect_broken(14455)), - when(wordsize(32), expect_broken(15061))], + [when(arch('powerpc64'), expect_broken(14455))], ghci_script, ['print022.script']) test('print023', extra_files(['../Test.hs']), ghci_script, ['print023.script']) test('print024', extra_files(['../Test.hs']), ghci_script, ['print024.script']) From git at git.haskell.org Wed Jul 4 12:48:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jul 2018 12:48:21 +0000 (UTC) Subject: [commit: ghc] master: Fix errors caused by invalid candidates leaking from hole fits (39de4e3) Message-ID: <20180704124821.2208B3ABA6@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/39de4e3d33dd9879398062620ad00b1e3b8481ce/ghc >--------------------------------------------------------------- commit 39de4e3d33dd9879398062620ad00b1e3b8481ce Author: Matthías Páll Gissurarson Date: Wed Jul 4 14:54:54 2018 +0300 Fix errors caused by invalid candidates leaking from hole fits This is a one line fix (and a note) that fixes four tickets, #15007, #15321 and #15202, #15314 The issue was that errors caused by illegal candidates (according to GHC stage or being internal names) were leaking to the user, causing bewildering error messages. If a candidate causes the type checker to error, it is not a valid hole fit, and should be discarded. As mentioned in #15321, this can cause a pattern of omissions, which might be hard to discover. A better approach would be to gather the error messages, and ask users to report them as GHC bugs. This will be implemented in a subsequent change. Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15007, #15321, #15202, #15314 Differential Revision: https://phabricator.haskell.org/D4909 >--------------------------------------------------------------- 39de4e3d33dd9879398062620ad00b1e3b8481ce compiler/typecheck/TcHoleErrors.hs | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs index e624d00..ee4d617 100644 --- a/compiler/typecheck/TcHoleErrors.hs +++ b/compiler/typecheck/TcHoleErrors.hs @@ -355,6 +355,15 @@ the only non-hole constraint that mentions any free type variables mentioned in the hole constraint for `_a`, namely `a_a1pd[tau:2]` , and similarly for the hole `_b` we only require that the `$dShow_a1pe` constraint is solved. +Note [Leaking errors] +~~~~~~~~~~~~~~~~~~~ + +When considering candidates, GHC believes that we're checking for validity in +actual source. However, As evidenced by #15321, #15007 and #15202, this can +cause bewildering error messages. The solution here is simple: if a candidate +would cause the type checker to error, it is not a valid hole fit, and thus it +is discarded. + -} @@ -509,11 +518,11 @@ getLocalBindings tidy_orig ct -- See Note [Valid hole fits include ...] findValidHoleFits :: TidyEnv --The tidy_env for zonking - -> [Implication] --Enclosing implications for givens - -> [Ct] -- The unsolved simple constraints in the - -- implication for the hole. - -> Ct -- The hole constraint itself - -> TcM (TidyEnv, SDoc) + -> [Implication] --Enclosing implications for givens + -> [Ct] -- The unsolved simple constraints in the + -- implication for the hole. + -> Ct -- The hole constraint itself + -> TcM (TidyEnv, SDoc) findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct = do { rdr_env <- getGlobalRdrEnv ; lclBinds <- getLocalBindings tidy_env ct @@ -818,6 +827,8 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct = go subs _ _ _ [] = return (False, reverse subs) go subs _ (Just 0) _ _ = return (True, reverse subs) go subs seen maxleft ty (el:elts) = + -- See Note [Leaking errors] + tryTcDiscardingErrs discard_it $ do { traceTc "lookingUp" $ ppr el ; maybeThing <- lookup el ; case maybeThing of From git at git.haskell.org Wed Jul 4 13:43:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jul 2018 13:43:40 +0000 (UTC) Subject: [commit: ghc] master: Add regression test for #15321 (e835fdb) Message-ID: <20180704134340.A239A3ABA6@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e835fdb18cca66820728afce9c924a1c71f17fee/ghc >--------------------------------------------------------------- commit e835fdb18cca66820728afce9c924a1c71f17fee Author: Ömer Sinan Ağacan Date: Wed Jul 4 16:43:13 2018 +0300 Add regression test for #15321 >--------------------------------------------------------------- e835fdb18cca66820728afce9c924a1c71f17fee testsuite/tests/th/T15321.hs | 9 +++++++++ testsuite/tests/th/T15321.stderr | 12 ++++++++++++ testsuite/tests/th/all.T | 1 + 3 files changed, 22 insertions(+) diff --git a/testsuite/tests/th/T15321.hs b/testsuite/tests/th/T15321.hs new file mode 100644 index 0000000..0f0b4d5 --- /dev/null +++ b/testsuite/tests/th/T15321.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T15321 where + +foo :: String +foo = test + +bar :: String +bar = $(_ "baz") diff --git a/testsuite/tests/th/T15321.stderr b/testsuite/tests/th/T15321.stderr new file mode 100644 index 0000000..7807bcf --- /dev/null +++ b/testsuite/tests/th/T15321.stderr @@ -0,0 +1,12 @@ + +T15321.hs:9:9: error: + • Found hole: _ :: [Char] -> Language.Haskell.TH.Lib.Internal.ExpQ + • In the expression: _ + In the expression: _ "baz" + In the untyped splice: $(_ "baz") + • Valid hole fits include + fail :: forall (m :: * -> *) a. Monad m => String -> m a + with fail @Language.Haskell.TH.Syntax.Q + @Language.Haskell.TH.Syntax.Exp + (imported from ‘Prelude’ at T15321.hs:3:8-13 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f86cc96..f95e8f4 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -415,3 +415,4 @@ test('T14885a', normal, compile, ['']) test('T14885b', normal, compile, ['']) test('T14885c', normal, compile, ['']) test('T15243', normal, compile, ['-dsuppress-uniques']) +test('T15321', normal, compile_fail, ['']) From git at git.haskell.org Wed Jul 4 13:50:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jul 2018 13:50:19 +0000 (UTC) Subject: [commit: ghc] master: Add regression test for #15007 (f6ac083) Message-ID: <20180704135019.A064A3ABA6@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6ac0833b733afa628955cdcf6e31171a53e2222/ghc >--------------------------------------------------------------- commit f6ac0833b733afa628955cdcf6e31171a53e2222 Author: Ömer Sinan Ağacan Date: Wed Jul 4 16:49:19 2018 +0300 Add regression test for #15007 >--------------------------------------------------------------- f6ac0833b733afa628955cdcf6e31171a53e2222 .../should_run/T13285.stdout => ghci/should_run/T15007.script} | 1 + .../tests/ghci/{scripts/T10249.stderr => should_run/T15007.stderr} | 6 +++--- .../should_run/T13285.stdout => ghci/should_run/T15007.stdout} | 0 testsuite/tests/ghci/should_run/all.T | 1 + 4 files changed, 5 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/deSugar/should_run/T13285.stdout b/testsuite/tests/ghci/should_run/T15007.script similarity index 66% copy from testsuite/tests/deSugar/should_run/T13285.stdout copy to testsuite/tests/ghci/should_run/T15007.script index 6ed281c..04f2649 100644 --- a/testsuite/tests/deSugar/should_run/T13285.stdout +++ b/testsuite/tests/ghci/should_run/T15007.script @@ -1,2 +1,3 @@ 1 1 +_ diff --git a/testsuite/tests/ghci/scripts/T10249.stderr b/testsuite/tests/ghci/should_run/T15007.stderr similarity index 79% copy from testsuite/tests/ghci/scripts/T10249.stderr copy to testsuite/tests/ghci/should_run/T15007.stderr index c821566..da1dc5d 100644 --- a/testsuite/tests/ghci/scripts/T10249.stderr +++ b/testsuite/tests/ghci/should_run/T15007.stderr @@ -1,9 +1,9 @@ -:1:1: error: +:3:1: error: • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by the inferred type of it :: t - at :1:1 + at :3:1 • In the expression: _ In an equation for ‘it’: it = _ - • Relevant bindings include it :: t (bound at :1:1) + • Relevant bindings include it :: t (bound at :3:1) diff --git a/testsuite/tests/deSugar/should_run/T13285.stdout b/testsuite/tests/ghci/should_run/T15007.stdout similarity index 100% copy from testsuite/tests/deSugar/should_run/T13285.stdout copy to testsuite/tests/ghci/should_run/T15007.stdout diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 430df28..d92b0e7 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -33,3 +33,4 @@ test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) test('T14963a', just_ghci, ghci_script, ['T14963a.script']) test('T14963b', just_ghci, ghci_script, ['T14963b.script']) test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script']) +test('T15007', just_ghci, ghci_script, ['T15007.script']) From git at git.haskell.org Wed Jul 4 14:08:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jul 2018 14:08:02 +0000 (UTC) Subject: [commit: ghc] master: Revert "Don't lock the MVar closure on tryReadMVar" (8f44995) Message-ID: <20180704140802.4E0823ABA6@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f449955e0417ca7b2d3b324262aa8d1a87ad822/ghc >--------------------------------------------------------------- commit 8f449955e0417ca7b2d3b324262aa8d1a87ad822 Author: Ömer Sinan Ağacan Date: Wed Jul 4 17:05:56 2018 +0300 Revert "Don't lock the MVar closure on tryReadMVar" This reverts commit 6bb0c5db818c1ba9cd5fe1785a3020cfddf0c223. See discussion in D4905. >--------------------------------------------------------------- 8f449955e0417ca7b2d3b324262aa8d1a87ad822 rts/PrimOps.cmm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 058fe1e..6081fab 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -1825,14 +1825,18 @@ stg_readMVarzh ( P_ mvar, /* :: MVar a */ ) stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ ) { - W_ val; + W_ val, info, tso, q; - val = StgMVar_value(mvar); + LOCK_CLOSURE(mvar, info); - if (val == stg_END_TSO_QUEUE_closure) { + if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) { + unlockClosure(mvar, info); return (0, stg_NO_FINALIZER_closure); } + val = StgMVar_value(mvar); + + unlockClosure(mvar, info); return (1, val); } From git at git.haskell.org Thu Jul 5 09:52:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 09:52:22 +0000 (UTC) Subject: [commit: ghc] master: Add comments on Typeable (n :: Nat) (7ce6f64) Message-ID: <20180705095222.C744C3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ce6f642a2806c425ba21d48a077d997703cf25b/ghc >--------------------------------------------------------------- commit 7ce6f642a2806c425ba21d48a077d997703cf25b Author: Simon Peyton Jones Date: Tue Jul 3 08:50:19 2018 +0100 Add comments on Typeable (n :: Nat) See Note [Typeable for Nat and Symbol] in TcInteract, which I added after discussion on Trac #15322 >--------------------------------------------------------------- 7ce6f642a2806c425ba21d48a077d997703cf25b compiler/deSugar/DsBinds.hs | 3 ++- compiler/typecheck/TcInteract.hs | 25 +++++++++++++++++++++++-- 2 files changed, 25 insertions(+), 3 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index bec68b0..db7acfd 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1279,7 +1279,8 @@ ds_ev_typeable ty (EvTypeableTrFun ev1 ev2) } ds_ev_typeable ty (EvTypeableTyLit ev) - = do { fun <- dsLookupGlobalId tr_fun + = -- See Note [Typeable for Nat and Symbol] in TcInteract + do { fun <- dsLookupGlobalId tr_fun ; dict <- dsEvTerm ev -- Of type KnownNat/KnownSym ; let proxy = mkTyApps (Var proxyHashId) [ty_kind, ty] ; return (mkApps (mkTyApps (Var fun) [ty]) [ dict, proxy ]) } diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 97d1dde..5d3a988 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2882,8 +2882,8 @@ mk_typeable_pred :: Class -> Type -> PredType mk_typeable_pred clas ty = mkClassPred clas [ typeKind ty, ty ] -- Typeable is implied by KnownNat/KnownSymbol. In the case of a type literal - -- we generate a sub-goal for the appropriate class. See #10348 for what - -- happens when we fail to do this. + -- we generate a sub-goal for the appropriate class. + -- See Note [Typeable for Nat and Symbol] doTyLit :: Name -> Type -> TcS LookupInstResult doTyLit kc t = do { kc_clas <- tcLookupClass kc ; let kc_pred = mkClassPred kc_clas [ t ] @@ -2930,6 +2930,27 @@ a TypeRep for them. For qualified but not polymorphic types, like at the current state of affairs this would be an odd exception as no other class works with impredicative types. For now we leave it off, until we have a better story for impredicativity. + + +Note [Typeable for Nat and Symbol] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We have special Typeable instances for Nat and Symbol. Roughly we +have this instance, implemented here by doTyLit: + instance KnownNat n => Typeable (n :: Nat) where + typeRep = tyepNatTypeRep @n +where + Data.Typeable.Internals.typeNatTypeRep :: KnownNat a => TypeRep a + +Ultimately typeNatTypeRep uses 'natSing' from KnownNat to get a +runtime value 'n'; it turns it into a string with 'show' and uses +that to whiz up a TypeRep TyCon for 'n', with mkTypeLitTyCon. +See #10348. + +Because of this rule it's inadvisable (see #15322) to have a constraint + f :: (Typeable (n :: Nat)) => blah +in a function signature; it gives rise to overlap problems just as +if you'd written + f :: Eq [a] => blah -} {- ******************************************************************** From git at git.haskell.org Thu Jul 5 09:52:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 09:52:25 +0000 (UTC) Subject: [commit: ghc] master: Fix comment (14dfdf6) Message-ID: <20180705095225.910E13ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14dfdf6a0a3364e2d3ae6f6839ef65bb24df4ebf/ghc >--------------------------------------------------------------- commit 14dfdf6a0a3364e2d3ae6f6839ef65bb24df4ebf Author: Simon Peyton Jones Date: Tue Jul 3 08:51:21 2018 +0100 Fix comment >--------------------------------------------------------------- 14dfdf6a0a3364e2d3ae6f6839ef65bb24df4ebf compiler/typecheck/TcSMonad.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 9aafbf3..0ac91a1 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -3188,7 +3188,7 @@ demoteUnfilledFmv fmv ----------------------------- dischargeFunEq :: CtEvidence -> TcTyVar -> TcCoercion -> TcType -> TcS () --- (dischargeFunEqCan ev tv co ty) +-- (dischargeFunEq tv co ty) -- Preconditions -- - ev :: F tys ~ tv is a CFunEqCan -- - tv is a FlatMetaTv of FlatSkolTv From git at git.haskell.org Thu Jul 5 09:52:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 09:52:30 +0000 (UTC) Subject: [commit: ghc] master: Refactor validity checking for constraints (45f44e2) Message-ID: <20180705095230.16D6B3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/45f44e2c9d5db2f25c52abb402f197c20579400f/ghc >--------------------------------------------------------------- commit 45f44e2c9d5db2f25c52abb402f197c20579400f Author: Simon Peyton Jones Date: Wed Jul 4 15:17:54 2018 +0100 Refactor validity checking for constraints There are several changes here. * TcInteract has gotten too big, so I moved all the class-instance matching out of TcInteract into a new module ClsInst. It parallels the FamInst module. The main export of ClsInst is matchGlobalInst. This now works in TcM not TcS. * A big reason to make matchGlobalInst work in TcM is that we can then use it from TcValidity.checkSimplifiableClassConstraint. That extends checkSimplifiableClassConstraint to work uniformly for built-in instances, which means that we now get a warning if we have givens (Typeable x, KnownNat n); see Trac #15322. * This change also made me refactor LookupInstResult, in particular by adding the InstanceWhat field. I also changed the name of the type to ClsInstResult. Then instead of matchGlobalInst reporting a staging error (which is inappropriate for the call from TcValidity), we can do so in TcInteract.checkInstanceOK. * In TcValidity, we now check quantified constraints for termination. For example, this signature should be rejected: f :: (forall a. Eq (m a) => Eq (m a)) => blah as discussed in Trac #15316. The main change here is that TcValidity.check_pred_help now uses classifyPredType, and has a case for ForAllPred which it didn't before. This had knock-on refactoring effects in TcValidity. >--------------------------------------------------------------- 45f44e2c9d5db2f25c52abb402f197c20579400f compiler/ghc.cabal.in | 1 + compiler/typecheck/ClsInst.hs | 586 +++++++++++++++++++ compiler/typecheck/TcInteract.hs | 634 ++------------------- compiler/typecheck/TcSMonad.hs | 54 +- compiler/typecheck/TcSimplify.hs | 2 +- compiler/typecheck/TcValidity.hs | 170 ++++-- .../tests/indexed-types/should_compile/T15322.hs | 12 + .../indexed-types/should_compile/T15322.stderr | 8 + .../tests/indexed-types/should_compile/T15322a.hs | 12 + .../indexed-types/should_compile/T15322a.stderr | 12 + testsuite/tests/indexed-types/should_compile/all.T | 2 + .../should_compile/SomethingShowable.stderr | 4 +- testsuite/tests/polykinds/T11466.stderr | 4 +- testsuite/tests/quantified-constraints/T15316.hs | 21 + .../tests/quantified-constraints/T15316.stderr | 6 + testsuite/tests/quantified-constraints/all.T | 1 + testsuite/tests/typecheck/should_compile/T10177.hs | 3 + .../tests/typecheck/should_compile/T13526.stderr | 4 +- .../should_compile/TcCustomSolverSuper.hs | 10 +- testsuite/tests/typecheck/should_fail/T8912.stderr | 4 +- .../tests/typecheck/should_fail/fd-loop.stderr | 6 - .../tests/typecheck/should_fail/tcfail157.stderr | 7 - .../tests/typecheck/should_fail/tcfail211.stderr | 4 +- 23 files changed, 881 insertions(+), 686 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 45f44e2c9d5db2f25c52abb402f197c20579400f From git at git.haskell.org Thu Jul 5 13:52:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:06 +0000 (UTC) Subject: [commit: ghc] master: Fix #15307 by making nlHsFunTy parenthesize more (59a15a5) Message-ID: <20180705135206.49D803ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59a15a56e180b59656e45df04f7df61de8298881/ghc >--------------------------------------------------------------- commit 59a15a56e180b59656e45df04f7df61de8298881 Author: Ryan Scott Date: Thu Jul 5 08:29:59 2018 -0400 Fix #15307 by making nlHsFunTy parenthesize more Summary: `nlHsFunTy` wasn't parenthesizing its arguments at all, which led to `-ddump-deriv` producing incorrectly parenthesized types (since it uses `nlHsFunTy` to construct those types), as demonstrated in #15307. Fix this by changing `nlHsFunTy` to add parentheses à la `ppr_ty`: always parenthesizing the argument type with function precedence, and recursively processing the result type, adding parentheses for each function type it encounters. Test Plan: make test TEST=T14578 Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15307 Differential Revision: https://phabricator.haskell.org/D4890 >--------------------------------------------------------------- 59a15a56e180b59656e45df04f7df61de8298881 compiler/hsSyn/HsUtils.hs | 8 +++++++- testsuite/tests/deriving/should_compile/T14578.stderr | 9 +++++---- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index e8e59b0..9a66b4a 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -497,7 +497,13 @@ nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t)) nlHsTyVar x = noLoc (HsTyVar noExt NotPromoted (noLoc x)) -nlHsFunTy a b = noLoc (HsFunTy noExt a b) +nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) + (parenthesize_fun_tail b)) + where + parenthesize_fun_tail (L loc (HsFunTy ext ty1 ty2)) + = L loc (HsFunTy ext (parenthesizeHsType funPrec ty1) + (parenthesize_fun_tail ty2)) + parenthesize_fun_tail lty = lty nlHsParTy t = noLoc (HsParTy noExt t) nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr index bdb6ca5..acbbdd6 100644 --- a/testsuite/tests/deriving/should_compile/T14578.stderr +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -7,10 +7,10 @@ Derived class instances: = GHC.Prim.coerce @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep). - a -> b -> f a -> f b) + (a -> b) -> f a -> f b) @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep). - a -> b -> T14578.App f a -> T14578.App f b) + (a -> b) -> T14578.App f a -> T14578.App f b) GHC.Base.fmap (GHC.Base.<$) = GHC.Prim.coerce @@ -43,11 +43,12 @@ Derived class instances: @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep) (c :: TYPE GHC.Types.LiftedRep). - a -> b -> c -> f a -> f b -> f c) + (a -> b -> c) -> f a -> f b -> f c) @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep) (c :: TYPE GHC.Types.LiftedRep). - a -> b -> c -> T14578.App f a -> T14578.App f b -> T14578.App f c) + (a -> b -> c) + -> T14578.App f a -> T14578.App f b -> T14578.App f c) GHC.Base.liftA2 (GHC.Base.*>) = GHC.Prim.coerce From git at git.haskell.org Thu Jul 5 13:52:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:09 +0000 (UTC) Subject: [commit: ghc] master: Fix #15308 by suppressing invisble args more rigorously (93b7ac8) Message-ID: <20180705135209.BC45D3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93b7ac8d73885369f61f6eb6147352d45de4e957/ghc >--------------------------------------------------------------- commit 93b7ac8d73885369f61f6eb6147352d45de4e957 Author: Ryan Scott Date: Thu Jul 5 08:30:02 2018 -0400 Fix #15308 by suppressing invisble args more rigorously Summary: There was a buglet in `stripInvisArgs` (which is part of the pretty-printing pipeline for types) in which only invisble arguments which came before any visible arguments would be suppressed, but any invisble arguments that came //after// visible ones would still be printed, even if `-fprint-explicit-kinds` wasn't enabled. The fix is simple: make `stripInvisArgs` recursively process the remaining types even after a visible argument is encountered. Test Plan: make test TEST=T15308 Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15308 Differential Revision: https://phabricator.haskell.org/D4891 >--------------------------------------------------------------- 93b7ac8d73885369f61f6eb6147352d45de4e957 compiler/iface/IfaceType.hs | 7 ++++++- testsuite/tests/dependent/should_fail/T15308.hs | 12 ++++++++++++ testsuite/tests/dependent/should_fail/T15308.stderr | 5 +++++ testsuite/tests/dependent/should_fail/all.T | 1 + testsuite/tests/typecheck/should_fail/T12785b.stderr | 12 ++++-------- 5 files changed, 28 insertions(+), 9 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 537f419..d741265 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -513,8 +513,13 @@ stripInvisArgs dflags tys where suppress_invis c = case c of + ITC_Nil -> ITC_Nil ITC_Invis _ ts -> suppress_invis ts - _ -> c + ITC_Vis t ts -> ITC_Vis t $ suppress_invis ts + -- Keep recursing through the remainder of the arguments, as it's + -- possible that there are remaining invisible ones. + -- See the "In type declarations" section of Note [TyVarBndrs, + -- TyVarBinders, TyConBinders, and visibility] in TyCoRep. tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType] tcArgsIfaceTypes ITC_Nil = [] diff --git a/testsuite/tests/dependent/should_fail/T15308.hs b/testsuite/tests/dependent/should_fail/T15308.hs new file mode 100644 index 0000000..b49fe1f --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15308.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +module T15308 where + +import Data.Kind + +data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where + MkFoo :: Foo a f + +f :: Foo a f -> String +f = show diff --git a/testsuite/tests/dependent/should_fail/T15308.stderr b/testsuite/tests/dependent/should_fail/T15308.stderr new file mode 100644 index 0000000..a4bdbd5 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15308.stderr @@ -0,0 +1,5 @@ + +T15308.hs:12:5: error: + • No instance for (Show (Foo a f)) arising from a use of ‘show’ + • In the expression: show + In an equation for ‘f’: f = show diff --git a/testsuite/tests/dependent/should_fail/all.T b/testsuite/tests/dependent/should_fail/all.T index 2bfc39a..1bc3f42 100644 --- a/testsuite/tests/dependent/should_fail/all.T +++ b/testsuite/tests/dependent/should_fail/all.T @@ -32,3 +32,4 @@ test('T14845_fail2', normal, compile_fail, ['']) test('InferDependency', normal, compile_fail, ['']) test('T15245', normal, compile_fail, ['']) test('T15215', normal, compile_fail, ['']) +test('T15308', normal, compile_fail, ['-fno-print-explicit-kinds']) diff --git a/testsuite/tests/typecheck/should_fail/T12785b.stderr b/testsuite/tests/typecheck/should_fail/T12785b.stderr index b8e572d..44937c3 100644 --- a/testsuite/tests/typecheck/should_fail/T12785b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12785b.stderr @@ -11,7 +11,7 @@ T12785b.hs:29:63: error: ‘s’ is a rigid type variable bound by a pattern with constructor: Hide :: forall a (n :: Peano) (f :: a -> *) (s :: HTree n a). - STree n a f s -> Hidden n f, + STree n f s -> Hidden n f, in an equation for ‘nest’ at T12785b.hs:29:7-12 • In the second argument of ‘($)’, namely ‘a `SBranchX` tr’ @@ -20,12 +20,8 @@ T12785b.hs:29:63: error: nest (Hide a `Branch` (nest . hmap nest -> Hide tr)) = Hide $ a `SBranchX` tr • Relevant bindings include - tr :: STree - n - (HTree ('S n) (HTree ('S ('S n)) a)) - (STree ('S n) (HTree ('S ('S n)) a) (STree ('S ('S n)) a f)) - s1 + tr :: STree n (STree ('S n) (STree ('S ('S n)) f)) s1 (bound at T12785b.hs:29:49) - a :: STree ('S m) a f s (bound at T12785b.hs:29:12) - nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) a f) + a :: STree ('S m) f s (bound at T12785b.hs:29:12) + nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) f) (bound at T12785b.hs:27:1) From git at git.haskell.org Thu Jul 5 13:52:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:13 +0000 (UTC) Subject: [commit: ghc] master: Instantiate GND bindings with an explicit type signature (132273f) Message-ID: <20180705135213.D24F23ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/132273f34e394bf7e900d0c15e01e91edd711890/ghc >--------------------------------------------------------------- commit 132273f34e394bf7e900d0c15e01e91edd711890 Author: Ryan Scott Date: Thu Jul 5 08:30:05 2018 -0400 Instantiate GND bindings with an explicit type signature Summary: Before, we were using visible type application to apply impredicative types to `coerce` in `GeneralizedNewtypeDeriving`-generated bindings. This approach breaks down when combined with `QuantifiedConstraints` in certain ways, which #14883 and #15290 provide examples of. See Note [GND and QuantifiedConstraints] for all the gory details. To avoid this issue, we instead use an explicit type signature to instantiate each GND binding, and use that to bind any type variables that might be bound by a class method's type signature. This reduces the need to impredicative type applications, and more importantly, makes the programs from #14883 and #15290 work again. Test Plan: make test TEST="T15290b T15290c T15290d T14883" Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14883, #15290 Differential Revision: https://phabricator.haskell.org/D4895 >--------------------------------------------------------------- 132273f34e394bf7e900d0c15e01e91edd711890 compiler/hsSyn/HsUtils.hs | 2 +- compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcGenDeriv.hs | 148 ++++++++++++++++++--- .../tests/deriving/should_compile/T14578.stderr | 103 +++++++------- .../should_compile/T14883.hs} | 6 +- testsuite/tests/deriving/should_compile/T15290c.hs | 20 +++ testsuite/tests/deriving/should_compile/T15290d.hs | 12 ++ testsuite/tests/deriving/should_compile/all.T | 3 + testsuite/tests/deriving/should_fail/T15073.stderr | 26 ++-- testsuite/tests/deriving/should_fail/T4846.stderr | 5 +- 10 files changed, 234 insertions(+), 93 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 132273f34e394bf7e900d0c15e01e91edd711890 From git at git.haskell.org Thu Jul 5 13:52:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:17 +0000 (UTC) Subject: [commit: ghc] master: Fix newtype instance GADTs (9275186) Message-ID: <20180705135217.A03C73ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/927518668111584a06f12bd9eb1b0910a38acf4f/ghc >--------------------------------------------------------------- commit 927518668111584a06f12bd9eb1b0910a38acf4f Author: Ryan Scott Date: Thu Jul 5 08:49:50 2018 -0400 Fix newtype instance GADTs Summary: This was taken from Richard's branch, which in turn was submitted to Phab by Matthew, which in turn was commandeered by Ryan. This fixes an issue with newtype instances in which too many coercions were being applied in the worker. This fixes the issue by removing the data family instance axiom from the worker and moving to the wrapper. Moreover, we now require all newtype instances to have wrappers, for symmetry with data instances. Reviewers: goldfire, bgamari, simonpj, mpickering Reviewed By: mpickering Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15318 Differential Revision: https://phabricator.haskell.org/D4902 >--------------------------------------------------------------- 927518668111584a06f12bd9eb1b0910a38acf4f compiler/basicTypes/MkId.hs | 52 ++++++++++++++++++---- .../tests/indexed-types/should_compile/T15318.hs | 8 ++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 52 insertions(+), 9 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 602cd3d..4cd20ff 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -19,8 +19,7 @@ module MkId ( mkPrimOpId, mkFCallId, - wrapNewTypeBody, unwrapNewTypeBody, - wrapFamInstBody, + unwrapNewTypeBody, wrapFamInstBody, DataConBoxer(..), mkDataConRep, mkDataConWorkId, -- And some particular Ids; see below for why they are wired in @@ -247,6 +246,47 @@ Hence we translate to -- Coercion from family type to representation type Co7T a :: T [a] ~ :R7T a +Newtype instances through an additional wrinkle into the mix. Consider the +following example (adapted from #15318, comment:2): + + data family T a + newtype instance T [a] = MkT [a] + +Within the newtype instance, there are three distinct types at play: + +1. The newtype's underlying type, [a]. +2. The instance's representation type, TList a (where TList is the + representation tycon). +3. The family type, T [a]. + +We need two coercions in order to cast from (1) to (3): + +(a) A newtype coercion axiom: + + axiom coTList a :: TList a ~ [a] + + (Where TList is the representation tycon of the newtype instance.) + +(b) A data family instance coercion axiom: + + axiom coT a :: T [a] ~ TList a + +When we translate the newtype instance to Core, we obtain: + + -- Wrapper + $WMkT :: forall a. [a] -> T [a] + $WMkT a x = MkT a x |> Sym (coT a) + + -- Worker + MkT :: forall a. [a] -> TList [a] + MkT a x = x |> Sym (coTList a) + +Unlike for data instances, the worker for a newtype instance is actually an +executable function which expands to a cast, but otherwise, the general +strategy is essentially the same as for data instances. Also note that we have +a wrapper, which is unusual for a newtype, but we make GHC produce one anyway +for symmetry with the way data instances are handled. + Note [Newtype datacons] ~~~~~~~~~~~~~~~~~~~~~~~ The "data constructor" for a newtype should always be vanilla. At one @@ -614,8 +654,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con -- of some newtypes written with GADT syntax. See below. && (any isBanged (ev_ibangs ++ arg_ibangs) -- Some forcing/unboxing (includes eq_spec) - || isFamInstTyCon tycon -- Cast result || (not $ null eq_spec))) -- GADT + || isFamInstTyCon tycon -- Cast result || dataConUserTyVarsArePermuted data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the @@ -1009,15 +1049,9 @@ wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr -- -- If a coercion constructor is provided in the newtype, then we use -- it, otherwise the wrap/unwrap are both no-ops --- --- If the we are dealing with a newtype *instance*, we have a second coercion --- identifying the family instance with the constructor of the newtype --- instance. This coercion is applied in any case (ie, composed with the --- coercion constructor of the newtype or applied by itself). wrapNewTypeBody tycon args result_expr = ASSERT( isNewTyCon tycon ) - wrapFamInstBody tycon args $ mkCast result_expr (mkSymCo co) where co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [] diff --git a/testsuite/tests/indexed-types/should_compile/T15318.hs b/testsuite/tests/indexed-types/should_compile/T15318.hs new file mode 100644 index 0000000..342b6ef --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15318.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T15138 where + +data family Sn a +newtype instance Sn (Either a b) where + SnC :: forall b a. Char -> Sn (Either a b) diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 6255dd2..5cecd52 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -284,5 +284,6 @@ test('T15144', normal, compile, ['']) test('T15122', normal, compile, ['']) test('T13777', normal, compile, ['']) test('T14164', normal, compile, ['']) +test('T15318', normal, compile, ['']) test('T15322', normal, compile, ['']) test('T15322a', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 5 13:52:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:21 +0000 (UTC) Subject: [commit: ghc] master: Parenthesize rank-n contexts in Convert (5773397) Message-ID: <20180705135221.1FA553ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/57733978482dc1e566a7d4cd90d4cbbd1315e3b2/ghc >--------------------------------------------------------------- commit 57733978482dc1e566a7d4cd90d4cbbd1315e3b2 Author: Ryan Scott Date: Thu Jul 5 08:50:56 2018 -0400 Parenthesize rank-n contexts in Convert Summary: A simple oversight. Test Plan: make test TEST=T15324 Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15324 Differential Revision: https://phabricator.haskell.org/D4910 >--------------------------------------------------------------- 57733978482dc1e566a7d4cd90d4cbbd1315e3b2 compiler/hsSyn/Convert.hs | 4 +++- testsuite/tests/th/T15324.hs | 7 +++++++ testsuite/tests/th/T15324.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 17 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 329d000..aa651da 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1283,7 +1283,9 @@ cvtTypeKind ty_str ty x'' <- case x' of L _ HsFunTy{} -> returnL (HsParTy noExt x') L _ HsForAllTy{} -> returnL (HsParTy noExt x') - -- #14646 + -- #14646 + L _ HsQualTy{} -> returnL (HsParTy noExt x') + -- #15324 _ -> return x' returnL (HsFunTy noExt x'' y') | otherwise -> diff --git a/testsuite/tests/th/T15324.hs b/testsuite/tests/th/T15324.hs new file mode 100644 index 0000000..ea124f4 --- /dev/null +++ b/testsuite/tests/th/T15324.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module T15324 where + +$([d| f :: forall a. (Show a => a) -> a + f _ = undefined + |]) diff --git a/testsuite/tests/th/T15324.stderr b/testsuite/tests/th/T15324.stderr new file mode 100644 index 0000000..49db9ed --- /dev/null +++ b/testsuite/tests/th/T15324.stderr @@ -0,0 +1,6 @@ +T15324.hs:(5,3)-(7,6): Splicing declarations + [d| f :: forall a. (Show a => a) -> a + f _ = undefined |] + ======> + f :: forall a. (Show a => a) -> a + f _ = undefined diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f95e8f4..d8b8c94 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -416,3 +416,4 @@ test('T14885b', normal, compile, ['']) test('T14885c', normal, compile, ['']) test('T15243', normal, compile, ['-dsuppress-uniques']) test('T15321', normal, compile_fail, ['']) +test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Thu Jul 5 13:52:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:23 +0000 (UTC) Subject: [commit: ghc] master: Accept new stdout for tcrun045 (45f0026) Message-ID: <20180705135223.E88763ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/45f0026818402aa08398131507bc587ea4a2b387/ghc >--------------------------------------------------------------- commit 45f0026818402aa08398131507bc587ea4a2b387 Author: Ryan Scott Date: Thu Jul 5 09:44:18 2018 -0400 Accept new stdout for tcrun045 The stdout produced by test tcrun045 changed in commit 45f44e2c9d5db2f25c52abb402f197c20579400f. The change appears to be benign, so I've decided to accept it. >--------------------------------------------------------------- 45f0026818402aa08398131507bc587ea4a2b387 testsuite/tests/typecheck/should_run/tcrun045.stderr | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/typecheck/should_run/tcrun045.stderr b/testsuite/tests/typecheck/should_run/tcrun045.stderr index f6b1652..feabc4b 100644 --- a/testsuite/tests/typecheck/should_run/tcrun045.stderr +++ b/testsuite/tests/typecheck/should_run/tcrun045.stderr @@ -1,9 +1,7 @@ tcrun045.hs:11:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: ?imp::Int - While checking an instance declaration - In the instance declaration for ‘C Int’ + • In the instance declaration for ‘C Int’ tcrun045.hs:24:1: error: • Illegal implicit parameter ‘?imp::Int’ @@ -13,6 +11,4 @@ tcrun045.hs:24:1: error: tcrun045.hs:27:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: ?imp::Int - While checking an instance declaration - In the instance declaration for ‘D Int’ + • In the instance declaration for ‘D Int’ From git at git.haskell.org Thu Jul 5 13:52:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:26 +0000 (UTC) Subject: [commit: ghc] master: Comment out a pprTrace (9b26aa0) Message-ID: <20180705135226.B68A83ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9b26aa09036e6cd5ceb92b01350ba9d33fadb933/ghc >--------------------------------------------------------------- commit 9b26aa09036e6cd5ceb92b01350ba9d33fadb933 Author: Ryan Scott Date: Thu Jul 5 08:54:03 2018 -0400 Comment out a pprTrace This was introduced in commit 45f44e2c9d5db2f25c52abb402f197c20579400f, but it results in lots of "check_class ~" messages when validating. I've decided to just comment it out. >--------------------------------------------------------------- 9b26aa09036e6cd5ceb92b01350ba9d33fadb933 compiler/typecheck/TcValidity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 86cb922..60fb261 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -854,7 +854,7 @@ check_class_pred :: TidyEnv -> DynFlags -> UserTypeCtxt check_class_pred env dflags ctxt pred cls tys | cls `hasKey` heqTyConKey -- (~) and (~~) are classified as classes, || cls `hasKey` eqTyConKey -- but here we want to treat them as equalities - = pprTrace "check_class" (ppr cls) $ + = -- pprTrace "check_class" (ppr cls) $ check_eq_pred env dflags pred | isIPClass cls From git at git.haskell.org Thu Jul 5 13:52:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:30 +0000 (UTC) Subject: [commit: ghc] master: Make ppr_tc_args aware of -fprint-explicit-kinds (dbdcacf) Message-ID: <20180705135230.3E5BA3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbdcacfc55f28d8a85484cc1cf13dd78c45bf7ee/ghc >--------------------------------------------------------------- commit dbdcacfc55f28d8a85484cc1cf13dd78c45bf7ee Author: Ryan Scott Date: Thu Jul 5 08:52:20 2018 -0400 Make ppr_tc_args aware of -fprint-explicit-kinds Summary: `ppr_tc_args` was printing invisible kind arguments even when `-fprint-explicit-kinds` wasn't enabled. Easily fixed. Test Plan: make test TEST=T15341 Reviewers: goldfire, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15341 Differential Revision: https://phabricator.haskell.org/D4932 >--------------------------------------------------------------- dbdcacfc55f28d8a85484cc1cf13dd78c45bf7ee compiler/iface/IfaceType.hs | 8 ++++++-- testsuite/tests/ghci/scripts/T15341.hs | 6 ++++++ testsuite/tests/ghci/scripts/T15341.script | 4 ++++ testsuite/tests/ghci/scripts/T15341.stdout | 6 ++++++ testsuite/tests/ghci/scripts/T7939.stdout | 8 ++++---- testsuite/tests/ghci/scripts/all.T | 1 + testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr | 2 +- 7 files changed, 28 insertions(+), 7 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index d741265..5a7f761 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -824,11 +824,15 @@ pprParendIfaceTcArgs = ppr_tc_args appPrec ppr_tc_args :: PprPrec -> IfaceTcArgs -> SDoc ppr_tc_args ctx_prec args - = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts + = let ppr_rest = ppr_tc_args ctx_prec + pprTys t ts = ppr_ty ctx_prec t <+> ppr_rest ts in case args of ITC_Nil -> empty ITC_Vis t ts -> pprTys t ts - ITC_Invis t ts -> pprTys t ts + ITC_Invis t ts -> sdocWithDynFlags $ \dflags -> + if gopt Opt_PrintExplicitKinds dflags + then pprTys t ts + else ppr_rest ts ------------------- pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc diff --git a/testsuite/tests/ghci/scripts/T15341.hs b/testsuite/tests/ghci/scripts/T15341.hs new file mode 100644 index 0000000..b84c1bb --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T15341 where + +type family Foo (a :: k) :: k where + Foo a = a diff --git a/testsuite/tests/ghci/scripts/T15341.script b/testsuite/tests/ghci/scripts/T15341.script new file mode 100644 index 0000000..0a3ffdc --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.script @@ -0,0 +1,4 @@ +:load T15341.hs +:info Foo +:set -fprint-explicit-kinds +:info Foo diff --git a/testsuite/tests/ghci/scripts/T15341.stdout b/testsuite/tests/ghci/scripts/T15341.stdout new file mode 100644 index 0000000..1d29dc7 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.stdout @@ -0,0 +1,6 @@ +type family Foo (a :: k) :: k + where Foo a = a + -- Defined at T15341.hs:5:1 +type family Foo k (a :: k) :: k + where Foo k a = a + -- Defined at T15341.hs:5:1 diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout index db2590c..82a8658 100644 --- a/testsuite/tests/ghci/scripts/T7939.stdout +++ b/testsuite/tests/ghci/scripts/T7939.stdout @@ -15,13 +15,13 @@ type family H (a :: Bool) :: Bool H :: Bool -> Bool type family J (a :: [k]) :: Bool where - J k '[] = 'False - J k (h : t) = 'True + J '[] = 'False + J (h : t) = 'True -- Defined at T7939.hs:17:1 J :: [k] -> Bool type family K (a1 :: [a]) :: Maybe a where - K a '[] = 'Nothing - K a (h : t) = 'Just h + K '[] = 'Nothing + K (h : t) = 'Just h -- Defined at T7939.hs:21:1 K :: [a] -> Maybe a diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 29fbdf8..8954594 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -269,3 +269,4 @@ test('T14676', extra_files(['../prog002']), ghci_script, ['T14676.script']) test('T14796', normal, ghci_script, ['T14796.script']) test('T14969', normal, ghci_script, ['T14969.script']) test('T15259', normal, ghci_script, ['T15259.script']) +test('T15341', normal, ghci_script, ['T15341.script']) diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr index ba1f46e..cab5078 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr @@ -27,5 +27,5 @@ ClosedFam3.hs-boot:12:1: error: Main module: type family Baz a :: * where Baz Int = Bool Boot file: type family Baz (a :: k) :: * - where Baz * Int = Bool + where Baz Int = Bool The types have different kinds From git at git.haskell.org Thu Jul 5 13:52:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jul 2018 13:52:33 +0000 (UTC) Subject: [commit: ghc] master: Fix #15331 with careful blasts of parenthesizeHsType (b6a3386) Message-ID: <20180705135233.9A1973ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6a3386186b77333b7a6cdc163499d7dae0dad1c/ghc >--------------------------------------------------------------- commit b6a3386186b77333b7a6cdc163499d7dae0dad1c Author: Ryan Scott Date: Thu Jul 5 08:51:43 2018 -0400 Fix #15331 with careful blasts of parenthesizeHsType Summary: Another `-ddump-splices` bug that can be solved with more judicious use of parentheses. Test Plan: make test TEST=T15331 Reviewers: goldfire, bgamari, alanz, tdammers Reviewed By: tdammers Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15331 Differential Revision: https://phabricator.haskell.org/D4920 >--------------------------------------------------------------- b6a3386186b77333b7a6cdc163499d7dae0dad1c compiler/hsSyn/Convert.hs | 3 ++- compiler/hsSyn/HsTypes.hs | 4 ++-- compiler/hsSyn/HsUtils.hs | 5 ++++- compiler/typecheck/TcGenDeriv.hs | 2 +- testsuite/tests/th/T15331.hs | 9 +++++++++ testsuite/tests/th/T15331.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 7 files changed, 25 insertions(+), 5 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index aa651da..c64cb7c 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -818,7 +818,8 @@ cvtl e = wrapL (cvt e) cvt (AppTypeE e t) = do { e' <- cvtl e ; t' <- cvtType t ; tp <- wrap_apps t' - ; return $ HsAppType (mkHsWildCardBndrs tp) e' } + ; let tp' = parenthesizeHsType appPrec tp + ; return $ HsAppType (mkHsWildCardBndrs tp') e' } cvt (LamE [] e) = cvt e -- Degenerate case. We convert the body as its -- own expression to avoid pretty-printing -- oddities that can result from zero-argument diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 6d14d7d..cbaa9fb 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -1425,8 +1425,8 @@ ppr_tylit (HsStrTy _ s) = text (show s) hsTypeNeedsParens :: PprPrec -> HsType pass -> Bool hsTypeNeedsParens p = go where - go (HsForAllTy{}) = False - go (HsQualTy{}) = False + go (HsForAllTy{}) = p >= funPrec + go (HsQualTy{}) = p >= funPrec go (HsBangTy{}) = p > topPrec go (HsRecTy{}) = False go (HsTyVar{}) = False diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index ca0cb92..a759f1a 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -178,7 +178,10 @@ mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2) mkHsAppType :: (XAppTypeE (GhcPass id) ~ LHsWcType GhcRn) => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id) -mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType t e) +mkHsAppType e t = addCLoc e t_body (HsAppType paren_wct e) + where + t_body = hswc_body t + paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body } mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn mkHsAppTypes = foldl mkHsAppType diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index e1665e2..beaad98 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1810,7 +1810,7 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs nlHsAppType e s = noLoc (HsAppType hs_ty e) where - hs_ty = mkHsWildCardBndrs $ nlHsParTy (typeToLHsType s) + hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec (typeToLHsType s) nlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs nlExprWithTySig e s = noLoc $ ExprWithTySig hs_ty diff --git a/testsuite/tests/th/T15331.hs b/testsuite/tests/th/T15331.hs new file mode 100644 index 0000000..0b0a076 --- /dev/null +++ b/testsuite/tests/th/T15331.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +module T15331 where + +import Data.Proxy + +$([d| f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) + |]) diff --git a/testsuite/tests/th/T15331.stderr b/testsuite/tests/th/T15331.stderr new file mode 100644 index 0000000..99bfdfd --- /dev/null +++ b/testsuite/tests/th/T15331.stderr @@ -0,0 +1,6 @@ +T15331.hs:(7,3)-(9,6): Splicing declarations + [d| f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) |] + ======> + f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index d8b8c94..84aa84b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -417,3 +417,4 @@ test('T14885c', normal, compile, ['']) test('T15243', normal, compile, ['-dsuppress-uniques']) test('T15321', normal, compile_fail, ['']) test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Fri Jul 6 14:57:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 14:57:04 +0000 (UTC) Subject: [commit: ghc] master: Make a variant of mkCastErr for kind coercions (18cedbb) Message-ID: <20180706145704.3454B3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18cedbb55c7a0bdbfade4d28d3bb8927277df8d8/ghc >--------------------------------------------------------------- commit 18cedbb55c7a0bdbfade4d28d3bb8927277df8d8 Author: Ryan Scott Date: Fri Jul 6 10:53:00 2018 -0400 Make a variant of mkCastErr for kind coercions Summary: I discovered when debugging #15346 that the Core Lint error message for ill typed casts always mentions types of enclosed //expressions//, even if the thing being casted is actually a type. This generalizes `mkCastErr` a bit to allow it to give the proper labelling for kind coercions. Test Plan: Run on failing program in #15346, read the Core Lint error Reviewers: goldfire, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4940 >--------------------------------------------------------------- 18cedbb55c7a0bdbfade4d28d3bb8927277df8d8 compiler/coreSyn/CoreLint.hs | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index fb421a1..d2724ba 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1370,7 +1370,7 @@ lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) lintType (CastTy ty co) = do { k1 <- lintType ty ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastErr ty co k1' k1) + ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) ; return k2 } lintType (CoercionTy co) @@ -2477,14 +2477,32 @@ mkArityMsg binder ] where (StrictSig dmd_ty) = idStrictness binder -} -mkCastErr :: Outputable casted => casted -> Coercion -> Type -> Type -> MsgDoc -mkCastErr expr co from_ty expr_ty - = vcat [text "From-type of Cast differs from type of enclosed expression", - text "From-type:" <+> ppr from_ty, - text "Type of enclosed expr:" <+> ppr expr_ty, - text "Actual enclosed expr:" <+> ppr expr, +mkCastErr :: CoreExpr -> Coercion -> Type -> Type -> MsgDoc +mkCastErr expr = mk_cast_err "expression" "type" (ppr expr) + +mkCastTyErr :: Type -> Coercion -> Kind -> Kind -> MsgDoc +mkCastTyErr ty = mk_cast_err "type" "kind" (ppr ty) + +mk_cast_err :: String -- ^ What sort of casted thing this is + -- (\"expression\" or \"type\"). + -> String -- ^ What sort of coercion is being used + -- (\"type\" or \"kind\"). + -> SDoc -- ^ The thing being casted. + -> Coercion -> Type -> Type -> MsgDoc +mk_cast_err thing_str co_str pp_thing co from_ty thing_ty + = vcat [from_msg <+> text "of Cast differs from" <+> co_msg + <+> text "of" <+> enclosed_msg, + from_msg <> colon <+> ppr from_ty, + text (capitalise co_str) <+> text "of" <+> enclosed_msg <> colon + <+> ppr thing_ty, + text "Actual" <+> enclosed_msg <> colon <+> pp_thing, text "Coercion used in cast:" <+> ppr co ] + where + co_msg, from_msg, enclosed_msg :: SDoc + co_msg = text co_str + from_msg = text "From-" <> co_msg + enclosed_msg = text "enclosed" <+> text thing_str mkBadUnivCoMsg :: LeftOrRight -> Coercion -> SDoc mkBadUnivCoMsg lr co From git at git.haskell.org Fri Jul 6 17:05:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 17:05:07 +0000 (UTC) Subject: [commit: ghc] master: Remove BUILD_DPH, not used (8c628ad) Message-ID: <20180706170507.F14713ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c628ad9b9241dcf4ea087ca9efa5f0ca9632aa5/ghc >--------------------------------------------------------------- commit 8c628ad9b9241dcf4ea087ca9efa5f0ca9632aa5 Author: Krzysztof Gogolewski Date: Fri Jul 6 19:04:30 2018 +0200 Remove BUILD_DPH, not used >--------------------------------------------------------------- 8c628ad9b9241dcf4ea087ca9efa5f0ca9632aa5 mk/build.mk.sample | 3 --- mk/config.mk.in | 2 -- 2 files changed, 5 deletions(-) diff --git a/mk/build.mk.sample b/mk/build.mk.sample index ce7b4d6..601ab02 100644 --- a/mk/build.mk.sample +++ b/mk/build.mk.sample @@ -99,9 +99,6 @@ endif # https://ghc.haskell.org/trac/ghc/wiki/Building/RunningTests/Running#AdditionalPackages #BUILD_EXTRA_PKGS=YES -# Uncomment the following line to enable building DPH -#BUILD_DPH=YES - # Uncomment the following to force `integer-gmp` to use the in-tree GMP 6.1.2 # (other sometimes useful configure-options: `--with-gmp-{includes,libraries}`) #libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp diff --git a/mk/config.mk.in b/mk/config.mk.in index 6ff8e0e..c97f551 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -875,8 +875,6 @@ else HSCOLOUR_SRCS = YES endif -# Build and install DPH? -BUILD_DPH = NO # Build and install the "extra" packages (see ./packages)? BUILD_EXTRA_PKGS = NO From git at git.haskell.org Fri Jul 6 18:08:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:08:53 +0000 (UTC) Subject: [commit: ghc] master: circleci: Detect core count (de95bf4) Message-ID: <20180706180853.22F3E3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de95bf40ee0af0e7da4cb6cc4e0ad33694234bb9/ghc >--------------------------------------------------------------- commit de95bf40ee0af0e7da4cb6cc4e0ad33694234bb9 Author: Ben Gamari Date: Fri Jul 6 10:57:55 2018 -0400 circleci: Detect core count Test Plan: Try `./validate`, CircleCI build; make sure core count detection works in both cases. Reviewers: alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14470 Differential Revision: https://phabricator.haskell.org/D4897 >--------------------------------------------------------------- de95bf40ee0af0e7da4cb6cc4e0ad33694234bb9 .circleci/config.yml | 10 ++++++---- mk/detect-cpu-count.sh | 26 ++++++++++++++++++++++++++ validate | 24 +----------------------- 3 files changed, 33 insertions(+), 27 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e52d38d..298162e 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -15,7 +15,9 @@ aliases: name: submodules command: .circleci/fetch-submodules.sh - &buildenv - THREADS: 9 + # ideally we would simply set THREADS here instead of re-detecting it every + # time we need it below. Unfortunately, there is no way to set an environment + # variable with the result of a shell script. SKIP_PERF_TESTS: YES VERBOSE: 2 - &boot @@ -50,19 +52,19 @@ aliases: - &make run: name: Build - command: "make -j$THREADS" + command: "make -j`mk/detect-cpu-count.sh`" - &build_hadrian run: name: Build GHC using Hadrian command: | cabal update - hadrian/build.sh -j$THREADS + hadrian/build.sh -j`mk/detect-cpu-count.sh` - &test run: name: Test command: | mkdir -p test-results - make test SKIP_PERF_TESTS=YES JUNIT_FILE=../../test-results/junit.xml + make test THREADS=`mk/detect-cpu-count.sh` SKIP_PERF_TESTS=YES JUNIT_FILE=../../test-results/junit.xml - &store_test_results store_test_results: path: test-results diff --git a/mk/detect-cpu-count.sh b/mk/detect-cpu-count.sh new file mode 100755 index 0000000..abc4738 --- /dev/null +++ b/mk/detect-cpu-count.sh @@ -0,0 +1,26 @@ +#!/bin/sh + +detect_cpu_count () { + if [ "$CPUS" = "" ]; then + # Windows standard environment variable + CPUS="$NUMBER_OF_PROCESSORS" + fi + + if [ "$CPUS" = "" ]; then + # Linux + CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null` + fi + + if [ "$CPUS" = "" ]; then + # FreeBSD + CPUS=`getconf NPROCESSORS_ONLN 2>/dev/null` + fi + + if [ "$CPUS" = "" ]; then + # nothing helped + CPUS="1" + fi +} + +detect_cpu_count +echo "$CPUS" diff --git a/validate b/validate index 0332e5b..2f82b28 100755 --- a/validate +++ b/validate @@ -119,29 +119,7 @@ check_packages () { fi } -detect_cpu_count () { - if [ "$CPUS" = "" ]; then - # Windows standard environment variable - CPUS="$NUMBER_OF_PROCESSORS" - fi - - if [ "$CPUS" = "" ]; then - # Linux - CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null` - fi - - if [ "$CPUS" = "" ]; then - # FreeBSD - CPUS=`getconf NPROCESSORS_ONLN 2>/dev/null` - fi - - if [ "$CPUS" = "" ]; then - # nothing helped - CPUS="1" - fi -} - -detect_cpu_count +CPUS=`mk/detect-cpu-count.sh` if ! [ -d testsuite ] then From git at git.haskell.org Fri Jul 6 18:09:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:09:09 +0000 (UTC) Subject: [commit: ghc] master: users guide: Mention -fprint-typechecker-elaboration in -ddump-tc docs (87b28a8) Message-ID: <20180706180909.BA2F43ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/87b28a83fa7ff772ae0c22cf5d3f3e88e24cf466/ghc >--------------------------------------------------------------- commit 87b28a83fa7ff772ae0c22cf5d3f3e88e24cf466 Author: Ben Gamari Date: Fri Jul 6 10:58:15 2018 -0400 users guide: Mention -fprint-typechecker-elaboration in -ddump-tc docs Reviewers: mpickering Reviewed By: mpickering Subscribers: mpickering, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4898 >--------------------------------------------------------------- 87b28a83fa7ff772ae0c22cf5d3f3e88e24cf466 docs/users_guide/debugging.rst | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index ab5942f..2039e12 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -158,7 +158,9 @@ These flags dump various information from GHC's typechecker and renamer. :shortdesc: Dump typechecker output :type: dynamic - Dump typechecker output + Dump typechecker output. Note that this hides a great deal of detail by + default; you might consider using this with + :ghc-flag:`-fprint-typechecker-elaboration`. .. ghc-flag:: -ddump-tc-ast :shortdesc: Dump typechecker output as a syntax tree @@ -213,7 +215,8 @@ subexpression elimination pass. Print a one-line summary of the size of the Core program at the end of the optimisation pipeline. -.. ghc-flag:: -ddump-ds -ddump-ds-preopt +.. ghc-flag:: -ddump-ds + -ddump-ds-preopt :shortdesc: Dump desugarer output. :type: dynamic From git at git.haskell.org Fri Jul 6 18:09:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:09:24 +0000 (UTC) Subject: [commit: ghc] master: Mark AutoDeriveTypeable as deprecated (f59332f) Message-ID: <20180706180924.4D9873ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f59332f92b30306675da22150de092eeebbf55f3/ghc >--------------------------------------------------------------- commit f59332f92b30306675da22150de092eeebbf55f3 Author: Krzysztof Gogolewski Date: Fri Jul 6 10:59:43 2018 -0400 Mark AutoDeriveTypeable as deprecated Test Plan: validate Reviewers: bgamari, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15342 Differential Revision: https://phabricator.haskell.org/D4933 >--------------------------------------------------------------- f59332f92b30306675da22150de092eeebbf55f3 compiler/main/DynFlags.hs | 5 ++++- docs/users_guide/glasgow_exts.rst | 2 +- testsuite/tests/dependent/should_compile/dynamic-paper.hs | 2 +- testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs | 1 - testsuite/tests/deriving/should_compile/T7710.hs | 1 - testsuite/tests/deriving/should_compile/T8950.hs | 2 +- testsuite/tests/typecheck/should_compile/T10348.hs | 2 +- testsuite/tests/typecheck/should_fail/T9999.hs | 2 +- 8 files changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 2ecbd6e..3957879 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -4115,7 +4115,10 @@ xFlagsDeps = [ flagSpec "AlternativeLayoutRuleTransitional" LangExt.AlternativeLayoutRuleTransitional, flagSpec "Arrows" LangExt.Arrows, - flagSpec "AutoDeriveTypeable" LangExt.AutoDeriveTypeable, + depFlagSpecCond "AutoDeriveTypeable" LangExt.AutoDeriveTypeable + id + ("Typeable instances are created automatically " ++ + "for all types since GHC 8.2."), flagSpec "BangPatterns" LangExt.BangPatterns, flagSpec "BinaryLiterals" LangExt.BinaryLiterals, flagSpec "CApiFFI" LangExt.CApiFFI, diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 4a860ac..2a98522 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -4453,7 +4453,7 @@ Deriving ``Data`` instances .. extension:: DeriveDataTypeable :shortdesc: Enable deriving for the Data class. - Implied by :extension:`AutoDeriveTypeable`. + Implied by (deprecated) :extension:`AutoDeriveTypeable`. :since: 6.8.1 diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.hs b/testsuite/tests/dependent/should_compile/dynamic-paper.hs index 2c284cf..c998f09 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.hs +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.hs @@ -7,7 +7,7 @@ Stephanie Weirich, Richard Eisenberg, and Dimitrios Vytiniotis, 2016. -} {-# LANGUAGE RankNTypes, PolyKinds, TypeOperators, ScopedTypeVariables, GADTs, FlexibleInstances, UndecidableInstances, RebindableSyntax, - DataKinds, MagicHash, AutoDeriveTypeable #-} + DataKinds, MagicHash #-} {-# OPTIONS_GHC -Wno-missing-methods -Wno-redundant-constraints #-} {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} -- Because we define a local Typeable class and have diff --git a/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs b/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs index 52e6c38..281b330 100644 --- a/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs +++ b/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} diff --git a/testsuite/tests/deriving/should_compile/T7710.hs b/testsuite/tests/deriving/should_compile/T7710.hs index 5375c2c..9a5af94 100644 --- a/testsuite/tests/deriving/should_compile/T7710.hs +++ b/testsuite/tests/deriving/should_compile/T7710.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE TypeFamilies #-} module T7710 where diff --git a/testsuite/tests/deriving/should_compile/T8950.hs b/testsuite/tests/deriving/should_compile/T8950.hs index b913b27..58c6590 100644 --- a/testsuite/tests/deriving/should_compile/T8950.hs +++ b/testsuite/tests/deriving/should_compile/T8950.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AutoDeriveTypeable, DataKinds, StandaloneDeriving #-} +{-# LANGUAGE DataKinds, StandaloneDeriving #-} module T8950 where diff --git a/testsuite/tests/typecheck/should_compile/T10348.hs b/testsuite/tests/typecheck/should_compile/T10348.hs index dadb8aa..d79e66b 100644 --- a/testsuite/tests/typecheck/should_compile/T10348.hs +++ b/testsuite/tests/typecheck/should_compile/T10348.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AutoDeriveTypeable, GADTs, DataKinds, KindSignatures, StandaloneDeriving, TypeOperators #-} +{-# LANGUAGE GADTs, DataKinds, KindSignatures, StandaloneDeriving, TypeOperators #-} module T10348 where diff --git a/testsuite/tests/typecheck/should_fail/T9999.hs b/testsuite/tests/typecheck/should_fail/T9999.hs index 656e913..8422df2 100644 --- a/testsuite/tests/typecheck/should_fail/T9999.hs +++ b/testsuite/tests/typecheck/should_fail/T9999.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AutoDeriveTypeable, PolyKinds, TypeFamilies, StandaloneDeriving #-} +{-# LANGUAGE PolyKinds, TypeFamilies, StandaloneDeriving #-} module T9999 where From git at git.haskell.org Fri Jul 6 18:09:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:09:39 +0000 (UTC) Subject: [commit: ghc] master: Add a broken test for lingering state from TH unique names #9693 (fbe162f) Message-ID: <20180706180939.B105D3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fbe162f58caa31df445d9edbf0b0919810687011/ghc >--------------------------------------------------------------- commit fbe162f58caa31df445d9edbf0b0919810687011 Author: Michael Sloan Date: Fri Jul 6 11:00:10 2018 -0400 Add a broken test for lingering state from TH unique names #9693 The stderr output is ``` Loading with T9693_initial.hs T9693_main.hs:4:1: Same exact name in multiple name-spaces: type constructor or class ‘X’, declared at: T9693_main.hs:4:1 data constructor ‘X’, declared at: T9693_main.hs:4:1 Probable cause: you bound a unique Template Haskell name (NameU), perhaps via newName, in different name-spaces. If that's it, then -ddump-splices might be useful Reloading with T9693_modified.hs T9693_main.hs:1:1: Data constructor ‘X’ used as a type constructor ``` The strange thing is that the modified version uses (mkName "X"), which should be fine for simultaneous use in both a data constructor and type constructor. Indeed, on a fresh load, the modified version works fine. So there is some sort of state left over from the prior load when (newName "X") was used. Test Plan: testsuite/tests/th/T9693.script Reviewers: bgamari, sighingnow, RyanGlScott Reviewed By: sighingnow, RyanGlScott Subscribers: RyanGlScott, sighingnow, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4926 >--------------------------------------------------------------- fbe162f58caa31df445d9edbf0b0919810687011 testsuite/tests/th/T9693.script | 7 +++++++ testsuite/tests/th/T9693_initial.hs | 9 +++++++++ testsuite/tests/th/{should_compile/T8025/A.hs => T9693_main.hs} | 5 +++-- testsuite/tests/th/T9693_modified.hs | 9 +++++++++ testsuite/tests/th/all.T | 2 ++ 5 files changed, 30 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/th/T9693.script b/testsuite/tests/th/T9693.script new file mode 100644 index 0000000..99643e7 --- /dev/null +++ b/testsuite/tests/th/T9693.script @@ -0,0 +1,7 @@ +System.Directory.copyFile "T9693_initial.hs" "T9693.hs" +System.IO.hPutStrLn System.IO.stderr "Loading with T9693_initial.hs" +:load T9693_main.hs +System.Directory.copyFile "T9693_modified.hs" "T9693.hs" +System.IO.hPutStrLn System.IO.stderr "Reloading with T9693_modified.hs" +:reload +System.Directory.removeFile "T9693.hs" diff --git a/testsuite/tests/th/T9693_initial.hs b/testsuite/tests/th/T9693_initial.hs new file mode 100644 index 0000000..b646f0e --- /dev/null +++ b/testsuite/tests/th/T9693_initial.hs @@ -0,0 +1,9 @@ +module T9693 where +import Language.Haskell.TH + +stuff = do + -- let x = mkName "X" + x <- newName "X" + sequence $ [dataD (return []) x [] Nothing [ + normalC x [] + ] []] diff --git a/testsuite/tests/th/should_compile/T8025/A.hs b/testsuite/tests/th/T9693_main.hs similarity index 56% copy from testsuite/tests/th/should_compile/T8025/A.hs copy to testsuite/tests/th/T9693_main.hs index c0e3083..71e7c9a 100644 --- a/testsuite/tests/th/should_compile/T8025/A.hs +++ b/testsuite/tests/th/T9693_main.hs @@ -1,3 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -module A where -a = [|3|] +import T9693 + +stuff diff --git a/testsuite/tests/th/T9693_modified.hs b/testsuite/tests/th/T9693_modified.hs new file mode 100644 index 0000000..cab2c04 --- /dev/null +++ b/testsuite/tests/th/T9693_modified.hs @@ -0,0 +1,9 @@ +module T9693 where +import Language.Haskell.TH + +stuff = do + let x = mkName "X" + -- x <- newName "X" + sequence $ [dataD (return []) x [] Nothing [ + normalC x [] + ] []] diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 84aa84b..e147491 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -418,3 +418,5 @@ test('T15243', normal, compile, ['-dsuppress-uniques']) test('T15321', normal, compile_fail, ['']) test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +# Note: T9693 should be only_ways(['ghci']) once it's fixed. +test('T9693', expect_broken(9693), ghci_script, ['T9693.script']) From git at git.haskell.org Fri Jul 6 18:09:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:09:53 +0000 (UTC) Subject: [commit: ghc] master: Simplify lintIdUnfolding (379bb20) Message-ID: <20180706180953.CF8A63ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/379bb201417870482b310cf65505046650fc69b2/ghc >--------------------------------------------------------------- commit 379bb201417870482b310cf65505046650fc69b2 Author: Matthew Pickering Date: Fri Jul 6 11:00:40 2018 -0400 Simplify lintIdUnfolding The logic for `DFunUnfolding` seemed quite confusing and unecessary. A simpler strategy uses `maybeUnfoldingTemplate`, as that is what is actually used when doing inlining and checking that has the right type. Reviewers: simonpj, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4919 >--------------------------------------------------------------- 379bb201417870482b310cf65505046650fc69b2 compiler/coreSyn/CoreLint.hs | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index d2724ba..93826f5 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -657,18 +657,11 @@ lintRhs _bndr rhs = fmap lf_check_static_ptrs getLintFlags >>= go go _ = markAllJoinsBad $ lintCoreExpr rhs lintIdUnfolding :: Id -> Type -> Unfolding -> LintM () -lintIdUnfolding bndr bndr_ty (CoreUnfolding { uf_tmpl = rhs, uf_src = src }) - | isStableSource src +lintIdUnfolding bndr bndr_ty uf + | isStableUnfolding uf + , Just rhs <- maybeUnfoldingTemplate uf = do { ty <- lintRhs bndr rhs ; ensureEqTys bndr_ty ty (mkRhsMsg bndr (text "unfolding") ty) } - -lintIdUnfolding bndr bndr_ty (DFunUnfolding { df_con = con, df_bndrs = bndrs - , df_args = args }) - = do { ty <- lintBinders LambdaBind bndrs $ \ bndrs' -> - do { res_ty <- lintCoreArgs (dataConRepType con) args - ; return (mkLamTypes bndrs' res_ty) } - ; ensureEqTys bndr_ty ty (mkRhsMsg bndr (text "dfun unfolding") ty) } - lintIdUnfolding _ _ _ = return () -- Do not Lint unstable unfoldings, because that leads -- to exponential behaviour; c.f. CoreFVs.idUnfoldingVars From git at git.haskell.org Fri Jul 6 18:10:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:10:12 +0000 (UTC) Subject: [commit: ghc] master: Fix for built-in Natural literals desugaring (987b5e7) Message-ID: <20180706181012.3753D3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/987b5e7fbacd8afd2c8463c16eac28cd68f43155/ghc >--------------------------------------------------------------- commit 987b5e7fbacd8afd2c8463c16eac28cd68f43155 Author: Sylvain Henry Date: Fri Jul 6 11:01:14 2018 -0400 Fix for built-in Natural literals desugaring The recent patch "Built-in Natural literals in Core" (https://phabricator.haskell.org/rGHCfe770c211631e7b4c9b0b1e88ef9b6046c6 585ef) introduced a regression when desugaring large numbers. This patch fixes it and adds a regression test. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15301 Differential Revision: https://phabricator.haskell.org/D4885 >--------------------------------------------------------------- 987b5e7fbacd8afd2c8463c16eac28cd68f43155 libraries/base/GHC/Natural.hs | 2 +- testsuite/tests/numeric/should_run/T15301.hs | 7 +++++++ .../tests/numeric/should_run/T15301.stdout | 0 testsuite/tests/numeric/should_run/all.T | 1 + 4 files changed, 9 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index db8d8b8..a35688d 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -594,7 +594,7 @@ mkNatural :: [Word] -- ^ value expressed in 32 bit chunks, least -> Natural mkNatural [] = wordToNaturalBase 0## mkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural` - shiftLNatural (mkNatural is') 31 + shiftLNatural (mkNatural is') 32 {-# CONSTANT_FOLDED mkNatural #-} -- | Convert 'Int' to 'Natural'. diff --git a/testsuite/tests/numeric/should_run/T15301.hs b/testsuite/tests/numeric/should_run/T15301.hs new file mode 100644 index 0000000..6efbce4 --- /dev/null +++ b/testsuite/tests/numeric/should_run/T15301.hs @@ -0,0 +1,7 @@ +import Numeric +import GHC.Natural + +main = do + -- test that GHC correctly compiles big Natural literals + let x = 0xffffffffffffffffffffffff :: Natural + print (showHex x "" == "ffffffffffffffffffffffff") diff --git a/libraries/base/tests/IO/IOError002.stdout b/testsuite/tests/numeric/should_run/T15301.stdout similarity index 100% copy from libraries/base/tests/IO/IOError002.stdout copy to testsuite/tests/numeric/should_run/T15301.stdout diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 691fc26..140fa6c 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -65,3 +65,4 @@ test('T10011', normal, compile_and_run, ['']) test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) +test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Fri Jul 6 18:10:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:10:27 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #15053 (f03f0d6) Message-ID: <20180706181027.283063ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f03f0d61bebe287e0df0254c175eb2f183d697aa/ghc >--------------------------------------------------------------- commit f03f0d61bebe287e0df0254c175eb2f183d697aa Author: Ben Gamari Date: Fri Jul 6 11:01:38 2018 -0400 testsuite: Add test for #15053 Reviewers: Phyx Reviewed By: Phyx Subscribers: Phyx, rwbarton, thomie, carter GHC Trac Issues: #15053 Differential Revision: https://phabricator.haskell.org/D4883 >--------------------------------------------------------------- f03f0d61bebe287e0df0254c175eb2f183d697aa testsuite/tests/parser/should_fail/T15053.hs | 3 +++ testsuite/tests/parser/should_fail/all.T | 1 + 2 files changed, 4 insertions(+) diff --git a/testsuite/tests/parser/should_fail/T15053.hs b/testsuite/tests/parser/should_fail/T15053.hs new file mode 100644 index 0000000..44154a4 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15053.hs @@ -0,0 +1,3 @@ +{-# OPTIONS_GHC -O1 } +" + #-} diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 1e71e40..93d0e0a 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -125,3 +125,4 @@ test('typeops_A', normal, compile_fail, ['']) test('typeops_B', normal, compile_fail, ['']) test('typeops_C', normal, compile_fail, ['']) test('typeops_D', normal, compile_fail, ['']) +test('T15053', expect_broken(15053), compile_fail, ['']) # shouldn't panic From git at git.haskell.org Fri Jul 6 18:10:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:10:44 +0000 (UTC) Subject: [commit: ghc] master: rts: Enable two-step allocator on FreeBSD (8736715) Message-ID: <20180706181044.11BB73ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8736715857d08cc1f88d766c257b39c05df20639/ghc >--------------------------------------------------------------- commit 8736715857d08cc1f88d766c257b39c05df20639 Author: Ben Gamari Date: Fri Jul 6 11:11:20 2018 -0400 rts: Enable two-step allocator on FreeBSD Previously we would prevent any operating system not providing the MEM_NORESERVE flag from using the two-step allocator. Afterall, Linux will reserve swap-space for a mapping unless this flag is given, which is most certainly not what we want. However, it seems that FreeBSD provides the reservation-only mapping behavior that we expect despite not providing the MEM_NORESERVE macro. In fact, it provided the macro until 2014, when it was removed on account of not being implemented in the kernel. However, empirical evidence suggests that just plain mmap does what we want. Reviewers: erikd, simonmar Subscribers: rwbarton, thomie, erikd, carter GHC Trac Issues: #15348 Differential Revision: https://phabricator.haskell.org/D4939 >--------------------------------------------------------------- 8736715857d08cc1f88d766c257b39c05df20639 configure.ac | 17 +++++++++-------- rts/posix/OSMem.c | 11 ++++++++--- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/configure.ac b/configure.ac index ac464b6..1976530 100644 --- a/configure.ac +++ b/configure.ac @@ -1182,22 +1182,23 @@ if test "$ac_cv_sizeof_void_p" -eq 8 ; then if test "x$EnableLargeAddressSpace" = "xyes" ; then if test "$ghc_host_os" = "darwin" ; then use_large_address_space=yes - elif test "$ghc_host_os" = "openbsd" ; then - # as of OpenBSD 5.8 (2015), OpenBSD does not support mmap with MAP_NORESERVE. - # The flag MAP_NORESERVE is supported for source compatibility reasons, - # but is completely ignored by OS mmap + elif test "$ghc_host_os" = "openbsd" ; then + # as of OpenBSD 5.8 (2015), OpenBSD does not support mmap with MAP_NORESERVE. + # The flag MAP_NORESERVE is supported for source compatibility reasons, + # but is completely ignored by OS mmap use_large_address_space=no else - AC_CHECK_DECLS([MAP_NORESERVE, MADV_FREE, MADV_DONTNEED],[],[], + AC_CHECK_DECLS([MAP_NORESERVE, MAP_GUARD, MADV_FREE, MADV_DONTNEED],[],[], [ #include #include #include #include ]) - if test "$ac_cv_have_decl_MAP_NORESERVE" = "yes" && - test "$ac_cv_have_decl_MADV_FREE" = "yes" || - test "$ac_cv_have_decl_MADV_DONTNEED" = "yes" ; then + if ( test "$ac_cv_have_decl_MAP_NORESERVE" = "yes" || + test "$ac_cv_have_decl_MAP_GUARD" = "yes" ) && + ( test "$ac_cv_have_decl_MADV_FREE" = "yes" || + test "$ac_cv_have_decl_MADV_DONTNEED" = "yes" ) ; then use_large_address_space=yes fi fi diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index e63e798..08f9635 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -102,8 +102,10 @@ void osMemInit(void) The naming is chosen from the Win32 API (VirtualAlloc) which does the same thing and has done so forever, while support for this in Unix systems has only been added recently and is hidden in the posix portability mess. - It is confusing because to get the reserve behavior we need MAP_NORESERVE - (which tells the kernel not to allocate backing space), but heh... + The Linux manpage suggests that mmap must be passed MAP_NORESERVE in order + to get reservation-only behavior. It is confusing because to get the reserve + behavior we need MAP_NORESERVE (which tells the kernel not to allocate backing + space), but heh... */ enum { @@ -161,7 +163,10 @@ my_mmap (void *addr, W_ size, int operation) else prot = PROT_NONE; if (operation == MEM_RESERVE) -# if defined(MAP_NORESERVE) +# if defined(MAP_GUARD) + // Provided by FreeBSD + flags = MAP_GUARD; +# elif defined(MAP_NORESERVE) flags = MAP_NORESERVE; # else # if defined(USE_LARGE_ADDRESS_SPACE) From git at git.haskell.org Fri Jul 6 18:12:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jul 2018 18:12:30 +0000 (UTC) Subject: [commit: ghc] master: Revert "rts: Enable two-step allocator on FreeBSD" (6715373) Message-ID: <20180706181230.AB4273ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/671537364ae09dc65d4bb1c646aa80e9c8f808df/ghc >--------------------------------------------------------------- commit 671537364ae09dc65d4bb1c646aa80e9c8f808df Author: Ben Gamari Date: Fri Jul 6 14:12:03 2018 -0400 Revert "rts: Enable two-step allocator on FreeBSD" This reverts commit 8736715857d08cc1f88d766c257b39c05df20639. I hadn't intended on merging this. >--------------------------------------------------------------- 671537364ae09dc65d4bb1c646aa80e9c8f808df configure.ac | 17 ++++++++--------- rts/posix/OSMem.c | 11 +++-------- 2 files changed, 11 insertions(+), 17 deletions(-) diff --git a/configure.ac b/configure.ac index 1976530..ac464b6 100644 --- a/configure.ac +++ b/configure.ac @@ -1182,23 +1182,22 @@ if test "$ac_cv_sizeof_void_p" -eq 8 ; then if test "x$EnableLargeAddressSpace" = "xyes" ; then if test "$ghc_host_os" = "darwin" ; then use_large_address_space=yes - elif test "$ghc_host_os" = "openbsd" ; then - # as of OpenBSD 5.8 (2015), OpenBSD does not support mmap with MAP_NORESERVE. - # The flag MAP_NORESERVE is supported for source compatibility reasons, - # but is completely ignored by OS mmap + elif test "$ghc_host_os" = "openbsd" ; then + # as of OpenBSD 5.8 (2015), OpenBSD does not support mmap with MAP_NORESERVE. + # The flag MAP_NORESERVE is supported for source compatibility reasons, + # but is completely ignored by OS mmap use_large_address_space=no else - AC_CHECK_DECLS([MAP_NORESERVE, MAP_GUARD, MADV_FREE, MADV_DONTNEED],[],[], + AC_CHECK_DECLS([MAP_NORESERVE, MADV_FREE, MADV_DONTNEED],[],[], [ #include #include #include #include ]) - if ( test "$ac_cv_have_decl_MAP_NORESERVE" = "yes" || - test "$ac_cv_have_decl_MAP_GUARD" = "yes" ) && - ( test "$ac_cv_have_decl_MADV_FREE" = "yes" || - test "$ac_cv_have_decl_MADV_DONTNEED" = "yes" ) ; then + if test "$ac_cv_have_decl_MAP_NORESERVE" = "yes" && + test "$ac_cv_have_decl_MADV_FREE" = "yes" || + test "$ac_cv_have_decl_MADV_DONTNEED" = "yes" ; then use_large_address_space=yes fi fi diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 08f9635..e63e798 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -102,10 +102,8 @@ void osMemInit(void) The naming is chosen from the Win32 API (VirtualAlloc) which does the same thing and has done so forever, while support for this in Unix systems has only been added recently and is hidden in the posix portability mess. - The Linux manpage suggests that mmap must be passed MAP_NORESERVE in order - to get reservation-only behavior. It is confusing because to get the reserve - behavior we need MAP_NORESERVE (which tells the kernel not to allocate backing - space), but heh... + It is confusing because to get the reserve behavior we need MAP_NORESERVE + (which tells the kernel not to allocate backing space), but heh... */ enum { @@ -163,10 +161,7 @@ my_mmap (void *addr, W_ size, int operation) else prot = PROT_NONE; if (operation == MEM_RESERVE) -# if defined(MAP_GUARD) - // Provided by FreeBSD - flags = MAP_GUARD; -# elif defined(MAP_NORESERVE) +# if defined(MAP_NORESERVE) flags = MAP_NORESERVE; # else # if defined(USE_LARGE_ADDRESS_SPACE) From git at git.haskell.org Sun Jul 8 16:24:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jul 2018 16:24:09 +0000 (UTC) Subject: [commit: ghc] master: Define an Outputable MCoercion instance (6595bee) Message-ID: <20180708162409.63DB23ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6595bee749ddb49d9058ed47ab7c1b6e7558ae17/ghc >--------------------------------------------------------------- commit 6595bee749ddb49d9058ed47ab7c1b6e7558ae17 Author: Ryan Scott Date: Sun Jul 8 12:20:53 2018 -0400 Define an Outputable MCoercion instance Summary: I needed this when debugging #15346. Test Plan: Does it compile? It does? Cool. Reviewers: bgamari, mpickering Reviewed By: mpickering Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15311 Differential Revision: https://phabricator.haskell.org/D4944 >--------------------------------------------------------------- 6595bee749ddb49d9058ed47ab7c1b6e7558ae17 compiler/types/TyCoRep.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 7923369..0ec5888 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -964,6 +964,10 @@ data MCoercion -- Other coercions type MCoercionR = MCoercion +instance Outputable MCoercion where + ppr MRefl = text "MRefl" + ppr (MCo co) = text "MCo" <+> ppr co + {- Note [Refl invariant] ~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Tue Jul 10 01:38:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 01:38:59 +0000 (UTC) Subject: [commit: ghc] master: Refactor coercion rule (55a3f85) Message-ID: <20180710013859.E25053ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/55a3f8552c9dc9b84e204ec6623c698912795347/ghc >--------------------------------------------------------------- commit 55a3f8552c9dc9b84e204ec6623c698912795347 Author: ningning Date: Mon Jul 9 20:02:03 2018 -0400 Refactor coercion rule Summary: The patch is an attempt on #15192. It defines a new coercion rule ``` | GRefl Role Type MCoercion ``` which correspondes to the typing rule ``` t1 : k1 ------------------------------------ GRefl r t1 MRefl: t1 ~r t1 t1 : k1 co :: k1 ~ k2 ------------------------------------ GRefl r t1 (MCo co) : t1 ~r t1 |> co ``` MCoercion wraps a coercion, which might be reflexive (MRefl) or not (MCo co). To know more about MCoercion see #14975. We keep Refl ty as a special case for nominal reflexive coercions, naemly, Refl ty :: ty ~n ty. This commit is meant to be a general performance improvement, but there are a few regressions. See #15192, comment:13 for more information. Test Plan: ./validate Reviewers: bgamari, goldfire, simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15192 Differential Revision: https://phabricator.haskell.org/D4747 >--------------------------------------------------------------- 55a3f8552c9dc9b84e204ec6623c698912795347 compiler/backpack/RnModIface.hs | 9 +- compiler/coreSyn/CoreFVs.hs | 8 +- compiler/coreSyn/CoreLint.hs | 25 ++- compiler/coreSyn/CoreOpt.hs | 2 +- compiler/iface/IfaceSyn.hs | 10 +- compiler/iface/IfaceType.hs | 106 +++++++----- compiler/iface/TcIface.hs | 8 +- compiler/iface/ToIface.hs | 7 +- compiler/typecheck/TcCanonical.hs | 21 ++- compiler/typecheck/TcEvidence.hs | 14 +- compiler/typecheck/TcFlatten.hs | 85 +++++---- compiler/typecheck/TcTyDecls.hs | 9 +- compiler/typecheck/TcType.hs | 7 +- compiler/typecheck/TcUnify.hs | 12 +- compiler/typecheck/TcValidity.hs | 8 +- compiler/types/Coercion.hs | 334 +++++++++++++++++++++++------------- compiler/types/Coercion.hs-boot | 4 +- compiler/types/FamInstEnv.hs | 16 +- compiler/types/OptCoercion.hs | 101 ++++++----- compiler/types/TyCoRep.hs | 118 +++++++++---- compiler/types/TyCoRep.hs-boot | 3 + compiler/types/Type.hs | 54 +++--- compiler/types/Unify.hs | 49 ++++-- testsuite/tests/perf/compiler/all.T | 3 +- 24 files changed, 637 insertions(+), 376 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 55a3f8552c9dc9b84e204ec6623c698912795347 From git at git.haskell.org Tue Jul 10 11:45:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 11:45:19 +0000 (UTC) Subject: [commit: ghc] master: More refactoring in TcValidity (fd0f033) Message-ID: <20180710114519.74EA83ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fd0f0334189c0c5c9b186bd1b009f706d3d86086/ghc >--------------------------------------------------------------- commit fd0f0334189c0c5c9b186bd1b009f706d3d86086 Author: Simon Peyton Jones Date: Thu Jul 5 17:09:47 2018 +0100 More refactoring in TcValidity This patch responds to Trac #15334 by making it an error to write an instance declaration for a tuple constraint like (Eq [a], Show [a]). I then discovered that instance validity checking was scattered betweeen TcInstDcls and TcValidity, so I took the time to bring it all together, into TcValidity.checkValidInstHead In doing so I discovered that there are lot of special cases. I have not changed them, but at least they are all laid out clearly now. >--------------------------------------------------------------- fd0f0334189c0c5c9b186bd1b009f706d3d86086 compiler/hsSyn/HsDecls.hs | 4 +- compiler/prelude/TysWiredIn.hs | 2 +- compiler/typecheck/TcDeriv.hs | 20 +- compiler/typecheck/TcInstDcls.hs | 60 +----- compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/typecheck/TcType.hs | 7 +- compiler/typecheck/TcValidity.hs | 203 ++++++++++++++------- testsuite/tests/deriving/should_fail/T14916.stderr | 6 +- testsuite/tests/deriving/should_fail/T9687.stderr | 2 +- testsuite/tests/polykinds/T8132.stderr | 2 +- testsuite/tests/quantified-constraints/T15334.hs | 9 + .../tests/quantified-constraints/T15334.stderr | 6 + testsuite/tests/quantified-constraints/all.T | 1 + .../tests/typecheck/should_fail/T12837.stderr | 6 +- .../tests/typecheck/should_fail/T13068.stderr | 2 +- .../tests/typecheck/should_fail/T14390.stderr | 3 +- .../typecheck/should_fail/TcCoercibleFail2.stderr | 5 +- 17 files changed, 196 insertions(+), 144 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fd0f0334189c0c5c9b186bd1b009f706d3d86086 From git at git.haskell.org Tue Jul 10 11:45:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 11:45:22 +0000 (UTC) Subject: [commit: ghc] master: Add nakedSubstTy and use it in TcHsType.tcInferApps (5067b20) Message-ID: <20180710114522.51A983ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5067b205a8abb5a9f98335d3a929f647c88c0aa2/ghc >--------------------------------------------------------------- commit 5067b205a8abb5a9f98335d3a929f647c88c0aa2 Author: Simon Peyton Jones Date: Mon Jul 9 17:29:22 2018 +0100 Add nakedSubstTy and use it in TcHsType.tcInferApps This was a tricky one. During type checking we maintain TcType: Note [The well-kinded type invariant] That is, types are well-kinded /without/ zonking. But in tcInferApps we were destroying that invariant by calling substTy, which in turn uses smart constructors, which eliminate apparently-redundant Refl casts. This is horribly hard to debug beause they really are Refls and so it "ought" to be OK to discard them. But it isn't, as the above Note describes in some detail. Maybe we should review the invariant? But for now I just followed it, tricky thought it is. This popped up because (for some reason) when I fixed Trac #15343, that exposed this bug by making test polykinds/T14174a fail (in Trac #14174 which indeed has the same origin). So this patch fixes a long standing and very subtle bug. One interesting point: I defined nakedSubstTy in a few lines by using the generic mapType stuff. I note that the "normal" TyCoRep.substTy does /not/ use mapType. But perhaps it should: substTy has lots of $! strict applications in it, and they could all be eliminated just by useing the StrictIdentity monad. And that'd make it much easier to experiment with switching between strict and lazy versions. >--------------------------------------------------------------- 5067b205a8abb5a9f98335d3a929f647c88c0aa2 compiler/typecheck/TcHsType.hs | 20 +++++--- compiler/typecheck/TcType.hs | 108 ++++++++++++++++++++++++++++++----------- 2 files changed, 94 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 5067b205a8abb5a9f98335d3a929f647c88c0aa2 From git at git.haskell.org Tue Jul 10 11:45:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 11:45:26 +0000 (UTC) Subject: [commit: ghc] master: Fix decompsePiCos and visible type application (aedbf7f) Message-ID: <20180710114526.08D133ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aedbf7f1c402ecbcb5ff192d5fb4dd6dd4771bf8/ghc >--------------------------------------------------------------- commit aedbf7f1c402ecbcb5ff192d5fb4dd6dd4771bf8 Author: Simon Peyton Jones Date: Mon Jul 9 17:20:06 2018 +0100 Fix decompsePiCos and visible type application Trac #15343 was caused by two things First, in TcHsType.tcHsTypeApp, which deals with the type argment in visible type application, we were failing to call solveLocalEqualities. But the type argument is like a user type signature so it's at least inconsitent not to do so. I thought that would nail it. But it didn't. It turned out that we were ended up calling decomposePiCos on a type looking like this (f |> co) Int where co :: (forall a. ty) ~ (t1 -> t2) Now, 'co' is insoluble, and we'll report that later. But meanwhile we don't want to crash in decomposePiCos. My fix involves keeping track of the type on both sides of the coercion, and ensuring that the outer shape matches before decomposing. I wish there was a simpler way to do this. But I think this one is at least robust. I suppose it is possible that the decomposePiCos fix would have cured the original report, but I'm leaving the one-line tcHsTypeApp fix in too because it just seems more consistent. >--------------------------------------------------------------- aedbf7f1c402ecbcb5ff192d5fb4dd6dd4771bf8 compiler/typecheck/TcFlatten.hs | 12 ++- compiler/typecheck/TcHsType.hs | 5 +- compiler/types/Coercion.hs | 110 +++++++++++++-------- compiler/types/Coercion.hs-boot | 2 +- compiler/types/Type.hs | 4 +- testsuite/tests/dependent/should_fail/T15343.hs | 14 +++ .../tests/dependent/should_fail/T15343.stderr | 7 ++ testsuite/tests/dependent/should_fail/all.T | 2 + 8 files changed, 107 insertions(+), 49 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc aedbf7f1c402ecbcb5ff192d5fb4dd6dd4771bf8 From git at git.haskell.org Tue Jul 10 11:45:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 11:45:28 +0000 (UTC) Subject: [commit: ghc] master: More tc-tracing (03d7268) Message-ID: <20180710114528.D23BA3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/03d726837ad3a73133fee26de86dd57544f2d757/ghc >--------------------------------------------------------------- commit 03d726837ad3a73133fee26de86dd57544f2d757 Author: Simon Peyton Jones Date: Mon Jul 9 17:27:47 2018 +0100 More tc-tracing And I added some HasDebugCallStack constraints to tcExpectedKind and related functions too. >--------------------------------------------------------------- 03d726837ad3a73133fee26de86dd57544f2d757 compiler/typecheck/TcExpr.hs | 2 ++ compiler/typecheck/TcHsType.hs | 10 +++++++--- compiler/typecheck/TcTyClsDecls.hs | 14 ++++++++------ 3 files changed, 17 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index c638ab9..47e3bc4 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1350,7 +1350,9 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald ; traceTc "VTA" (vcat [ppr tv, debugPprType kind , debugPprType ty_arg , debugPprType (typeKind ty_arg) + , debugPprType inner_ty , debugPprType insted_ty ]) + ; (inner_wrap, args', res_ty) <- go acc_args (n+1) insted_ty args -- inner_wrap :: insted_ty "->" (map typeOf args') -> res_ty diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 463c7e0..624e920 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -837,7 +837,7 @@ tcWildCardOcc wc_info exp_kind --------------------------- -- | Call 'tc_infer_hs_type' and check its result against an expected kind. -tc_infer_hs_type_ek :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType +tc_infer_hs_type_ek :: HasDebugCallStack => TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType tc_infer_hs_type_ek mode hs_ty ek = do { (ty, k) <- tc_infer_hs_type mode hs_ty ; checkExpectedKind hs_ty ty k ek } @@ -1004,7 +1004,8 @@ tcTyApps mode orig_hs_ty fun_ty fun_ki args -------------------------- -- Like checkExpectedKindX, but returns only the final type; convenient wrapper -- Obeys Note [The tcType invariant] -checkExpectedKind :: HsType GhcRn -- type we're checking (for printing) +checkExpectedKind :: HasDebugCallStack + => HsType GhcRn -- type we're checking (for printing) -> TcType -- type we're checking (might be knot-tied) -> TcKind -- the known kind of that type -> TcKind -- the expected kind @@ -1012,7 +1013,8 @@ checkExpectedKind :: HsType GhcRn -- type we're checking (for printing) checkExpectedKind hs_ty ty act exp = fstOf3 <$> checkExpectedKindX Nothing (ppr hs_ty) ty act exp -checkExpectedKindX :: Maybe (VarEnv Kind) -- Possibly, instantiations for kind vars +checkExpectedKindX :: HasDebugCallStack + => Maybe (VarEnv Kind) -- Possibly, instantiations for kind vars -> SDoc -- HsType whose kind we're checking -> TcType -- the type whose kind we're checking -> TcKind -- the known kind of that type, k @@ -2712,6 +2714,7 @@ tcLHsKindSig ctxt hs_kind -- See Note [Recipe for checking a signature] in TcHsType = do { kind <- solveLocalEqualities $ tc_lhs_kind kindLevelMode hs_kind + ; traceTc "tcLHsKindSig" (ppr kind) ; kind <- zonkPromoteType kind -- This zonk is very important in the case of higher rank kinds -- E.g. Trac #13879 f :: forall (p :: forall z (y::z). ). @@ -2721,6 +2724,7 @@ tcLHsKindSig ctxt hs_kind -- else we may fail to substitute properly ; checkValidType ctxt kind + ; traceTc "tcLHsKindSig2" (ppr kind) ; return kind } tc_lhs_kind :: TcTyMode -> LHsKind GhcRn -> TcM Kind diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index a1c3d43..f212fdd 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -1563,17 +1563,17 @@ kcFamTyPats :: TcTyCon kcFamTyPats tc_fam_tc tv_names arg_pats kind_checker = discardResult $ kcImplicitTKBndrs tv_names $ - do { let loc = nameSrcSpan name - lhs_fun = L loc (HsTyVar noExt NotPromoted (L loc name)) - -- lhs_fun is for error messages only - no_fun = pprPanic "kcFamTyPats" (ppr name) + do { let name = tyConName tc_fam_tc + loc = nameSrcSpan name + lhs_fun = L loc (HsTyVar noExt NotPromoted (L loc name)) + -- lhs_fun is for error messages only + no_fun = pprPanic "kcFamTyPats" (ppr name) fun_kind = tyConKind tc_fam_tc ; (_, _, res_kind_out) <- tcInferApps typeLevelMode Nothing lhs_fun no_fun fun_kind arg_pats + ; traceTc "kcFamTyPats" (vcat [ ppr tc_fam_tc, ppr arg_pats, ppr res_kind_out ]) ; kind_checker res_kind_out } - where - name = tyConName tc_fam_tc tcFamTyPats :: TyCon -> Maybe ClsInstInfo @@ -1628,6 +1628,8 @@ tcFamTyPats fam_tc mb_clsinfo <- tcInferApps typeLevelMode mb_kind_env lhs_fun fun_ty fun_kind arg_pats + ; traceTc "tcFamTyPats 1" (vcat [ ppr fam_tc, ppr arg_pats, ppr res_kind_out ]) + ; stuff <- kind_checker res_kind_out ; return (args, stuff) } From git at git.haskell.org Tue Jul 10 11:56:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 11:56:45 +0000 (UTC) Subject: [commit: ghc] master: Optional context for a quantified constraint (8ec2946) Message-ID: <20180710115645.012FA3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ec2946048123f9278cf68eaf520104319a1f569/ghc >--------------------------------------------------------------- commit 8ec2946048123f9278cf68eaf520104319a1f569 Author: Simon Peyton Jones Date: Tue Jul 10 12:55:21 2018 +0100 Optional context for a quantified constraint This is a documentation-only fix, addressing Trac #15354. >--------------------------------------------------------------- 8ec2946048123f9278cf68eaf520104319a1f569 docs/users_guide/glasgow_exts.rst | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 2a98522..041cfb4 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9731,11 +9731,11 @@ We to extend ``class`` (warning: this is a rather confusingly named non-terminal .. code-block:: none class ::= ... - | context => qtycls inst - | context => tyvar inst + | [context =>] qtycls inst + | [context =>] tyvar inst The definition of ``inst`` is unchanged from the Haskell Report (roughly, just a type). -That is the only syntactic change to the language. +The ``context =>`` part is optional. That is the only syntactic change to the language. Notes: @@ -9744,8 +9744,8 @@ Notes: .. code-block:: none class ::= ... - | [forall tyavrs .] context => qtycls inst1 ... instn - | [forall tyavrs .] context => tyvar inst1 ... instn + | [forall tyavrs .] [context =>] qtycls inst1 ... instn + | [forall tyavrs .] [context =>] tyvar inst1 ... instn Note that an explicit ``forall`` is often absolutely essential. Consider the rose-tree example :: From git at git.haskell.org Tue Jul 10 23:55:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 23:55:32 +0000 (UTC) Subject: [commit: ghc] master: Unwrap casts before checking vars in eager unifier (042df60) Message-ID: <20180710235532.CBD9E3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/042df603cbb5a77ec13ccfec2ce7bad2bb940aae/ghc >--------------------------------------------------------------- commit 042df603cbb5a77ec13ccfec2ce7bad2bb940aae Author: Richard Eisenberg Date: Thu Jul 5 14:21:43 2018 -0400 Unwrap casts before checking vars in eager unifier Previously, checking whether (tv |> co) ~ (tv |> co) got deferred, because we looked for vars before stripping casts. (The left type would get stripped, and then tv ~ (tv |> co) would scare the occurs- checker.) This opportunity for improvement presented itself in other work. This is just an optimization. Some programs can now report more errors simultaneously. >--------------------------------------------------------------- 042df603cbb5a77ec13ccfec2ce7bad2bb940aae compiler/typecheck/TcUnify.hs | 19 ++++--- .../tests/partial-sigs/should_fail/T12634.stderr | 14 +++++ .../tests/partial-sigs/should_fail/T14040a.stderr | 37 -------------- .../tests/partial-sigs/should_fail/T14584.stderr | 46 ++++++++++++++--- testsuite/tests/polykinds/T12593.stderr | 59 +++++++++++++++++++--- testsuite/tests/polykinds/T14846.stderr | 25 +++++---- .../tests/typecheck/should_compile/T2494.stderr | 6 +-- .../tests/typecheck/should_fail/VtaFail.stderr | 22 ++++++++ 8 files changed, 157 insertions(+), 71 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 042df603cbb5a77ec13ccfec2ce7bad2bb940aae From git at git.haskell.org Tue Jul 10 23:55:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 23:55:36 +0000 (UTC) Subject: [commit: ghc] master: Kind-check CUSK associated types separately (030211d) Message-ID: <20180710235536.845433ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/030211d21207dabb7a4bf21cc9af6fa5eb066db1/ghc >--------------------------------------------------------------- commit 030211d21207dabb7a4bf21cc9af6fa5eb066db1 Author: Richard Eisenberg Date: Thu Jul 5 15:09:50 2018 -0400 Kind-check CUSK associated types separately Previously, we kind-checked associated types while while still figuring out the kind of a CUSK class. This caused trouble, as documented in Note [Don't process associated types in kcLHsQTyVars] in TcTyClsDecls. This commit moves this process after the initial kind of the class is determined. Fixes #15142. Test case: indexed-types/should_compile/T15142.hs >--------------------------------------------------------------- 030211d21207dabb7a4bf21cc9af6fa5eb066db1 compiler/typecheck/TcHsType.hs | 12 ++-- compiler/typecheck/TcTyClsDecls.hs | 71 ++++++++++++++-------- .../tests/indexed-types/should_compile/T15142.hs | 14 +++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 4 files changed, 66 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 030211d21207dabb7a4bf21cc9af6fa5eb066db1 From git at git.haskell.org Tue Jul 10 23:55:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 23:55:39 +0000 (UTC) Subject: [commit: ghc] master: Expand and implement Note [The tcType invariant] (cf67e59) Message-ID: <20180710235539.62BCC3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf67e59a90bcaba657a9f5db3d5defb6289c274f/ghc >--------------------------------------------------------------- commit cf67e59a90bcaba657a9f5db3d5defb6289c274f Author: Richard Eisenberg Date: Thu Jul 5 19:51:59 2018 -0400 Expand and implement Note [The tcType invariant] Read that note -- it's necessary to make sure that we can always call typeKind without panicking. As discussed on #14873, there were more checks and zonking to do, implemented here. There are no known bugs fixed by this patch, but there are likely unknown ones. >--------------------------------------------------------------- cf67e59a90bcaba657a9f5db3d5defb6289c274f compiler/typecheck/TcHsType.hs | 77 ++++++++++++++++++++++++++---------------- 1 file changed, 48 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cf67e59a90bcaba657a9f5db3d5defb6289c274f From git at git.haskell.org Tue Jul 10 23:55:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jul 2018 23:55:42 +0000 (UTC) Subject: [commit: ghc] master: Note [Ordering of implicit variables] (7f4dd88) Message-ID: <20180710235542.3E2DE3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7f4dd888f12ec9a24cc2d7f60f214706bd33a1ab/ghc >--------------------------------------------------------------- commit 7f4dd888f12ec9a24cc2d7f60f214706bd33a1ab Author: Richard Eisenberg Date: Tue Jul 10 18:03:09 2018 -0400 Note [Ordering of implicit variables] This addresses #14808 [ci skip] >--------------------------------------------------------------- 7f4dd888f12ec9a24cc2d7f60f214706bd33a1ab compiler/hsSyn/HsTypes.hs | 33 +++++++++++++++++++++++++++++++++ compiler/rename/RnTypes.hs | 5 +++++ compiler/typecheck/TcHsType.hs | 2 ++ compiler/types/TyCon.hs | 2 +- compiler/types/Type.hs | 5 +++++ docs/users_guide/glasgow_exts.rst | 29 +++++++++++++++++++++++++---- 6 files changed, 71 insertions(+), 5 deletions(-) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index cbaa9fb..8a1f33f 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -217,6 +217,37 @@ Note carefully: * After type checking is done, we report what types the wildcards got unified with. +Note [Ordering of implicit variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since the advent of -XTypeApplications, GHC makes promises about the ordering +of implicit variable quantification. Specifically, we offer that implicitly +quantified variables (such as those in const :: a -> b -> a, without a `forall`) +will occur in left-to-right order of first occurrence. Here are a few examples: + + const :: a -> b -> a -- forall a b. ... + f :: Eq a => b -> a -> a -- forall a b. ... contexts are included + + type a <-< b = b -> a + g :: a <-< b -- forall a b. ... type synonyms matter + + class Functor f where + fmap :: (a -> b) -> f a -> f b -- forall f a b. ... + -- The f is quantified by the class, so only a and b are considered in fmap + +This simple story is complicated by the possibility of dependency: all variables +must come after any variables mentioned in their kinds. + + typeRep :: Typeable a => TypeRep (a :: k) -- forall k a. ... + +The k comes first because a depends on k, even though the k appears later than +the a in the code. Thus, GHC does a *stable topological sort* on the variables. +By "stable", we mean that any two variables who do not depend on each other +preserve their existing left-to-right ordering. + +Implicitly bound variables are collected by extractHsTysRdrTyVars and friends +in RnTypes. These functions thus promise to keep left-to-right ordering. +Look for pointers to this note to see the places where the action happens. + -} -- | Located Haskell Context @@ -308,6 +339,8 @@ data HsImplicitBndrs pass thing -- See Note [HsType binders] data HsIBRn = HsIBRn { hsib_vars :: [Name] -- Implicitly-bound kind & type vars + -- Order is important; see + -- Note [Ordering of implicit variables] , hsib_closed :: Bool -- Taking the hsib_vars into account, -- is the payload closed? Used in -- TcHsType.decideKindGeneralisationPlan diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index c8ddd0a..a9e02dc 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -340,6 +340,8 @@ rnImplicitBndrs bind_free_tvs implicit_kind_vars_msg kvs ; loc <- getSrcSpanM + -- NB: kinds before tvs, as mandated by + -- Note [Ordering of implicit variables] in HsTypes ; vars <- mapM (newLocalBndrRn . L loc . unLoc) (kvs ++ real_tvs) ; traceRn "checkMixedVars2" $ @@ -1558,6 +1560,9 @@ of the k in Proxy k being reported as out of scope. -} -- See Note [Kind and type-variable binders] +-- These lists are guaranteed to preserve left-to-right ordering of +-- the types the variables were extracted from. See also +-- Note [Ordering of implicit variables] in HsTypes. data FreeKiTyVars = FKTV { fktv_kis :: [Located RdrName] , fktv_tys :: [Located RdrName] } diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 8373472..6039eea 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1839,6 +1839,8 @@ tcImplicitTKBndrsX new_tv skol_info tv_names thing_inside ; skol_tvs <- mapM zonkTcTyCoVarBndr skol_tvs -- use zonkTcTyCoVarBndr because a skol_tv might be a SigTv + -- do a stable topological sort, following + -- Note [Ordering of implicit variables] in HsTypes ; let final_tvs = toposortTyVars skol_tvs ; traceTc "tcImplicitTKBndrs" (ppr tv_names $$ ppr final_tvs) ; return (final_tvs, result) } diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 3801137..7836a02 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -391,7 +391,7 @@ See also: -} type TyConBinder = TyVarBndr TyVar TyConBndrVis - -- See also Note [TyBinder] in TyCoRep + -- See also Note [TyBinders] in TyCoRep data TyConBndrVis = NamedTCB ArgFlag diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 0833665..e96188f 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1815,6 +1815,11 @@ predTypeEqRel ty -- -- This is a deterministic sorting operation -- (that is, doesn't depend on Uniques). +-- +-- It is also meant to be stable: that is, variables should not +-- be reordered unnecessarily. The implementation of this +-- has been observed to be stable, though it is not proven to +-- be so. See also Note [Ordering of implicit variables] in HsTypes toposortTyVars :: [TyCoVar] -> [TyCoVar] toposortTyVars tvs = reverse $ [ node_payload node | node <- topologicalSortG $ diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 041cfb4..678f75c 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -10606,14 +10606,35 @@ Here are the details: will have its type variables ordered as ``m, a, b, c``. +- If the type signature includes any kind annotations (either on variable + binders or as annotations on types), any variables used in kind + annotations come before any variables never used in kind annotations. + This rule is not recursive: if there is an annotation within an annotation, + then the variables used therein are on equal footing. Examples:: + + f :: Proxy (a :: k) -> Proxy (b :: j) -> () + -- as if f :: forall k j a b. ... + + g :: Proxy (b :: j) -> Proxy (a :: (Proxy :: (k -> Type) -> Type) Proxy) -> () + -- as if g :: forall j k b a. ... + -- NB: k is in a kind annotation within a kind annotation + - If any of the variables depend on other variables (that is, if some of the variables are *kind* variables), the variables are reordered so that kind variables come before type variables, preserving the left-to-right order as much as possible. That is, GHC performs a - stable topological sort on the variables. - - For example: if we have ``bar :: Proxy (a :: (j, k)) -> b``, then - the variables are ordered ``j``, ``k``, ``a``, ``b``. + stable topological sort on the variables. Examples:: + + h :: Proxy (a :: (j, k)) -> Proxy (b :: Proxy a) -> () + -- as if h :: forall j k a b. ... + + In this example, all of ``a``, ``j``, and ``k`` are considered kind + variables and will always be placed before ``b``, a lowly type variable. + (Note that ``a`` is used in ``b``\'s kind.) Yet, even though ``a`` appears + lexically before ``j`` and ``k``, ``j`` and ``k`` are quantified first, + because ``a`` depends on ``j`` and ``k``. Note further that ``j`` and ``k`` + are not reordered with respect to eacho other, even though doing so would + not violate dependency conditions. - Visible type application is available to instantiate only user-specified type variables. This means that in ``data Proxy a = Proxy``, the unmentioned From git at git.haskell.org Wed Jul 11 02:26:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jul 2018 02:26:51 +0000 (UTC) Subject: [commit: ghc] master: Remove bad debugging output. (9768c94) Message-ID: <20180711022651.57A793ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9768c946ef1e15c636c098154eac082c813c87b7/ghc >--------------------------------------------------------------- commit 9768c946ef1e15c636c098154eac082c813c87b7 Author: Richard Eisenberg Date: Tue Jul 10 22:00:36 2018 -0400 Remove bad debugging output. The removed line could cause GHC to hang by printing a knot-tied type. >--------------------------------------------------------------- 9768c946ef1e15c636c098154eac082c813c87b7 compiler/typecheck/TcHsType.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 6039eea..1b3ae90 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -977,7 +977,6 @@ tcInferApps mode mb_kind_info orig_hs_ty fun_ty fun_ki orig_hs_args ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $ tc_lhs_type mode arg exp_kind ; traceTc "tcInferApps (vis 1)" (vcat [ ppr exp_kind - , ppr arg' , ppr (typeKind arg') ]) ; let subst' = extendTvSubstBinderAndInScope subst ki_binder arg' ; go (n+1) (arg' : acc_args) subst' From git at git.haskell.org Wed Jul 11 11:09:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jul 2018 11:09:46 +0000 (UTC) Subject: [commit: ghc] master: Add test for Trac #15352 (81d8b17) Message-ID: <20180711110946.D62A53ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/81d8b1792d01e0645468e35e23e758dd9c7a6349/ghc >--------------------------------------------------------------- commit 81d8b1792d01e0645468e35e23e758dd9c7a6349 Author: Simon Peyton Jones Date: Wed Jul 11 12:04:46 2018 +0100 Add test for Trac #15352 >--------------------------------------------------------------- 81d8b1792d01e0645468e35e23e758dd9c7a6349 .../tests/indexed-types/should_compile/T15352.hs | 31 ++++++++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 2 ++ 2 files changed, 33 insertions(+) diff --git a/testsuite/tests/indexed-types/should_compile/T15352.hs b/testsuite/tests/indexed-types/should_compile/T15352.hs new file mode 100644 index 0000000..d83512f --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15352.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TypeInType #-} -- or PolyKinds +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +module T15352 where + +import Data.Kind + +class C (x :: Type) (y :: k) where + type F y + + +type Hom k = k -> k -> Type + +type family Ob (p :: Hom k) :: k -> Constraint + +class ( obP ~ Ob p + , opP ~ Dom p + , obQ ~ Ob q + , opQ ~ Dom q + , p ~ Dom f + , q ~ Cod f + ) => Functor' (obP :: i -> Constraint) + (opP :: Hom i) + (p :: Hom i) + (obQ :: j -> Constraint) + (opQ :: Hom j) + (q :: Hom j) + (f :: i -> j) where + type Dom f :: Hom i + type Cod f :: Hom j diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 3f27591..035c85d 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -288,3 +288,5 @@ test('T15318', normal, compile, ['']) test('T15322', normal, compile, ['']) test('T15322a', normal, compile_fail, ['']) test('T15142', normal, compile, ['']) +test('T15352', normal, compile, ['']) + From git at git.haskell.org Wed Jul 11 11:09:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jul 2018 11:09:49 +0000 (UTC) Subject: [commit: ghc] master: Better Note [The well-kinded type invariant] (e24da5e) Message-ID: <20180711110949.BF9903ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e24da5edb4709bdb050c8d0676f302d0b87b8446/ghc >--------------------------------------------------------------- commit e24da5edb4709bdb050c8d0676f302d0b87b8446 Author: Simon Peyton Jones Date: Wed Jul 11 12:05:20 2018 +0100 Better Note [The well-kinded type invariant] c.f. Trac #14873 >--------------------------------------------------------------- e24da5edb4709bdb050c8d0676f302d0b87b8446 compiler/typecheck/TcType.hs | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 96d4524..83e62e0 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1402,26 +1402,26 @@ getDFunTyLitKey (StrTyLit n) = mkOccName Name.varName (show n) -- hm ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See also Note [The tcType invariant] in TcHsType. -During type inference, we maintain the invariant that - - INVARIANT: every type is well-kinded /without/ zonking - - EXCEPT: you are allowed (ty |> co) even if the kind of ty - does not match the from-kind of co. - -Main goal: if this invariant is respected, then typeKind cannot fail -(as it can for ill-kinded types). - -In particular, we can get types like - (k |> co) Int -where - k :: kappa - co :: Refl (Type -> Type) - kappa is a unification variable and kappa := Type already - -So in the un-zonked form (k Int) would be ill-kinded, -but (k |> co) Int is well-kinded. So we want to keep that 'co' -/even though it is Refl/. +During type inference, we maintain this invariant + + (INV-TK): it is legal to call 'typeKind' on any Type ty, + /without/ zonking ty + +For example, suppose + kappa is a unification variable + We have already unified kappa := Type + yielding co :: Refl (Type -> Type) + a :: kappa +then consider the type + (a Int) +If we call typeKind on that, we'll crash, because the (un-zonked) +kind of 'a' is just kappa, not an arrow kind. If we zonk first +we'd be fine, but that is too tiresome, so instead we maintain +(TK-INV). So we do not form (a Int); instead we form + (a |> co) Int +and typeKind has no problem with that. + +Bottom line: we want to keep that 'co' /even though it is Refl/. Immediate consequence: during type inference we cannot use the "smart contructors" for types, particularly From git at git.haskell.org Wed Jul 11 16:31:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jul 2018 16:31:42 +0000 (UTC) Subject: [commit: ghc] master: Use IfaceAppArgs to store an IfaceAppTy's arguments (1c35362) Message-ID: <20180711163142.B0B843ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c3536239cb5e83ff1427ac410d8fa2549e7d9c0/ghc >--------------------------------------------------------------- commit 1c3536239cb5e83ff1427ac410d8fa2549e7d9c0 Author: Ryan Scott Date: Wed Jul 11 12:28:38 2018 -0400 Use IfaceAppArgs to store an IfaceAppTy's arguments Summary: Currently, an `IfaceAppTy` has no way to tell whether its argument is visible or not, so it simply treats all arguments as visible, leading to #15330. We already have a solution for this problem in the form of the `IfaceTcArgs` data structure, used by `IfaceTyConApp` to represent the arguments to a type constructor. Therefore, it makes sense to reuse this machinery for `IfaceAppTy`, so this patch does just that. This patch: 1. Renames `IfaceTcArgs` to `IfaceAppArgs` to reflect its more general purpose. 2. Changes the second field of `IfaceAppTy` from `IfaceType` to `IfaceAppArgs`, and propagates the necessary changes through. In particular, pretty-printing an `IfaceAppTy` now goes through the `IfaceAppArgs` pretty-printer, which correctly displays arguments as visible or not for free, fixing #15330. 3. Changes `toIfaceTypeX` and related functions so that when converting an `AppTy` to an `IfaceAppTy`, it flattens as many argument `AppTy`s as possible, and then converts those arguments into an `IfaceAppArgs` list, using the kind of the function `Type` as a guide. (Doing so minimizes the number of times we need to call `typeKind`, which is more expensive that finding the kind of a `TyCon`.) Test Plan: make test TEST=T15330 Reviewers: goldfire, simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15330 Differential Revision: https://phabricator.haskell.org/D4938 >--------------------------------------------------------------- 1c3536239cb5e83ff1427ac410d8fa2549e7d9c0 compiler/backpack/RnModIface.hs | 18 +- compiler/iface/IfaceSyn.hs | 26 +- compiler/iface/IfaceType.hs | 297 +++++++++++++-------- compiler/iface/IfaceType.hs-boot | 4 +- compiler/iface/TcIface.hs | 21 +- compiler/iface/ToIface.hs | 37 ++- compiler/iface/ToIface.hs-boot | 4 +- compiler/types/TyCoRep.hs | 3 + .../tests/indexed-types/should_fail/T14369.stderr | 6 +- .../tests/partial-sigs/should_fail/T14040a.stderr | 9 +- .../tests/typecheck/should_fail/T14350.stderr | 23 +- testsuite/tests/typecheck/should_fail/T15330.hs | 15 ++ .../tests/typecheck/should_fail/T15330.stderr | 14 + testsuite/tests/typecheck/should_fail/all.T | 1 + 14 files changed, 296 insertions(+), 182 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1c3536239cb5e83ff1427ac410d8fa2549e7d9c0 From git at git.haskell.org Thu Jul 12 14:10:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 14:10:26 +0000 (UTC) Subject: [commit: ghc] master: Minor refactoring in CmmUtils.mkLiveness (3efd7cd) Message-ID: <20180712141026.0B5A43ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3efd7cd9bacc362b97a5c8b23994addaa614adda/ghc >--------------------------------------------------------------- commit 3efd7cd9bacc362b97a5c8b23994addaa614adda Author: Ömer Sinan Ağacan Date: Thu Jul 12 17:09:52 2018 +0300 Minor refactoring in CmmUtils.mkLiveness Test Plan: validate Reviewers: bgamari, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4957 >--------------------------------------------------------------- 3efd7cd9bacc362b97a5c8b23994addaa614adda compiler/cmm/CmmParse.y | 2 +- compiler/cmm/CmmUtils.hs | 19 ++++++++----------- 2 files changed, 9 insertions(+), 12 deletions(-) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 4d7e288..8cc9883 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -542,7 +542,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) } live <- sequence $7 let prof = NoProfilingInfo -- drop one for the info pointer - bitmap = mkLiveness dflags (map Just (drop 1 live)) + bitmap = mkLiveness dflags (drop 1 live) rep = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap return (mkCmmRetLabel pkg $3, Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel pkg $3 diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 1ae5526..42d6484 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -456,20 +456,17 @@ regUsedIn dflags = regUsedIn_ where -- --------------------------------------------- -mkLiveness :: DynFlags -> [Maybe LocalReg] -> Liveness +mkLiveness :: DynFlags -> [LocalReg] -> Liveness mkLiveness _ [] = [] mkLiveness dflags (reg:regs) - = take sizeW bits ++ mkLiveness dflags regs + = bits ++ mkLiveness dflags regs where - sizeW = case reg of - Nothing -> 1 - Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE dflags - 1) - `quot` wORD_SIZE dflags - -- number of words, rounded up - bits = repeat $ is_non_ptr reg -- True <=> Non Ptr - - is_non_ptr Nothing = True - is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg) + sizeW = (widthInBytes (typeWidth (localRegType reg)) + wORD_SIZE dflags - 1) + `quot` wORD_SIZE dflags + -- number of words, rounded up + bits = replicate sizeW is_non_ptr -- True <=> Non Ptr + + is_non_ptr = not $ isGcPtrType (localRegType reg) -- ============================================== - From git at git.haskell.org Thu Jul 12 15:35:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:35:59 +0000 (UTC) Subject: [commit: ghc] master: Correct Simple to Complex wording (5ee9a1c) Message-ID: <20180712153559.799193ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ee9a1cd0e633ad5ef9d905681d1a231ce1f616c/ghc >--------------------------------------------------------------- commit 5ee9a1cd0e633ad5ef9d905681d1a231ce1f616c Author: Sasa Bogicevic Date: Thu Jun 21 11:06:13 2018 +0200 Correct Simple to Complex wording >--------------------------------------------------------------- 5ee9a1cd0e633ad5ef9d905681d1a231ce1f616c docs/users_guide/glasgow_exts.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 678f75c..44db5ab 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -15867,8 +15867,8 @@ Here are some examples: :: The type ``Simple`` has its parameter at role representational, which is generally the most common case. ``Simple Age`` would have the same representation as ``Simple Int``. The type ``Complex``, on the other -hand, has its parameter at role nominal, because ``Simple Age`` and -``Simple Int`` are *not* the same. Lastly, ``Phant Age`` and +hand, has its parameter at role nominal, because ``Complex Age`` and +``Complex Int`` are *not* the same. Lastly, ``Phant Age`` and ``Phant Bool`` have the same representation, even though ``Age`` and ``Bool`` are unrelated. From git at git.haskell.org Thu Jul 12 15:36:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:36:14 +0000 (UTC) Subject: [commit: ghc] master: Adding missing 'no' (00cb530) Message-ID: <20180712153614.CCFD73ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00cb530c40d897742ca69a7ee0942754a1f3802b/ghc >--------------------------------------------------------------- commit 00cb530c40d897742ca69a7ee0942754a1f3802b Author: jhb563 Date: Mon Jun 25 20:05:48 2018 -0700 Adding missing 'no' >--------------------------------------------------------------- 00cb530c40d897742ca69a7ee0942754a1f3802b compiler/basicTypes/Lexeme.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/Lexeme.hs b/compiler/basicTypes/Lexeme.hs index 74f6e6c..d397dea 100644 --- a/compiler/basicTypes/Lexeme.hs +++ b/compiler/basicTypes/Lexeme.hs @@ -2,7 +2,7 @@ -- -- Functions to evaluate whether or not a string is a valid identifier. -- There is considerable overlap between the logic here and the logic --- in Lexer.x, but sadly there seems to be way to merge them. +-- in Lexer.x, but sadly there seems to be no way to merge them. module Lexeme ( -- * Lexical characteristics of Haskell names From git at git.haskell.org Thu Jul 12 15:36:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:36:29 +0000 (UTC) Subject: [commit: ghc] master: Attempt to fix travis build (7527d1f) Message-ID: <20180712153629.116E33ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7527d1fef3927d0d9ff937645b958d9c40673540/ghc >--------------------------------------------------------------- commit 7527d1fef3927d0d9ff937645b958d9c40673540 Author: Michael Sloan Date: Thu Jun 28 17:07:45 2018 -0700 Attempt to fix travis build >--------------------------------------------------------------- 7527d1fef3927d0d9ff937645b958d9c40673540 .travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 09d9fef..980c3ae 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,15 +17,15 @@ addons: #- llvm-toolchain-precise-3.7 - ubuntu-toolchain-r-test packages: - - cabal-install-2.0 - - ghc-8.2.1 + - cabal-install-2.2 + - ghc-8.4.3 - alex-3.1.7 - happy-1.19.5 - python3 #- llvm-3.7 before_install: - - export PATH=/opt/ghc/8.2.1/bin:/opt/cabal/1.24/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:/usr/lib/llvm-3.7/bin:$PATH + - export PATH=/opt/ghc/8.4.3/bin:/opt/cabal/2.2/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:/usr/lib/llvm-3.7/bin:$PATH # Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git From git at git.haskell.org Thu Jul 12 15:36:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:36:43 +0000 (UTC) Subject: [commit: ghc] master: Link to iterate' doesn't work. (6a1e7e7) Message-ID: <20180712153643.7AC223ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6a1e7e7623cf4fdf5759bb9e8784da4ab65a9cb5/ghc >--------------------------------------------------------------- commit 6a1e7e7623cf4fdf5759bb9e8784da4ab65a9cb5 Author: David Sanders Date: Fri Jun 29 09:27:33 2018 -0700 Link to iterate' doesn't work. >--------------------------------------------------------------- 6a1e7e7623cf4fdf5759bb9e8784da4ab65a9cb5 libraries/base/GHC/List.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index 793ff49..c6a1706 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -444,7 +444,7 @@ minimum xs = foldl1 min xs -- > iterate f x == [x, f x, f (f x), ...] -- -- Note that 'iterate' is lazy, potentially leading to thunk build-up if --- the consumer doesn't force each iterate. See 'iterate\'' for a strict +-- the consumer doesn't force each iterate. See 'iterate'' for a strict -- variant of this function. {-# NOINLINE [1] iterate #-} iterate :: (a -> a) -> a -> [a] @@ -461,7 +461,7 @@ iterateFB c f x0 = go x0 #-} --- | 'iterate\'' is the strict version of 'iterate'. +-- | 'iterate'' is the strict version of 'iterate'. -- -- It ensures that the result of each application of force to weak head normal -- form before proceeding. From git at git.haskell.org Thu Jul 12 15:36:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:36:58 +0000 (UTC) Subject: [commit: ghc] master: Register 'haddockHTMLs' for inplace builds (8bccefc) Message-ID: <20180712153658.6C7DD3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8bccefc06db5aa28e0d999594c87f60eef84121b/ghc >--------------------------------------------------------------- commit 8bccefc06db5aa28e0d999594c87f60eef84121b Author: Alec Theriault Date: Tue Jun 19 10:12:47 2018 -0700 Register 'haddockHTMLs' for inplace builds >--------------------------------------------------------------- 8bccefc06db5aa28e0d999594c87f60eef84121b utils/ghc-cabal/Main.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index a918895..8b77649 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -299,7 +299,6 @@ generate directory distdir config_args final_ipi = installedPkgInfo { Installed.installedUnitId = ipid, Installed.compatPackageKey = display (packageId pd), - Installed.haddockHTMLs = [], Installed.includeDirs = concatMap fixupIncludeDir (Installed.includeDirs installedPkgInfo) } content = Installed.showInstalledPackageInfo final_ipi ++ "\n" From git at git.haskell.org Thu Jul 12 15:37:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:37:13 +0000 (UTC) Subject: [commit: ghc] master: Bump xhtml submodule to 3000.2.2.1 (8e51ece) Message-ID: <20180712153713.B5AFE3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e51eced36cc07090a7713d99a22e881453d63b0/ghc >--------------------------------------------------------------- commit 8e51eced36cc07090a7713d99a22e881453d63b0 Author: Ben Gamari Date: Tue Jul 10 20:20:51 2018 -0400 Bump xhtml submodule to 3000.2.2.1 >--------------------------------------------------------------- 8e51eced36cc07090a7713d99a22e881453d63b0 libraries/xhtml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/xhtml b/libraries/xhtml index c5c623e..721779a 160000 --- a/libraries/xhtml +++ b/libraries/xhtml @@ -1 +1 @@ -Subproject commit c5c623e497f13ec187e0d228e0e8a3d9ee39a715 +Subproject commit 721779acc35dccd6a43a292b24099b65d93d390c From git at git.haskell.org Thu Jul 12 15:37:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:37:28 +0000 (UTC) Subject: [commit: ghc] master: Trac #8581 users_guide/glasgow_exts section 10.7 (471a992) Message-ID: <20180712153728.5662E3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/471a992ab956fe90d51b875a81d6963592db5553/ghc >--------------------------------------------------------------- commit 471a992ab956fe90d51b875a81d6963592db5553 Author: AntC Date: Wed Jun 20 23:17:31 2018 +1200 Trac #8581 users_guide/glasgow_exts section 10.7 as per comments on the ticket; also linked to Haskell folk art of 'Smart constructors'. >--------------------------------------------------------------- 471a992ab956fe90d51b875a81d6963592db5553 docs/users_guide/glasgow_exts.rst | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 44db5ab..c3322b7 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -5435,6 +5435,37 @@ pattern synonym: :: pattern StrictJust a <- Just !a where StrictJust !a = Just a +Constructing an explicitly bidirectional pattern synonym also: + +- can create different data constructors from the underlying data type, + not just the one appearing in the pattern match; + +- can call any functions or conditional logic, especially validation, + of course providing it constructs a result of the right type; + +- can use guards on the lhs of the ``=``; + +- can have multiple equations. + +For example: :: + + data PosNeg = Pos Int | Neg Int + pattern Smarter{ nonneg } <- Pos nonneg where + Smarter x = if x >= 0 then (Pos x) else (Neg x) + +Or using guards: :: + + pattern Smarter{ nonneg } <- Pos nonneg where + Smarter x | x >= 0 = (Pos x) + | otherwise = (Neg x) + +There is an extensive Haskell folk art of `smart constructors +`_, +essentially functions that wrap validation around a constructor, +and avoid exposing its representation. +The downside is that the underlying constructor can't be used as a matcher. +Pattern synonyms can be used as genuinely smart constructors, for both validation and matching. + The table below summarises where each kind of pattern synonym can be used. +---------------+----------------+---------------+---------------------------+ @@ -5508,7 +5539,7 @@ the syntax for bidirectional pattern synonyms is: :: and the syntax for explicitly bidirectional pattern synonyms is: :: pattern pat_lhs <- pat where - pat_lhs = expr + pat_lhs = expr -- lhs restricted, see below We can define either prefix, infix or record pattern synonyms by modifying the form of `pat_lhs`. The syntax for these is as follows: @@ -5522,6 +5553,9 @@ Infix ``arg1 `Name` arg2`` Record ``Name{arg1,arg2,...,argn}`` ======= ============================ +The `pat_lhs` for explicitly bidirectional construction cannot use Record syntax. +(Because the rhs *expr* might be constructing different data constructors.) +It can use guards with multiple equations. Pattern synonym declarations can only occur in the top level of a module. In particular, they are not allowed as local definitions. From git at git.haskell.org Thu Jul 12 15:37:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:37:43 +0000 (UTC) Subject: [commit: ghc] master: The Types section in Core-Spec doc is out-dated (19e1e6b) Message-ID: <20180712153743.9F02C3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/19e1e6bf22031d563eb7f0a3d09bd07fce9e04d7/ghc >--------------------------------------------------------------- commit 19e1e6bf22031d563eb7f0a3d09bd07fce9e04d7 Author: ningning Date: Fri Jul 6 17:23:49 2018 -0400 The Types section in Core-Spec doc is out-dated >--------------------------------------------------------------- 19e1e6bf22031d563eb7f0a3d09bd07fce9e04d7 docs/core-spec/CoreSyn.ott | 4 ++-- docs/core-spec/core-spec.mng | 11 ++++++----- docs/core-spec/core-spec.pdf | Bin 355707 -> 355711 bytes 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott index e12f68b..c8615ad 100644 --- a/docs/core-spec/CoreSyn.ott +++ b/docs/core-spec/CoreSyn.ott @@ -113,8 +113,8 @@ t {{ tex \tau }}, k {{ tex \kappa }}, s {{ tex \sigma }}, phi {{ tex \phi }} | n :: :: TyVarTy {{ com \ctor{TyVarTy}: Variable }} | t1 t2 :: :: AppTy {{ com \ctor{AppTy}: Application }} | T :: :: TyConApp {{ com \ctor{TyConApp}: Application of type constructor }} - | t1 -> t2 :: :: FunTy {{ com \ctor{ForAllTy (Anon ...) ...}: Function }} - | forall n . t :: :: ForAllTy {{ com \ctor{ForAllTy (Named ...) ...}: Type and coercion polymorphism }} + | t1 -> t2 :: :: FunTy {{ com \ctor{FunTy}: Function }} + | forall n . t :: :: ForAllTy {{ com \ctor{ForAllTy}: Type and coercion polymorphism }} | lit :: :: LitTy {{ com \ctor{LitTy}: Type-level literal }} | t |> g :: :: CastTy {{ com \ctor{CastTy}: Kind cast }} | g :: :: CoercionTy {{ com \ctor{CoercionTy}: Coercion used in type }} diff --git a/docs/core-spec/core-spec.mng b/docs/core-spec/core-spec.mng index 64e90bb..19dabcb 100644 --- a/docs/core-spec/core-spec.mng +++ b/docs/core-spec/core-spec.mng @@ -169,9 +169,10 @@ A program is just a list of bindings: \gram{\ottt} -\ctor{ForAllTy}s are represented in two different ways, depending on whether -the \ctor{ForAllTy} is anonymous (written $[[t1 -> t2]]$) or -named (written $[[forall n . t]]$). +\ctor{FunTy} is the special case for non-dependent function type. The +\ctor{TyBinder} in \ghcfile{types/TyCoRep.lhs} distinguishes whether a binder is +anonymous (\ctor{FunTy}) or named (\ctor{ForAllTy}). See +\verb|Note [TyBinders]| in \ghcfile{types/TyCoRep.lhs}. There are some invariants on types: \begin{itemize} @@ -182,7 +183,7 @@ $[[T]]$. It should be another application or a type variable. does \emph{not} need to be saturated. \item A saturated application of $[[(->) t1 t2]]$ should be represented as $[[t1 -> t2]]$. This is a different point in the grammar, not just pretty-printing. -The constructor for a saturated $[[(->)]]$ is \texttt{ForAllTy}. +The constructor for a saturated $[[(->)]]$ is \texttt{FunTy}. \item A type-level literal is represented in GHC with a different datatype than a term-level literal, but we are ignoring this distinction here. \item A coercion used as a type should appear only in the right-hand side of @@ -194,7 +195,7 @@ are purely representational. The metatheory would remain the same if these forms were removed in favor of $[[t1 t2]]$. Nevertheless, we keep all three forms in this documentation to accurately reflect the implementation. -The \texttt{Named} variant of a \texttt{Binder} (the first argument to a +The \texttt{ArgFlag} field of a \texttt{TyVarBinder} (the first argument to a \texttt{ForAllTy}) also tracks visibility of arguments. Visibility affects only source Haskell, and is omitted from this presentation. diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf index 3732818..372a18d 100644 Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ From git at git.haskell.org Thu Jul 12 15:37:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:37:58 +0000 (UTC) Subject: [commit: ghc] master: Fix gcdExtInteger (trac#15350) (7c207c8) Message-ID: <20180712153758.62D6C3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7c207c86ab0de955ebec70eeeb366ba0d94acc4a/ghc >--------------------------------------------------------------- commit 7c207c86ab0de955ebec70eeeb366ba0d94acc4a Author: Bodigrim Date: Sat Jul 7 00:20:10 2018 +0100 Fix gcdExtInteger (trac#15350) >--------------------------------------------------------------- 7c207c86ab0de955ebec70eeeb366ba0d94acc4a libraries/integer-gmp/src/GHC/Integer/Type.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 9ea7c06..9636b9f 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -1389,7 +1389,9 @@ gcdExtSBigNat x y = case runS go of (g,s) -> (# g, s #) where go = do g@(MBN# g#) <- newBigNat# gn0# - s@(MBN# s#) <- newBigNat# (absI# xn#) + -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext + -- abs(s) < abs(y) / (2 g) + s@(MBN# s#) <- newBigNat# (absI# yn#) I# ssn_# <- liftIO (integer_gmp_gcdext# s# g# x# xn# y# yn#) let ssn# = narrowGmpSize# ssn_# sn# = absI# ssn# From git at git.haskell.org Thu Jul 12 15:38:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:38:14 +0000 (UTC) Subject: [commit: ghc] master: Make boot work if ACLOCAL_PATH is not set (101e904) Message-ID: <20180712153814.2BC843ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/101e90472b5536fffce1c19324db45451faf5246/ghc >--------------------------------------------------------------- commit 101e90472b5536fffce1c19324db45451faf5246 Author: Neil Mitchell Date: Mon Jul 9 16:17:57 2018 +0100 Make boot work if ACLOCAL_PATH is not set >--------------------------------------------------------------- 101e90472b5536fffce1c19324db45451faf5246 boot | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/boot b/boot index d57dcc8..29643e4 100755 --- a/boot +++ b/boot @@ -151,7 +151,7 @@ def autoreconf(): # Get the normalized ACLOCAL_PATH for Windows # This is necessary since on Windows this will be a Windows # path, which autoreconf doesn't know doesn't know how to handle. - ac_local = os.environ['ACLOCAL_PATH'] + ac_local = os.getenv('ACLOCAL_PATH', '') ac_local_arg = re.sub(r';', r':', ac_local) ac_local_arg = re.sub(r'\\', r'/', ac_local_arg) ac_local_arg = re.sub(r'(\w):/', r'/\1/', ac_local_arg) From git at git.haskell.org Thu Jul 12 15:40:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:40:33 +0000 (UTC) Subject: [commit: ghc] master: Add flag to show docs of valid hole fits (c4d9834) Message-ID: <20180712154033.B92553ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c4d983412dc8128ac85d3bce0c8e91718af38ed2/ghc >--------------------------------------------------------------- commit c4d983412dc8128ac85d3bce0c8e91718af38ed2 Author: Matthías Páll Gissurarson Date: Thu Jul 12 09:57:00 2018 -0400 Add flag to show docs of valid hole fits One issue with valid hole fits is that the function names can often be opaque for the uninitiated, such as `($)`. This diff adds a new flag, `-fshow-docs-of-hole-fits` that adds the documentation of the identifier in question to the message, using the same mechanism as the `:doc` command. As an example, with this flag enabled, the valid hole fits for `_ :: [Int] -> Int` will include: ``` Valid hole fits include head :: forall a. [a] -> a {-^ Extract the first element of a list, which must be non-empty.-} with head @Int (imported from ‘Prelude’ (and originally defined in ‘GHC.List’)) ``` And one of the refinement hole fits, `($) _`, will read: ``` Valid refinement hole fits include ... ($) (_ :: [Int] -> Int) where ($) :: forall a b. (a -> b) -> a -> b {-^ Application operator. This operator is redundant, since ordinary application @(f x)@ means the same as @(f '$' x)@. However, '$' has low, right-associative binding precedence, so it sometimes allows parentheses to be omitted; for example: > f $ g $ h x = f (g (h x)) It is also useful in higher-order situations, such as @'map' ('$' 0) xs@, or @'Data.List.zipWith' ('$') fs xs at . Note that @($)@ is levity-polymorphic in its result type, so that foo $ True where foo :: Bool -> Int# is well-typed-} with ($) @'GHC.Types.LiftedRep @[Int] @Int (imported from ‘Prelude’ (and originally defined in ‘GHC.Base’)) ``` Another example of where documentation can come in very handy, is when working with the `lens` library. When you compile ``` {-# OPTIONS_GHC -fno-show-provenance-of-hole-fits -fshow-docs-of-hole-fits #-} module LensDemo where import Control.Lens import Control.Monad.State newtype Test = Test { _value :: Int } deriving (Show) value :: Lens' Test Int value f (Test i) = Test <$> f i updTest :: Test -> Test updTest t = t &~ do _ value (1 :: Int) ``` You get: ``` Valid hole fits include (#=) :: forall s (m :: * -> *) a b. MonadState s m => ALens s s a b -> b -> m () {-^ A version of ('Control.Lens.Setter..=') that works on 'ALens'.-} with (#=) @Test @(StateT Test Identity) @Int @Int (<#=) :: forall s (m :: * -> *) a b. MonadState s m => ALens s s a b -> b -> m b {-^ A version of ('Control.Lens.Setter.<.=') that works on 'ALens'.-} with (<#=) @Test @(StateT Test Identity) @Int @Int (<*=) :: forall s (m :: * -> *) a. (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a {-^ Multiply the target of a numerically valued 'Lens' into your 'Monad''s state and return the result. When you do not need the result of the multiplication, ('Control.Lens.Setter.*=') is more flexible. @ ('<*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a ('<*=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a @-} with (<*=) @Test @(StateT Test Identity) @Int (<+=) :: forall s (m :: * -> *) a. (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a {-^ Add to the target of a numerically valued 'Lens' into your 'Monad''s state and return the result. When you do not need the result of the addition, ('Control.Lens.Setter.+=') is more flexible. @ ('<+=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a ('<+=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a @-} with (<+=) @Test @(StateT Test Identity) @Int (<-=) :: forall s (m :: * -> *) a. (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a {-^ Subtract from the target of a numerically valued 'Lens' into your 'Monad''s state and return the result. When you do not need the result of the subtraction, ('Control.Lens.Setter.-=') is more flexible. @ ('<-=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a ('<-=') :: ('MonadState' s m, 'Num' a) => 'Control.Lens.Iso.Iso'' s a -> a -> m a @-} with (<-=) @Test @(StateT Test Identity) @Int (<<*=) :: forall s (m :: * -> *) a. (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a {-^ Modify the target of a 'Lens' into your 'Monad''s state by multipling a value and return the /old/ value that was replaced. When you do not need the result of the operation, ('Control.Lens.Setter.*=') is more flexible. @ ('<<*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a ('<<*=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a @-} with (<<*=) @Test @(StateT Test Identity) @Int (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) ``` Which allows you to see at a glance what opaque operators like `(<<*=)` and `(<#=)` do. Reviewers: bgamari, sjakobi Reviewed By: sjakobi Subscribers: sjakobi, alexbiehl, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4848 >--------------------------------------------------------------- c4d983412dc8128ac85d3bce0c8e91718af38ed2 compiler/iface/LoadIface.hs | 11 ++++- compiler/main/DynFlags.hs | 3 ++ compiler/typecheck/TcHoleErrors.hs | 82 ++++++++++++++++++++++++++++---------- docs/users_guide/glasgow_exts.rst | 15 +++++++ 4 files changed, 89 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c4d983412dc8128ac85d3bce0c8e91718af38ed2 From git at git.haskell.org Thu Jul 12 15:40:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 15:40:49 +0000 (UTC) Subject: [commit: ghc] master: Fix handling of ApplicativeDo in TH AST quotes (234093c) Message-ID: <20180712154049.9A2393ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/234093cf1562d032b38382a5cc08be8dd71c4fe3/ghc >--------------------------------------------------------------- commit 234093cf1562d032b38382a5cc08be8dd71c4fe3 Author: Michael Sloan Date: Thu Jul 12 10:05:41 2018 -0400 Fix handling of ApplicativeDo in TH AST quotes See https://ghc.haskell.org/trac/ghc/ticket/14471 Also fixes a parenthesization bug in pprStmt when ret_stripped is True Test Plan: tests added to testsuite Trac issues: #14471 Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4912 >--------------------------------------------------------------- 234093cf1562d032b38382a5cc08be8dd71c4fe3 compiler/rename/RnExpr.hs | 6 +++++- testsuite/tests/th/T14471.hs | 13 +++++++++++++ testsuite/tests/th/T14471.stdout | 3 +++ testsuite/tests/th/TH_rebindableAdo.hs | 17 +++++++++++++++++ testsuite/tests/th/TH_rebindableAdo.stdout | 3 +++ testsuite/tests/th/all.T | 2 ++ 6 files changed, 43 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 937ffaf..b9e097c 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -26,6 +26,7 @@ import GhcPrelude import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS, rnMatchGroup, rnGRHS, makeMiniFixityEnv) import HsSyn +import TcEnv ( isBrackStage ) import TcRnMonad import Module ( getModule ) import RnEnv @@ -731,7 +732,10 @@ postProcessStmtsForApplicativeDo ctxt stmts ado_is_on <- xoptM LangExt.ApplicativeDo ; let is_do_expr | DoExpr <- ctxt = True | otherwise = False - ; if ado_is_on && is_do_expr + -- don't apply the transformation inside TH brackets, because + -- DsMeta does not handle ApplicativeDo. + ; in_th_bracket <- isBrackStage <$> getStage + ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) ; rearrangeForApplicativeDo ctxt stmts } else noPostProcessStmts ctxt stmts } diff --git a/testsuite/tests/th/T14471.hs b/testsuite/tests/th/T14471.hs new file mode 100644 index 0000000..e1355b1 --- /dev/null +++ b/testsuite/tests/th/T14471.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH +import Prelude + +main = putStrLn $(do + expr <- [| + do x <- getLine + y <- getLine + pure (x, y) + |] + stringE (pprint expr)) diff --git a/testsuite/tests/th/T14471.stdout b/testsuite/tests/th/T14471.stdout new file mode 100644 index 0000000..f9f15f9 --- /dev/null +++ b/testsuite/tests/th/T14471.stdout @@ -0,0 +1,3 @@ +do {x_0 <- System.IO.getLine; + y_1 <- System.IO.getLine; + GHC.Base.return (x_0, y_1)} diff --git a/testsuite/tests/th/TH_rebindableAdo.hs b/testsuite/tests/th/TH_rebindableAdo.hs new file mode 100644 index 0000000..ad97020 --- /dev/null +++ b/testsuite/tests/th/TH_rebindableAdo.hs @@ -0,0 +1,17 @@ +-- Same as T14471 but also enables RebindableSyntax, since that's a +-- tricky case. + +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH +import Prelude + +main = putStrLn $(do + expr <- [| + do x <- getLine + y <- getLine + pure (x, y) + |] + stringE (pprint expr)) diff --git a/testsuite/tests/th/TH_rebindableAdo.stdout b/testsuite/tests/th/TH_rebindableAdo.stdout new file mode 100644 index 0000000..4fc2806 --- /dev/null +++ b/testsuite/tests/th/TH_rebindableAdo.stdout @@ -0,0 +1,3 @@ +do {x_0 <- System.IO.getLine; + y_1 <- System.IO.getLine; + GHC.Base.pure (x_0, y_1)} diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index e147491..d55d415 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -420,3 +420,5 @@ test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) # Note: T9693 should be only_ways(['ghci']) once it's fixed. test('T9693', expect_broken(9693), ghci_script, ['T9693.script']) +test('T14471', normal, compile, ['']) +test('TH_rebindableAdo', normal, compile, ['']) From git at git.haskell.org Thu Jul 12 19:05:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 19:05:31 +0000 (UTC) Subject: [commit: ghc] master: Fix handling of unbound constructor names in TH #14627 (0f79b0e) Message-ID: <20180712190531.0AA783ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1/ghc >--------------------------------------------------------------- commit 0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1 Author: Michael Sloan Date: Thu Jul 12 10:07:28 2018 -0400 Fix handling of unbound constructor names in TH #14627 Also adds a comment to UnboundVarE clarifying that it also is used for unbound constructor identifiers, since that isn't very clear from the name. Test Plan: testsuite/tests/th/T14627.hs Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4923 >--------------------------------------------------------------- 0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1 compiler/hsSyn/Convert.hs | 6 +++++- libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 7 ++++++- testsuite/tests/th/T14627.hs | 6 ++++++ testsuite/tests/th/T14627.stderr | 2 ++ testsuite/tests/th/all.T | 1 + 5 files changed, 20 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index c64cb7c..84e4594 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -913,7 +913,11 @@ cvtl e = wrapL (cvt e) flds ; return $ mkRdrRecordUpd e' flds' } cvt (StaticE e) = fmap (HsStatic noExt) $ cvtl e - cvt (UnboundVarE s) = do { s' <- vName s; return $ HsVar noExt (noLoc s') } + cvt (UnboundVarE s) = do -- Use of 'vcName' here instead of 'vName' is + -- important, because UnboundVarE may contain + -- constructor names - see #14627. + { s' <- vcName s + ; return $ HsVar noExt (noLoc s') } cvt (LabelE s) = do { return $ HsOverLabel noExt Nothing (fsLit s) } {- Note [Dropping constructors] diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 9665c65..f5f60c3 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1620,7 +1620,12 @@ data Exp | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@ | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ | StaticE Exp -- ^ @{ static e }@ - | UnboundVarE Name -- ^ @{ _x }@ (hole) + | UnboundVarE Name -- ^ @{ _x }@ + -- + -- This is used for holes or unresolved + -- identifiers in AST quotes. Note that + -- it could either have a variable name + -- or constructor name. | LabelE String -- ^ @{ #x }@ ( Overloaded label ) deriving( Show, Eq, Ord, Data, Generic ) diff --git a/testsuite/tests/th/T14627.hs b/testsuite/tests/th/T14627.hs new file mode 100644 index 0000000..aebf6bd --- /dev/null +++ b/testsuite/tests/th/T14627.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +import Language.Haskell.TH.Syntax + +[d| f = Bool |] >>= addTopDecls >> return [] + +main = return () diff --git a/testsuite/tests/th/T14627.stderr b/testsuite/tests/th/T14627.stderr new file mode 100644 index 0000000..1db6488 --- /dev/null +++ b/testsuite/tests/th/T14627.stderr @@ -0,0 +1,2 @@ + +T14627.hs:4:1: error: Data constructor not in scope: Bool diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index d55d415..b3f72c8 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -422,3 +422,4 @@ test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T9693', expect_broken(9693), ghci_script, ['T9693.script']) test('T14471', normal, compile, ['']) test('TH_rebindableAdo', normal, compile, ['']) +test('T14627', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 12 19:05:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 19:05:45 +0000 (UTC) Subject: [commit: ghc] master: Export findImportUsage and ImportDeclUsage (2b1adaa) Message-ID: <20180712190545.84ACC3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b1adaa7817c453df868d928312a9a99a0481eb1/ghc >--------------------------------------------------------------- commit 2b1adaa7817c453df868d928312a9a99a0481eb1 Author: Matthew Pickering Date: Thu Jul 12 10:08:01 2018 -0400 Export findImportUsage and ImportDeclUsage Reviewers: bgamari, alpmestan Reviewed By: alpmestan Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15335 Differential Revision: https://phabricator.haskell.org/D4927 >--------------------------------------------------------------- 2b1adaa7817c453df868d928312a9a99a0481eb1 compiler/rename/RnNames.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index d377f5e..33d44b9 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -20,7 +20,9 @@ module RnNames ( mkChildEnv, findChildren, dodgyMsg, - dodgyMsgInsert + dodgyMsgInsert, + findImportUsage, + ImportDeclUsage ) where #include "HsVersions.h" From git at git.haskell.org Thu Jul 12 19:06:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 19:06:00 +0000 (UTC) Subject: [commit: ghc] master: docs: remove leftovers of static flags (f282f02) Message-ID: <20180712190600.138EE3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f282f02d9d3b190244b6cf4a0cb1bb88816cae84/ghc >--------------------------------------------------------------- commit f282f02d9d3b190244b6cf4a0cb1bb88816cae84 Author: Krzysztof Gogolewski Date: Thu Jul 12 10:08:14 2018 -0400 docs: remove leftovers of static flags Remove "dynamic + :set" category from documentation, because all dynamic flags support ":set"; this is a leftover of "static + :set". Test Plan: make html Reviewers: bgamari, mpickering Reviewed By: mpickering Subscribers: mpickering, osa1, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4942 >--------------------------------------------------------------- f282f02d9d3b190244b6cf4a0cb1bb88816cae84 docs/users_guide/flags.py | 4 +++- docs/users_guide/flags.rst | 4 ++-- docs/users_guide/packages.rst | 14 +++++++------- docs/users_guide/phases.rst | 2 +- docs/users_guide/safe_haskell.rst | 6 +++--- docs/users_guide/separate_compilation.rst | 4 ++-- docs/users_guide/using.rst | 30 +++++++++++------------------- 7 files changed, 29 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 f282f02d9d3b190244b6cf4a0cb1bb88816cae84 From git at git.haskell.org Thu Jul 12 19:06:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 19:06:15 +0000 (UTC) Subject: [commit: ghc] master: Release notes about source plugins (305da44) Message-ID: <20180712190615.14DEA3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/305da44c86950855e2a86dee446fda2694f2f0ac/ghc >--------------------------------------------------------------- commit 305da44c86950855e2a86dee446fda2694f2f0ac Author: Matthew Pickering Date: Thu Jul 12 10:10:00 2018 -0400 Release notes about source plugins >--------------------------------------------------------------- 305da44c86950855e2a86dee446fda2694f2f0ac docs/users_guide/8.6.1-notes.rst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index 5b13909..72a3790 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -125,6 +125,11 @@ Language This is now an error unless :extension:`PolyKinds` is enabled. +- The plugin mechanism has been extended to allow plugins to run between frontend + phases. Of particular note are the parser and typechecker plugins which run + after parsing and typechecking have completed. Collectively, these new extension + points are called :ref:`source plugins `. + - Type literals now could be used in type class instances without the extension :extension:`FlexibleInstances`. From git at git.haskell.org Thu Jul 12 19:06:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 19:06:29 +0000 (UTC) Subject: [commit: ghc] master: Run the renamed source plugin after each HsGroup (1a79270) Message-ID: <20180712190629.DF1083ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a79270c72cfcd98d683cfe7b2c777d8dd353b78/ghc >--------------------------------------------------------------- commit 1a79270c72cfcd98d683cfe7b2c777d8dd353b78 Author: Matthew Pickering Date: Thu Jul 12 10:12:23 2018 -0400 Run the renamed source plugin after each HsGroup This allows modification of each `HsGroup` after it has been renamed. The old behaviour of keeping the renamed source until later can be recovered if desired by using the `keepRenamedSource` plugin but it shouldn't really be necessary as it can be inspected in the `TcGblEnv`. Reviewers: nboldi, bgamari, alpmestan Reviewed By: nboldi, alpmestan Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15315 Differential Revision: https://phabricator.haskell.org/D4947 >--------------------------------------------------------------- 1a79270c72cfcd98d683cfe7b2c777d8dd353b78 compiler/main/HscMain.hs | 7 +--- compiler/main/Plugins.hs | 37 ++++++++++++++-------- compiler/typecheck/TcRnDriver.hs | 36 +++++++++++---------- docs/users_guide/extending_ghc.rst | 19 +++++------ testsuite/tests/plugins/plugins09.stdout | 2 +- testsuite/tests/plugins/plugins11.stdout | 2 +- .../plugins/simple-plugin/Simple/SourcePlugin.hs | 14 ++++---- 7 files changed, 64 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1a79270c72cfcd98d683cfe7b2c777d8dd353b78 From git at git.haskell.org Thu Jul 12 19:06:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 19:06:44 +0000 (UTC) Subject: [commit: ghc] master: Fix deadlock between STM and throwTo (7fc418d) Message-ID: <20180712190644.B60FD3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7fc418df856d9b58034eeec48915646e67a7a562/ghc >--------------------------------------------------------------- commit 7fc418df856d9b58034eeec48915646e67a7a562 Author: Simon Marlow Date: Thu Jul 12 10:13:47 2018 -0400 Fix deadlock between STM and throwTo There was a lock-order reversal between lockTSO() and the TVar lock, see #15136 for the details. It turns out we can fix this pretty easily by just deleting all the locking code(!). The principle for unblocking a `BlockedOnSTM` thread then becomes the same as for other kinds of blocking: if the TSO belongs to this capability then we do it directly, otherwise we send a message to the capability that owns the TSO. That is, a thread blocked on STM is owned by its capability, as it should be. The possible downside of this is that we might send multiple messages to wake up a thread when the thread is on another capability. This is safe, it's just not very efficient. I'll try to do some experiments to see if this is a problem. Test Plan: Test case from #15136 doesn't deadlock any more. Reviewers: bgamari, osa1, erikd Reviewed By: osa1 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15136 Differential Revision: https://phabricator.haskell.org/D4956 >--------------------------------------------------------------- 7fc418df856d9b58034eeec48915646e67a7a562 rts/RaiseAsync.c | 9 --------- rts/SMPClosureOps.h | 9 --------- rts/STM.c | 19 +------------------ rts/Threads.c | 5 ++++- rts/sm/Sanity.c | 3 ++- 5 files changed, 7 insertions(+), 38 deletions(-) diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index f5e96a2..b08acc4 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -416,21 +416,12 @@ check_target: } case BlockedOnSTM: - lockTSO(target); - // Unblocking BlockedOnSTM threads requires the TSO to be - // locked; see STM.c:unpark_tso(). - if (target->why_blocked != BlockedOnSTM) { - unlockTSO(target); - goto retry; - } if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { blockedThrowTo(cap,target,msg); - unlockTSO(target); return THROWTO_BLOCKED; } else { raiseAsync(cap, target, msg->exception, false, NULL); - unlockTSO(target); return THROWTO_SUCCESS; } diff --git a/rts/SMPClosureOps.h b/rts/SMPClosureOps.h index 1d18e1b..c73821a 100644 --- a/rts/SMPClosureOps.h +++ b/rts/SMPClosureOps.h @@ -124,15 +124,6 @@ EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info) p->header.info = info; } -// Handy specialised versions of lockClosure()/unlockClosure() -INLINE_HEADER void lockTSO(StgTSO *tso); -INLINE_HEADER void lockTSO(StgTSO *tso) -{ lockClosure((StgClosure *)tso); } - -INLINE_HEADER void unlockTSO(StgTSO *tso); -INLINE_HEADER void unlockTSO(StgTSO *tso) -{ unlockClosure((StgClosure*)tso, (const StgInfoTable *)&stg_TSO_info); } - #endif /* CMINUSMINUS */ #include "EndPrivate.h" diff --git a/rts/STM.c b/rts/STM.c index 058eec7..abb4417 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -332,24 +332,7 @@ static void unpark_tso(Capability *cap, StgTSO *tso) { // queues: it's up to the thread itself to remove it from the wait queues // if it decides to do so when it is scheduled. - // Unblocking a TSO from BlockedOnSTM is done under the TSO lock, - // to avoid multiple CPUs unblocking the same TSO, and also to - // synchronise with throwTo(). The first time the TSO is unblocked - // we mark this fact by setting block_info.closure == STM_AWOKEN. - // This way we can avoid sending further wakeup messages in the - // future. - lockTSO(tso); - if (tso->why_blocked == BlockedOnSTM && - tso->block_info.closure == &stg_STM_AWOKEN_closure) { - TRACE("unpark_tso already woken up tso=%p", tso); - } else if (tso -> why_blocked == BlockedOnSTM) { - TRACE("unpark_tso on tso=%p", tso); - tso->block_info.closure = &stg_STM_AWOKEN_closure; - tryWakeupThread(cap,tso); - } else { - TRACE("spurious unpark_tso on tso=%p", tso); - } - unlockTSO(tso); + tryWakeupThread(cap,tso); } static void unpark_waiters_on(Capability *cap, StgTVar *s) { diff --git a/rts/Threads.c b/rts/Threads.c index be69622..78c5b6c 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -297,8 +297,11 @@ tryWakeupThread (Capability *cap, StgTSO *tso) goto unblock; } - case BlockedOnBlackHole: case BlockedOnSTM: + tso->block_info.closure = &stg_STM_AWOKEN_closure; + goto unblock; + + case BlockedOnBlackHole: case ThreadMigrating: goto unblock; diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c index e5a22fd..8d4171b 100644 --- a/rts/sm/Sanity.c +++ b/rts/sm/Sanity.c @@ -547,7 +547,8 @@ checkTSO(StgTSO *tso) ASSERT(next == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || info == &stg_TSO_info || - info == &stg_WHITEHOLE_info); // happens due to STM doing lockTSO() + info == &stg_WHITEHOLE_info); // used to happen due to STM doing + // lockTSO(), might not happen now if ( tso->why_blocked == BlockedOnMVar || tso->why_blocked == BlockedOnMVarRead From git at git.haskell.org Thu Jul 12 20:05:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 20:05:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump xhtml submodule to 3000.2.2.1 (5059edb) Message-ID: <20180712200528.54B6C3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/5059edb0fe59581ae52e446d7eca5fd03746ce83/ghc >--------------------------------------------------------------- commit 5059edb0fe59581ae52e446d7eca5fd03746ce83 Author: Ben Gamari Date: Tue Jul 10 20:20:51 2018 -0400 Bump xhtml submodule to 3000.2.2.1 (cherry picked from commit 5a1290a8317056065f409ffd47fa6114172a1a15) >--------------------------------------------------------------- 5059edb0fe59581ae52e446d7eca5fd03746ce83 libraries/xhtml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/xhtml b/libraries/xhtml index c5c623e..721779a 160000 --- a/libraries/xhtml +++ b/libraries/xhtml @@ -1 +1 @@ -Subproject commit c5c623e497f13ec187e0d228e0e8a3d9ee39a715 +Subproject commit 721779acc35dccd6a43a292b24099b65d93d390c From git at git.haskell.org Thu Jul 12 20:05:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 20:05:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix for built-in Natural literals desugaring (31f7d21) Message-ID: <20180712200531.AA79B3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/31f7d21bae5d75621a4077e2966a80ce30c55d46/ghc >--------------------------------------------------------------- commit 31f7d21bae5d75621a4077e2966a80ce30c55d46 Author: Sylvain Henry Date: Fri Jul 6 11:01:14 2018 -0400 Fix for built-in Natural literals desugaring The recent patch "Built-in Natural literals in Core" (https://phabricator.haskell.org/rGHCfe770c211631e7b4c9b0b1e88ef9b6046c6 585ef) introduced a regression when desugaring large numbers. This patch fixes it and adds a regression test. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15301 Differential Revision: https://phabricator.haskell.org/D4885 (cherry picked from commit 987b5e7fbacd8afd2c8463c16eac28cd68f43155) >--------------------------------------------------------------- 31f7d21bae5d75621a4077e2966a80ce30c55d46 libraries/base/GHC/Natural.hs | 2 +- testsuite/tests/numeric/should_run/T15301.hs | 7 +++++++ .../tests/numeric/should_run/T15301.stdout | 0 testsuite/tests/numeric/should_run/all.T | 1 + 4 files changed, 9 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index db8d8b8..a35688d 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -594,7 +594,7 @@ mkNatural :: [Word] -- ^ value expressed in 32 bit chunks, least -> Natural mkNatural [] = wordToNaturalBase 0## mkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural` - shiftLNatural (mkNatural is') 31 + shiftLNatural (mkNatural is') 32 {-# CONSTANT_FOLDED mkNatural #-} -- | Convert 'Int' to 'Natural'. diff --git a/testsuite/tests/numeric/should_run/T15301.hs b/testsuite/tests/numeric/should_run/T15301.hs new file mode 100644 index 0000000..6efbce4 --- /dev/null +++ b/testsuite/tests/numeric/should_run/T15301.hs @@ -0,0 +1,7 @@ +import Numeric +import GHC.Natural + +main = do + -- test that GHC correctly compiles big Natural literals + let x = 0xffffffffffffffffffffffff :: Natural + print (showHex x "" == "ffffffffffffffffffffffff") diff --git a/libraries/base/tests/IO/IOError002.stdout b/testsuite/tests/numeric/should_run/T15301.stdout similarity index 100% copy from libraries/base/tests/IO/IOError002.stdout copy to testsuite/tests/numeric/should_run/T15301.stdout diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 691fc26..140fa6c 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -65,3 +65,4 @@ test('T10011', normal, compile_and_run, ['']) test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) +test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Thu Jul 12 20:05:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 20:05:34 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Expand and implement Note [The tcType invariant] (634c07d) Message-ID: <20180712200534.8C05B3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/634c07dc2bd9b2be53d707d613df9e7100d543aa/ghc >--------------------------------------------------------------- commit 634c07dc2bd9b2be53d707d613df9e7100d543aa Author: Richard Eisenberg Date: Thu Jul 5 19:51:59 2018 -0400 Expand and implement Note [The tcType invariant] Read that note -- it's necessary to make sure that we can always call typeKind without panicking. As discussed on #14873, there were more checks and zonking to do, implemented here. There are no known bugs fixed by this patch, but there are likely unknown ones. (cherry picked from commit cf67e59a90bcaba657a9f5db3d5defb6289c274f) >--------------------------------------------------------------- 634c07dc2bd9b2be53d707d613df9e7100d543aa compiler/typecheck/TcHsType.hs | 77 ++++++++++++++++++++++++++---------------- 1 file changed, 48 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 634c07dc2bd9b2be53d707d613df9e7100d543aa From git at git.haskell.org Thu Jul 12 20:05:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 20:05:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Make ppr_tc_args aware of -fprint-explicit-kinds (113bdb8) Message-ID: <20180712200538.17FDB3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/113bdb8b873b1e3def4f86f2a3c6923b869dcb0f/ghc >--------------------------------------------------------------- commit 113bdb8b873b1e3def4f86f2a3c6923b869dcb0f Author: Ryan Scott Date: Thu Jul 5 08:52:20 2018 -0400 Make ppr_tc_args aware of -fprint-explicit-kinds Summary: `ppr_tc_args` was printing invisible kind arguments even when `-fprint-explicit-kinds` wasn't enabled. Easily fixed. Test Plan: make test TEST=T15341 Reviewers: goldfire, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15341 Differential Revision: https://phabricator.haskell.org/D4932 (cherry picked from commit dbdcacfc55f28d8a85484cc1cf13dd78c45bf7ee) >--------------------------------------------------------------- 113bdb8b873b1e3def4f86f2a3c6923b869dcb0f compiler/iface/IfaceType.hs | 8 ++++++-- testsuite/tests/ghci/scripts/T15341.hs | 6 ++++++ testsuite/tests/ghci/scripts/T15341.script | 4 ++++ testsuite/tests/ghci/scripts/T15341.stdout | 6 ++++++ testsuite/tests/ghci/scripts/T7939.stdout | 8 ++++---- testsuite/tests/ghci/scripts/all.T | 1 + testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr | 2 +- 7 files changed, 28 insertions(+), 7 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 537f419..3b1c948 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -819,11 +819,15 @@ pprParendIfaceTcArgs = ppr_tc_args appPrec ppr_tc_args :: PprPrec -> IfaceTcArgs -> SDoc ppr_tc_args ctx_prec args - = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts + = let ppr_rest = ppr_tc_args ctx_prec + pprTys t ts = ppr_ty ctx_prec t <+> ppr_rest ts in case args of ITC_Nil -> empty ITC_Vis t ts -> pprTys t ts - ITC_Invis t ts -> pprTys t ts + ITC_Invis t ts -> sdocWithDynFlags $ \dflags -> + if gopt Opt_PrintExplicitKinds dflags + then pprTys t ts + else ppr_rest ts ------------------- pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc diff --git a/testsuite/tests/ghci/scripts/T15341.hs b/testsuite/tests/ghci/scripts/T15341.hs new file mode 100644 index 0000000..b84c1bb --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T15341 where + +type family Foo (a :: k) :: k where + Foo a = a diff --git a/testsuite/tests/ghci/scripts/T15341.script b/testsuite/tests/ghci/scripts/T15341.script new file mode 100644 index 0000000..0a3ffdc --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.script @@ -0,0 +1,4 @@ +:load T15341.hs +:info Foo +:set -fprint-explicit-kinds +:info Foo diff --git a/testsuite/tests/ghci/scripts/T15341.stdout b/testsuite/tests/ghci/scripts/T15341.stdout new file mode 100644 index 0000000..1d29dc7 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.stdout @@ -0,0 +1,6 @@ +type family Foo (a :: k) :: k + where Foo a = a + -- Defined at T15341.hs:5:1 +type family Foo k (a :: k) :: k + where Foo k a = a + -- Defined at T15341.hs:5:1 diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout index db2590c..82a8658 100644 --- a/testsuite/tests/ghci/scripts/T7939.stdout +++ b/testsuite/tests/ghci/scripts/T7939.stdout @@ -15,13 +15,13 @@ type family H (a :: Bool) :: Bool H :: Bool -> Bool type family J (a :: [k]) :: Bool where - J k '[] = 'False - J k (h : t) = 'True + J '[] = 'False + J (h : t) = 'True -- Defined at T7939.hs:17:1 J :: [k] -> Bool type family K (a1 :: [a]) :: Maybe a where - K a '[] = 'Nothing - K a (h : t) = 'Just h + K '[] = 'Nothing + K (h : t) = 'Just h -- Defined at T7939.hs:21:1 K :: [a] -> Maybe a diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 29fbdf8..8954594 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -269,3 +269,4 @@ test('T14676', extra_files(['../prog002']), ghci_script, ['T14676.script']) test('T14796', normal, ghci_script, ['T14796.script']) test('T14969', normal, ghci_script, ['T14969.script']) test('T15259', normal, ghci_script, ['T15259.script']) +test('T15341', normal, ghci_script, ['T15341.script']) diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr index ba1f46e..cab5078 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr @@ -27,5 +27,5 @@ ClosedFam3.hs-boot:12:1: error: Main module: type family Baz a :: * where Baz Int = Bool Boot file: type family Baz (a :: k) :: * - where Baz * Int = Bool + where Baz Int = Bool The types have different kinds From git at git.haskell.org Thu Jul 12 21:06:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:06:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15331 with careful blasts of parenthesizeHsType (f663e50) Message-ID: <20180712210647.5BA733ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/f663e507eaf49c6a5e05fd6edb78d649a7611af4/ghc >--------------------------------------------------------------- commit f663e507eaf49c6a5e05fd6edb78d649a7611af4 Author: Ryan Scott Date: Thu Jul 5 08:51:43 2018 -0400 Fix #15331 with careful blasts of parenthesizeHsType Another `-ddump-splices` bug that can be solved with more judicious use of parentheses. Test Plan: make test TEST=T15331 Reviewers: goldfire, bgamari, alanz, tdammers Reviewed By: tdammers Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15331 Differential Revision: https://phabricator.haskell.org/D4920 (cherry picked from commit b6a3386186b77333b7a6cdc163499d7dae0dad1c) >--------------------------------------------------------------- f663e507eaf49c6a5e05fd6edb78d649a7611af4 compiler/hsSyn/Convert.hs | 3 ++- compiler/hsSyn/HsTypes.hs | 4 ++-- compiler/hsSyn/HsUtils.hs | 5 ++++- compiler/typecheck/TcGenDeriv.hs | 2 +- testsuite/tests/th/T15331.hs | 9 +++++++++ testsuite/tests/th/T15331.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 7 files changed, 25 insertions(+), 5 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 329d000..1c3c853 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -818,7 +818,8 @@ cvtl e = wrapL (cvt e) cvt (AppTypeE e t) = do { e' <- cvtl e ; t' <- cvtType t ; tp <- wrap_apps t' - ; return $ HsAppType (mkHsWildCardBndrs tp) e' } + ; let tp' = parenthesizeHsType appPrec tp + ; return $ HsAppType (mkHsWildCardBndrs tp') e' } cvt (LamE [] e) = cvt e -- Degenerate case. We convert the body as its -- own expression to avoid pretty-printing -- oddities that can result from zero-argument diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 6d14d7d..cbaa9fb 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -1425,8 +1425,8 @@ ppr_tylit (HsStrTy _ s) = text (show s) hsTypeNeedsParens :: PprPrec -> HsType pass -> Bool hsTypeNeedsParens p = go where - go (HsForAllTy{}) = False - go (HsQualTy{}) = False + go (HsForAllTy{}) = p >= funPrec + go (HsQualTy{}) = p >= funPrec go (HsBangTy{}) = p > topPrec go (HsRecTy{}) = False go (HsTyVar{}) = False diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index e8e59b0..22dbc1e 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -178,7 +178,10 @@ mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2) mkHsAppType :: (XAppTypeE (GhcPass id) ~ LHsWcType GhcRn) => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id) -mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType t e) +mkHsAppType e t = addCLoc e t_body (HsAppType paren_wct e) + where + t_body = hswc_body t + paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body } mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn mkHsAppTypes = foldl mkHsAppType diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index b944520..37d75db 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1706,7 +1706,7 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs nlHsAppType e s = noLoc (HsAppType hs_ty e) where - hs_ty = mkHsWildCardBndrs $ nlHsParTy (typeToLHsType s) + hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec (typeToLHsType s) nlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs nlExprWithTySig e s = noLoc $ ExprWithTySig hs_ty diff --git a/testsuite/tests/th/T15331.hs b/testsuite/tests/th/T15331.hs new file mode 100644 index 0000000..0b0a076 --- /dev/null +++ b/testsuite/tests/th/T15331.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +module T15331 where + +import Data.Proxy + +$([d| f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) + |]) diff --git a/testsuite/tests/th/T15331.stderr b/testsuite/tests/th/T15331.stderr new file mode 100644 index 0000000..99bfdfd --- /dev/null +++ b/testsuite/tests/th/T15331.stderr @@ -0,0 +1,6 @@ +T15331.hs:(7,3)-(9,6): Splicing declarations + [d| f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) |] + ======> + f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f86cc96..6209fde 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -415,3 +415,4 @@ test('T14885a', normal, compile, ['']) test('T14885b', normal, compile, ['']) test('T14885c', normal, compile, ['']) test('T15243', normal, compile, ['-dsuppress-uniques']) +test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Thu Jul 12 21:06:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:06:51 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Add regression test for #15321 (1fca115) Message-ID: <20180712210651.1D94B3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/1fca115b77de11358140faba1fd028b898f3db2e/ghc >--------------------------------------------------------------- commit 1fca115b77de11358140faba1fd028b898f3db2e Author: Ömer Sinan Ağacan Date: Wed Jul 4 16:43:13 2018 +0300 Add regression test for #15321 (cherry picked from commit e835fdb18cca66820728afce9c924a1c71f17fee) >--------------------------------------------------------------- 1fca115b77de11358140faba1fd028b898f3db2e testsuite/tests/th/T15321.hs | 9 +++++++++ testsuite/tests/th/T15321.stderr | 12 ++++++++++++ testsuite/tests/th/all.T | 1 + 3 files changed, 22 insertions(+) diff --git a/testsuite/tests/th/T15321.hs b/testsuite/tests/th/T15321.hs new file mode 100644 index 0000000..0f0b4d5 --- /dev/null +++ b/testsuite/tests/th/T15321.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T15321 where + +foo :: String +foo = test + +bar :: String +bar = $(_ "baz") diff --git a/testsuite/tests/th/T15321.stderr b/testsuite/tests/th/T15321.stderr new file mode 100644 index 0000000..7807bcf --- /dev/null +++ b/testsuite/tests/th/T15321.stderr @@ -0,0 +1,12 @@ + +T15321.hs:9:9: error: + • Found hole: _ :: [Char] -> Language.Haskell.TH.Lib.Internal.ExpQ + • In the expression: _ + In the expression: _ "baz" + In the untyped splice: $(_ "baz") + • Valid hole fits include + fail :: forall (m :: * -> *) a. Monad m => String -> m a + with fail @Language.Haskell.TH.Syntax.Q + @Language.Haskell.TH.Syntax.Exp + (imported from ‘Prelude’ at T15321.hs:3:8-13 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5f756fc..b3d53ac 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -417,3 +417,4 @@ test('T14885c', normal, compile, ['']) test('T15243', normal, compile, ['-dsuppress-uniques']) test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15321', normal, compile_fail, ['']) From git at git.haskell.org Thu Jul 12 21:06:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:06:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Export findImportUsage and ImportDeclUsage (423a8ef) Message-ID: <20180712210653.EBD023ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/423a8eff087b33da7f1077dea5d7e62238bd691b/ghc >--------------------------------------------------------------- commit 423a8eff087b33da7f1077dea5d7e62238bd691b Author: Matthew Pickering Date: Thu Jul 12 10:08:01 2018 -0400 Export findImportUsage and ImportDeclUsage Reviewers: bgamari, alpmestan Reviewed By: alpmestan Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15335 Differential Revision: https://phabricator.haskell.org/D4927 (cherry picked from commit 2b1adaa7817c453df868d928312a9a99a0481eb1) >--------------------------------------------------------------- 423a8eff087b33da7f1077dea5d7e62238bd691b compiler/rename/RnNames.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index d377f5e..33d44b9 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -20,7 +20,9 @@ module RnNames ( mkChildEnv, findChildren, dodgyMsg, - dodgyMsgInsert + dodgyMsgInsert, + findImportUsage, + ImportDeclUsage ) where #include "HsVersions.h" From git at git.haskell.org Thu Jul 12 21:06:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:06:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix mkGadtDecl does not set con_forall correctly (a39b58d) Message-ID: <20180712210657.8539B3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/a39b58d511f177c9c476cc104999caa67a55de2a/ghc >--------------------------------------------------------------- commit a39b58d511f177c9c476cc104999caa67a55de2a Author: Alan Zimmerman Date: Fri Jun 29 20:58:21 2018 +0200 Fix mkGadtDecl does not set con_forall correctly A GADT declaration surrounded in parens does not det the con_forall field correctly. e.g. data MaybeDefault v where TestParens :: (forall v . (Eq v) => MaybeDefault v) Closes #15323 (cherry picked from commit 6e4e6d1c674a9d0257ca5c6caa26da18edf8ad8c) >--------------------------------------------------------------- a39b58d511f177c9c476cc104999caa67a55de2a compiler/parser/RdrHsSyn.hs | 2 +- testsuite/tests/parser/should_compile/T15323.hs | 6 ++ .../tests/parser/should_compile/T15323.stderr | 96 ++++++++++++++++++++++ testsuite/tests/parser/should_compile/all.T | 1 + 4 files changed, 104 insertions(+), 1 deletion(-) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index a74d98a..ed5c592 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -643,7 +643,7 @@ mkGadtDecl :: [Located RdrName] mkGadtDecl names ty = (ConDeclGADT { con_g_ext = noExt , con_names = names - , con_forall = L l $ isLHsForAllTy ty + , con_forall = L l $ isLHsForAllTy ty' , con_qvars = mkHsQTvs tvs , con_mb_cxt = mcxt , con_args = args' diff --git a/testsuite/tests/parser/should_compile/T15323.hs b/testsuite/tests/parser/should_compile/T15323.hs new file mode 100644 index 0000000..ffc8ad8 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15323.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +module T15323 where + +data MaybeDefault v where + TestParens :: (forall v . (Eq v) => MaybeDefault v) diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr new file mode 100644 index 0000000..93b254b --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -0,0 +1,96 @@ + +==================== Parser AST ==================== + +({ T15323.hs:1:1 } + (HsModule + (Just + ({ T15323.hs:3:8-13 } + {ModuleName: T15323})) + (Nothing) + [] + [({ T15323.hs:(5,1)-(6,56) } + (TyClD + (NoExt) + (DataDecl + (NoExt) + ({ T15323.hs:5:6-17 } + (Unqual + {OccName: MaybeDefault})) + (HsQTvs + (NoExt) + [({ T15323.hs:5:19 } + (UserTyVar + (NoExt) + ({ T15323.hs:5:19 } + (Unqual + {OccName: v}))))]) + (Prefix) + (HsDataDefn + (NoExt) + (DataType) + ({ } + []) + (Nothing) + (Nothing) + [({ T15323.hs:6:5-56 } + (ConDeclGADT + (NoExt) + [({ T15323.hs:6:5-14 } + (Unqual + {OccName: TestParens}))] + ({ T15323.hs:6:21-55 } + (True)) + (HsQTvs + (NoExt) + [({ T15323.hs:6:28 } + (UserTyVar + (NoExt) + ({ T15323.hs:6:28 } + (Unqual + {OccName: v}))))]) + (Just + ({ T15323.hs:6:32-37 } + [({ T15323.hs:6:32-37 } + (HsParTy + (NoExt) + ({ T15323.hs:6:33-36 } + (HsAppTy + (NoExt) + ({ T15323.hs:6:33-34 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:33-34 } + (Unqual + {OccName: Eq})))) + ({ T15323.hs:6:36 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:36 } + (Unqual + {OccName: v}))))))))])) + (PrefixCon + []) + ({ T15323.hs:6:42-55 } + (HsAppTy + (NoExt) + ({ T15323.hs:6:42-53 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:42-53 } + (Unqual + {OccName: MaybeDefault})))) + ({ T15323.hs:6:55 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:55 } + (Unqual + {OccName: v})))))) + (Nothing)))] + ({ } + [])))))] + (Nothing) + (Nothing))) diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index ab0a393..1fd8c69 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -116,3 +116,4 @@ test('T14189', normal, compile, ['-dsuppress-uniques -ddump-rn-ast']) test('T13986', normal, compile, ['']) test('T10855', normal, compile, ['']) test('T15139', normal, compile, ['-Wincomplete-patterns -fdiagnostics-show-caret']) +test('T15323', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast']) From git at git.haskell.org Thu Jul 12 21:07:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:00 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix errors caused by invalid candidates leaking from hole fits (22c951e) Message-ID: <20180712210700.52DB83ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/22c951e6aab52adf32499a9568be44dc60e72acb/ghc >--------------------------------------------------------------- commit 22c951e6aab52adf32499a9568be44dc60e72acb Author: Matthías Páll Gissurarson Date: Wed Jul 4 14:54:54 2018 +0300 Fix errors caused by invalid candidates leaking from hole fits This is a one line fix (and a note) that fixes four tickets, #15007, #15321 and #15202, #15314 The issue was that errors caused by illegal candidates (according to GHC stage or being internal names) were leaking to the user, causing bewildering error messages. If a candidate causes the type checker to error, it is not a valid hole fit, and should be discarded. As mentioned in #15321, this can cause a pattern of omissions, which might be hard to discover. A better approach would be to gather the error messages, and ask users to report them as GHC bugs. This will be implemented in a subsequent change. Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15007, #15321, #15202, #15314 Differential Revision: https://phabricator.haskell.org/D4909 (cherry picked from commit 39de4e3d33dd9879398062620ad00b1e3b8481ce) >--------------------------------------------------------------- 22c951e6aab52adf32499a9568be44dc60e72acb compiler/typecheck/TcHoleErrors.hs | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs index e624d00..ee4d617 100644 --- a/compiler/typecheck/TcHoleErrors.hs +++ b/compiler/typecheck/TcHoleErrors.hs @@ -355,6 +355,15 @@ the only non-hole constraint that mentions any free type variables mentioned in the hole constraint for `_a`, namely `a_a1pd[tau:2]` , and similarly for the hole `_b` we only require that the `$dShow_a1pe` constraint is solved. +Note [Leaking errors] +~~~~~~~~~~~~~~~~~~~ + +When considering candidates, GHC believes that we're checking for validity in +actual source. However, As evidenced by #15321, #15007 and #15202, this can +cause bewildering error messages. The solution here is simple: if a candidate +would cause the type checker to error, it is not a valid hole fit, and thus it +is discarded. + -} @@ -509,11 +518,11 @@ getLocalBindings tidy_orig ct -- See Note [Valid hole fits include ...] findValidHoleFits :: TidyEnv --The tidy_env for zonking - -> [Implication] --Enclosing implications for givens - -> [Ct] -- The unsolved simple constraints in the - -- implication for the hole. - -> Ct -- The hole constraint itself - -> TcM (TidyEnv, SDoc) + -> [Implication] --Enclosing implications for givens + -> [Ct] -- The unsolved simple constraints in the + -- implication for the hole. + -> Ct -- The hole constraint itself + -> TcM (TidyEnv, SDoc) findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct = do { rdr_env <- getGlobalRdrEnv ; lclBinds <- getLocalBindings tidy_env ct @@ -818,6 +827,8 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct = go subs _ _ _ [] = return (False, reverse subs) go subs _ (Just 0) _ _ = return (True, reverse subs) go subs seen maxleft ty (el:elts) = + -- See Note [Leaking errors] + tryTcDiscardingErrs discard_it $ do { traceTc "lookingUp" $ ppr el ; maybeThing <- lookup el ; case maybeThing of From git at git.haskell.org Thu Jul 12 21:07:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:03 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Parenthesize rank-n contexts in Convert (a6a83d9) Message-ID: <20180712210703.C7E813ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/a6a83d9a26db2593fa0e09dcad4c1411d6deb4ac/ghc >--------------------------------------------------------------- commit a6a83d9a26db2593fa0e09dcad4c1411d6deb4ac Author: Ryan Scott Date: Thu Jul 5 08:50:56 2018 -0400 Parenthesize rank-n contexts in Convert Summary: A simple oversight. Test Plan: make test TEST=T15324 Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15324 Differential Revision: https://phabricator.haskell.org/D4910 (cherry picked from commit 57733978482dc1e566a7d4cd90d4cbbd1315e3b2) >--------------------------------------------------------------- a6a83d9a26db2593fa0e09dcad4c1411d6deb4ac compiler/hsSyn/Convert.hs | 4 +++- testsuite/tests/th/T15324.hs | 7 +++++++ testsuite/tests/th/T15324.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 17 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 1c3c853..c64cb7c 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1284,7 +1284,9 @@ cvtTypeKind ty_str ty x'' <- case x' of L _ HsFunTy{} -> returnL (HsParTy noExt x') L _ HsForAllTy{} -> returnL (HsParTy noExt x') - -- #14646 + -- #14646 + L _ HsQualTy{} -> returnL (HsParTy noExt x') + -- #15324 _ -> return x' returnL (HsFunTy noExt x'' y') | otherwise -> diff --git a/testsuite/tests/th/T15324.hs b/testsuite/tests/th/T15324.hs new file mode 100644 index 0000000..ea124f4 --- /dev/null +++ b/testsuite/tests/th/T15324.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module T15324 where + +$([d| f :: forall a. (Show a => a) -> a + f _ = undefined + |]) diff --git a/testsuite/tests/th/T15324.stderr b/testsuite/tests/th/T15324.stderr new file mode 100644 index 0000000..49db9ed --- /dev/null +++ b/testsuite/tests/th/T15324.stderr @@ -0,0 +1,6 @@ +T15324.hs:(5,3)-(7,6): Splicing declarations + [d| f :: forall a. (Show a => a) -> a + f _ = undefined |] + ======> + f :: forall a. (Show a => a) -> a + f _ = undefined diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 6209fde..5f756fc 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -416,3 +416,4 @@ test('T14885b', normal, compile, ['']) test('T14885c', normal, compile, ['']) test('T15243', normal, compile, ['-dsuppress-uniques']) test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Thu Jul 12 21:07:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Add nakedSubstTy and use it in TcHsType.tcInferApps (cfc4afa) Message-ID: <20180712210706.A2DD83ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/cfc4afad16d0eb99d5576cd998bcf473a1bc2af5/ghc >--------------------------------------------------------------- commit cfc4afad16d0eb99d5576cd998bcf473a1bc2af5 Author: Simon Peyton Jones Date: Mon Jul 9 17:29:22 2018 +0100 Add nakedSubstTy and use it in TcHsType.tcInferApps This was a tricky one. During type checking we maintain TcType: Note [The well-kinded type invariant] That is, types are well-kinded /without/ zonking. But in tcInferApps we were destroying that invariant by calling substTy, which in turn uses smart constructors, which eliminate apparently-redundant Refl casts. This is horribly hard to debug beause they really are Refls and so it "ought" to be OK to discard them. But it isn't, as the above Note describes in some detail. Maybe we should review the invariant? But for now I just followed it, tricky thought it is. This popped up because (for some reason) when I fixed Trac #15343, that exposed this bug by making test polykinds/T14174a fail (in Trac #14174 which indeed has the same origin). So this patch fixes a long standing and very subtle bug. One interesting point: I defined nakedSubstTy in a few lines by using the generic mapType stuff. I note that the "normal" TyCoRep.substTy does /not/ use mapType. But perhaps it should: substTy has lots of $! strict applications in it, and they could all be eliminated just by useing the StrictIdentity monad. And that'd make it much easier to experiment with switching between strict and lazy versions. (cherry picked from commit 5067b205a8abb5a9f98335d3a929f647c88c0aa2) >--------------------------------------------------------------- cfc4afad16d0eb99d5576cd998bcf473a1bc2af5 compiler/typecheck/TcHsType.hs | 20 +++++--- compiler/typecheck/TcType.hs | 108 ++++++++++++++++++++++++++++++----------- 2 files changed, 94 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 cfc4afad16d0eb99d5576cd998bcf473a1bc2af5 From git at git.haskell.org Thu Jul 12 21:07:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Kind-check CUSK associated types separately (d0dfc5c) Message-ID: <20180712210710.4B6FD3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/d0dfc5cc4859a07778bc674eb865811616d4d6c6/ghc >--------------------------------------------------------------- commit d0dfc5cc4859a07778bc674eb865811616d4d6c6 Author: Richard Eisenberg Date: Thu Jul 5 15:09:50 2018 -0400 Kind-check CUSK associated types separately Previously, we kind-checked associated types while while still figuring out the kind of a CUSK class. This caused trouble, as documented in Note [Don't process associated types in kcLHsQTyVars] in TcTyClsDecls. This commit moves this process after the initial kind of the class is determined. Fixes #15142. Test case: indexed-types/should_compile/T15142.hs (cherry picked from commit 030211d21207dabb7a4bf21cc9af6fa5eb066db1) >--------------------------------------------------------------- d0dfc5cc4859a07778bc674eb865811616d4d6c6 compiler/typecheck/TcHsType.hs | 12 ++-- compiler/typecheck/TcTyClsDecls.hs | 71 ++++++++++++++-------- .../tests/indexed-types/should_compile/T15142.hs | 14 +++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 4 files changed, 66 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d0dfc5cc4859a07778bc674eb865811616d4d6c6 From git at git.haskell.org Thu Jul 12 21:07:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Add commnent about binder order (4239611) Message-ID: <20180712210713.1B5F93ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/423961132e9d19850e290b38df15006c607744d1/ghc >--------------------------------------------------------------- commit 423961132e9d19850e290b38df15006c607744d1 Author: Simon Peyton Jones Date: Tue Jun 26 15:44:12 2018 +0100 Add commnent about binder order ...provoked by Trac #15308 (cherry picked from commit 3d002087dce9c61932dd17047902baa83581f4df) >--------------------------------------------------------------- 423961132e9d19850e290b38df15006c607744d1 compiler/types/TyCoRep.hs | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 9a5bfdb..7923369 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -559,9 +559,7 @@ This table summarises the visibility rules: optional kind applications, thus (T @*), but we have not yet implemented that ----- Examples of where the different visibilities come from ----- - -In term declarations: +---- In term declarations ---- * Inferred. Function defn, with no signature: f1 x = x We infer f1 :: forall {a}. a -> a, with 'a' Inferred @@ -592,7 +590,7 @@ In term declarations: Inferred - from inferred types (e.g. no pattern type signature) - or from inferred kind polymorphism -In type declarations: +---- In type declarations ---- * Inferred (k) data T1 a b = MkT1 (a b) @@ -621,6 +619,19 @@ In type declarations: So 'k' is Specified, because it appears explicitly, but 'k1' is Inferred, because it does not +Generally, in the list of TyConBinders for a TyCon, + +* Inferred arguments always come first +* Specified, Anon and Required can be mixed + +e.g. + data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where ... + +Here Foo's TyConBinders are + [Required 'a', Specified 'b', Anon] +and its kind prints as + Foo :: forall a -> forall b. (a -> b -> Type) -> Type + ---- Printing ----- We print forall types with enough syntax to tell you their visibility From git at git.haskell.org Thu Jul 12 21:07:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Run the renamed source plugin after each HsGroup (b52cfe4) Message-ID: <20180712210715.EA10E3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/b52cfe41e8abb2f1dd1e54ed1cf6ff7fcc0de210/ghc >--------------------------------------------------------------- commit b52cfe41e8abb2f1dd1e54ed1cf6ff7fcc0de210 Author: Matthew Pickering Date: Thu Jul 12 10:12:23 2018 -0400 Run the renamed source plugin after each HsGroup This allows modification of each `HsGroup` after it has been renamed. The old behaviour of keeping the renamed source until later can be recovered if desired by using the `keepRenamedSource` plugin but it shouldn't really be necessary as it can be inspected in the `TcGblEnv`. Reviewers: nboldi, bgamari, alpmestan Reviewed By: nboldi, alpmestan Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15315 Differential Revision: https://phabricator.haskell.org/D4947 (cherry picked from commit 1a79270c72cfcd98d683cfe7b2c777d8dd353b78) >--------------------------------------------------------------- b52cfe41e8abb2f1dd1e54ed1cf6ff7fcc0de210 compiler/main/HscMain.hs | 7 +--- compiler/main/Plugins.hs | 37 ++++++++++++++-------- compiler/typecheck/TcRnDriver.hs | 36 +++++++++++---------- docs/users_guide/extending_ghc.rst | 19 +++++------ testsuite/tests/plugins/plugins09.stdout | 2 +- testsuite/tests/plugins/plugins11.stdout | 2 +- .../plugins/simple-plugin/Simple/SourcePlugin.hs | 14 ++++---- 7 files changed, 64 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b52cfe41e8abb2f1dd1e54ed1cf6ff7fcc0de210 From git at git.haskell.org Thu Jul 12 21:07:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:19 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15308 by suppressing invisble args more rigorously (9bcbb22) Message-ID: <20180712210719.6FEB03ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/9bcbb222e5b701277ef315c5c4aa76b23f578d0c/ghc >--------------------------------------------------------------- commit 9bcbb222e5b701277ef315c5c4aa76b23f578d0c Author: Ryan Scott Date: Thu Jul 5 08:30:02 2018 -0400 Fix #15308 by suppressing invisble args more rigorously Summary: There was a buglet in `stripInvisArgs` (which is part of the pretty-printing pipeline for types) in which only invisble arguments which came before any visible arguments would be suppressed, but any invisble arguments that came //after// visible ones would still be printed, even if `-fprint-explicit-kinds` wasn't enabled. The fix is simple: make `stripInvisArgs` recursively process the remaining types even after a visible argument is encountered. Test Plan: make test TEST=T15308 Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15308 Differential Revision: https://phabricator.haskell.org/D4891 (cherry picked from commit 93b7ac8d73885369f61f6eb6147352d45de4e957) >--------------------------------------------------------------- 9bcbb222e5b701277ef315c5c4aa76b23f578d0c compiler/iface/IfaceType.hs | 7 ++++++- testsuite/tests/dependent/should_fail/T15308.hs | 12 ++++++++++++ testsuite/tests/dependent/should_fail/T15308.stderr | 5 +++++ testsuite/tests/dependent/should_fail/all.T | 1 + testsuite/tests/typecheck/should_fail/T12785b.stderr | 12 ++++-------- 5 files changed, 28 insertions(+), 9 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 3b1c948..5a7f761 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -513,8 +513,13 @@ stripInvisArgs dflags tys where suppress_invis c = case c of + ITC_Nil -> ITC_Nil ITC_Invis _ ts -> suppress_invis ts - _ -> c + ITC_Vis t ts -> ITC_Vis t $ suppress_invis ts + -- Keep recursing through the remainder of the arguments, as it's + -- possible that there are remaining invisible ones. + -- See the "In type declarations" section of Note [TyVarBndrs, + -- TyVarBinders, TyConBinders, and visibility] in TyCoRep. tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType] tcArgsIfaceTypes ITC_Nil = [] diff --git a/testsuite/tests/dependent/should_fail/T15308.hs b/testsuite/tests/dependent/should_fail/T15308.hs new file mode 100644 index 0000000..b49fe1f --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15308.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +module T15308 where + +import Data.Kind + +data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where + MkFoo :: Foo a f + +f :: Foo a f -> String +f = show diff --git a/testsuite/tests/dependent/should_fail/T15308.stderr b/testsuite/tests/dependent/should_fail/T15308.stderr new file mode 100644 index 0000000..a4bdbd5 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15308.stderr @@ -0,0 +1,5 @@ + +T15308.hs:12:5: error: + • No instance for (Show (Foo a f)) arising from a use of ‘show’ + • In the expression: show + In an equation for ‘f’: f = show diff --git a/testsuite/tests/dependent/should_fail/all.T b/testsuite/tests/dependent/should_fail/all.T index 2bfc39a..1bc3f42 100644 --- a/testsuite/tests/dependent/should_fail/all.T +++ b/testsuite/tests/dependent/should_fail/all.T @@ -32,3 +32,4 @@ test('T14845_fail2', normal, compile_fail, ['']) test('InferDependency', normal, compile_fail, ['']) test('T15245', normal, compile_fail, ['']) test('T15215', normal, compile_fail, ['']) +test('T15308', normal, compile_fail, ['-fno-print-explicit-kinds']) diff --git a/testsuite/tests/typecheck/should_fail/T12785b.stderr b/testsuite/tests/typecheck/should_fail/T12785b.stderr index b8e572d..44937c3 100644 --- a/testsuite/tests/typecheck/should_fail/T12785b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12785b.stderr @@ -11,7 +11,7 @@ T12785b.hs:29:63: error: ‘s’ is a rigid type variable bound by a pattern with constructor: Hide :: forall a (n :: Peano) (f :: a -> *) (s :: HTree n a). - STree n a f s -> Hidden n f, + STree n f s -> Hidden n f, in an equation for ‘nest’ at T12785b.hs:29:7-12 • In the second argument of ‘($)’, namely ‘a `SBranchX` tr’ @@ -20,12 +20,8 @@ T12785b.hs:29:63: error: nest (Hide a `Branch` (nest . hmap nest -> Hide tr)) = Hide $ a `SBranchX` tr • Relevant bindings include - tr :: STree - n - (HTree ('S n) (HTree ('S ('S n)) a)) - (STree ('S n) (HTree ('S ('S n)) a) (STree ('S ('S n)) a f)) - s1 + tr :: STree n (STree ('S n) (STree ('S ('S n)) f)) s1 (bound at T12785b.hs:29:49) - a :: STree ('S m) a f s (bound at T12785b.hs:29:12) - nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) a f) + a :: STree ('S m) f s (bound at T12785b.hs:29:12) + nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) f) (bound at T12785b.hs:27:1) From git at git.haskell.org Thu Jul 12 21:07:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15307 by making nlHsFunTy parenthesize more (92925b3) Message-ID: <20180712210722.3BEBB3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/92925b3dce6631a829e7f61c85da47842472f955/ghc >--------------------------------------------------------------- commit 92925b3dce6631a829e7f61c85da47842472f955 Author: Ryan Scott Date: Thu Jul 5 08:29:59 2018 -0400 Fix #15307 by making nlHsFunTy parenthesize more Summary: `nlHsFunTy` wasn't parenthesizing its arguments at all, which led to `-ddump-deriv` producing incorrectly parenthesized types (since it uses `nlHsFunTy` to construct those types), as demonstrated in #15307. Fix this by changing `nlHsFunTy` to add parentheses à la `ppr_ty`: always parenthesizing the argument type with function precedence, and recursively processing the result type, adding parentheses for each function type it encounters. Test Plan: make test TEST=T14578 Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15307 Differential Revision: https://phabricator.haskell.org/D4890 (cherry picked from commit 59a15a56e180b59656e45df04f7df61de8298881) >--------------------------------------------------------------- 92925b3dce6631a829e7f61c85da47842472f955 compiler/hsSyn/HsUtils.hs | 8 +++++++- testsuite/tests/deriving/should_compile/T14578.stderr | 9 +++++---- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 22dbc1e..388ffdc 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -500,7 +500,13 @@ nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t)) nlHsTyVar x = noLoc (HsTyVar noExt NotPromoted (noLoc x)) -nlHsFunTy a b = noLoc (HsFunTy noExt a b) +nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) + (parenthesize_fun_tail b)) + where + parenthesize_fun_tail (L loc (HsFunTy ext ty1 ty2)) + = L loc (HsFunTy ext (parenthesizeHsType funPrec ty1) + (parenthesize_fun_tail ty2)) + parenthesize_fun_tail lty = lty nlHsParTy t = noLoc (HsParTy noExt t) nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr index bdb6ca5..acbbdd6 100644 --- a/testsuite/tests/deriving/should_compile/T14578.stderr +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -7,10 +7,10 @@ Derived class instances: = GHC.Prim.coerce @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep). - a -> b -> f a -> f b) + (a -> b) -> f a -> f b) @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep). - a -> b -> T14578.App f a -> T14578.App f b) + (a -> b) -> T14578.App f a -> T14578.App f b) GHC.Base.fmap (GHC.Base.<$) = GHC.Prim.coerce @@ -43,11 +43,12 @@ Derived class instances: @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep) (c :: TYPE GHC.Types.LiftedRep). - a -> b -> c -> f a -> f b -> f c) + (a -> b -> c) -> f a -> f b -> f c) @(forall (a :: TYPE GHC.Types.LiftedRep) (b :: TYPE GHC.Types.LiftedRep) (c :: TYPE GHC.Types.LiftedRep). - a -> b -> c -> T14578.App f a -> T14578.App f b -> T14578.App f c) + (a -> b -> c) + -> T14578.App f a -> T14578.App f b -> T14578.App f c) GHC.Base.liftA2 (GHC.Base.*>) = GHC.Prim.coerce From git at git.haskell.org Thu Jul 12 21:07:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix nptr field alignment in RtClosureInspect (23b4d83) Message-ID: <20180712210725.0A3843ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/23b4d83f8f71f5e8a9373654ea9bc6f2814dc3fe/ghc >--------------------------------------------------------------- commit 23b4d83f8f71f5e8a9373654ea9bc6f2814dc3fe Author: Ömer Sinan Ağacan Date: Wed Jul 4 09:12:01 2018 +0300 Fix nptr field alignment in RtClosureInspect `extractSubTerms` (which is extracting pointer and non-pointer fields of a closure) was computing the alignment incorrectly when aligning a 64-bit value (e.g. a Double) on i386 by aligning it to 64-bits instead of to word size (32-bits). This is documented in `mkVirtHeapOffsetsWithPadding`: > Align the start offset (eg, 2-byte value should be 2-byte aligned). > But not more than to a word. Fixes #15061 Test Plan: Validated on both 32-bit and 64-bit. 32-bit fails with various unrelated stat failures, but no actual test failures. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15061 Differential Revision: https://phabricator.haskell.org/D4906 (cherry picked from commit 15bb4e0b6c08b1f8f5511f04af14242f13833ed1) >--------------------------------------------------------------- 23b4d83f8f71f5e8a9373654ea9bc6f2814dc3fe compiler/ghci/RtClosureInspect.hs | 11 +++++++---- testsuite/tests/ghci.debugger/scripts/all.T | 3 +-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 025efe8..e8d5aab 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -781,11 +781,14 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 dflags <- getDynFlags let word_size = wORD_SIZE dflags size_b = primRepSizeB dflags rep - -- Fields are always aligned. - !aligned_idx = roundUpTo arr_i size_b + -- Align the start offset (eg, 2-byte value should be 2-byte + -- aligned). But not more than to a word. The offset calculation + -- should be the same with the offset calculation in + -- StgCmmLayout.mkVirtHeapOffsetsWithPadding. + !aligned_idx = roundUpTo arr_i (min word_size size_b) !new_arr_i = aligned_idx + size_b ws | size_b < word_size = - [index size_b array aligned_idx word_size] + [index size_b aligned_idx word_size] | otherwise = let (q, r) = size_b `quotRem` word_size in ASSERT( r == 0 ) @@ -800,7 +803,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 (error "unboxedTupleTerm: no HValue for unboxed tuple") terms -- Extract a sub-word sized field from a word - index item_size_b array index_b word_size = + index item_size_b index_b word_size = (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes where mask :: Word diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 88acdb0..f2e2658 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -22,8 +22,7 @@ test('print019', extra_files(['../Test.hs']), ghci_script, ['print019.script']) test('print020', extra_files(['../HappyTest.hs']), ghci_script, ['print020.script']) test('print021', normal, ghci_script, ['print021.script']) test('print022', - [when(arch('powerpc64'), expect_broken(14455)), - when(wordsize(32), expect_broken(15061))], + [when(arch('powerpc64'), expect_broken(14455))], ghci_script, ['print022.script']) test('print023', extra_files(['../Test.hs']), ghci_script, ['print023.script']) test('print024', extra_files(['../Test.hs']), ghci_script, ['print024.script']) From git at git.haskell.org Thu Jul 12 21:07:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 21:07:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix newtype instance GADTs (eb680f2) Message-ID: <20180712210728.6FB4B3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/eb680f2c0a365b12f9b867da6bb10e9ab4b328e0/ghc >--------------------------------------------------------------- commit eb680f2c0a365b12f9b867da6bb10e9ab4b328e0 Author: Ryan Scott Date: Thu Jul 5 08:49:50 2018 -0400 Fix newtype instance GADTs Summary: This was taken from Richard's branch, which in turn was submitted to Phab by Matthew, which in turn was commandeered by Ryan. This fixes an issue with newtype instances in which too many coercions were being applied in the worker. This fixes the issue by removing the data family instance axiom from the worker and moving to the wrapper. Moreover, we now require all newtype instances to have wrappers, for symmetry with data instances. Reviewers: goldfire, bgamari, simonpj, mpickering Reviewed By: mpickering Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15318 Differential Revision: https://phabricator.haskell.org/D4902 (cherry picked from commit 927518668111584a06f12bd9eb1b0910a38acf4f) >--------------------------------------------------------------- eb680f2c0a365b12f9b867da6bb10e9ab4b328e0 compiler/basicTypes/MkId.hs | 52 ++++++++++++++++++---- .../tests/indexed-types/should_compile/T15318.hs | 8 ++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 52 insertions(+), 9 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index d6a52b4d..294a845 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -19,8 +19,7 @@ module MkId ( mkPrimOpId, mkFCallId, - wrapNewTypeBody, unwrapNewTypeBody, - wrapFamInstBody, + unwrapNewTypeBody, wrapFamInstBody, DataConBoxer(..), mkDataConRep, mkDataConWorkId, -- And some particular Ids; see below for why they are wired in @@ -247,6 +246,47 @@ Hence we translate to -- Coercion from family type to representation type Co7T a :: T [a] ~ :R7T a +Newtype instances through an additional wrinkle into the mix. Consider the +following example (adapted from #15318, comment:2): + + data family T a + newtype instance T [a] = MkT [a] + +Within the newtype instance, there are three distinct types at play: + +1. The newtype's underlying type, [a]. +2. The instance's representation type, TList a (where TList is the + representation tycon). +3. The family type, T [a]. + +We need two coercions in order to cast from (1) to (3): + +(a) A newtype coercion axiom: + + axiom coTList a :: TList a ~ [a] + + (Where TList is the representation tycon of the newtype instance.) + +(b) A data family instance coercion axiom: + + axiom coT a :: T [a] ~ TList a + +When we translate the newtype instance to Core, we obtain: + + -- Wrapper + $WMkT :: forall a. [a] -> T [a] + $WMkT a x = MkT a x |> Sym (coT a) + + -- Worker + MkT :: forall a. [a] -> TList [a] + MkT a x = x |> Sym (coTList a) + +Unlike for data instances, the worker for a newtype instance is actually an +executable function which expands to a cast, but otherwise, the general +strategy is essentially the same as for data instances. Also note that we have +a wrapper, which is unusual for a newtype, but we make GHC produce one anyway +for symmetry with the way data instances are handled. + Note [Newtype datacons] ~~~~~~~~~~~~~~~~~~~~~~~ The "data constructor" for a newtype should always be vanilla. At one @@ -614,8 +654,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con -- of some newtypes written with GADT syntax. See below. && (any isBanged (ev_ibangs ++ arg_ibangs) -- Some forcing/unboxing (includes eq_spec) - || isFamInstTyCon tycon -- Cast result || (not $ null eq_spec))) -- GADT + || isFamInstTyCon tycon -- Cast result || dataConUserTyVarsArePermuted data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the @@ -1009,15 +1049,9 @@ wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr -- -- If a coercion constructor is provided in the newtype, then we use -- it, otherwise the wrap/unwrap are both no-ops --- --- If the we are dealing with a newtype *instance*, we have a second coercion --- identifying the family instance with the constructor of the newtype --- instance. This coercion is applied in any case (ie, composed with the --- coercion constructor of the newtype or applied by itself). wrapNewTypeBody tycon args result_expr = ASSERT( isNewTyCon tycon ) - wrapFamInstBody tycon args $ mkCast result_expr (mkSymCo co) where co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [] diff --git a/testsuite/tests/indexed-types/should_compile/T15318.hs b/testsuite/tests/indexed-types/should_compile/T15318.hs new file mode 100644 index 0000000..342b6ef --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15318.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T15138 where + +data family Sn a +newtype instance Sn (Either a b) where + SnC :: forall b a. Char -> Sn (Either a b) diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 56448ac..8a2af94 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -284,3 +284,4 @@ test('T15144', normal, compile, ['']) test('T15122', normal, compile, ['']) test('T13777', normal, compile, ['']) test('T14164', normal, compile, ['']) +test('T15318', normal, compile, ['']) From git at git.haskell.org Thu Jul 12 22:21:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jul 2018 22:21:37 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Instantiate GND bindings with an explicit type signature (c0323d9) Message-ID: <20180712222137.BE4463ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/c0323d979d3676f919d6d02aecad7a8bfdcb8b8d/ghc >--------------------------------------------------------------- commit c0323d979d3676f919d6d02aecad7a8bfdcb8b8d Author: Ryan Scott Date: Thu Jul 5 08:30:05 2018 -0400 Instantiate GND bindings with an explicit type signature Summary: Before, we were using visible type application to apply impredicative types to `coerce` in `GeneralizedNewtypeDeriving`-generated bindings. This approach breaks down when combined with `QuantifiedConstraints` in certain ways, which #14883 and #15290 provide examples of. See Note [GND and QuantifiedConstraints] for all the gory details. To avoid this issue, we instead use an explicit type signature to instantiate each GND binding, and use that to bind any type variables that might be bound by a class method's type signature. This reduces the need to impredicative type applications, and more importantly, makes the programs from #14883 and #15290 work again. Test Plan: make test TEST="T15290b T15290c T15290d T14883" Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14883, #15290 Differential Revision: https://phabricator.haskell.org/D4895 (cherry picked from commit 132273f34e394bf7e900d0c15e01e91edd711890) >--------------------------------------------------------------- c0323d979d3676f919d6d02aecad7a8bfdcb8b8d compiler/hsSyn/HsUtils.hs | 2 +- compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcGenDeriv.hs | 148 ++++++++++++++++++--- .../tests/deriving/should_compile/T14578.stderr | 103 +++++++------- .../should_compile/T14883.hs} | 6 +- testsuite/tests/deriving/should_compile/T15290c.hs | 20 +++ testsuite/tests/deriving/should_compile/T15290d.hs | 12 ++ testsuite/tests/deriving/should_compile/all.T | 3 + testsuite/tests/deriving/should_fail/T15073.stderr | 26 ++-- testsuite/tests/deriving/should_fail/T4846.stderr | 5 +- 10 files changed, 234 insertions(+), 93 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c0323d979d3676f919d6d02aecad7a8bfdcb8b8d From git at git.haskell.org Fri Jul 13 09:31:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jul 2018 09:31:54 +0000 (UTC) Subject: [commit: ghc] master: Update submodule (3ee7ca1) Message-ID: <20180713093154.B04EE3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ee7ca1b07eb78d037be9c654db345d641657b4f/ghc >--------------------------------------------------------------- commit 3ee7ca1b07eb78d037be9c654db345d641657b4f Author: Simon Marlow Date: Fri Jul 13 10:29:02 2018 +0100 Update submodule >--------------------------------------------------------------- 3ee7ca1b07eb78d037be9c654db345d641657b4f libraries/stm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/stm b/libraries/stm index 637013d..4c24db6 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 637013d3f2596c86adc8c946e2f38e9e1a85fd84 +Subproject commit 4c24db6071fc1319232934562f7dbed45d498831 From git at git.haskell.org Fri Jul 13 12:13:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jul 2018 12:13:12 +0000 (UTC) Subject: [commit: ghc] master: Fix processHeapClosureForDead CONSTR_NOCAF case (2625f13) Message-ID: <20180713121312.AECE43ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2625f1310edeff62eb3876cc6efbe105a80fe4ad/ghc >--------------------------------------------------------------- commit 2625f1310edeff62eb3876cc6efbe105a80fe4ad Author: Ömer Sinan Ağacan Date: Fri Jul 13 15:12:19 2018 +0300 Fix processHeapClosureForDead CONSTR_NOCAF case CONSTR_NOCAF was introduced with 55d535da10d as a replacement for CONSTR_STATIC and CONSTR_NOCAF_STATIC, however, as explained in Note [static constructors], we copy CONSTR_NOCAFs (which can also be seen in evacuate) during GC, and they can become dead, like other CONSTR_X_Ys. processHeapClosureForDead is updated to reflect this. Test Plan: Validates on x86_64. Existing failures on i386. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #7836, #15063, #15087, #15165 Differential Revision: https://phabricator.haskell.org/D4928 >--------------------------------------------------------------- 2625f1310edeff62eb3876cc6efbe105a80fe4ad rts/LdvProfile.c | 5 ++++- testsuite/tests/profiling/should_run/all.T | 3 +-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c index 9499fdb..608961e 100644 --- a/rts/LdvProfile.c +++ b/rts/LdvProfile.c @@ -101,6 +101,7 @@ processHeapClosureForDead( const StgClosure *c ) case CONSTR_2_0: case CONSTR_1_1: case CONSTR_0_2: + case CONSTR_NOCAF: case FUN: case FUN_1_0: case FUN_0_1: @@ -130,7 +131,6 @@ processHeapClosureForDead( const StgClosure *c ) case IND_STATIC: case FUN_STATIC: case THUNK_STATIC: - case CONSTR_NOCAF: // stack objects case UPDATE_FRAME: case CATCH_FRAME: @@ -139,6 +139,9 @@ processHeapClosureForDead( const StgClosure *c ) case RET_BCO: case RET_SMALL: case RET_BIG: + case CATCH_STM_FRAME: + case CATCH_RETRY_FRAME: + case ATOMICALLY_FRAME: // others case INVALID_OBJECT: case COMPACT_NFDATA: diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 5ee45c3..8d605f2 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -34,8 +34,7 @@ test('T3001', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['']) test('T3001-2', - [only_ways(['prof_hb']), extra_ways(['prof_hb']), - when(wordsize(32), expect_broken(15063))], + [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['-package bytestring']) # For profasm/profthreaded, the answer is correct but the ordering of some From git at git.haskell.org Fri Jul 13 16:05:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jul 2018 16:05:03 +0000 (UTC) Subject: [commit: ghc] master: Improve comments about CUSKs (56b9e47) Message-ID: <20180713160503.411B63ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/56b9e47096393c7d8cedcde6d11b9203cba3a166/ghc >--------------------------------------------------------------- commit 56b9e47096393c7d8cedcde6d11b9203cba3a166 Author: Simon Peyton Jones Date: Fri Jul 13 10:25:38 2018 +0100 Improve comments about CUSKs >--------------------------------------------------------------- 56b9e47096393c7d8cedcde6d11b9203cba3a166 compiler/hsSyn/HsDecls.hs | 93 +++++++++++++++++++++++++++++++----------- compiler/typecheck/TcHsType.hs | 4 +- 2 files changed, 72 insertions(+), 25 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index ca8263b..07fa4e1 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -676,7 +676,7 @@ countTyClDecls decls isNewTy _ = False -- | Does this declaration have a complete, user-supplied kind signature? --- See Note [Complete user-supplied kind signatures] +-- See Note [CUSKs: complete user-supplied kind signatures] hsDeclHasCusk :: TyClDecl GhcRn -> Bool hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) @@ -774,34 +774,80 @@ pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x }) pprTyClDeclFlavour (XTyClDecl x) = ppr x -{- Note [Complete user-supplied kind signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [CUSKs: complete user-supplied kind signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We kind-check declarations differently if they have a complete, user-supplied kind signature (CUSK). This is because we can safely generalise a CUSKed declaration before checking all of the others, supporting polymorphic recursion. See ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy and #9200 for lots of discussion of how we got here. -A declaration has a CUSK if we can know its complete kind without doing any -inference, at all. Here are the rules: - - - A class or datatype is said to have a CUSK if and only if all of its type -variables are annotated. Its result kind is, by construction, Constraint or * -respectively. - - - A type synonym has a CUSK if and only if all of its type variables and its -RHS are annotated with kinds. - - - A closed type family is said to have a CUSK if and only if all of its type -variables and its return type are annotated. - - - An open type family always has a CUSK -- unannotated type variables (and -return type) default to *. - - - A data definition with a top-level :: must explicitly bind all kind variables -to the right of the ::. See test dependent/should_compile/KindLevels, which -requires this case. (Naturally, any kind variable mentioned before the :: should -not be bound after it.) +PRINCIPLE: + a type declaration has a CUSK iff we could produce a separate kind signature + for it, just like a type signature for a function, + looking only at the header of the declaration. + +Examples: + * data T1 (a :: *->*) (b :: *) = .... + -- Has CUSK; equivalant to T1 :: (*->*) -> * -> * + + * data T2 a b = ... + -- No CUSK; we do not want to guess T2 :: * -> * -> * + -- becuase the full decl might be data T a b = MkT (a b) + + * data T3 (a :: k -> *) (b :: *) = ... + -- CUSK; equivalent to T3 :: (k -> *) -> * -> * + -- We lexically generalise over k to get + -- T3 :: forall k. (k -> *) -> * -> * + -- The generalisation is here is purely lexical, just like + -- f3 :: a -> a + -- means + -- f3 :: forall a. a -> a + + * data T4 (a :: j k) = ... + -- CUSK; equivalent to T4 :: j k -> * + -- which we lexically generalise to T4 :: forall j k. j k -> * + -- and then, if PolyKinds is on, we further generalise to + -- T4 :: forall kk (j :: kk -> *) (k :: kk). j k -> * + -- Again this is exactly like what happens as the term level + -- when you write + -- f4 :: forall a b. a b -> Int + +NOTE THAT + * A CUSK does /not/ mean that everything about the kind signature is + fully specified by the user. Look at T4 and f4: we had do do kind + inference to figure out the kind-quantification. But in both cases + (T4 and f4) that inference is done looking /only/ at the header of T4 + (or signature for f4), not at the definition thereof. + + * The CUSK completely fixes the kind of the type constructor, forever. + + * The precise rules, for each declaration form, for whethher a declaration + has a CUSK are given in the user manual section "Complete user-supplied + kind signatures and polymorphic recursion". BUt they simply implement + PRINCIPLE above. + + * Open type families are interesting: + type family T5 a b :: * + There simply /is/ no accompanying declaration, so that info is all + we'll ever get. So we it has a CUSK by definition, and we default + any un-fixed kind variables to *. + + * Associated types are a bit tricker: + class C6 a where + type family T6 a b :: * + op :: a Int -> Int + Here C6 does not have a CUSK (in fact we ultimately discover that + a :: * -> *). And hence neither does T6, the associated family, + because we can't fix its kind until we have settled C6. Another + way to say it: unlike a top-level, we /may/ discover more about + a's kind from C6's definition. + + * A data definition with a top-level :: must explicitly bind all + kind variables to the right of the ::. See test + dependent/should_compile/KindLevels, which requires this + case. (Naturally, any kind variable mentioned before the :: should + not be bound after it.) -} @@ -1025,6 +1071,7 @@ data FamilyInfo pass | ClosedTypeFamily (Maybe [LTyFamInstEqn pass]) -- | Does this family declaration have a complete, user-supplied kind signature? +-- See Note [CUSKs: complete user-supplied kind signatures] famDeclHasCusk :: Maybe Bool -- ^ if associated, does the enclosing class have a CUSK? -> FamilyDecl pass -> Bool diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 1b3ae90..3032e07 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1600,8 +1600,8 @@ tcWildCardBindersX new_wc maybe_skol_info wc_names thing_inside -- user-supplied kind signature (CUSK), generalise the result. -- Used in 'getInitialKind' (for tycon kinds and other kinds) -- and in kind-checking (but not for tycon kinds, which are checked with --- tcTyClDecls). See also Note [Complete user-supplied kind signatures] in --- HsDecls. +-- tcTyClDecls). See Note [CUSKs: complete user-supplied kind signatures] +-- in HsDecls. -- -- This function does not do telescope checking. kcLHsQTyVars :: Name -- ^ of the thing being checked From git at git.haskell.org Fri Jul 13 16:05:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jul 2018 16:05:06 +0000 (UTC) Subject: [commit: ghc] master: Refactor floatEqualities slightly (b56926d) Message-ID: <20180713160506.1D7A93ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b56926d87add181c18ea046d2fe247c97d95b2df/ghc >--------------------------------------------------------------- commit b56926d87add181c18ea046d2fe247c97d95b2df Author: Simon Peyton Jones Date: Fri Jul 13 09:15:22 2018 +0100 Refactor floatEqualities slightly A conversation with Richard made me look at floatEqualities again, and I did not find it easy to read. This patch refactors it sligtly, with better variable naming and more comments. I also fixed one latent bug, I think. In the old code, I think that an inhomogeneous or insoluble equality (co :: t1~t2), which doesn't float, and ended up in the badly-named 'non_eqs', would not end up in extended_skols. Hence it would not capture an equality that mentioned 'co' in a cast. It's still pretty horrible (as Richard and I have been discussing), but better. No change in behaviour; I don't know a program that would trigger the latent bug, even if my reasoning is right. >--------------------------------------------------------------- b56926d87add181c18ea046d2fe247c97d95b2df compiler/typecheck/TcSimplify.hs | 62 +++++++++++++++++++++++----------------- 1 file changed, 36 insertions(+), 26 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 8f9b72b..13a3f73 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -2204,17 +2204,23 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs -- Now we can pick the ones to float -- The constraints are un-flattened and de-canonicalised - ; let seed_skols = mkVarSet skols `unionVarSet` + ; let (candidate_eqs, no_float_cts) = partitionBag is_float_eq_candidate simples + + seed_skols = mkVarSet skols `unionVarSet` mkVarSet given_ids `unionVarSet` - foldEvBindMap add_one emptyVarSet binds - add_one bind acc = extendVarSet acc (evBindVar bind) + foldrBag add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` + foldEvBindMap add_one_bind emptyVarSet binds -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) + -- Include the EvIds of any non-floating constraints + + extended_skols = transCloVarSet (add_captured_ev_ids candidate_eqs) seed_skols + -- extended_skols contains the EvIds of all the trapped constraints + -- See Note [What prevents a constraint from floating] (3) - (eqs, non_eqs) = partitionBag is_eq_ct simples - extended_skols = transCloVarSet (extra_skols eqs) seed_skols - (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols) eqs - remaining_simples = non_eqs `andCts` no_flt_eqs - -- extended_skols: See Note [What prevents a constraint from floating] (3) + (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols) + candidate_eqs + + remaining_simples = no_float_cts `andCts` no_flt_eqs -- Promote any unification variables mentioned in the floated equalities -- See Note [Promoting unification variables] @@ -2223,42 +2229,45 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols , text "Extended skols =" <+> ppr extended_skols , text "Simples =" <+> ppr simples - , text "Eqs =" <+> ppr eqs + , text "Candidate eqs =" <+> ppr candidate_eqs , text "Floated eqs =" <+> ppr flt_eqs]) ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } where + add_one_bind :: EvBind -> VarSet -> VarSet + add_one_bind bind acc = extendVarSet acc (evBindVar bind) + + add_non_flt_ct :: Ct -> VarSet -> VarSet + add_non_flt_ct ct acc | isDerivedCt ct = acc + | otherwise = extendVarSet acc (ctEvId ct) + is_floatable :: VarSet -> Ct -> Bool is_floatable skols ct | isDerivedCt ct = not (tyCoVarsOfCt ct `intersectsVarSet` skols) | otherwise = not (ctEvId ct `elemVarSet` skols) - is_eq_ct ct | CTyEqCan {} <- ct = True - | is_homo_eq (ctPred ct) = True - | otherwise = False - - extra_skols :: Cts -> VarSet -> VarSet - extra_skols eqs skols = foldrBag extra_skol emptyVarSet eqs + add_captured_ev_ids :: Cts -> VarSet -> VarSet + add_captured_ev_ids cts skols = foldrBag extra_skol emptyVarSet cts where extra_skol ct acc | isDerivedCt ct = acc | tyCoVarsOfCt ct `intersectsVarSet` skols = extendVarSet acc (ctEvId ct) | otherwise = acc - -- Float out alpha ~ ty, or ty ~ alpha - -- which might be unified outside - -- See Note [Which equalities to float] - is_homo_eq pred - | EqPred NomEq ty1 ty2 <- classifyPredType pred + -- Identify which equalities are candidates for floating + -- Float out alpha ~ ty, or ty ~ alpha which might be unified outside + -- See Note [Which equalities to float] + is_float_eq_candidate ct + | pred <- ctPred ct + , EqPred NomEq ty1 ty2 <- classifyPredType pred , typeKind ty1 `tcEqType` typeKind ty2 = case (tcGetTyVar_maybe ty1, tcGetTyVar_maybe ty2) of - (Just tv1, _) -> float_tv_eq tv1 ty2 - (_, Just tv2) -> float_tv_eq tv2 ty1 + (Just tv1, _) -> float_tv_eq_candidate tv1 ty2 + (_, Just tv2) -> float_tv_eq_candidate tv2 ty1 _ -> False - | otherwise - = False + | otherwise = False - float_tv_eq tv1 ty2 -- See Note [Which equalities to float] + float_tv_eq_candidate tv1 ty2 -- See Note [Which equalities to float] = isMetaTyVar tv1 && (not (isSigTyVar tv1) || isTyVarTy ty2) @@ -2335,7 +2344,8 @@ The "bound variables of the implication" are 1. The skolem type variables `ic_skols` 2. The "given" evidence variables `ic_given`. Example: - forall a. (co :: t1 ~# t2) => [W] co : (a ~# b |> co) + forall a. (co :: t1 ~# t2) => [W] co2 : (a ~# b |> co) + Here 'co' is bound 3. The binders of all evidence bindings in `ic_binds`. Example forall a. (d :: t1 ~ t2) From git at git.haskell.org Fri Jul 13 16:36:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jul 2018 16:36:27 +0000 (UTC) Subject: [commit: ghc] master: submodule update (e40eb73) Message-ID: <20180713163627.DB2B33ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e40eb738bb15795a22b2765e12c3add20efa91a5/ghc >--------------------------------------------------------------- commit e40eb738bb15795a22b2765e12c3add20efa91a5 Author: Simon Marlow Date: Fri Jul 13 17:34:17 2018 +0100 submodule update >--------------------------------------------------------------- e40eb738bb15795a22b2765e12c3add20efa91a5 libraries/parallel | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/parallel b/libraries/parallel index 41279a7..5015bc7 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit 41279a764acd0758f15801c10650d73343637451 +Subproject commit 5015bc74127beac29b4d08dcb3beb230149fed25 From git at git.haskell.org Fri Jul 13 22:50:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jul 2018 22:50:06 +0000 (UTC) Subject: [commit: ghc] master: Comments only (2928b92) Message-ID: <20180713225006.0E08D3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2928b925f94fd1423a192aa6421c9fdd05a0a9e4/ghc >--------------------------------------------------------------- commit 2928b925f94fd1423a192aa6421c9fdd05a0a9e4 Author: Simon Peyton Jones Date: Fri Jul 13 23:49:41 2018 +0100 Comments only >--------------------------------------------------------------- 2928b925f94fd1423a192aa6421c9fdd05a0a9e4 compiler/hsSyn/HsDecls.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 07fa4e1..3f54d20 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -848,6 +848,9 @@ NOTE THAT dependent/should_compile/KindLevels, which requires this case. (Naturally, any kind variable mentioned before the :: should not be bound after it.) + + This last point is much more debatable than the others; see + Trac #15142 comment:22 -} From git at git.haskell.org Sat Jul 14 16:00:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:00:15 +0000 (UTC) Subject: [commit: packages/haskeline] master: Bump version to 0.7.4.3. (3bf2b62) Message-ID: <20180714160015.434523ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/3bf2b621685fc795f0dc3f3196728ccea492d42b >--------------------------------------------------------------- commit 3bf2b621685fc795f0dc3f3196728ccea492d42b Author: Judah Jacobson Date: Sun Jun 24 14:32:46 2018 -0400 Bump version to 0.7.4.3. >--------------------------------------------------------------- 3bf2b621685fc795f0dc3f3196728ccea492d42b Changelog | 3 +++ haskeline.cabal | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/Changelog b/Changelog index 9740875..73f98dc 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,6 @@ +Changed in version 0.7.4.3: + * Bump upper bounds on base, containers, stm and unix + Changed in version 0.7.4.2: * Clean up the rest of the references to trac.haskell.org diff --git a/haskeline.cabal b/haskeline.cabal index 1750d40..903a01d 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -1,6 +1,6 @@ Name: haskeline Cabal-Version: >=1.10 -Version: 0.7.4.2 +Version: 0.7.4.3 Category: User Interfaces License: BSD3 License-File: LICENSE From git at git.haskell.org Sat Jul 14 16:00:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:00:17 +0000 (UTC) Subject: [commit: packages/haskeline] master: Fix redundant field in haskeline.cabal. (84a7b2b) Message-ID: <20180714160017.4810C3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/84a7b2b0afb9325cfcedc3ca56603539f0e8af3e >--------------------------------------------------------------- commit 84a7b2b0afb9325cfcedc3ca56603539f0e8af3e Author: Judah Jacobson Date: Sun Jun 24 14:35:30 2018 -0400 Fix redundant field in haskeline.cabal. Helps fix `stack upload`. >--------------------------------------------------------------- 84a7b2b0afb9325cfcedc3ca56603539f0e8af3e Changelog | 1 + haskeline.cabal | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/Changelog b/Changelog index 73f98dc..4095f03 100644 --- a/Changelog +++ b/Changelog @@ -1,5 +1,6 @@ Changed in version 0.7.4.3: * Bump upper bounds on base, containers, stm and unix + * Fix redundant "Category" field in haskeline.cabal Changed in version 0.7.4.2: * Clean up the rest of the references to trac.haskell.org diff --git a/haskeline.cabal b/haskeline.cabal index 903a01d..26bca84 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -7,7 +7,6 @@ License-File: LICENSE Copyright: (c) Judah Jacobson Author: Judah Jacobson Maintainer: Judah Jacobson -Category: User Interfaces Synopsis: A command-line interface for user input, written in Haskell. Description: Haskeline provides a user interface for line input in command-line From git at git.haskell.org Sat Jul 14 16:51:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:51:47 +0000 (UTC) Subject: [commit: ghc] master: Bump haskeline submodule to 0.7.4.3 (cbd4b33) Message-ID: <20180714165147.960B33ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cbd4b33317b6cd3751878bbe7a0cc7601bd169e7/ghc >--------------------------------------------------------------- commit cbd4b33317b6cd3751878bbe7a0cc7601bd169e7 Author: Ben Gamari Date: Sat Jul 14 11:29:55 2018 -0400 Bump haskeline submodule to 0.7.4.3 >--------------------------------------------------------------- cbd4b33317b6cd3751878bbe7a0cc7601bd169e7 libraries/haskeline | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/haskeline b/libraries/haskeline index 19b0be5..84a7b2b 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 19b0be5687e933494c462a72cd7348c397aa3406 +Subproject commit 84a7b2b0afb9325cfcedc3ca56603539f0e8af3e From git at git.haskell.org Sat Jul 14 16:52:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:02 +0000 (UTC) Subject: [commit: ghc] master: Bump mtl submodule to v2.2.2 (c67cf9e) Message-ID: <20180714165202.344B83ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c67cf9e9e66f629440c80ae3bf1616e2aac7002b/ghc >--------------------------------------------------------------- commit c67cf9e9e66f629440c80ae3bf1616e2aac7002b Author: Ben Gamari Date: Sat Jul 14 11:33:13 2018 -0400 Bump mtl submodule to v2.2.2 >--------------------------------------------------------------- c67cf9e9e66f629440c80ae3bf1616e2aac7002b libraries/mtl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/mtl b/libraries/mtl index bf4af11..c7d3967 160000 --- a/libraries/mtl +++ b/libraries/mtl @@ -1 +1 @@ -Subproject commit bf4af114ba3d35b2937fc74926aa49e128dd6c1f +Subproject commit c7d396732bd45e409478bd4df1d0ca95d6f39356 From git at git.haskell.org Sat Jul 14 16:52:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:11 +0000 (UTC) Subject: [commit: ghc] master: Bump directory submodule to v1.3.3.0 (b794c7e) Message-ID: <20180714165211.A1B803ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b794c7ed7d515a98b350417143fb46dd5e6d39df/ghc >--------------------------------------------------------------- commit b794c7ed7d515a98b350417143fb46dd5e6d39df Author: Ben Gamari Date: Sat Jul 14 11:36:00 2018 -0400 Bump directory submodule to v1.3.3.0 >--------------------------------------------------------------- b794c7ed7d515a98b350417143fb46dd5e6d39df libraries/directory | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/directory b/libraries/directory index 9c474f0..e9debc1 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 9c474f0d287b143c43dff275db0640d358e323cc +Subproject commit e9debc1d4a9c4b608a32f60bae173ed10f89fdce From git at git.haskell.org Sat Jul 14 16:52:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:14 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump haskeline submodule to 0.7.4.3 (148310f) Message-ID: <20180714165214.6ABB53ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/148310fd53d0cfc3d9acae5a9c8c5a0069710f01/ghc >--------------------------------------------------------------- commit 148310fd53d0cfc3d9acae5a9c8c5a0069710f01 Author: Ben Gamari Date: Sat Jul 14 11:29:55 2018 -0400 Bump haskeline submodule to 0.7.4.3 (cherry picked from commit cbd4b33317b6cd3751878bbe7a0cc7601bd169e7) >--------------------------------------------------------------- 148310fd53d0cfc3d9acae5a9c8c5a0069710f01 libraries/haskeline | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/haskeline b/libraries/haskeline index 19b0be5..84a7b2b 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 19b0be5687e933494c462a72cd7348c397aa3406 +Subproject commit 84a7b2b0afb9325cfcedc3ca56603539f0e8af3e From git at git.haskell.org Sat Jul 14 16:52:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:17 +0000 (UTC) Subject: [commit: ghc] master: Bump directory submodule to v1.3.3.0 (b794c7e) Message-ID: <20180714165217.3B5BE3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b794c7ed7d515a98b350417143fb46dd5e6d39df/ghc >--------------------------------------------------------------- commit b794c7ed7d515a98b350417143fb46dd5e6d39df Author: Ben Gamari Date: Sat Jul 14 11:36:00 2018 -0400 Bump directory submodule to v1.3.3.0 >--------------------------------------------------------------- b794c7ed7d515a98b350417143fb46dd5e6d39df libraries/directory | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/directory b/libraries/directory index 9c474f0..e9debc1 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 9c474f0d287b143c43dff275db0640d358e323cc +Subproject commit e9debc1d4a9c4b608a32f60bae173ed10f89fdce From git at git.haskell.org Sat Jul 14 16:52:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:17 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump unix submodule (3f96594) Message-ID: <20180714165217.4B3163ABA8@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/3f96594166bda2b228c1f9189dd5bfc7e1dd5a31/ghc >--------------------------------------------------------------- commit 3f96594166bda2b228c1f9189dd5bfc7e1dd5a31 Author: Ben Gamari Date: Sat Jul 14 11:43:31 2018 -0400 Bump unix submodule (cherry picked from commit c3328ff354db2be5994807fed6b5b132489a9e3e) >--------------------------------------------------------------- 3f96594166bda2b228c1f9189dd5bfc7e1dd5a31 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index c9ec0b0..ee3e99a 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit c9ec0b00012e5eb447ff021091f86efe31be8abf +Subproject commit ee3e99a0d8a75edc90a1a4e9fb1c593a99a02bb9 From git at git.haskell.org Sat Jul 14 16:52:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump haskeline submodule to 0.7.4.3 (148310f) Message-ID: <20180714165220.1B9173ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/148310fd53d0cfc3d9acae5a9c8c5a0069710f01/ghc >--------------------------------------------------------------- commit 148310fd53d0cfc3d9acae5a9c8c5a0069710f01 Author: Ben Gamari Date: Sat Jul 14 11:29:55 2018 -0400 Bump haskeline submodule to 0.7.4.3 (cherry picked from commit cbd4b33317b6cd3751878bbe7a0cc7601bd169e7) >--------------------------------------------------------------- 148310fd53d0cfc3d9acae5a9c8c5a0069710f01 libraries/haskeline | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/haskeline b/libraries/haskeline index 19b0be5..84a7b2b 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 19b0be5687e933494c462a72cd7348c397aa3406 +Subproject commit 84a7b2b0afb9325cfcedc3ca56603539f0e8af3e From git at git.haskell.org Sat Jul 14 16:52:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump mtl submodule to v2.2.2 (736f4bc) Message-ID: <20180714165220.2BFC03ABA8@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/736f4bce833d8b2b9c2df35572ea64d0b252252a/ghc >--------------------------------------------------------------- commit 736f4bce833d8b2b9c2df35572ea64d0b252252a Author: Ben Gamari Date: Sat Jul 14 11:33:13 2018 -0400 Bump mtl submodule to v2.2.2 (cherry picked from commit c67cf9e9e66f629440c80ae3bf1616e2aac7002b) >--------------------------------------------------------------- 736f4bce833d8b2b9c2df35572ea64d0b252252a libraries/mtl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/mtl b/libraries/mtl index bf4af11..c7d3967 160000 --- a/libraries/mtl +++ b/libraries/mtl @@ -1 +1 @@ -Subproject commit bf4af114ba3d35b2937fc74926aa49e128dd6c1f +Subproject commit c7d396732bd45e409478bd4df1d0ca95d6f39356 From git at git.haskell.org Sat Jul 14 16:52:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump unix submodule (3f96594) Message-ID: <20180714165222.F29DC3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/3f96594166bda2b228c1f9189dd5bfc7e1dd5a31/ghc >--------------------------------------------------------------- commit 3f96594166bda2b228c1f9189dd5bfc7e1dd5a31 Author: Ben Gamari Date: Sat Jul 14 11:43:31 2018 -0400 Bump unix submodule (cherry picked from commit c3328ff354db2be5994807fed6b5b132489a9e3e) >--------------------------------------------------------------- 3f96594166bda2b228c1f9189dd5bfc7e1dd5a31 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index c9ec0b0..ee3e99a 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit c9ec0b00012e5eb447ff021091f86efe31be8abf +Subproject commit ee3e99a0d8a75edc90a1a4e9fb1c593a99a02bb9 From git at git.haskell.org Sat Jul 14 16:52:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:23 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump directory submodule to v1.3.3.0 (ca59fa7) Message-ID: <20180714165223.174EE3ABA8@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/ca59fa76538d2548e94663cf6b0973afa62f66c4/ghc >--------------------------------------------------------------- commit ca59fa76538d2548e94663cf6b0973afa62f66c4 Author: Ben Gamari Date: Sat Jul 14 11:36:00 2018 -0400 Bump directory submodule to v1.3.3.0 (cherry picked from commit b794c7ed7d515a98b350417143fb46dd5e6d39df) >--------------------------------------------------------------- ca59fa76538d2548e94663cf6b0973afa62f66c4 libraries/directory | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/directory b/libraries/directory index 9c474f0..e9debc1 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 9c474f0d287b143c43dff275db0640d358e323cc +Subproject commit e9debc1d4a9c4b608a32f60bae173ed10f89fdce From git at git.haskell.org Sat Jul 14 16:52:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Remove random submodule (391ee97) Message-ID: <20180714165225.E57563ABA8@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/391ee977c0489ca1b5130417ba9d48d3eb419489/ghc >--------------------------------------------------------------- commit 391ee977c0489ca1b5130417ba9d48d3eb419489 Author: Ben Gamari Date: Sat Jul 14 11:47:37 2018 -0400 Remove random submodule I believe this was originally introduced to help test DPH, which is now gone. (cherry picked from commit 0905fec089b3270f540c7ee33959cbf8ecfcb4d7) >--------------------------------------------------------------- 391ee977c0489ca1b5130417ba9d48d3eb419489 ghc.mk | 2 +- libraries/random | 1 - packages | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/ghc.mk b/ghc.mk index c0b99c0..eed172e 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1215,7 +1215,7 @@ GIT_COMMIT_ID: sdist-ghc-prep-tree : VERSION GIT_COMMIT_ID # Extra packages which shouldn't be in the source distribution: see #8801 -EXTRA_PACKAGES=parallel random +EXTRA_PACKAGES=parallel .PHONY: sdist-ghc-prep-tree sdist-ghc-prep-tree : diff --git a/libraries/random b/libraries/random deleted file mode 160000 index c72dd0a..0000000 --- a/libraries/random +++ /dev/null @@ -1 +0,0 @@ -Subproject commit c72dd0a01ae6255bead2d4fad33f002bb5684030 diff --git a/packages b/packages index 94dad9e..0d3317d 100644 --- a/packages +++ b/packages @@ -65,5 +65,4 @@ libraries/xhtml - - https:/ nofib nofib - - libraries/parallel extra - ssh://git at github.com/haskell/parallel.git libraries/stm - - ssh://git at github.com/haskell/stm.git -libraries/random extra - https://github.com/haskell/random.git . - ghc.git - From git at git.haskell.org Sat Jul 14 16:52:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump mtl submodule to v2.2.2 (736f4bc) Message-ID: <20180714165225.CAD333ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/736f4bce833d8b2b9c2df35572ea64d0b252252a/ghc >--------------------------------------------------------------- commit 736f4bce833d8b2b9c2df35572ea64d0b252252a Author: Ben Gamari Date: Sat Jul 14 11:33:13 2018 -0400 Bump mtl submodule to v2.2.2 (cherry picked from commit c67cf9e9e66f629440c80ae3bf1616e2aac7002b) >--------------------------------------------------------------- 736f4bce833d8b2b9c2df35572ea64d0b252252a libraries/mtl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/mtl b/libraries/mtl index bf4af11..c7d3967 160000 --- a/libraries/mtl +++ b/libraries/mtl @@ -1 +1 @@ -Subproject commit bf4af114ba3d35b2937fc74926aa49e128dd6c1f +Subproject commit c7d396732bd45e409478bd4df1d0ca95d6f39356 From git at git.haskell.org Sat Jul 14 16:52:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: submodule update (e5b1ec9) Message-ID: <20180714165228.BB3373ABA8@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/e5b1ec954809d0b92b57518cb5b369ae0a4ca6f1/ghc >--------------------------------------------------------------- commit e5b1ec954809d0b92b57518cb5b369ae0a4ca6f1 Author: Simon Marlow Date: Fri Jul 13 17:34:17 2018 +0100 submodule update (cherry picked from commit e40eb738bb15795a22b2765e12c3add20efa91a5) >--------------------------------------------------------------- e5b1ec954809d0b92b57518cb5b369ae0a4ca6f1 libraries/parallel | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/parallel b/libraries/parallel index 41279a7..5015bc7 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit 41279a764acd0758f15801c10650d73343637451 +Subproject commit 5015bc74127beac29b4d08dcb3beb230149fed25 From git at git.haskell.org Sat Jul 14 16:52:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump directory submodule to v1.3.3.0 (ca59fa7) Message-ID: <20180714165228.A5B693ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/ca59fa76538d2548e94663cf6b0973afa62f66c4/ghc >--------------------------------------------------------------- commit ca59fa76538d2548e94663cf6b0973afa62f66c4 Author: Ben Gamari Date: Sat Jul 14 11:36:00 2018 -0400 Bump directory submodule to v1.3.3.0 (cherry picked from commit b794c7ed7d515a98b350417143fb46dd5e6d39df) >--------------------------------------------------------------- ca59fa76538d2548e94663cf6b0973afa62f66c4 libraries/directory | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/directory b/libraries/directory index 9c474f0..e9debc1 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 9c474f0d287b143c43dff275db0640d358e323cc +Subproject commit e9debc1d4a9c4b608a32f60bae173ed10f89fdce From git at git.haskell.org Sat Jul 14 16:52:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Remove random submodule (391ee97) Message-ID: <20180714165231.73F023ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/391ee977c0489ca1b5130417ba9d48d3eb419489/ghc >--------------------------------------------------------------- commit 391ee977c0489ca1b5130417ba9d48d3eb419489 Author: Ben Gamari Date: Sat Jul 14 11:47:37 2018 -0400 Remove random submodule I believe this was originally introduced to help test DPH, which is now gone. (cherry picked from commit 0905fec089b3270f540c7ee33959cbf8ecfcb4d7) >--------------------------------------------------------------- 391ee977c0489ca1b5130417ba9d48d3eb419489 ghc.mk | 2 +- libraries/random | 1 - packages | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/ghc.mk b/ghc.mk index c0b99c0..eed172e 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1215,7 +1215,7 @@ GIT_COMMIT_ID: sdist-ghc-prep-tree : VERSION GIT_COMMIT_ID # Extra packages which shouldn't be in the source distribution: see #8801 -EXTRA_PACKAGES=parallel random +EXTRA_PACKAGES=parallel .PHONY: sdist-ghc-prep-tree sdist-ghc-prep-tree : diff --git a/libraries/random b/libraries/random deleted file mode 160000 index c72dd0a..0000000 --- a/libraries/random +++ /dev/null @@ -1 +0,0 @@ -Subproject commit c72dd0a01ae6255bead2d4fad33f002bb5684030 diff --git a/packages b/packages index 94dad9e..0d3317d 100644 --- a/packages +++ b/packages @@ -65,5 +65,4 @@ libraries/xhtml - - https:/ nofib nofib - - libraries/parallel extra - ssh://git at github.com/haskell/parallel.git libraries/stm - - ssh://git at github.com/haskell/stm.git -libraries/random extra - https://github.com/haskell/random.git . - ghc.git - From git at git.haskell.org Sat Jul 14 16:52:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:34 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: submodule update (e5b1ec9) Message-ID: <20180714165234.3EFB03ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/e5b1ec954809d0b92b57518cb5b369ae0a4ca6f1/ghc >--------------------------------------------------------------- commit e5b1ec954809d0b92b57518cb5b369ae0a4ca6f1 Author: Simon Marlow Date: Fri Jul 13 17:34:17 2018 +0100 submodule update (cherry picked from commit e40eb738bb15795a22b2765e12c3add20efa91a5) >--------------------------------------------------------------- e5b1ec954809d0b92b57518cb5b369ae0a4ca6f1 libraries/parallel | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/parallel b/libraries/parallel index 41279a7..5015bc7 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit 41279a764acd0758f15801c10650d73343637451 +Subproject commit 5015bc74127beac29b4d08dcb3beb230149fed25 From git at git.haskell.org Sat Jul 14 16:52:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:52:48 +0000 (UTC) Subject: [commit: ghc] master: Bump unix submodule (c3328ff) Message-ID: <20180714165248.D74D63ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c3328ff354db2be5994807fed6b5b132489a9e3e/ghc >--------------------------------------------------------------- commit c3328ff354db2be5994807fed6b5b132489a9e3e Author: Ben Gamari Date: Sat Jul 14 11:43:31 2018 -0400 Bump unix submodule >--------------------------------------------------------------- c3328ff354db2be5994807fed6b5b132489a9e3e libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index c9ec0b0..ee3e99a 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit c9ec0b00012e5eb447ff021091f86efe31be8abf +Subproject commit ee3e99a0d8a75edc90a1a4e9fb1c593a99a02bb9 From git at git.haskell.org Sat Jul 14 16:53:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 16:53:03 +0000 (UTC) Subject: [commit: ghc] master: Remove random submodule (0905fec) Message-ID: <20180714165303.6B7683ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0905fec089b3270f540c7ee33959cbf8ecfcb4d7/ghc >--------------------------------------------------------------- commit 0905fec089b3270f540c7ee33959cbf8ecfcb4d7 Author: Ben Gamari Date: Sat Jul 14 11:47:37 2018 -0400 Remove random submodule I believe this was originally introduced to help test DPH, which is now gone. >--------------------------------------------------------------- 0905fec089b3270f540c7ee33959cbf8ecfcb4d7 ghc.mk | 2 +- libraries/random | 1 - packages | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/ghc.mk b/ghc.mk index c0b99c0..eed172e 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1215,7 +1215,7 @@ GIT_COMMIT_ID: sdist-ghc-prep-tree : VERSION GIT_COMMIT_ID # Extra packages which shouldn't be in the source distribution: see #8801 -EXTRA_PACKAGES=parallel random +EXTRA_PACKAGES=parallel .PHONY: sdist-ghc-prep-tree sdist-ghc-prep-tree : diff --git a/libraries/random b/libraries/random deleted file mode 160000 index c72dd0a..0000000 --- a/libraries/random +++ /dev/null @@ -1 +0,0 @@ -Subproject commit c72dd0a01ae6255bead2d4fad33f002bb5684030 diff --git a/packages b/packages index 8a6ff29..2f4dfd1 100644 --- a/packages +++ b/packages @@ -67,5 +67,4 @@ libraries/xhtml - - https:/ nofib nofib - - libraries/parallel extra - ssh://git at github.com/haskell/parallel.git libraries/stm - - ssh://git at github.com/haskell/stm.git -libraries/random extra - https://github.com/haskell/random.git . - ghc.git - From git at git.haskell.org Sat Jul 14 18:58:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 18:58:00 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix decompsePiCos and visible type application (5b10d53) Message-ID: <20180714185800.6F5683ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/5b10d537bde8e1c1cf5e0359d38dac7351ae8b2a/ghc >--------------------------------------------------------------- commit 5b10d537bde8e1c1cf5e0359d38dac7351ae8b2a Author: Simon Peyton Jones Date: Mon Jul 9 17:20:06 2018 +0100 Fix decompsePiCos and visible type application Trac #15343 was caused by two things First, in TcHsType.tcHsTypeApp, which deals with the type argment in visible type application, we were failing to call solveLocalEqualities. But the type argument is like a user type signature so it's at least inconsitent not to do so. I thought that would nail it. But it didn't. It turned out that we were ended up calling decomposePiCos on a type looking like this (f |> co) Int where co :: (forall a. ty) ~ (t1 -> t2) Now, 'co' is insoluble, and we'll report that later. But meanwhile we don't want to crash in decomposePiCos. My fix involves keeping track of the type on both sides of the coercion, and ensuring that the outer shape matches before decomposing. I wish there was a simpler way to do this. But I think this one is at least robust. I suppose it is possible that the decomposePiCos fix would have cured the original report, but I'm leaving the one-line tcHsTypeApp fix in too because it just seems more consistent. (cherry picked from commit aedbf7f1c402ecbcb5ff192d5fb4dd6dd4771bf8) >--------------------------------------------------------------- 5b10d537bde8e1c1cf5e0359d38dac7351ae8b2a compiler/typecheck/TcFlatten.hs | 12 ++- compiler/typecheck/TcHsType.hs | 5 +- compiler/types/Coercion.hs | 99 ++++++++++++++-------- compiler/types/Coercion.hs-boot | 2 +- compiler/types/Type.hs | 4 +- testsuite/tests/dependent/should_fail/T15343.hs | 14 +++ .../tests/dependent/should_fail/T15343.stderr | 7 ++ testsuite/tests/dependent/should_fail/all.T | 2 + 8 files changed, 102 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5b10d537bde8e1c1cf5e0359d38dac7351ae8b2a From git at git.haskell.org Sat Jul 14 18:58:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 18:58:03 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix processHeapClosureForDead CONSTR_NOCAF case (30a4bcc) Message-ID: <20180714185803.3E66E3ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/30a4bcc3fc3a434b3b6ab64289934281591ce09a/ghc >--------------------------------------------------------------- commit 30a4bcc3fc3a434b3b6ab64289934281591ce09a Author: Ömer Sinan Ağacan Date: Fri Jul 13 15:12:19 2018 +0300 Fix processHeapClosureForDead CONSTR_NOCAF case CONSTR_NOCAF was introduced with 55d535da10d as a replacement for CONSTR_STATIC and CONSTR_NOCAF_STATIC, however, as explained in Note [static constructors], we copy CONSTR_NOCAFs (which can also be seen in evacuate) during GC, and they can become dead, like other CONSTR_X_Ys. processHeapClosureForDead is updated to reflect this. Test Plan: Validates on x86_64. Existing failures on i386. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #7836, #15063, #15087, #15165 Differential Revision: https://phabricator.haskell.org/D4928 (cherry picked from commit 2625f1310edeff62eb3876cc6efbe105a80fe4ad) >--------------------------------------------------------------- 30a4bcc3fc3a434b3b6ab64289934281591ce09a rts/LdvProfile.c | 5 ++++- testsuite/tests/profiling/should_run/all.T | 3 +-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c index 9499fdb..608961e 100644 --- a/rts/LdvProfile.c +++ b/rts/LdvProfile.c @@ -101,6 +101,7 @@ processHeapClosureForDead( const StgClosure *c ) case CONSTR_2_0: case CONSTR_1_1: case CONSTR_0_2: + case CONSTR_NOCAF: case FUN: case FUN_1_0: case FUN_0_1: @@ -130,7 +131,6 @@ processHeapClosureForDead( const StgClosure *c ) case IND_STATIC: case FUN_STATIC: case THUNK_STATIC: - case CONSTR_NOCAF: // stack objects case UPDATE_FRAME: case CATCH_FRAME: @@ -139,6 +139,9 @@ processHeapClosureForDead( const StgClosure *c ) case RET_BCO: case RET_SMALL: case RET_BIG: + case CATCH_STM_FRAME: + case CATCH_RETRY_FRAME: + case ATOMICALLY_FRAME: // others case INVALID_OBJECT: case COMPACT_NFDATA: diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 5ee45c3..8d605f2 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -34,8 +34,7 @@ test('T3001', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['']) test('T3001-2', - [only_ways(['prof_hb']), extra_ways(['prof_hb']), - when(wordsize(32), expect_broken(15063))], + [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['-package bytestring']) # For profasm/profthreaded, the answer is correct but the ordering of some From git at git.haskell.org Sat Jul 14 18:58:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 14 Jul 2018 18:58:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix deadlock between STM and throwTo (1cdc3ec) Message-ID: <20180714185806.14F173ABA7@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/1cdc3ecccd087f5be2e3cdfa6827f7cee57a8206/ghc >--------------------------------------------------------------- commit 1cdc3ecccd087f5be2e3cdfa6827f7cee57a8206 Author: Simon Marlow Date: Thu Jul 12 10:13:47 2018 -0400 Fix deadlock between STM and throwTo There was a lock-order reversal between lockTSO() and the TVar lock, see #15136 for the details. It turns out we can fix this pretty easily by just deleting all the locking code(!). The principle for unblocking a `BlockedOnSTM` thread then becomes the same as for other kinds of blocking: if the TSO belongs to this capability then we do it directly, otherwise we send a message to the capability that owns the TSO. That is, a thread blocked on STM is owned by its capability, as it should be. The possible downside of this is that we might send multiple messages to wake up a thread when the thread is on another capability. This is safe, it's just not very efficient. I'll try to do some experiments to see if this is a problem. Test Plan: Test case from #15136 doesn't deadlock any more. Reviewers: bgamari, osa1, erikd Reviewed By: osa1 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15136 Differential Revision: https://phabricator.haskell.org/D4956 (cherry picked from commit 7fc418df856d9b58034eeec48915646e67a7a562) >--------------------------------------------------------------- 1cdc3ecccd087f5be2e3cdfa6827f7cee57a8206 rts/RaiseAsync.c | 9 --------- rts/SMPClosureOps.h | 9 --------- rts/STM.c | 19 +------------------ rts/Threads.c | 5 ++++- rts/sm/Sanity.c | 3 ++- 5 files changed, 7 insertions(+), 38 deletions(-) diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index f5e96a2..b08acc4 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -416,21 +416,12 @@ check_target: } case BlockedOnSTM: - lockTSO(target); - // Unblocking BlockedOnSTM threads requires the TSO to be - // locked; see STM.c:unpark_tso(). - if (target->why_blocked != BlockedOnSTM) { - unlockTSO(target); - goto retry; - } if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { blockedThrowTo(cap,target,msg); - unlockTSO(target); return THROWTO_BLOCKED; } else { raiseAsync(cap, target, msg->exception, false, NULL); - unlockTSO(target); return THROWTO_SUCCESS; } diff --git a/rts/SMPClosureOps.h b/rts/SMPClosureOps.h index 1d18e1b..c73821a 100644 --- a/rts/SMPClosureOps.h +++ b/rts/SMPClosureOps.h @@ -124,15 +124,6 @@ EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info) p->header.info = info; } -// Handy specialised versions of lockClosure()/unlockClosure() -INLINE_HEADER void lockTSO(StgTSO *tso); -INLINE_HEADER void lockTSO(StgTSO *tso) -{ lockClosure((StgClosure *)tso); } - -INLINE_HEADER void unlockTSO(StgTSO *tso); -INLINE_HEADER void unlockTSO(StgTSO *tso) -{ unlockClosure((StgClosure*)tso, (const StgInfoTable *)&stg_TSO_info); } - #endif /* CMINUSMINUS */ #include "EndPrivate.h" diff --git a/rts/STM.c b/rts/STM.c index 058eec7..abb4417 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -332,24 +332,7 @@ static void unpark_tso(Capability *cap, StgTSO *tso) { // queues: it's up to the thread itself to remove it from the wait queues // if it decides to do so when it is scheduled. - // Unblocking a TSO from BlockedOnSTM is done under the TSO lock, - // to avoid multiple CPUs unblocking the same TSO, and also to - // synchronise with throwTo(). The first time the TSO is unblocked - // we mark this fact by setting block_info.closure == STM_AWOKEN. - // This way we can avoid sending further wakeup messages in the - // future. - lockTSO(tso); - if (tso->why_blocked == BlockedOnSTM && - tso->block_info.closure == &stg_STM_AWOKEN_closure) { - TRACE("unpark_tso already woken up tso=%p", tso); - } else if (tso -> why_blocked == BlockedOnSTM) { - TRACE("unpark_tso on tso=%p", tso); - tso->block_info.closure = &stg_STM_AWOKEN_closure; - tryWakeupThread(cap,tso); - } else { - TRACE("spurious unpark_tso on tso=%p", tso); - } - unlockTSO(tso); + tryWakeupThread(cap,tso); } static void unpark_waiters_on(Capability *cap, StgTVar *s) { diff --git a/rts/Threads.c b/rts/Threads.c index be69622..78c5b6c 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -297,8 +297,11 @@ tryWakeupThread (Capability *cap, StgTSO *tso) goto unblock; } - case BlockedOnBlackHole: case BlockedOnSTM: + tso->block_info.closure = &stg_STM_AWOKEN_closure; + goto unblock; + + case BlockedOnBlackHole: case ThreadMigrating: goto unblock; diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c index e5a22fd..8d4171b 100644 --- a/rts/sm/Sanity.c +++ b/rts/sm/Sanity.c @@ -547,7 +547,8 @@ checkTSO(StgTSO *tso) ASSERT(next == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || info == &stg_TSO_info || - info == &stg_WHITEHOLE_info); // happens due to STM doing lockTSO() + info == &stg_WHITEHOLE_info); // used to happen due to STM doing + // lockTSO(), might not happen now if ( tso->why_blocked == BlockedOnMVar || tso->why_blocked == BlockedOnMVarRead From git at git.haskell.org Sun Jul 15 00:03:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 00:03:07 +0000 (UTC) Subject: [commit: ghc] master: Optimise wakeups for STM (502640c) Message-ID: <20180715000307.590653A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/502640c90c3d0fbb6c46257be14fdc7e3c694c6c/ghc >--------------------------------------------------------------- commit 502640c90c3d0fbb6c46257be14fdc7e3c694c6c Author: Simon Marlow Date: Sat Jul 14 20:02:03 2018 -0400 Optimise wakeups for STM Avoids repeated wakeup messages being sent when a TVar is written to multiple times. See comments for details. Test Plan: * Test from #15136 (will be added to stm shortly) * existing stm tests Reviewers: bgamari, osa1, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15136 Differential Revision: https://phabricator.haskell.org/D4961 >--------------------------------------------------------------- 502640c90c3d0fbb6c46257be14fdc7e3c694c6c rts/STM.c | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/rts/STM.c b/rts/STM.c index abb4417..976ad87 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -332,7 +332,29 @@ static void unpark_tso(Capability *cap, StgTSO *tso) { // queues: it's up to the thread itself to remove it from the wait queues // if it decides to do so when it is scheduled. - tryWakeupThread(cap,tso); + // Only the capability that owns this TSO may unblock it. We can + // call tryWakeupThread() which will either unblock it directly if + // it belongs to this cap, or send a message to the owning cap + // otherwise. + + // But we don't really want to send multiple messages if we write + // to the same TVar multiple times, and the owning cap hasn't yet + // woken up the thread and removed it from the TVar's watch list. + // So, we use the tso->block_info as a flag to indicate whether + // we've already done tryWakeupThread() for this thread. + + // Safety Note: we hold the TVar lock at this point, so we know + // that this thread is definitely still blocked, since the first + // thing a thread will do when it runs is remove itself from the + // TVar watch queues, and to do that it would need to lock the + // TVar. + + if (tso->block_info.closure != &stg_STM_AWOKEN_closure) { + // safe to do a non-atomic test-and-set here, because it's + // fine if we do multiple tryWakeupThread()s. + tso->block_info.closure = &stg_STM_AWOKEN_closure; + tryWakeupThread(cap,tso); + } } static void unpark_waiters_on(Capability *cap, StgTVar *s) { From git at git.haskell.org Sun Jul 15 01:27:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 01:27:49 +0000 (UTC) Subject: [commit: ghc] master: Remove ASSERTion about increasing TcLevels (a754a42) Message-ID: <20180715012749.EECFB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a754a420b53cd2210ef60dcd695bf3334af2e400/ghc >--------------------------------------------------------------- commit a754a420b53cd2210ef60dcd695bf3334af2e400 Author: Richard Eisenberg Date: Thu Jul 12 16:10:34 2018 -0400 Remove ASSERTion about increasing TcLevels This removes an ASSERTion that TcLevels should increase by exactly one in every implication. While this is a sensible goal, it's not true today, and we should not be crippling DEBUG for everyone while debugging this. The ASSERT was added in 261dd83cacec71edd551e9c581d05285c9ea3226 >--------------------------------------------------------------- a754a420b53cd2210ef60dcd695bf3334af2e400 compiler/typecheck/TcSimplify.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 13a3f73..c57ef56 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1495,7 +1495,8 @@ solveImplication imp@(Implic { ic_tclvl = tclvl = do { inerts <- getTcSInerts ; traceTcS "solveImplication {" (ppr imp $$ text "Inerts" <+> ppr inerts) - ; when debugIsOn check_tc_level + -- commented out; see `where` clause below + -- ; when debugIsOn check_tc_level -- Solve the nested constraints ; (no_given_eqs, given_insols, residual_wanted) @@ -1544,10 +1545,15 @@ solveImplication imp@(Implic { ic_tclvl = tclvl -- TcLevels must be strictly increasing (see (ImplicInv) in -- Note [TcLevel and untouchable type variables] in TcType), -- and in fact I thinkthey should always increase one level at a time. + + -- Though sensible, this check causes lots of testsuite failures. It is + -- remaining commented out for now. + {- check_tc_level = do { cur_lvl <- TcS.getTcLevel ; MASSERT2( tclvl == pushTcLevel cur_lvl , text "Cur lvl =" <+> ppr cur_lvl $$ text "Imp lvl =" <+> ppr tclvl ) } + -} ---------------------- setImplicationStatus :: Implication -> TcS (Maybe Implication) From git at git.haskell.org Sun Jul 15 01:27:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 01:27:52 +0000 (UTC) Subject: [commit: ghc] master: Don't mkNakedCastTy on something unsaturated (15ce9b4) Message-ID: <20180715012752.C14DD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15ce9b45515415b0cbe606e9324a7858c9009c0b/ghc >--------------------------------------------------------------- commit 15ce9b45515415b0cbe606e9324a7858c9009c0b Author: Richard Eisenberg Date: Thu Jul 12 18:45:09 2018 -0400 Don't mkNakedCastTy on something unsaturated A recent commit added extra calls to mkNakedCastTy to satisfy Note [The tcType invariant]. However, some of these casts were being applied to unsaturated type family applications, which caused ASSERTion failures in TcFlatten later on. This patch is more judicious in using mkNakedCastTy to avoid this problem. >--------------------------------------------------------------- 15ce9b45515415b0cbe606e9324a7858c9009c0b compiler/typecheck/TcHsType.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 3032e07..c9c3347 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1211,8 +1211,16 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ; let (tc_kind_bndrs, tc_inner_ki) = splitPiTysInvisible tc_kind ; (tc_args, kind) <- instantiateTyN Nothing (length (tyConBinders tc_tc)) tc_kind_bndrs tc_inner_ki - ; let tc_ty = mkNakedTyConApp tc tc_args `mkNakedCastTy` mkRepReflCo kind - -- mkNakedCastTy is for (IT5) of Note [The tcType invariant] + ; let is_saturated = tc_args `lengthAtLeast` tyConArity tc_tc + tc_ty + | is_saturated = mkNakedTyConApp tc tc_args `mkNakedCastTy` mkRepReflCo kind + -- mkNakedCastTy is for (IT5) of Note [The tcType invariant] + | otherwise = mkNakedTyConApp tc tc_args + -- if the tycon isn't yet saturated, then we don't want mkNakedCastTy, + -- because that means we'll have an unsaturated type family + -- We don't need it anyway, because we can be sure that the + -- type family kind will accept further arguments (because it is + -- not yet saturated) -- tc and tc_ty must not be traced here, because that would -- force the evaluation of a potentially knot-tied variable (tc), -- and the typechecker would hang, as per #11708 @@ -2742,7 +2750,7 @@ tcLHsKindSig ctxt hs_kind -- Result is zonked = do { kind <- solveLocalEqualities $ tc_lhs_kind kindLevelMode hs_kind - ; traceTc "tcLHsKindSig" (ppr kind) + ; traceTc "tcLHsKindSig" (ppr hs_kind $$ ppr kind) ; kind <- zonkPromoteType kind -- This zonk is very important in the case of higher rank kinds -- E.g. Trac #13879 f :: forall (p :: forall z (y::z). ). From git at git.haskell.org Sun Jul 15 01:27:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 01:27:55 +0000 (UTC) Subject: [commit: ghc] master: Make some tests robust against DEBUG compiler (b7d6002) Message-ID: <20180715012755.9B7A83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7d60022bfcfdeb5e27ba5a0575b2c229b36e21b/ghc >--------------------------------------------------------------- commit b7d60022bfcfdeb5e27ba5a0575b2c229b36e21b Author: Richard Eisenberg Date: Thu Jul 12 16:21:54 2018 -0400 Make some tests robust against DEBUG compiler Several tests were failing in DEBUG mode, but fixing this was easy: just pass $(TEST_HC_OPTS) in the relevant Makefiles. >--------------------------------------------------------------- b7d60022bfcfdeb5e27ba5a0575b2c229b36e21b testsuite/tests/backpack/cabal/T14304/Makefile | 2 +- testsuite/tests/backpack/cabal/bkpcabal01/Makefile | 2 +- testsuite/tests/backpack/cabal/bkpcabal02/Makefile | 2 +- testsuite/tests/backpack/cabal/bkpcabal03/Makefile | 2 +- testsuite/tests/backpack/cabal/bkpcabal04/Makefile | 2 +- testsuite/tests/backpack/cabal/bkpcabal05/Makefile | 2 +- testsuite/tests/backpack/cabal/bkpcabal06/Makefile | 2 +- testsuite/tests/backpack/cabal/bkpcabal07/Makefile | 2 +- testsuite/tests/cabal/T12733/Makefile | 2 +- testsuite/tests/cabal/cabal01/Makefile | 2 +- testsuite/tests/cabal/cabal03/Makefile | 2 +- testsuite/tests/cabal/cabal04/Makefile | 2 +- testsuite/tests/cabal/cabal05/Makefile | 2 +- testsuite/tests/cabal/cabal06/Makefile | 2 +- testsuite/tests/cabal/cabal08/Makefile | 2 +- testsuite/tests/cabal/cabal09/Makefile | 2 +- testsuite/tests/driver/T3007/Makefile | 4 ++-- testsuite/tests/patsyn/should_compile/T13350/Makefile | 2 +- testsuite/tests/safeHaskell/check/pkg01/Makefile | 18 +++++++++--------- testsuite/tests/typecheck/T13168/Makefile | 2 +- testsuite/tests/typecheck/bug1465/Makefile | 2 +- 21 files changed, 30 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b7d60022bfcfdeb5e27ba5a0575b2c229b36e21b From git at git.haskell.org Sun Jul 15 01:27:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 01:27:58 +0000 (UTC) Subject: [commit: ghc] master: Move check for dcUserTyVarBinders invariant (fe0fa63) Message-ID: <20180715012758.73D933A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe0fa63ebe63862e5515a0deaf25f63825c238db/ghc >--------------------------------------------------------------- commit fe0fa63ebe63862e5515a0deaf25f63825c238db Author: Richard Eisenberg Date: Thu Jul 12 17:48:39 2018 -0400 Move check for dcUserTyVarBinders invariant Previously, this check was done in mkDataCon. But this sometimes caused assertion failures if an invalid data con was made. I've moved the check to checkValidDataCon, where we can be sure the datacon is otherwise valid first. >--------------------------------------------------------------- fe0fa63ebe63862e5515a0deaf25f63825c238db compiler/basicTypes/DataCon.hs | 19 +++---------------- compiler/typecheck/TcTyClsDecls.hs | 19 +++++++++++++++++++ 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 5e7b4cb..f174130 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -87,7 +87,6 @@ import qualified Data.Data as Data import Data.Char import Data.Word import Data.List( find ) -import qualified Data.Set as Set {- Data constructor representation @@ -887,24 +886,12 @@ mkDataCon name declared_infix prom_info = con where is_vanilla = null ex_tvs && null eq_spec && null theta - -- Check the dcUserTyVarBinders invariant - -- (see Note [DataCon user type variable binders]) - user_tvbs_invariant = - Set.fromList (filterEqSpec eq_spec univ_tvs ++ ex_tvs) - == Set.fromList (binderVars user_tvbs) - user_tvbs' = - ASSERT2( user_tvbs_invariant - , (vcat [ ppr name - , ppr univ_tvs - , ppr ex_tvs - , ppr eq_spec - , ppr user_tvbs ]) ) - user_tvbs + con = MkData {dcName = name, dcUnique = nameUnique name, dcVanilla = is_vanilla, dcInfix = declared_infix, dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, - dcUserTyVarBinders = user_tvbs', + dcUserTyVarBinders = user_tvbs, dcEqSpec = eq_spec, dcOtherTheta = theta, dcStupidTheta = stupid_theta, @@ -937,7 +924,7 @@ mkDataCon name declared_infix prom_info -- See Note [Promoted data constructors] in TyCon prom_tv_bndrs = [ mkNamedTyConBinder vis tv - | TvBndr tv vis <- user_tvbs' ] + | TvBndr tv vis <- user_tvbs ] prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys) prom_res_kind = orig_res_ty diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 308fbb9..bb350a7 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -76,6 +76,8 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.List import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.Set as Set + {- ************************************************************************ @@ -2720,6 +2722,23 @@ checkValidDataCon dflags existential_ok tc con -- data T = MkT {-# UNPACK #-} !a -- Can't unpack ; zipWith3M_ check_bang (dataConSrcBangs con) (dataConImplBangs con) [1..] + -- Check the dcUserTyVarBinders invariant + -- See Note [DataCon user type variable binders] in DataCon + -- checked here because we sometimes build invalid DataCons before + -- erroring above here + ; when debugIsOn $ + do { let (univs, exs, eq_spec, _, _, _) = dataConFullSig con + user_tvs = dataConUserTyVars con + user_tvbs_invariant + = Set.fromList (filterEqSpec eq_spec univs ++ exs) + == Set.fromList user_tvs + ; MASSERT2( user_tvbs_invariant + , vcat ([ ppr con + , ppr univs + , ppr exs + , ppr eq_spec + , ppr user_tvs ])) } + ; traceTc "Done validity of data con" $ vcat [ ppr con , text "Datacon user type:" <+> ppr (dataConUserType con) From git at git.haskell.org Sun Jul 15 01:28:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 01:28:01 +0000 (UTC) Subject: [commit: ghc] master: Reclassify some performance tests (8a70ccb) Message-ID: <20180715012801.4B56F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a70ccbb552191e1972f3c5d7fce839176c4c0e3/ghc >--------------------------------------------------------------- commit 8a70ccbb552191e1972f3c5d7fce839176c4c0e3 Author: Richard Eisenberg Date: Sat Jul 14 15:43:01 2018 -0400 Reclassify some performance tests There were some performance tests not classified by compiler_num_stats_field, causing erroneous failures when testing a DEBUG compiler. This fixes that oversight, addressing #15374. >--------------------------------------------------------------- 8a70ccbb552191e1972f3c5d7fce839176c4c0e3 testsuite/tests/perf/should_run/all.T | 2 +- testsuite/tests/pmcheck/should_compile/all.T | 24 ++++++++++++++++++++---- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 0e7996ef..a8107c4 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -562,7 +562,7 @@ test('T13623', ['-O2']) test('T14052', - [stats_num_field('bytes allocated', + [compiler_stats_num_field('bytes allocated', [ (wordsize(64), 2346183840, 15) ])], ghci_script, ['T14052.script']) diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T index db6e726..e382e3f 100644 --- a/testsuite/tests/pmcheck/should_compile/all.T +++ b/testsuite/tests/pmcheck/should_compile/all.T @@ -37,10 +37,26 @@ test('T9951b', [], compile, test('T9951', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11303', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11276', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11303b', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11374', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11195', compile_timeout_multiplier(0.60), compile, ['-package ghc -fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M2G -RTS']) +test('T11276', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 165890392, 10)] + # 2018-07-14: 165890392 INITIAL + ), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) + +test('T11303b', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 54373936, 10)] + # 2018-07-14: 54373936 INITIAL + ), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) + +test('T11374', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 280144864, 10)] + # 2018-07-14: 280144864 INITIAL + ), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) + +test('T11195', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 7852567480, 10)] + # 2018-07-14: 7852567480 INITIAL + ), compile, ['-package ghc -fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M2G -RTS']) + test('T11984', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T14086', normal, compile, From git at git.haskell.org Sun Jul 15 01:28:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 01:28:04 +0000 (UTC) Subject: [commit: ghc] master: Disable -fghci-leak-check in DEBUG mode (6d55e36) Message-ID: <20180715012804.2B19C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d55e36f6d4b71402b3a27cd466d237034d3a5b8/ghc >--------------------------------------------------------------- commit 6d55e36f6d4b71402b3a27cd466d237034d3a5b8 Author: Richard Eisenberg Date: Sat Jul 14 15:27:48 2018 -0400 Disable -fghci-leak-check in DEBUG mode The DEBUG compiler's GHCi still leaks. This commit suppresses testsuite failures due to this leak. See #15372. >--------------------------------------------------------------- 6d55e36f6d4b71402b3a27cd466d237034d3a5b8 testsuite/config/ghc | 2 +- testsuite/driver/testlib.py | 3 ++- testsuite/tests/ghci/scripts/T9293.stdout | 4 ---- testsuite/tests/ghci/scripts/all.T | 16 ++++++++++++++-- testsuite/tests/ghci/scripts/ghci057.stdout | 4 ---- 5 files changed, 17 insertions(+), 12 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index f41f372..a850be9 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -80,7 +80,7 @@ config.way_flags = { 'prof_no_auto' : ['-prof', '-static', '-fasm'], 'profasm' : ['-O', '-prof', '-static', '-fprof-auto'], 'profthreaded' : ['-O', '-prof', '-static', '-fprof-auto', '-threaded'], - 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '-fghci-leak-check', '+RTS', '-I0.1', '-RTS'], + 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '+RTS', '-I0.1', '-RTS'] + (['-fghci-leak-check'] if not config.compiler_debugged else []), 'sanity' : ['-debug'], 'threaded1' : ['-threaded', '-debug'], 'threaded1_ls' : ['-threaded', '-debug'], diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index dac2684..f7863c3 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -970,8 +970,9 @@ def ghci_script( name, way, script): # We pass HC and HC_OPTS as environment variables, so that the # script can invoke the correct compiler by using ':! $HC $HC_OPTS' - cmd = ('HC={{compiler}} HC_OPTS="{flags}" {{compiler}} {flags} {way_flags}' + cmd = ('HC={{compiler}} HC_OPTS="{flags}" {{compiler}} {way_flags} {flags}' ).format(flags=flags, way_flags=way_flags) + # NB: put way_flags before flags so that flags in all.T can overrie others getTestOpts().stdin = script return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout index 4fdd350..2e5adc4 100644 --- a/testsuite/tests/ghci/scripts/T9293.stdout +++ b/testsuite/tests/ghci/scripts/T9293.stdout @@ -10,7 +10,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: @@ -30,7 +29,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: @@ -49,7 +47,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: @@ -70,7 +67,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 8954594..b054be9 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -1,5 +1,12 @@ # coding=utf8 +# Note [Disabling ghci-leak-check] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# The -fno-ghci-leak-check is because this test prints the current GHC settings +# and the ghci-leak-check is turned off in DEBUG mode. See #15372. So we need to +# turn it off in non-DEBUG mode, too, so that one stdout works for both modes. +# After #15372 is fully fixed, these "extra_hc_opts" should be removed. + test('ghci001', combined_output, ghci_script, ['ghci001.script']) test('ghci002', combined_output, ghci_script, ['ghci002.script']) test('ghci003', combined_output, ghci_script, ['ghci003.script']) @@ -91,7 +98,9 @@ test('ghci056', extra_run_opts('ghci056_c.o')], ghci_script, ['ghci056.script']) -test('ghci057', normal, ghci_script, ['ghci057.script']) +test('ghci057', extra_hc_opts("-fno-ghci-leak-check"), ghci_script, ['ghci057.script']) + # See Note [Disabling ghci-leak-check] + test('ghci060', normal, ghci_script, ['ghci060.script']) test('ghci061', normal, ghci_script, ['ghci061.script']) test('ghci062', [extra_files(['ghci062/', 'ghci062/Test.hs']), @@ -190,7 +199,10 @@ test('T9181', normal, ghci_script, ['T9181.script']) test('T9086b', normal, ghci_script, ['T9086b.script']) test('T9140', combined_output, ghci_script, ['T9140.script']) test('T9658', normal, ghci_script, ['T9658.script']) -test('T9293', extra_files(['ghci057.hs']), ghci_script, ['T9293.script']) + +test('T9293', [extra_hc_opts('-fno-ghci-leak-check'), extra_files(['ghci057.hs'])], ghci_script, ['T9293.script']) + # See Note [Disabling ghci-leak-check] + test('T9762', [ unless(have_dynamic(),skip) , pre_cmd('$MAKE -s --no-print-directory T9762_prep') diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout index 4fdd350..2e5adc4 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stdout +++ b/testsuite/tests/ghci/scripts/ghci057.stdout @@ -10,7 +10,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: @@ -30,7 +29,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: @@ -49,7 +47,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: @@ -70,7 +67,6 @@ other dynamic, non-language, flag settings: -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history - -fghci-leak-check -fimplicit-import-qualified -fshow-warning-groups warning settings: From git at git.haskell.org Sun Jul 15 14:17:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 14:17:32 +0000 (UTC) Subject: [commit: ghc] master: Replace atomicModifyMutVar# (af9b744) Message-ID: <20180715141732.205D43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af9b744bbf1c39078e561b19edd3c5234b361b27/ghc >--------------------------------------------------------------- commit af9b744bbf1c39078e561b19edd3c5234b361b27 Author: David Feuer Date: Sun Jul 15 10:15:15 2018 -0400 Replace atomicModifyMutVar# Reviewers: simonmar, hvr, bgamari, erikd, fryguybob, rrnewton Reviewed By: simonmar Subscribers: fryguybob, rwbarton, thomie, carter GHC Trac Issues: #15364 Differential Revision: https://phabricator.haskell.org/D4884 >--------------------------------------------------------------- af9b744bbf1c39078e561b19edd3c5234b361b27 compiler/prelude/primops.txt.pp | 34 ++++++--- includes/stg/MiscClosures.h | 3 +- libraries/base/Data/IORef.hs | 23 ++----- libraries/base/GHC/Conc/Windows.hs | 13 ++-- libraries/base/GHC/Event/Control.hs | 2 +- libraries/base/GHC/Exts.hs | 27 ++++++++ libraries/base/GHC/ForeignPtr.hs | 9 +-- libraries/base/GHC/IORef.hs | 125 ++++++++++++++++++++++++++++++++-- libraries/base/System/IO.hs | 2 +- rts/PrimOps.cmm | 71 +++++++++++++++---- rts/RtsSymbols.c | 3 +- testsuite/tests/perf/should_run/all.T | 3 +- 12 files changed, 255 insertions(+), 60 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc af9b744bbf1c39078e561b19edd3c5234b361b27 From git at git.haskell.org Sun Jul 15 17:38:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jul 2018 17:38:09 +0000 (UTC) Subject: [commit: ghc] master: TTG typo: XFieldOcc should be XCFieldOcc (9269541) Message-ID: <20180715173809.1606B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/926954196f9ffd7b89cba53061b39ef996e1650c/ghc >--------------------------------------------------------------- commit 926954196f9ffd7b89cba53061b39ef996e1650c Author: Alan Zimmerman Date: Sun Jul 15 19:35:51 2018 +0200 TTG typo: XFieldOcc should be XCFieldOcc In the following data FieldOcc pass = FieldOcc { extFieldOcc :: XFieldOcc pass , rdrNameFieldOcc :: Located RdrName -- ^ See Note [Located RdrNames] in HsExpr } | XFieldOcc (XXFieldOcc pass) we are using XFieldOcc for both the extFieldOcc type and the extra constructor. The first one should be XCFieldOcc Updates haddock submodule closes #15386 >--------------------------------------------------------------- 926954196f9ffd7b89cba53061b39ef996e1650c compiler/hsSyn/HsExtension.hs | 4 ++-- compiler/hsSyn/HsPat.hs | 4 ++-- compiler/hsSyn/HsTypes.hs | 12 ++++++------ utils/haddock | 2 +- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index a23b973..a7c467d 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -973,11 +973,11 @@ type ForallXConDeclField (c :: * -> Constraint) (x :: *) = -- --------------------------------------------------------------------- -type family XFieldOcc x +type family XCFieldOcc x type family XXFieldOcc x type ForallXFieldOcc (c :: * -> Constraint) (x :: *) = - ( c (XFieldOcc x) + ( c (XCFieldOcc x) , c (XXFieldOcc x) ) diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 866b0e2..faefb84 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -444,14 +444,14 @@ data HsRecField' id arg = HsRecField { -- -- See also Note [Disambiguating record fields] in TcExpr. -hsRecFields :: HsRecFields p arg -> [XFieldOcc p] +hsRecFields :: HsRecFields p arg -> [XCFieldOcc p] hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds) -- Probably won't typecheck at once, things have changed :/ hsRecFieldsArgs :: HsRecFields p arg -> [arg] hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds) -hsRecFieldSel :: HsRecField pass arg -> Located (XFieldOcc pass) +hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass) hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl hsRecFieldId :: HsRecField GhcTc arg -> Located Id diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 8a1f33f..8c5387d 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -1169,19 +1169,19 @@ type LFieldOcc pass = Located (FieldOcc pass) -- Represents an *occurrence* of an unambiguous field. We store -- both the 'RdrName' the user originally wrote, and after the -- renamer, the selector function. -data FieldOcc pass = FieldOcc { extFieldOcc :: XFieldOcc pass +data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass , rdrNameFieldOcc :: Located RdrName -- ^ See Note [Located RdrNames] in HsExpr } | XFieldOcc (XXFieldOcc pass) -deriving instance (p ~ GhcPass pass, Eq (XFieldOcc p)) => Eq (FieldOcc p) -deriving instance (p ~ GhcPass pass, Ord (XFieldOcc p)) => Ord (FieldOcc p) +deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq (FieldOcc p) +deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p) -type instance XFieldOcc GhcPs = NoExt -type instance XFieldOcc GhcRn = Name -type instance XFieldOcc GhcTc = Id +type instance XCFieldOcc GhcPs = NoExt +type instance XCFieldOcc GhcRn = Name +type instance XCFieldOcc GhcTc = Id type instance XXFieldOcc (GhcPass _) = NoExt diff --git a/utils/haddock b/utils/haddock index 3266a96..e3926b5 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 3266a962f7b6083b4b48cb66e70c62e3157df930 +Subproject commit e3926b50ab8a7269fd6904b06e881745f08bc5d6 From git at git.haskell.org Mon Jul 16 14:29:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 14:29:45 +0000 (UTC) Subject: [commit: ghc] master: Fix parse errors in core-spec.pdf (8b6a9e5) Message-ID: <20180716142945.BADB43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b6a9e5575fc848dc03b50b415aa57447654662f/ghc >--------------------------------------------------------------- commit 8b6a9e5575fc848dc03b50b415aa57447654662f Author: Ryan Scott Date: Mon Jul 16 09:51:18 2018 -0400 Fix parse errors in core-spec.pdf Summary: `core-spec.pdf` was emitting parse errors due to not specifying role arguments in some uses of `nth`. This patch adds those role arguments. (Credit goes to Richard Eisenberg for actually figuring out what said arguments should be.) Test Plan: Read it Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15373 Differential Revision: https://phabricator.haskell.org/D4965 >--------------------------------------------------------------- 8b6a9e5575fc848dc03b50b415aa57447654662f docs/core-spec/CoreSyn.ott | 3 +++ docs/core-spec/OpSem.ott | 29 ++++++++++++++++++++++------- docs/core-spec/core-spec.pdf | Bin 355711 -> 354450 bytes 3 files changed, 25 insertions(+), 7 deletions(-) diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott index c8615ad..57ed6e2 100644 --- a/docs/core-spec/CoreSyn.ott +++ b/docs/core-spec/CoreSyn.ott @@ -275,6 +275,7 @@ ind, I {{ tex i }} :: 'Ind_' ::= {{ com Indices, numbers }} | 0 :: M :: zero | 1 :: M :: one | 2 :: M :: two + | 3 :: M :: three terms :: 'Terms_' ::= {{ com List of terms }} | :: :: List @@ -388,6 +389,7 @@ terminals :: 'terminals_' ::= | validDcRoles :: :: validDcRoles {{ tex \textsf{validDcRoles} }} | --> :: :: steps {{ tex \longrightarrow }} | coercionKind :: :: coercionKind {{ tex \textsf{coercionKind} }} + | coercionRole :: :: coercionRole {{ tex \textsf{coercionRole} }} | take :: :: take {{ tex \textsf{take}\! }} | coaxrProves :: :: coaxrProves {{ tex \textsf{coaxrProves} }} | Just :: :: Just {{ tex \textsf{Just} }} @@ -465,6 +467,7 @@ formula :: 'formula_' ::= | no other case matches :: :: no_other_case {{ tex \text{no other case matches} }} | t = coercionKind g :: :: coercionKind + | R = coercionRole g :: :: coercionRole | Just ( t1 , t2 ) = coaxrProves mu :: :: coaxrProves | mu1 = mu2 :: :: mu_rewrite diff --git a/docs/core-spec/OpSem.ott b/docs/core-spec/OpSem.ott index 03be476..efed85a 100644 --- a/docs/core-spec/OpSem.ott +++ b/docs/core-spec/OpSem.ott @@ -34,8 +34,12 @@ e1 e2 --> e1' e2 ----------------------------- :: Beta (\n.e1) e2 --> e1[n |-> e2] -g0 = sym (nth 0 g) -g1 = nth 1 g +% g : (t1 -> t2) ~Rep# (t3 -> t4) +% e2 : t3 +% g0 : t3 ~Rep# t1 +% g1 : t2 ~Rep# t4 +g0 = sym (nth Rep 2 g) +g1 = nth Rep 3 g not e2 is_a_type not e2 is_a_coercion ----------------------------------------------- :: Push @@ -44,9 +48,19 @@ not e2 is_a_coercion ---------------------------------------- :: TPush ((\n.e) |> g) t --> (\n.(e |> g n)) t -g0 = nth 1 (nth 0 g) -g1 = sym (nth 2 (nth 0 g)) -g2 = nth 1 g +% g : ((t1 ~rho# t2) -> t3) ~Rep# ((t4 ~rho# t5) -> t6) +% g2 : t3 ~Rep# t6 +% g' : t4 ~rho# t5 +% g0 : t1 ~rho# t4 +% g1 : t5 ~rho# t2 +% recall that (->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> Type +% and that (~#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[]) +% so pulling out the first visible argument for both is argument 2, +% and the second visible argument for both is argument 3 +R = coercionRole g' +g0 = nth R 2 (nth Rep 2 g) +g1 = sym (nth R 3 (nth Rep 2 g)) +g2 = nth Rep 3 g ------------------------------- :: CPush ((\n.e) |> g) g' --> (\n.e |> g2) (g0 ; g' ; g1) @@ -80,9 +94,10 @@ no other case matches ------------------------------------------------------------ :: MatchDefault case e as n return t of --> u[n |-> e] -T k'~#k T = coercionKind g +T k'~Rep# k T = coercionKind g + = tyConRoles T forall . forall . $ -> T = dataConRepType K - (t1cc $ nth aa g] // aa /> _Nom] // bb />) // cc /> + (t1cc $ nth Raa aa g] // aa /> _Nom] // bb />) // cc /> --------------------------- :: CasePush case (K ) |> g as n return t2 of --> \\ case K as n return t2 of diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf index 372a18d..97694dc 100644 Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ From git at git.haskell.org Mon Jul 16 14:33:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 14:33:43 +0000 (UTC) Subject: [commit: ghc] master: Fix space leaks (71f6b18) Message-ID: <20180716143343.CD4DB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/71f6b18ba365da9ee4795f6cbce6ec9f1bfe95e8/ghc >--------------------------------------------------------------- commit 71f6b18ba365da9ee4795f6cbce6ec9f1bfe95e8 Author: Simon Marlow Date: Mon Jun 18 17:18:10 2018 +0100 Fix space leaks Summary: All these were detected by -fghci-leak-check when GHC was compiled *without* optimisation (e.g. using the "quick" build flavour). Unfortunately I don't know of a good way to keep this working. I'd like to just disable the -fghci-leak-check flag when the compiler is built without optimisation, but it doesn't look like we have an easy way to do that. And even if we could, it would be fragile anyway, Test Plan: `cd testsuite/tests/ghci; make` Reviewers: bgamari, hvr, erikd, tdammers Subscribers: tdammers, rwbarton, thomie, carter GHC Trac Issues: #15246 Differential Revision: https://phabricator.haskell.org/D4872 >--------------------------------------------------------------- 71f6b18ba365da9ee4795f6cbce6ec9f1bfe95e8 compiler/ghci/Linker.hs | 33 +++++++++++++++++++-------------- compiler/iface/IfaceEnv.hs | 7 ++++--- compiler/main/DriverPipeline.hs | 4 ++-- compiler/main/HscTypes.hs | 6 +++--- compiler/typecheck/TcRnMonad.hs | 9 +++++---- compiler/utils/IOEnv.hs | 2 +- ghc/GHCi/UI.hs | 7 ++++--- testsuite/tests/perf/compiler/all.T | 9 ++++++--- 8 files changed, 44 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 71f6b18ba365da9ee4795f6cbce6ec9f1bfe95e8 From git at git.haskell.org Mon Jul 16 19:22:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 19:22:00 +0000 (UTC) Subject: [commit: ghc] master: #15387 Fix setting testsuite verbose to zero (0d6ef6d) Message-ID: <20180716192200.81E5C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d6ef6d71e5077eb217456fdd8a515a8cab724ad/ghc >--------------------------------------------------------------- commit 0d6ef6d71e5077eb217456fdd8a515a8cab724ad Author: Antti Siponen Date: Sun Jul 15 21:47:42 2018 +0200 #15387 Fix setting testsuite verbose to zero >--------------------------------------------------------------- 0d6ef6d71e5077eb217456fdd8a515a8cab724ad testsuite/driver/runtests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 811a6e0..4e275c5 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -104,7 +104,7 @@ if args.threads: config.threads = args.threads config.use_threads = True -if args.verbose: +if args.verbose is not None: config.verbose = args.verbose config.skip_perf_tests = args.skip_perf_tests From git at git.haskell.org Mon Jul 16 20:41:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 20:41:16 +0000 (UTC) Subject: [commit: ghc] master: driver: skip -Bsymbolic on unregisterised targets (Trac #15338) (8ec4899) Message-ID: <20180716204116.899273A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ec48990fee9e245bb2fe40dc6f65b61b8612157/ghc >--------------------------------------------------------------- commit 8ec48990fee9e245bb2fe40dc6f65b61b8612157 Author: Sergei Trofimovich Date: Mon Jul 16 21:38:30 2018 +0100 driver: skip -Bsymbolic on unregisterised targets (Trac #15338) Trac #15338 is yet another example where -Bsymbolic breaks semantics of a C program: global variable duplication happens and unsafePerformIO creates two stdout copies. When -Bsymbolic is not used both C compiler and linker agree on how global variables are handled. In case of sh4 it consists on a few assertions: 1. global variable is exported from shared library 2. code is referred to this variable via GOT-like mechanism to allow interposition 3. global variable is present .bss section on an executable (as an R_*_COPY relocation: symbol contents is copied at executable startup time) 4. and symbol in executable interposes symbol in shared library. This way both code in shared library and code in executable refer to a copy of global variable in .bss section of an executable. Unfortunately -Bsymbolic option breaks assumption [2.] and generates direct references to the symbol. This causes mismatch between values seen from executable and values seen from shared library code. This change disables '-Bsymbolic' for unregisterised targets. Signed-off-by: Sergei Trofimovich Test Plan: test 'ghc-pkg --version | cat' to emit data Reviewers: simonmar, bgamari, jrtc27 Reviewed By: jrtc27 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15338 Differential Revision: https://phabricator.haskell.org/D4959 >--------------------------------------------------------------- 8ec48990fee9e245bb2fe40dc6f65b61b8612157 compiler/main/SysTools.hs | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index d987d7d..c3d154f 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -548,9 +548,12 @@ linkDynLib dflags0 o_files dep_packages ------------------------------------------------------------------- let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } + unregisterised = platformUnregisterised (targetPlatform dflags) let bsymbolicFlag = -- we need symbolic linking to resolve - -- non-PIC intra-package-relocations - ["-Wl,-Bsymbolic"] + -- non-PIC intra-package-relocations for + -- performance (where symbolic linking works) + -- See Note [-Bsymbolic assumptions by GHC] + ["-Wl,-Bsymbolic" | not unregisterised] runLink dflags ( map Option verbFlags @@ -607,3 +610,27 @@ getFrameworkOpts dflags platform -- reverse because they're added in reverse order from the cmd line: framework_opts = concat [ ["-framework", fw] | fw <- reverse frameworks ] + +{- +Note [-Bsymbolic assumptions by GHC] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +GHC has a few assumptions about interaction of relocations in NCG and linker: + +1. -Bsymbolic resolves internal references when the shared library is linked, + which is important for performance. +2. When there is a reference to data in a shared library from the main program, + the runtime linker relocates the data object into the main program using an + R_*_COPY relocation. +3. If we used -Bsymbolic, then this results in multiple copies of the data + object, because some references have already been resolved to point to the + original instance. This is bad! + +We work around [3.] for native compiled code by avoiding the generation of +R_*_COPY relocations. + +Unregisterised compiler can't evade R_*_COPY relocations easily thus we disable +-Bsymbolic linking there. + +See related Trac tickets: #4210, #15338 +-} From git at git.haskell.org Mon Jul 16 21:30:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 21:30:42 +0000 (UTC) Subject: [commit: ghc] master: aclocal.m4: allow riscv and riscv64 CPU (beba89a) Message-ID: <20180716213042.2B6AF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/beba89a0f16681c85d39fc8a894bde4162ff492a/ghc >--------------------------------------------------------------- commit beba89a0f16681c85d39fc8a894bde4162ff492a Author: Sergei Trofimovich Date: Mon Jul 16 22:28:21 2018 +0100 aclocal.m4: allow riscv and riscv64 CPU Tested on riscv64-unknown-linux-gnu tuple. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- beba89a0f16681c85d39fc8a894bde4162ff492a aclocal.m4 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index 11c7acd..ce621b8 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -217,7 +217,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS], mipsel) test -z "[$]2" || eval "[$]2=ArchMipsel" ;; - hppa|hppa1_1|ia64|m68k|nios2|rs6000|s390|s390x|sh4|vax) + hppa|hppa1_1|ia64|m68k|nios2|riscv|riscv64|rs6000|s390|s390x|sh4|vax) test -z "[$]2" || eval "[$]2=ArchUnknown" ;; *) @@ -1878,6 +1878,12 @@ case "$1" in powerpc*) $2="powerpc" ;; + riscv64*) + $2="riscv64" + ;; + riscv*) + $2="riscv" + ;; rs6000) $2="rs6000" ;; From git at git.haskell.org Mon Jul 16 22:10:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 22:10:31 +0000 (UTC) Subject: [commit: ghc] master: Modernize S_TPush in the core spec (7fe4993) Message-ID: <20180716221032.0385F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7fe4993673e43e5b21f38d79ecc8b5163e97ee84/ghc >--------------------------------------------------------------- commit 7fe4993673e43e5b21f38d79ecc8b5163e97ee84 Author: Ryan Scott Date: Mon Jul 16 18:10:01 2018 -0400 Modernize S_TPush in the core spec Summary: The specification for the `S_TPush` rule in the core spec's operational semantics is woefully out-of-date. Let's bring it in line with the presentation in //System FC with Explicit Kind Equality//. Test Plan: Read it Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4970 >--------------------------------------------------------------- 7fe4993673e43e5b21f38d79ecc8b5163e97ee84 docs/core-spec/OpSem.ott | 10 ++++++++-- docs/core-spec/core-spec.pdf | Bin 354450 -> 354354 bytes 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/docs/core-spec/OpSem.ott b/docs/core-spec/OpSem.ott index efed85a..389c5e8 100644 --- a/docs/core-spec/OpSem.ott +++ b/docs/core-spec/OpSem.ott @@ -45,8 +45,14 @@ not e2 is_a_coercion ----------------------------------------------- :: Push ((\n.e1) |> g) e2 --> (\n.e1 |> g1) (e2 |> g0) ----------------------------------------- :: TPush -((\n.e) |> g) t --> (\n.(e |> g n)) t +% g : (forall (a : k1). t1) ~Rep# (forall (a : k2). t2) +% t : k2 +% g' : k2 ~# k1 +% t' : k1 +g' = sym (nth Nom 0 g) +t' = t |> g' +-------------------------------------------------------- :: TPush +((\n.e) |> g) t --> ((\n.e) t') |> (g @ (_Nom |> g')) % g : ((t1 ~rho# t2) -> t3) ~Rep# ((t4 ~rho# t5) -> t6) % g2 : t3 ~Rep# t6 diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf index 97694dc..21a8852 100644 Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ From git at git.haskell.org Mon Jul 16 22:27:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 22:27:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Optimise wakeups for STM (c15ba1f) Message-ID: <20180716222746.D47153A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/c15ba1fb83575081bb6a1d4955f9e13626ef8d51/ghc >--------------------------------------------------------------- commit c15ba1fb83575081bb6a1d4955f9e13626ef8d51 Author: Simon Marlow Date: Sat Jul 14 20:02:03 2018 -0400 Optimise wakeups for STM Avoids repeated wakeup messages being sent when a TVar is written to multiple times. See comments for details. Test Plan: * Test from #15136 (will be added to stm shortly) * existing stm tests Reviewers: bgamari, osa1, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15136 Differential Revision: https://phabricator.haskell.org/D4961 (cherry picked from commit 502640c90c3d0fbb6c46257be14fdc7e3c694c6c) >--------------------------------------------------------------- c15ba1fb83575081bb6a1d4955f9e13626ef8d51 rts/STM.c | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/rts/STM.c b/rts/STM.c index abb4417..976ad87 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -332,7 +332,29 @@ static void unpark_tso(Capability *cap, StgTSO *tso) { // queues: it's up to the thread itself to remove it from the wait queues // if it decides to do so when it is scheduled. - tryWakeupThread(cap,tso); + // Only the capability that owns this TSO may unblock it. We can + // call tryWakeupThread() which will either unblock it directly if + // it belongs to this cap, or send a message to the owning cap + // otherwise. + + // But we don't really want to send multiple messages if we write + // to the same TVar multiple times, and the owning cap hasn't yet + // woken up the thread and removed it from the TVar's watch list. + // So, we use the tso->block_info as a flag to indicate whether + // we've already done tryWakeupThread() for this thread. + + // Safety Note: we hold the TVar lock at this point, so we know + // that this thread is definitely still blocked, since the first + // thing a thread will do when it runs is remove itself from the + // TVar watch queues, and to do that it would need to lock the + // TVar. + + if (tso->block_info.closure != &stg_STM_AWOKEN_closure) { + // safe to do a non-atomic test-and-set here, because it's + // fine if we do multiple tryWakeupThread()s. + tso->block_info.closure = &stg_STM_AWOKEN_closure; + tryWakeupThread(cap,tso); + } } static void unpark_waiters_on(Capability *cap, StgTVar *s) { From git at git.haskell.org Mon Jul 16 23:29:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 23:29:16 +0000 (UTC) Subject: [commit: ghc] master: Do not imply NoStarIsType by TypeOperators/TypeInType (65c186f) Message-ID: <20180716232916.2E5553A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/65c186f0fdde95fd7c63ab9bd9b33a0213dba7d1/ghc >--------------------------------------------------------------- commit 65c186f0fdde95fd7c63ab9bd9b33a0213dba7d1 Author: Vladislav Zavialov Date: Mon Jul 16 18:46:52 2018 -0400 Do not imply NoStarIsType by TypeOperators/TypeInType Implementation of the "Embrace TypeInType" proposal was done according to the spec, which specified that TypeOperators must imply NoStarIsType. This implication was meant to prevent breakage and to be removed in 2 releases. However, compiling head.hackage has shown that this implication only magnified the breakage, so there is no reason to have it in the first place. To remain in compliance with the three-release policy, we add a workaround to define the (*) type operator even when -XStarIsType is on. Test Plan: ./validate Reviewers: bgamari, RyanGlScott, goldfire, phadej, hvr Reviewed By: bgamari, RyanGlScott Subscribers: harpocrates, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4865 >--------------------------------------------------------------- 65c186f0fdde95fd7c63ab9bd9b33a0213dba7d1 compiler/basicTypes/RdrName.hs | 23 ++++++--------- compiler/main/DynFlags.hs | 15 ++++------ compiler/parser/Lexer.x | 5 ---- compiler/parser/RdrHsSyn.hs | 20 +++++++++++-- compiler/rename/RnEnv.hs | 3 +- docs/users_guide/8.6.1-notes.rst | 3 +- docs/users_guide/glasgow_exts.rst | 8 ++---- docs/users_guide/using-warnings.rst | 31 ++++++++++++++++++++ libraries/base/GHC/TypeNats.hs | 1 + testsuite/tests/dependent/ghci/T14238.stdout | 2 +- .../partial-sigs/should_compile/T15039b.stderr | 33 +++++++++------------- .../partial-sigs/should_compile/T15039d.stderr | 33 +++++++++------------- .../tests/partial-sigs/should_fail/T14584.stderr | 4 +-- testsuite/tests/polykinds/T10134.hs | 6 ++-- testsuite/tests/th/TH_unresolvedInfix.hs | 1 + testsuite/tests/th/TH_unresolvedInfix_Lib.hs | 1 + .../typecheck/should_compile/TcTypeNatSimple.hs | 16 +++++------ .../should_compile/type_in_type_hole_fits.hs | 4 +-- .../typecheck/should_run/TcTypeNatSimpleRun.hs | 6 ++-- .../tests/warnings/should_compile/StarBinder.hs | 5 ++++ .../warnings/should_compile/StarBinder.stderr | 10 +++++++ testsuite/tests/warnings/should_compile/all.T | 2 ++ 22 files changed, 134 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 65c186f0fdde95fd7c63ab9bd9b33a0213dba7d1 From git at git.haskell.org Mon Jul 16 23:48:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 23:48:30 +0000 (UTC) Subject: [commit: ghc] master: Fix example in `asum` docs (5de8e26) Message-ID: <20180716234830.1F0E53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5de8e262775f8248556431be5868dd8457921343/ghc >--------------------------------------------------------------- commit 5de8e262775f8248556431be5868dd8457921343 Author: Simon Jakobi Date: Mon Jul 2 14:52:47 2018 +0200 Fix example in `asum` docs >--------------------------------------------------------------- 5de8e262775f8248556431be5868dd8457921343 libraries/base/Data/Foldable.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 847eb56..52edeb1 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -574,7 +574,7 @@ sequence_ = foldr (>>) (return ()) -- | The sum of a collection of actions, generalizing 'concat'. -- --- asum [Just "Hello", Nothing, Just "World"] +-- >>> asum [Just "Hello", Nothing, Just "World"] -- Just "Hello" asum :: (Foldable t, Alternative f) => t (f a) -> f a {-# INLINE asum #-} From git at git.haskell.org Mon Jul 16 23:50:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 23:50:50 +0000 (UTC) Subject: [commit: ghc] master: Fix hash in haddock of ghc-prim. (28199a2) Message-ID: <20180716235050.D69AB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28199a21b174ff1aff6a8acc8ec0253dca482205/ghc >--------------------------------------------------------------- commit 28199a21b174ff1aff6a8acc8ec0253dca482205 Author: Masahiro Sakai Date: Sat Jul 14 23:52:51 2018 +0900 Fix hash in haddock of ghc-prim. Some hash signs in documents in primops.txt.pp were not escaped properly. Those raw hash signs were kept in haddock and texts between those hash signs were interpreted as anchors by haddock. >--------------------------------------------------------------- 28199a21b174ff1aff6a8acc8ec0253dca482205 compiler/prelude/primops.txt.pp | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index b8c6811..56d6243 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1676,7 +1676,7 @@ primop CopyByteArrayOp "copyByteArray#" GenPrimOp primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the first MutableByteArray# to the specified region in the second MutableByteArray#. + {Copy a range of the first MutableByteArray\# to the specified region in the second MutableByteArray\#. Both arrays must fully contain the specified ranges, but this is not checked. The regions are allowed to overlap, although this is only possible when the same array is provided as both the source and the destination.} @@ -1687,10 +1687,10 @@ primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s - {Copy a range of the ByteArray# to the memory range starting at the Addr#. - The ByteArray# and the memory region at Addr# must fully contain the - specified ranges, but this is not checked. The Addr# must not point into the - ByteArray# (e.g. if the ByteArray# were pinned), but this is not checked + {Copy a range of the ByteArray\# to the memory range starting at the Addr\#. + The ByteArray\# and the memory region at Addr\# must fully contain the + specified ranges, but this is not checked. The Addr\# must not point into the + ByteArray\# (e.g. if the ByteArray\# were pinned), but this is not checked either.} with has_side_effects = True @@ -1699,10 +1699,10 @@ primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp MutableByteArray# s -> Int# -> Addr# -> Int# -> State# s -> State# s - {Copy a range of the MutableByteArray# to the memory range starting at the - Addr#. The MutableByteArray# and the memory region at Addr# must fully - contain the specified ranges, but this is not checked. The Addr# must not - point into the MutableByteArray# (e.g. if the MutableByteArray# were + {Copy a range of the MutableByteArray\# to the memory range starting at the + Addr\#. The MutableByteArray\# and the memory region at Addr\# must fully + contain the specified ranges, but this is not checked. The Addr\# must not + point into the MutableByteArray\# (e.g. if the MutableByteArray\# were pinned), but this is not checked either.} with has_side_effects = True @@ -1711,10 +1711,10 @@ primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a memory range starting at the Addr# to the specified range in the - MutableByteArray#. The memory region at Addr# and the ByteArray# must fully - contain the specified ranges, but this is not checked. The Addr# must not - point into the MutableByteArray# (e.g. if the MutableByteArray# were pinned), + {Copy a memory range starting at the Addr\# to the specified range in the + MutableByteArray\#. The memory region at Addr\# and the ByteArray\# must fully + contain the specified ranges, but this is not checked. The Addr\# must not + point into the MutableByteArray\# (e.g. if the MutableByteArray\# were pinned), but this is not checked either.} with has_side_effects = True @@ -1894,7 +1894,7 @@ primop WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPr primop CopyArrayArrayOp "copyArrayArray#" GenPrimOp ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the ArrayArray# to the specified region in the MutableArrayArray#. + {Copy a range of the ArrayArray\# to the specified region in the MutableArrayArray\#. Both arrays must fully contain the specified ranges, but this is not checked. The two arrays must not be the same array in different states, but this is not checked either.} with @@ -2243,7 +2243,7 @@ primop AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp contents and the result of applying the given function to the previous contents. Note that this isn't strictly speaking the correct type for this function; it should really be - {\tt MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, a, (a, b) #)}, + {\tt MutVar\# s a -> (a -> (a,b)) -> State\# s -> (\# State\# s, a, (a, b) \#)}, but we don't know about pairs here. } with out_of_line = True @@ -2786,13 +2786,13 @@ primop CompactResizeOp "compactResize#" GenPrimOp primop CompactContainsOp "compactContains#" GenPrimOp Compact# -> a -> State# RealWorld -> (# State# RealWorld, Int# #) - { Returns 1# if the object is contained in the compact, 0# otherwise. } + { Returns 1\# if the object is contained in the compact, 0\# otherwise. } with out_of_line = True primop CompactContainsAnyOp "compactContainsAny#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, Int# #) - { Returns 1# if the object is in any compact at all, 0# otherwise. } + { Returns 1\# if the object is in any compact at all, 0\# otherwise. } with out_of_line = True From git at git.haskell.org Mon Jul 16 23:56:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jul 2018 23:56:37 +0000 (UTC) Subject: [commit: ghc] master: Fixed "Memory Model" example. (c4b8e71) Message-ID: <20180716235637.660A93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c4b8e719effe9b420b1c5cec0194134a44b26823/ghc >--------------------------------------------------------------- commit c4b8e719effe9b420b1c5cec0194134a44b26823 Author: Francesco Ariis Date: Mon Jul 16 19:56:03 2018 -0400 Fixed "Memory Model" example. removed whitespace and added relevant imports to the "Memory Model" example (haddock documentation). Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4966 >--------------------------------------------------------------- c4b8e719effe9b420b1c5cec0194134a44b26823 libraries/base/Data/IORef.hs | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/libraries/base/Data/IORef.hs b/libraries/base/Data/IORef.hs index 6f07a09..4476926 100644 --- a/libraries/base/Data/IORef.hs +++ b/libraries/base/Data/IORef.hs @@ -111,19 +111,23 @@ atomicWriteIORef ref a = do processor architecture. For example, on x86, loads can move ahead of stores, so in the following example: -> maybePrint :: IORef Bool -> IORef Bool -> IO () -> maybePrint myRef yourRef = do -> writeIORef myRef True -> yourVal <- readIORef yourRef -> unless yourVal $ putStrLn "critical section" -> -> main :: IO () -> main = do -> r1 <- newIORef False -> r2 <- newIORef False -> forkIO $ maybePrint r1 r2 -> forkIO $ maybePrint r2 r1 -> threadDelay 1000000 + > import Data.IORef + > import Control.Monad (unless) + > import Control.Concurrent (forkIO, threadDelay) + > + > maybePrint :: IORef Bool -> IORef Bool -> IO () + > maybePrint myRef yourRef = do + > writeIORef myRef True + > yourVal <- readIORef yourRef + > unless yourVal $ putStrLn "critical section" + > + > main :: IO () + > main = do + > r1 <- newIORef False + > r2 <- newIORef False + > forkIO $ maybePrint r1 r2 + > forkIO $ maybePrint r2 r1 + > threadDelay 1000000 it is possible that the string @"critical section"@ is printed twice, even though there is no interleaving of the operations of the From git at git.haskell.org Tue Jul 17 00:47:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 00:47:40 +0000 (UTC) Subject: [commit: ghc] master: Support the GHCi debugger with -fexternal-interpreter (3bdf0d0) Message-ID: <20180717004740.A38983A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3bdf0d01ff47977830ada30ce85f174098486e23/ghc >--------------------------------------------------------------- commit 3bdf0d01ff47977830ada30ce85f174098486e23 Author: Simon Marlow Date: Mon Jul 16 19:58:31 2018 -0400 Support the GHCi debugger with -fexternal-interpreter * All the tests in tests/ghci.debugger now pass with -fexternal-interpreter. These tests are now run with the ghci-ext way in addition to the normal way so we won't break it in the future. * I removed all the unsafeCoerce# calls from RtClosureInspect. Yay! The main changes are: * New messages: GetClosure and Seq. GetClosure is a remote interface to GHC.Exts.Heap.getClosureData, which required Binary instances for various datatypes. Fortunately this wasn't too painful thanks to DeriveGeneric. * No cheating by unsafeCoercing values when printing them. Now we have to turn the Closure representation back into the native representation when printing Int, Float, Double, Integer and Char. Of these, Integer was the most painful - we now have a dependency on integer-gmp due to needing access to the representation. * Fixed a bug in rts/Heap.c - it was bogusly returning stack content as pointers for an AP_STACK closure. Test Plan: * `cd testsuite/tests/ghci.debugger && make` * validate Reviewers: bgamari, patrickdoc, nomeata, angerman, hvr, erikd, goldfire Subscribers: alpmestan, snowleopard, rwbarton, thomie, carter GHC Trac Issues: #13184 Differential Revision: https://phabricator.haskell.org/D4955 >--------------------------------------------------------------- 3bdf0d01ff47977830ada30ce85f174098486e23 compiler/ghc.cabal.in | 10 ++ compiler/ghci/Debugger.hs | 18 +-- compiler/ghci/GHCi.hs | 14 ++ compiler/ghci/RtClosureInspect.hs | 178 +++++++++++++++------ compiler/main/InteractiveEval.hs | 14 +- ghc.mk | 1 + libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs | 5 +- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs | 9 +- .../ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc | 4 +- libraries/ghci/GHCi/Message.hs | 35 +++- libraries/ghci/GHCi/Run.hs | 7 +- libraries/integer-gmp/src/GHC/Integer/Type.hs | 5 + rts/Heap.c | 11 +- testsuite/tests/ghci.debugger/scripts/all.T | 8 +- 14 files changed, 241 insertions(+), 78 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3bdf0d01ff47977830ada30ce85f174098486e23 From git at git.haskell.org Tue Jul 17 00:47:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 00:47:54 +0000 (UTC) Subject: [commit: ghc] master: split-obj: disable split-objects on Windows. (5364994) Message-ID: <20180717004754.DA8DE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/53649947223f197cf93e26393486f578d56c46c6/ghc >--------------------------------------------------------------- commit 53649947223f197cf93e26393486f578d56c46c6 Author: Tamar Christina Date: Mon Jul 16 20:04:04 2018 -0400 split-obj: disable split-objects on Windows. A change has caused GHC to generate excessive specializations. This is making GHC generate 1800 splits for a simple GHC.Prim module, which means 1800 fork/exec calls. Due to this compilation times on Windows with split-objs on take over 24 hours to complete depending on your disk speed. Also the end compiler compiling medium to large project is also much slower. So I think we need to just disable split-objects. As there's nothing that can be done about this. Test Plan: ./validate Reviewers: bgamari Subscribers: tdammers, rwbarton, thomie, erikd, carter GHC Trac Issues: #15051 Differential Revision: https://phabricator.haskell.org/D4915 >--------------------------------------------------------------- 53649947223f197cf93e26393486f578d56c46c6 configure.ac | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/configure.ac b/configure.ac index ac464b6..2b05535 100644 --- a/configure.ac +++ b/configure.ac @@ -710,6 +710,12 @@ cygwin32|mingw32) else AC_PATH_PROG([PerlCmd],[perl]) fi + # because of Trac #15051 SplitObjs is useless on Windows. It regresses + # build times to days for a build, and this effect is also there for end users + # of GHC. So unfortunately we have to disable it, even without having + # split-sections. Though the compile time hit for split-sections should be + # tiny compared to this so maybe we should enable it for x86_64. + SplitObjsBroken=YES ;; *) AC_PATH_PROG([PerlCmd],[perl]) From git at git.haskell.org Tue Jul 17 09:08:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 09:08:22 +0000 (UTC) Subject: [commit: ghc] master: Fix a typo in related trac ticket number (973ff4a) Message-ID: <20180717090822.E89DA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/973ff4a142e77e247caebf828aa51f9810394938/ghc >--------------------------------------------------------------- commit 973ff4a142e77e247caebf828aa51f9810394938 Author: Sasa Bogicevic Date: Tue Jul 17 11:07:53 2018 +0200 Fix a typo in related trac ticket number Reviewers: goldfire, bgamari, mpickering Reviewed By: mpickering Subscribers: mpickering, goldfire, rwbarton, thomie, carter GHC Trac Issues: #15405 Differential Revision: https://phabricator.haskell.org/D4975 >--------------------------------------------------------------- 973ff4a142e77e247caebf828aa51f9810394938 compiler/typecheck/TcHsType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index c9c3347..0b40a3c 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1150,7 +1150,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon -- here because we are also maintaining -- Note [The tcType invariant], so we don't just -- want to zonk the kind, leaving the TyVar - -- un-zonked (Trac #114873) + -- un-zonked (Trac #14873) do { ty <- zonkTcTyVar tv ; return (ty, typeKind ty) } From git at git.haskell.org Tue Jul 17 15:52:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 15:52:56 +0000 (UTC) Subject: [commit: ghc] wip/T15050: Merge branch 'master' into wip/T15050 (f20381d) Message-ID: <20180717155256.506603A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15050 Link : http://ghc.haskell.org/trac/ghc/changeset/f20381d3431016ee4212f7761992ecc4cfe5440e/ghc >--------------------------------------------------------------- commit f20381d3431016ee4212f7761992ecc4cfe5440e Merge: 2b8eb54 973ff4a Author: Joachim Breitner Date: Tue Jul 17 10:54:49 2018 -0400 Merge branch 'master' into wip/T15050 >--------------------------------------------------------------- Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f20381d3431016ee4212f7761992ecc4cfe5440e From git at git.haskell.org Tue Jul 17 15:53:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 15:53:01 +0000 (UTC) Subject: [commit: ghc] wip/T15050's head updated: Merge branch 'master' into wip/T15050 (f20381d) Message-ID: <20180717155301.6C5063A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T15050' now includes: e732210 ghc-prim: Refactor and document __sync_fetch_and_nand workaround 1126e69 testsuite: Fix overflow in T13623 on 32-bit machines ec9638b testsuite: Fix T4442 on 32-bit architectures acb7361 Stable.c: minor refactoring, add/update some comments 625eea9 Update Hadrian submodule 3d38e82 Do not unpack class dictionaries with INLINABLE 693857f Comments only 705dcb0 Refactor in OccurAnal 313720a Rename a local variable c3823cb TTG : complete for balance of hsSyn AST 56bbe1e Add missing stdout file for T14955 512f503 Minor refactoring in Exitify 69119b2 Comments only: the FVAnn invariant 0c01224 Refactor tcExtendLocalFamInst a bit 08003e7 Make out-of-scope errors more prominent 6da5b87 Better linting for types 4e45ebe Add test case for #15108 07cc603 Don't crash when pretty-printing bad joins d4cc74f Preserve join-point arity in CoreOpt b5739bd rts: Don't disable formatting warning in RetainerSet.c 6212d01 testsuite: Bump performance meterics due to 3d38e8284b73 260e23b rts: Add -hT to the rts usage message b7b6617 rts: Allow profiling by closure type in prof way 60f9e46 Exitify: Do not trip over shadowing (fixes #15110) dc655bf errorWithoutStackTrace: omit profiling stack trace (#14970) 4cb5595 storageAddCapabilities: fix bug in updating nursery pointers 198db04 Set arity for absentError 6742ce2 Test Trac #15114 5de0be8 Add regression tests for #14904 358b508 Compute DW_FORM_block length correctly; also fixes #15068 e34e30e Warn against using Data.Monoid.First 90589a9 document the plan for removing Data.Semigroup.Option cf35ab9 minor improvement to wording of warning against First. Add warning against Last 107d2cb Don't shadow "result" in JUnit driver 1ad0277 CircleCI: Save test results as JUnit XML 75361b1 Fix NUMA support on Windows (#15049) 6132d7c Correctly add unwinding info in manifestSp and makeFixupBlocks 866525a Move the ResponseFile module from haddock into base 721e826 GHCi: Improve the error message for hidden packages 6462d90 rts: Throw better error if --numa is used without libnuma support 79c4f10 Enable warning flags to safe-guard against regressions in `base` 5697432 Normalize T14999 test output some more 33de71f Simplify callSiteInline a little b750dcc testsuite: Bump T9630 allocations as a result of 33de71fa06d0 56e8c6f Update docker images to use GHC 8.4.2 and cabal-install-2.2 13e8bc0 Fix typo in user guide about promoted list 49f5943 rel-notes: Note that -hT is now allowed 426ae98 Split TrieMap into a general (TrieMap) and core specific (CoreTrieMap) module. 361d23a Normalize the element type of ListPat, fix #14547 0f046aa testsuite: Add test for #15067 cb1ee7e Do not supply `-mcpu` if `-optlc` provides `-mcpu` already. 418881f Use unsafeInsertNew to create timers in TimerManager 6243bba Add 'addWordC#' PrimOp be580b4 Add test for invertability of `Floating` methods. d814dd3 Add hyperbolic functions to test of Float-inverses 3ea3341 Stable area hyperbolic sine for `Double` and `Float`. 46548ed base/changelog: Note stabilization of asinh (#14927) 7271db4 testsuite: Bump T5631 expected allocations 875b61e printStackChunk: recognise a few more ret frames 61b245a Small refactoring in Exitify 5b3104a Used named fields for DataDeclRn aa03ad8 Simplify the kind checking for type/class decls 37acca7 users-guide: Move discussion MAX_PATH out of release notes 280de0c Revert "Normalize the element type of ListPat, fix #14547" 981bf47 Normalize the element type of ListPat, fix #14547 849547b Revert "Normalize the element type of ListPat, fix #14547" ba6e445 Normalize the element type of ListPat, fix #14547 5fe6aaa Add -fghci-leak-check to check for space leaks b2ff5dd Fix #15038 e5bb515 rts: remove unused round_up_to_mblocks function 87e169a Revert "Add -fghci-leak-check to check for space leaks" 40a76c9 BlockAlloc.c: reuse tail_of function cb5c2fe Fix unwinding of C -> Haskell FFI calls with -threaded 3781034 Expand $tooldir in ghc --info output 2323ffd Adds CTRL-C handler in Windows's timeout (trac issue #12721) bec2e71 Revert "Fix unwinding of C -> Haskell FFI calls with -threaded" 78db41e Use correct source spans for EmptyCase 00049e2 Emit info-level log message when package envs are loaded 6ab7cf9 Simplify -ddump-json implementation 9039f84 base: Fix handling of showEFloat (Just 0) f0212a9 TcInteract: Ensure that tycons have representations before solving for Typeable 2188427 Bump array submodule 7c665f9 Refactor LitString eb39f98 Fix a few GCC warnings 2828dbf Fix changelog message for asinh cdbe00f Remove unused things from utils/Digraph d4abd03 rts: Compile with gcc -Og 30c887d GHCi: Include a note in the hint to expose a hidden package 48dee7c Clarify what the FFI spec says bf6cad8 Add note documenting refineDefaultAlt 21e1a00 Fix #14875 by introducing PprPrec, and using it cf88c2b ghc-pkg: Configure handle encodings 8f3c149 Add support for opting out of package environments ca3d303 Fix another batch of `./validate --slow` failures b713986 Improve some Foldable methods for NonEmpty 6d57a92 utils/fs: use , not e408d03 Fix #14973 1e27209 Revert "rts: Compile with gcc -Og" d92c755 Fix performance regressions from #14737 79bbb23 rts: export new absentSumFieldError from base f49f90b Tidy up error suppression df6670e testsuite: Fix expected allocations of T9020 and T12425 9dbf66d Revert "Simplify callSiteInline a little" 45ad0c3 Ensure that RTS cabal file reflects dependency on libnuma 1154c9b More explicit comment on switch in registerDelay af986f9 testsuite: Disable T14697 on Windows 01b15b8 Calling GetLastError() on Windows for socket IO (trac issue #12012) bb338f2 Algebraically simplify add/sub with carry/overflow bb3fa2d Less Tc inside simplCore (Phase 1 for #14391) a18e7df Force findPtr to be included in the binary eb8e692 An overhaul of the SRT representation fbd28e2 Allow CmmLabelDiffOff with different widths 2b0918c Save a word in the info table on x86_64 838b690 Merge FUN_STATIC closure with its SRT 01bb17f Make finalizers more reliable. 3310f7f InfoTables: Fix #if uses introduced by D4634 126b412 Add pprTraceM to Outputable as analog to traceM. 99f8cc8 Fix #15039 by pretty-printing equalities more systematically 4ffaf4b Improve numeric stability of numericEnumFrom for floating numbers 0c7db22 Fix #15073 by suggesting UnboxedTuples in an error message f2d27c1 Comments and refactoring only b701e47 Update Cabal submodule 5f15d53 Add /* fallthrough */ to fix -Wimplicit-fallthrough warning f27e4f6 Fix GHCi space leaks (#15111) 5d3b15e Fix unwinding of C -> Haskell FFI calls with -threaded (2nd try) 819b9cf Add regression tests for #11515 and #12563 797a462 Comments only efe4054 Tiny refactor 2bbdd00 Orient TyVar/TyVar equalities with deepest on the left 5a7c657 Debug tracing only ae292c6 Do not unify representational equalities d78dde9 Fix retainer profiling after SRT overhaul c617c1f base: Add Foldable and Traversable instances for Alt 9171c7f base: Fix typo c4219d9 Another batch of './validation --slow' tweaks 12deb9a rts: Fix compaction of SmallMutArrPtrs ec22f7d Add HeapView functionality e1fd946 ghc-prim: Bump version 1cdc14f ghc-pkg: recompute `abi-depends` for updated packages f2ce86c Do better sharing in the short-cut solver 5f3fb71 Fix perf numbers for #15164 b7e80ae Remove TcType.toTcType 57858fc Make dischargeFmv handle Deriveds af0757d Check for type families in an instance context 97121b6 Revert "ghc-pkg: recompute `abi-depends` for updated packages" db6085b Improve performance of CallArity 928f606 Typo in comments 49a832d Remove special case from TcTyVar level check 86bba7d Add missing check to isReflCoVar_maybe d191db4 Don't expose strictness when sm_inline is False a32c8f7 Use dischargeFunEq consistently d424d4a Fix a bug in SRT generation bf10456 Disable the SRT offset optimisation on MachO platforms 49691c4 testsuite: Bump OS X performance numbers 1879d9d Check for mismatched class methods during typechecking 979f085 Clean up the conflicting data family instances error message 5ca623a Minor typos 5b6ef59 Add -fghci-leak-check to check for space leaks c618732 isDllName: use Opt_ExternalDynamicRefs, not WayDyn 40d5b9e Comments about the substition invariant 11eed2f testsuite: Don't rely on find command in T15038 72835ff Add regression test for #11766 00f7e28 Add regression test for #14172 9ed7e8d Add regression test for #14246 6a9b9b4 Mark #12447's test case as expected to pass b67e8a3 base: Introduce Data.Monoid.Ap a5446c4 Update GHC.Stats docs 4778cba Fix 32 bit windows build 60fb2b2 Clean up Windows testsuite failures f804811 Factor stack chunk printing out of printTSO 25f01db Typofixes [ci skip] 6848a99 remove dead maybeIsLFCon 36656b9 Typofix in manual [ci skip] d14b1ec Minor refactoring 9969863 Use a less confusing type variable in a few types 576078a base: Improve zip documentation 5e91cde Unmask readMVar in readChan fa2d7e1 testsuite: Fix incorrectly capitalized True in testlib.py 1245835 testsuite: Use /usr/bin/env instead of /bin/bash 929bbe4 Handle TREC_CHUNK in printClosure 857005a Move printMutableList to Printer.c next to other printers e4003b6 llvm-targets: Add versioned ARM targets bdfc85b Fix validate for GHCi without TABLES_NEXT_TO_CODE bd429dc Update repository sub-dir for ghc-heap in ghc-heap.cabal.in 2ea93a7 Improve the documentation of lexically scoped type variables 8fe99c7 Remove incorrect comment 9ded0d6 Delete duplicate definition of fingerprintByteString c65159d T14732 now passes with the profasm way 49e423e Put the `ev_binds` of main function inside `runMainIO` 34464fe rts: Don't madvise if mmap failed 9aac442 Define MCoercion type a4ae199 Extract hard-coded LLVM opt flags into a file b876c1b users-guide: Point out GNTD may require additional extensions e0b44e2 Improved Valid Hole Fits 1d1e2b7 Implement "An API for deciding whether plugins should cause recompilation" 64fd0fa ghc-heap: Add dependency from GHC.Exts.Heap.Closures to InfoTableProf 5030109 testsuite: Fix hashbangs 730781b rts/posix: Use less aggressive backoff schedule for heap reservation sizing b57a54f SplicePat's should not trip -Wunused-pattern-binds 91a82de testsuite: Make T3234 more robust 15ece72 base: Improve documentation of indexArray# 533d345 configure: Make sphinx-build version test work on recent versions 471b2a0 users-guide: Fix various issues in debugging flags section d1beebb Make HsDocString a newtype of ByteString 21a9fb5 base/TimerManager: Clamp timer expiration time to maxBound b592bd9 dead strip dylibs on macOS 5748c79 Change jump targets in JMP_TBL from blocks to X86.JumpDest. 9921f5b Cleanups [ci skip] 9fd4ed9 UNREG: mark SRT as writable in generated C code bd43378 Optimizations for CmmBlockElim. c983a1d testsuite: Add test for #15186 f0c1eb8 Conservatively estimate levity in worker/wrapper 13a8660 Add llvm-target for powerpc64le-unknown-linux faee23b vectorise: Put it out of its misery 9ea4596 C codegen: print details of pprStatics panics a122d4f rts: Rip out support for STM invariants e0f33a6 testsuite: Don't assume location of bash 7272566 Bump version of stm submodule back to 2.4 c2783cc Extended the plugin system to run plugins on more representations ac91d07 Fix #13777 by improving the underdetermined CUSK error message 18cb4f5 Check for singletons when creating Bag/OrdList from a list. 21e9d4f Fix #15214 by listing (~) in isBuiltInOcc_maybe 2627377 rts: Query system rlimit for maximum address-space size 1626fe6 Handle abi-depends correctly in ghc-pkg 5b82ee6 Remove ~# from surface syntax 4d80044 Fix a bad interaction between GADTs and COMPLETE sets 08073e1 Turn "inaccessible code" error into a warning 9b7eec8 tcExtendTyVarEnv2 changed to tcExtendNameTyVarEnv f68c2cb Allow aligning of cmm procs at specific boundry 1f88f54 Improve exhaustiveness checking for literal values and patterns, fix #14546 6128037 Fix typo in OverloadedLabels docs 90e99c4 Add tests for #8128 and #8740 b564eb7 testsuite: Mark T14547 as broken 4dd1895 testsuite: Really mark T14547 as broken 554bc7f Provide `getWithUserData` and `putWithUserData` 0e5d2b7 Do a late CSE pass 9d600ea Expand type synonyms when Linting a forall a1a507a Refactor SetLevels.abstractVars c560f38 Bump stm and haskeline submodules d8efb09 Fix broken test T14547. 36091ec Document the fact that cmm dumps won't show unreachable blocks. 7df5896 Implement QuantifiedConstraints 1a61c6b Add Outputable instance for HsArg 97cea31 Improve extendTvSubst assertion aa77c60 Also suppress uniques in cmm dumps with `-dsuppress-uniques`. 85309a3 Serialize docstrings to ifaces, display them with new GHCi :doc command 8ed8b03 Introduce DerivingVia 4075656 Rename some mutable closure types for consistency 455477a rts: Reuse dbl_link_remove in a few places d964b05 Let the simplifier know that seq# forces 635a59a Do not scavenge SMALL_MUT_ARR_PTRS_CLEAN in mut_lists 7f45906 Comments only c16382d Remove ad-hoc special case in occAnal 1508600 testsuite: Fix dynamic-paper stderr file f741711 Update hadrian submodule 64c71ce Don't use unsafeGlobalDynFlags in optCoercion db4f064 WorkWrap: Rip out unsafeGlobalDynFlags usage in mkWwInlineRule e7678d6 Index arrays more eagerly 767536c Fix unparseable pretty-printing of promoted data cons efea32c Check if both branches of an Cmm if have the same target. 0361fc0 Move 'HsBangTy' out in constructor arguments 5026840 testsuite: Add test for #15232 569c16a Fix #15243 by fixing incorrect uses of NotPromoted bc9a838 Document #15079 in the users' guide 04e29fc testsuite: Skip T13838 in ghci way 5926b6e Don't expose (~#), (~R#), (~P#) from GHC.Prim 3397396 Fix #15236 by removing parentheses from funTyConName 838cb53 rts: Fix reference to srt_bitmap in ASSERT in RetainerProfile fa34ced Rename dataConRepNameUnique to dataConTyRepNameUnique dc8c03b Run typeCheckResultAction and renamedResultAction in TcM rather than Hsc 200c8e0 Allow Haddock comments before function arguments. 6fbe5f2 Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` 297879a Add support for FreeBSD arm d66ca01 typecheck: Don't warn about "redundant" TypeError constraints 838aeb9 Run Linux slow validate nightly on Circle CI 40db277 Fix `print-explicit-runtime-reps` (#11786). a9eb645 users guide: Fix spelling 9976bed rts: Handle SMALL_MUT_ARR_PTRS in checkClosure bb83831 Do not omit T4030 in GHCi mode e1f74aa users-guide: Spelling and style pass over QuantifiedConstraints docs 229789a testsuite: Bump performance metrics of T9233 and T13035 14f4347 Bump Cabal submodule 96ddfa4 testsuite: Suppress uniques in T15243 output 93220d4 testsuite: Remove uniques from T15243's stderr output 502026f Make seq# evaluatedness look through casts 25597a9 Comments only a169149 Remove duplicate quantified constraints 97d0542 Small refactor, adding checkBadTelescope 6ccfa62 Remove a tc-trace 0180230 rts: Fix a var name in a comment, fix a typo da53417 docs: Add mentions of new plugins mechanisms to users guide aab3c6d Refactor TcExpr.tcSeq bb539cf Bump hadrian submodule a610c21 Fix some of the failures in sanity way cc78d25 testuite: remove strace call. b5ccee4 Do not skip conc004 in GHCi way a3c0b42 testsuite: Print summary even if interrupted f7b9456 Minor refactoring and docs in selector optimisation 16c70da Disable T12903 on Darwin due to flakiness f1b097f OptCoercion: Ensure we use new UnivCo provenance to construct optimised cos. 908edbf libiserv: Add license file 3606075 testsuite: Add -fghci-leak-check to expected output on mingw32 5600729 testsuite: Add Windows-specific output for T5611 261209d Duplicated and 97d1419 Update user manual sections for -rtsopts and -with-rtsopts ca7653a testsuite: Fix T4442 on i386 0238a6c UNREG: PprC: add support for of W32 literals 4a93166 Disable `-fdefer-out-of-scope-variables` in ghci. 8ae7c1b Make Control.Exception.throw levity polymorphic. 5f5d0c9 Mark test broken on powerpc64[le] 87d691c users-guide: Fix PtrRepLifted to LiftedRep 69b50ef Fix deserialization of docs (#15240) d24e73a Replace `showSDocUnsafe` with `showSDoc` in extending_ghc.rst 233d815 rts: Ignore RLIMIT_AS if it is zero 6f083b3 desugar: Rip out unsafeGlobalDynFlags usage in decomposeRuleLhs e4c41ec rts: Don't keep findPtr symbol alive if not -DDEBUG 4672e2e relnotes: Add mention of QuantifiedConstraints d650729 Embrace -XTypeInType, add -XStarIsType 0c5aac8 Revert inadvertant changes to .gitmodules 8ffac59 Revert "rts: Don't keep findPtr symbol alive if not -DDEBUG" 8062d7f Fix binary and haddock submodule commits f9b925a Bump haddock submodule 3a18a82 Fix broken link db5ef2b Exclude libraries/libiserv/ghc.mk and other things via .gitignore. 01c9d95 UNREG: PprC: add support for of W16 literals (Ticket #15237) 807ab22 Fix the bind-recovery type f903e55 Fix corner case in typeKind, plus refactoring 2f6069c Make better "fake tycons" in error recovery dbe5370 circleci: Remove systemd from Fedora nsswitch configuration 69954a1 Fix documentation for `-dth-dec-file` b7deeed testsuite: Make T4442 compile on i386 and mark as broken e6498d6 Bump supported LLVM version to 6.0 78f5344 No Unicode in Parser.y b67b971 Make NameSort note into proper Note 91822e4 Add "quantified constraint" context in error message, fix #15231. 9c89ef3 Make dtrace enabled GHC work as a bootstrap compiler on FreeBSD 7100850 Use data con name instead of parent in lookupRecFieldOcc 42f3b53 Fix #13833: accept type literals with no FlexibleInstances fe770c2 Built-in Natural literals in Core 1279428 Quantify unfixed kind variables in CUSKs 8ee9c57 Amend configure script to support lndir build tree 1ab2dcb testsuite: Mark num009 as broken due to #15062 1f2ed99 testsuite: Mark overflow1 as broken on 32-bit platforms due to #15255 86210b2 rts: Use .cfi_{start|end}proc directives cd95c2f Preserve parenthesis in function application in typechecker a81b99d Bump nofib submodule dbc8c0f base: Improve the documentation of the enumFrom series of functions de34a71 rts: Remove use of __USE_MINGW_ANSI_STDIO 819d8ef circleci: Bump fedora docker image tag f998947 circleci: Add a reference to the documentation on the Wiki 60e4bb4 Enhanced constant folding d55035f Revert "Amend configure script to support lndir build tree" 4cd5521 base: Add default implementation for Data.Bits.bitSize 8df2447 Warn about implicit kind variables with -Wcompat 76b343f Revert "rts: Use .cfi_{start|end}proc directives" 0db05ad Bump process submodule d1c7239 configure: Fail when bootstrapping with GHC 8.2.1 749bc1a testsuite: Mark T3001-2 as broken on 32-bit platforms 9897440 testsuite: Mark print022 as broken on 32-bit platforms ccd8ce4 Handle DuplicateRecordFields correctly in filterImports (fixes #14487) df0f148 Improve error message when importing an unusable package 793902e Improve documentation of Eq, Ord instances for Float and Double c637541 Provide a better error message for unpromotable data constructor contexts b8e3499 UNREG: fix CmmRegOff large offset handling on W64 platforms 008ea12 Use __FILE__ for Cmm assertion locations, fix #8619 04e9fe5 Add -Werror=compat 50d7b2a Remove accidentally checked-in T14845.stderr d621644 Fix an infinite loop in niFixTCvSubst 850ae8c Two small refactorings 30b029b Fix typechecking of kind signatures 6ac8a72 Typofixes in docs and comments [ci skip] de692fd Fix typo in comment only a9b01c0 Mark some TH tests as req_interp 83a7b1c Adjust comments (Trac #14164) 676c575 Fix API Annotations for GADT constructors 26e9806 Document and simplify tcInstTyBinders 4cdd574 configure: Bump version to 8.6.0 000ac86 testsuite: Bump metrics for T5631 and T6048 50e7bff containers: Bump to 0.6.0.1 f0179e3 testsuite: Skip T11627a and T11627b on Darwin 7b8dcd9 testsuite: Add broken test for #15289 a5eaa0f Tweak wording in documentation 436c0e9 findPtr: don't search the nursery 21fa62f base: Add missing instances for Data.Ord.Down 7363ba4 Revert "containers: Bump to 0.6.0.1" e839ee2 A few more typofixes in docs/comments [ci skip] 942e6c9 configure: Fix libnuma detection logic f4dce6c Allow :info for (~) in GHCi b948398 Remove HsEqTy and XEqTy 76e110f rts: A bit of cleanup of posix itimer implementation 227ede4 Fix gcc.exe: error: CreateProcess: No such file or directory c35ad6e containers: Bump to 0.6.0.1 c7cd5a6 configure: Set version to 8.7 3048a87 Fix incorrect GHC versioning 50a35e5 Drop redundant Note 32eb419 Instances in no-evidence implications e065369 Refactor try_solve_fromInstance in shortCutSolver d5459a3 Remove unnecessary call to checkReductionDepth 122ba98 Move a Note to the module that refers to it 5f06cf6 TTG for IPBind had wrong extension name 391b0ca Explain why opt-cmm is not dumped by ddump-cmm-verbose. 63d474b Include ghc-heap and libiserv in the "package" file. c7b1e93 rts: Abort if timerfd read fails 67c422c rts/linker/{SymbolExtras,elf_got}.c: map code as read-only 33724fc Remove -Wamp flag 5db9f91 Tweak API Annotations for ConDeclGADT 2896082 Fix error recovery for pattern synonyms 95324f0 Improve tc-tracing a bit 9fc40c7 Refactor the kind-checking of tyvar binders 577399c Coments and debug tracing only b4d5459 More misc comments cea409a Remove unused BottomFound from Tick 1c2c2d3 Record some notes about "innocuous" transformations e53c113 API Annotations when parsing typapp 261dd83 Fix TcLevel manipulation in TcDerivInfer.simplifyDeriv 7a2b5d0 A bit more tc-tracking in TcUnify.uUnfilledVar bb50eca Remove dead code 629d01a Typofixes in comments and whitespace only [ci skip] 5865e9a Typo fix in rts [skip ci] 3d00208 Add commnent about binder order 4168ee3 rts: Update some comments, minor refactoring a54c94f Show addresses of live objects in GHCi leak check 437ff69 Add ghc-prim as dependency to ghc-bin 45de833 Clarify role of coercion in flattening function 904abd4 Document SRT scavenging behavior of scavenge_block() and scavenge_one() 4760a8c Add -ddump-rtti to user's guide and man page 9a371d6 A few typofixes in comments 6bb0c5d Don't lock the MVar closure on tryReadMVar 6e4e6d1 Fix mkGadtDecl does not set con_forall correctly b4e6483 testsuite: remove unused scc001 target 6cb189d RtClosureInspect: add some docs, remove unused stuff 15bb4e0 Fix nptr field alignment in RtClosureInspect 39de4e3 Fix errors caused by invalid candidates leaking from hole fits e835fdb Add regression test for #15321 f6ac083 Add regression test for #15007 8f44995 Revert "Don't lock the MVar closure on tryReadMVar" 7ce6f64 Add comments on Typeable (n :: Nat) 14dfdf6 Fix comment 45f44e2 Refactor validity checking for constraints 59a15a5 Fix #15307 by making nlHsFunTy parenthesize more 93b7ac8 Fix #15308 by suppressing invisble args more rigorously 132273f Instantiate GND bindings with an explicit type signature 9275186 Fix newtype instance GADTs 5773397 Parenthesize rank-n contexts in Convert b6a3386 Fix #15331 with careful blasts of parenthesizeHsType dbdcacf Make ppr_tc_args aware of -fprint-explicit-kinds 9b26aa0 Comment out a pprTrace 45f0026 Accept new stdout for tcrun045 18cedbb Make a variant of mkCastErr for kind coercions 8c628ad Remove BUILD_DPH, not used de95bf4 circleci: Detect core count 87b28a8 users guide: Mention -fprint-typechecker-elaboration in -ddump-tc docs f59332f Mark AutoDeriveTypeable as deprecated fbe162f Add a broken test for lingering state from TH unique names #9693 379bb20 Simplify lintIdUnfolding 987b5e7 Fix for built-in Natural literals desugaring f03f0d6 testsuite: Add test for #15053 8736715 rts: Enable two-step allocator on FreeBSD 6715373 Revert "rts: Enable two-step allocator on FreeBSD" 6595bee Define an Outputable MCoercion instance 55a3f85 Refactor coercion rule fd0f033 More refactoring in TcValidity aedbf7f Fix decompsePiCos and visible type application 03d7268 More tc-tracing 5067b20 Add nakedSubstTy and use it in TcHsType.tcInferApps 8ec2946 Optional context for a quantified constraint 042df60 Unwrap casts before checking vars in eager unifier 030211d Kind-check CUSK associated types separately cf67e59 Expand and implement Note [The tcType invariant] 7f4dd88 Note [Ordering of implicit variables] 9768c94 Remove bad debugging output. 81d8b17 Add test for Trac #15352 e24da5e Better Note [The well-kinded type invariant] 1c35362 Use IfaceAppArgs to store an IfaceAppTy's arguments 3efd7cd Minor refactoring in CmmUtils.mkLiveness 5ee9a1c Correct Simple to Complex wording 00cb530 Adding missing 'no' 7527d1f Attempt to fix travis build 6a1e7e7 Link to iterate' doesn't work. 8bccefc Register 'haddockHTMLs' for inplace builds 8e51ece Bump xhtml submodule to 3000.2.2.1 471a992 Trac #8581 users_guide/glasgow_exts section 10.7 19e1e6b The Types section in Core-Spec doc is out-dated 7c207c8 Fix gcdExtInteger (trac#15350) 101e904 Make boot work if ACLOCAL_PATH is not set c4d9834 Add flag to show docs of valid hole fits 234093c Fix handling of ApplicativeDo in TH AST quotes 0f79b0e Fix handling of unbound constructor names in TH #14627 2b1adaa Export findImportUsage and ImportDeclUsage f282f02 docs: remove leftovers of static flags 305da44 Release notes about source plugins 1a79270 Run the renamed source plugin after each HsGroup 7fc418d Fix deadlock between STM and throwTo 3ee7ca1 Update submodule 2625f13 Fix processHeapClosureForDead CONSTR_NOCAF case b56926d Refactor floatEqualities slightly 56b9e47 Improve comments about CUSKs e40eb73 submodule update 2928b92 Comments only cbd4b33 Bump haskeline submodule to 0.7.4.3 c67cf9e Bump mtl submodule to v2.2.2 b794c7e Bump directory submodule to v1.3.3.0 c3328ff Bump unix submodule 0905fec Remove random submodule 502640c Optimise wakeups for STM a754a42 Remove ASSERTion about increasing TcLevels b7d6002 Make some tests robust against DEBUG compiler fe0fa63 Move check for dcUserTyVarBinders invariant 15ce9b4 Don't mkNakedCastTy on something unsaturated 6d55e36 Disable -fghci-leak-check in DEBUG mode 8a70ccb Reclassify some performance tests af9b744 Replace atomicModifyMutVar# 9269541 TTG typo: XFieldOcc should be XCFieldOcc 8b6a9e5 Fix parse errors in core-spec.pdf 71f6b18 Fix space leaks 0d6ef6d #15387 Fix setting testsuite verbose to zero 8ec4899 driver: skip -Bsymbolic on unregisterised targets (Trac #15338) beba89a aclocal.m4: allow riscv and riscv64 CPU 7fe4993 Modernize S_TPush in the core spec 65c186f Do not imply NoStarIsType by TypeOperators/TypeInType 5de8e26 Fix example in `asum` docs 28199a2 Fix hash in haddock of ghc-prim. c4b8e71 Fixed "Memory Model" example. 3bdf0d0 Support the GHCi debugger with -fexternal-interpreter 5364994 split-obj: disable split-objects on Windows. 973ff4a Fix a typo in related trac ticket number f20381d Merge branch 'master' into wip/T15050 From git at git.haskell.org Tue Jul 17 17:03:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 17:03:22 +0000 (UTC) Subject: [commit: ghc] wip/T15050: Update more test output (b32988f) Message-ID: <20180717170322.C01833A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15050 Link : http://ghc.haskell.org/trac/ghc/changeset/b32988f79b8025dfa6ef67f83b8360741b878abc/ghc >--------------------------------------------------------------- commit b32988f79b8025dfa6ef67f83b8360741b878abc Author: Joachim Breitner Date: Tue Jul 17 13:02:48 2018 -0400 Update more test output >--------------------------------------------------------------- b32988f79b8025dfa6ef67f83b8360741b878abc testsuite/tests/typecheck/should_compile/all.T | 2 +- testsuite/tests/typecheck/should_compile/tc141.stderr | 7 +++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 8f14be2..7ae7007 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -620,7 +620,7 @@ test('SplitWD', normal, compile, ['']) # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. test('T14441', omit_ways(['profasm']), compile, ['']) -test('T15050', [expect_broken(15050)], compile, ['']) +test('T15050', normal, compile, ['']) test('T14735', normal, compile, ['']) test('T15180', normal, compile, ['']) test('T15232', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_compile/tc141.stderr b/testsuite/tests/typecheck/should_compile/tc141.stderr index f964303..f0cfdef 100644 --- a/testsuite/tests/typecheck/should_compile/tc141.stderr +++ b/testsuite/tests/typecheck/should_compile/tc141.stderr @@ -38,13 +38,12 @@ tc141.hs:13:13: error: tc141.hs:15:18: error: • Couldn't match expected type ‘a1’ with actual type ‘p1’ - because type variable ‘a1’ would escape its scope - This (rigid, skolem) type variable is bound by + ‘a1’ is a rigid type variable bound by the type signature for: v :: forall a1. a1 at tc141.hs:14:14-19 - ‘p’ is a rigid type variable bound by - the inferred type of g :: a -> p -> a1 + ‘p1’ is a rigid type variable bound by + the inferred type of g :: p -> p1 -> a at tc141.hs:(13,1)-(16,13) • In the expression: b In an equation for ‘v’: v = b From git at git.haskell.org Tue Jul 17 19:15:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 19:15:00 +0000 (UTC) Subject: [commit: ghc] master: aclocal.m4: narrow down 'riscv*' to 'riscv-*' and 'riscv32*' (5e63a25) Message-ID: <20180717191500.DA9FB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e63a25249f3cb07300258e115af9ff55079d2ea/ghc >--------------------------------------------------------------- commit 5e63a25249f3cb07300258e115af9ff55079d2ea Author: Sergei Trofimovich Date: Tue Jul 17 20:01:44 2018 +0100 aclocal.m4: narrow down 'riscv*' to 'riscv-*' and 'riscv32*' Two minor changes: - 32-bit CPU macro is called riscv32_HOST_ARCH (was riscv_HOST_ARCH) - shrink understood tuples from riscv* to riscv-* and riscv32*-* as a tiny safeguard against riscv128*- in future. Suggested-by: James Clarke Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 5e63a25249f3cb07300258e115af9ff55079d2ea aclocal.m4 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index ce621b8..eef4dc7 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -217,7 +217,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS], mipsel) test -z "[$]2" || eval "[$]2=ArchMipsel" ;; - hppa|hppa1_1|ia64|m68k|nios2|riscv|riscv64|rs6000|s390|s390x|sh4|vax) + hppa|hppa1_1|ia64|m68k|nios2|riscv32|riscv64|rs6000|s390|s390x|sh4|vax) test -z "[$]2" || eval "[$]2=ArchUnknown" ;; *) @@ -1881,8 +1881,8 @@ case "$1" in riscv64*) $2="riscv64" ;; - riscv*) - $2="riscv" + riscv|riscv32*) + $2="riscv32" ;; rs6000) $2="rs6000" From git at git.haskell.org Tue Jul 17 19:35:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 19:35:44 +0000 (UTC) Subject: [commit: ghc] master: Fix a typo (ab0c238) Message-ID: <20180717193544.E88493A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab0c2388428c6192ad81f3b93cda58e78c7d218d/ghc >--------------------------------------------------------------- commit ab0c2388428c6192ad81f3b93cda58e78c7d218d Author: Sasa Bogicevic Date: Tue Jul 17 21:33:25 2018 +0200 Fix a typo Reviewers: goldfire, bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15406 Differential Revision: https://phabricator.haskell.org/D4976 >--------------------------------------------------------------- ab0c2388428c6192ad81f3b93cda58e78c7d218d compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 83e62e0..afe3613 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1448,7 +1448,7 @@ Notes: * The Refls will be removed later, when we zonk the type. * This /also/ applies to substitution. We must use nakedSubstTy, - not substTy, bucause the latter uses smart constructors that do + not substTy, because the latter uses smart constructors that do Refl-elimination. * None of this is to do with knot-tying, which is the (quite distinct) From git at git.haskell.org Tue Jul 17 19:35:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 19:35:47 +0000 (UTC) Subject: [commit: ghc] master: Fix spelling errors (2c38a6e) Message-ID: <20180717193547.B96423A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c38a6ee0e24509820d20d6aa450f3c341121423/ghc >--------------------------------------------------------------- commit 2c38a6ee0e24509820d20d6aa450f3c341121423 Author: Sasa Bogicevic Date: Tue Jul 17 21:33:47 2018 +0200 Fix spelling errors Reviewers: goldfire, bgamari, osa1 Reviewed By: osa1 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15407 Differential Revision: https://phabricator.haskell.org/D4977 >--------------------------------------------------------------- 2c38a6ee0e24509820d20d6aa450f3c341121423 compiler/typecheck/TcType.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index afe3613..01bdabe 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -856,7 +856,7 @@ promoteSkolemsX tclvl = mapAccumL (promoteSkolemX tclvl) ************************************************************************ -} --- | Finds outermost type-family applications occuring in a type, +-- | Finds outermost type-family applications occurring in a type, -- after expanding synonyms. In the list (F, tys) that is returned -- we guarantee that tys matches F's arity. For example, given -- type family F a :: * -> * (arity 1) @@ -1440,7 +1440,7 @@ a's kind, so we'll call matchExpectedFunKind, and unify That evidence is actually Refl, but we must not discard the cast to form the result type ((a::kappa) (Int::*)) -bacause that does not satisfy the invariant, and crashes TypeKind. This +because that does not satisfy the invariant, and crashes TypeKind. This caused Trac #14174 and #14520. Notes: From git at git.haskell.org Tue Jul 17 19:35:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 19:35:50 +0000 (UTC) Subject: [commit: ghc] master: Correct spelling errors (1f924cb) Message-ID: <20180717193550.8B8D93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f924cb399ea0638356c8e28d8d3593fa63b653f/ghc >--------------------------------------------------------------- commit 1f924cb399ea0638356c8e28d8d3593fa63b653f Author: Sasa Bogicevic Date: Tue Jul 17 21:34:04 2018 +0200 Correct spelling errors Reviewers: bgamari, osa1 Reviewed By: osa1 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15408 Differential Revision: https://phabricator.haskell.org/D4978 >--------------------------------------------------------------- 1f924cb399ea0638356c8e28d8d3593fa63b653f compiler/typecheck/TcUnify.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 410277c..31ddf0f 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -558,7 +558,7 @@ tcSubTypeET _ _ (Infer inf_res) ty_expected = ASSERT2( not (ir_inst inf_res), ppr inf_res $$ ppr ty_expected ) -- An (Infer inf_res) ExpSigmaType passed into tcSubTypeET never -- has the ir_inst field set. Reason: in patterns (which is what - -- tcSubTypeET is used for) do not agressively instantiate + -- tcSubTypeET is used for) do not aggressively instantiate do { co <- fill_infer_result ty_expected inf_res -- Since ir_inst is false, we can skip fillInferResult -- and go straight to fill_infer_result @@ -750,7 +750,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected -- go ty_a (TyVarTy alpha) -- which, in the impredicative case unified alpha := ty_a -- where th_a is a polytype. Not only is this probably bogus (we - -- simply do not have decent story for imprdicative types), but it + -- simply do not have decent story for impredicative types), but it -- caused Trac #12616 because (also bizarrely) 'deriving' code had -- -XImpredicativeTypes on. I deleted the entire case. @@ -907,7 +907,7 @@ has the ir_inst flag. f :: forall {a}. a -> forall b. Num b => b -> b -> b This is surely confusing for users. - And worse, the monomorphism restriction won't properly. The MR is + And worse, the monomorphism restriction won't work properly. The MR is dealt with in simplifyInfer, and simplifyInfer has no way of instantiating. This could perhaps be worked around, but it may be hard to know even when instantiation should happen. @@ -1024,7 +1024,7 @@ to (forall a. a->a) -> alpha[l+1] and emit the constraint [W] alpha[l+1] ~ Int -Now the poromoted type can fill the ref cell, while the emitted +Now the promoted type can fill the ref cell, while the emitted equality can float or not, according to the usual rules. But that's not quite right! We are exposing the arrow! We could @@ -1037,7 +1037,7 @@ Here we abstract over the '->' inside the forall, in case that is subject to an equality constraint from a GADT match. Note that we kept the outer (->) because that's part of -the polymorphic "shape". And becauuse of impredicativity, +the polymorphic "shape". And because of impredicativity, GADT matches can't give equalities that affect polymorphic shape. @@ -1662,7 +1662,7 @@ So we look for a positive reason to swap, using a three-step test: on the left because there are fewer restrictions on updating TauTvs - - SigTv/TauTv: put on the left eitehr + - SigTv/TauTv: put on the left either a) Because it's touchable and can be unified, or b) Even if it's not touchable, TcSimplify.floatEqualities looks for meta tyvars on the left @@ -1694,7 +1694,7 @@ Wanteds and Givens, but either way, deepest wins! Simple. If we orient the Given a[2] on the left, we'll rewrite the Wanted to (beta[1] ~ b[1]), and that can float out of the implication. Otherwise it can't. By putting the deepest variable on the left - we maximise our changes of elminating skolem capture. + we maximise our changes of eliminating skolem capture. See also TcSMonad Note [Let-bound skolems] for another reason to orient with the deepest skolem on the left. @@ -1757,7 +1757,7 @@ where fsk is a flatten-skolem (FlatSkolTv). Suppose we have then we'll reduce the second constraint to [G] a ~ fsk and then replace all uses of 'a' with fsk. That's bad because -in error messages intead of saying 'a' we'll say (F [a]). In all +in error messages instead of saying 'a' we'll say (F [a]). In all places, including those where the programmer wrote 'a' in the first place. Very confusing! See Trac #7862. @@ -1997,7 +1997,7 @@ matchExpectedFunKind hs_ty = go Suppose we are considering unifying (alpha :: *) ~ Int -> (beta :: alpha -> alpha) This may be an error (what is that alpha doing inside beta's kind?), -but we must not make the mistake of actuallyy unifying or we'll +but we must not make the mistake of actually unifying or we'll build an infinite data structure. So when looking for occurrences of alpha in the rhs, we must look in the kinds of type variables that occur there. From git at git.haskell.org Tue Jul 17 19:35:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jul 2018 19:35:53 +0000 (UTC) Subject: [commit: ghc] master: Fix some typos in docs (932300b) Message-ID: <20180717193553.637443A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/932300bb55c8745aea7f29dc36b6d5021e6855c8/ghc >--------------------------------------------------------------- commit 932300bb55c8745aea7f29dc36b6d5021e6855c8 Author: Sasa Bogicevic Date: Tue Jul 17 21:34:23 2018 +0200 Fix some typos in docs Reviewers: bgamari, osa1 Reviewed By: osa1 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15410 Differential Revision: https://phabricator.haskell.org/D4979 >--------------------------------------------------------------- 932300bb55c8745aea7f29dc36b6d5021e6855c8 docs/users_guide/glasgow_exts.rst | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 5cf5c58..5d1c0b3 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -3778,7 +3778,7 @@ GHC extends this mechanism along several axes: * In Haskell 98, the only derivable classes are ``Eq``, ``Ord``, ``Enum``, ``Ix``, ``Bounded``, ``Read``, and ``Show``. `Various - langauge extensions <#deriving-extra>`__ extend this list. + language extensions <#deriving-extra>`__ extend this list. * Besides the stock approach to deriving instances by generating all method definitions, GHC supports two additional deriving strategies, which can @@ -4123,7 +4123,7 @@ There are two exceptions to this rule: That is, :extension:`DeriveFunctor` pattern-matches its way into tuples and maps over each type that constitutes the tuple. The generated code is - reminiscient of what would be generated from + reminiscent of what would be generated from ``data Triple a = Triple a Int [a]``, except with extra machinery to handle the tuple. @@ -4359,7 +4359,7 @@ There are some other differences regarding what data types can have derived polymorphic types that are syntactically equivalent to the last type parameter. In particular: - - We don't fold over the arguments of ``E1`` or ``E4`` beacause even though + - We don't fold over the arguments of ``E1`` or ``E4`` because even though ``(a ~ Int)``, ``Int`` is not syntactically equivalent to ``a``. - We don't fold over the argument of ``E3`` because ``a`` is not universally @@ -5722,7 +5722,7 @@ Note also the following points pattern P x y v <- MkT True x y (v::a) Here the universal type variable `a` scopes over the definition of `P`, - but the existential `b` does not. (c.f. disussion on Trac #14998.) + but the existential `b` does not. (c.f. discussion on Trac #14998.) - For a bidirectional pattern synonym, a use of the pattern synonym as an expression has the type @@ -7984,7 +7984,7 @@ keyword in the family instance: :: type Elem [e] = e ... -The data or type family instance for an assocated type must follow +The data or type family instance for an associated type must follow the rule that the type indexes corresponding to class parameters must have precisely the same as type given in the instance head. For example: :: @@ -10557,7 +10557,7 @@ assumptions", and a related `blog post ` but type inference becomes -less predicatable if you do so. (Read the papers!) +less predictable if you do so. (Read the papers!) .. _kind-generalisation: @@ -10665,7 +10665,7 @@ Here are the details: (Note that ``a`` is used in ``b``\'s kind.) Yet, even though ``a`` appears lexically before ``j`` and ``k``, ``j`` and ``k`` are quantified first, because ``a`` depends on ``j`` and ``k``. Note further that ``j`` and ``k`` - are not reordered with respect to eacho other, even though doing so would + are not reordered with respect to each other, even though doing so would not violate dependency conditions. - Visible type application is available to instantiate only user-specified @@ -11177,7 +11177,7 @@ the following pairs are equivalent: :: h x y = y in ... -Notice that GHC always adds implicit quantfiers *at the outermost level* +Notice that GHC always adds implicit quantifiers *at the outermost level* of a user-written type; it does *not* find the inner-most possible quantification point. For example: :: @@ -15014,7 +15014,7 @@ modules. ``COMPLETE`` pragmas should be thought of as asserting a universal truth about a set of patterns and as a result, should not be used to silence context specific incomplete match warnings. -When specifing a ``COMPLETE`` pragma, the result types of all patterns must +When specifying a ``COMPLETE`` pragma, the result types of all patterns must be consistent with each other. This is a sanity check as it would be impossible to match on all the patterns if the types were inconsistent. From git at git.haskell.org Wed Jul 18 20:26:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jul 2018 20:26:45 +0000 (UTC) Subject: [commit: ghc] master: testsuite: force plugin tests sequentially on Windows. (b290f15) Message-ID: <20180718202645.548FB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b290f15c4d01d45c41c02ae5c5333a1fab022a32/ghc >--------------------------------------------------------------- commit b290f15c4d01d45c41c02ae5c5333a1fab022a32 Author: Tamar Christina Date: Wed Jul 18 21:05:41 2018 +0100 testsuite: force plugin tests sequentially on Windows. Summary: Package registration does not seem to be thread-safe on Windows. Placing the system under heavily load seems to trigger registration failures even though they are all different package-dbs. This makes the plugin tests a bit flaky. I think this is because on Windows we use pessimistic locks while on Linux we use atomic file replacement. On Windows ReplaceFile is atomic, just the metadata write may not be. Since the metadata is not of importance we should either switch over to ReplaceFile or fix the locking code to not error out but wait. For now however I have to force these 25 tests to run serially in order to guarantee their correctness. Test Plan: ./validate Reviewers: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15313, #13194 Differential Revision: https://phabricator.haskell.org/D4918 >--------------------------------------------------------------- b290f15c4d01d45c41c02ae5c5333a1fab022a32 testsuite/tests/plugins/all.T | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 34b1162..ba4b87d 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -1,96 +1,118 @@ setTestOpts(req_interp) +# The implementation of ghc-pkg doesn't seem to be multi-concurrent process safe +# on windows. These tests which mutate the package db need to be run +# sequentially until this is fixed. This likely means that #13194 isn't fully +# solved. See also #15313. + test('plugins01', - [extra_files(['simple-plugin/']), + [extra_files(['simple-plugin/']), when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins01 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins01']) test('plugins02', - [extra_files(['simple-plugin/']), + [extra_files(['simple-plugin/']), when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins02 TOP={top}')], compile_fail, ['-package-db simple-plugin/pkg.plugins02/local.package.conf -fplugin Simple.BadlyTypedPlugin -package simple-plugin ' + config.plugin_way_flags]) test('plugins03', - [extra_files(['simple-plugin/']), + [extra_files(['simple-plugin/']), when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins03 TOP={top}')], compile_fail, ['-package-db simple-plugin/pkg.plugins03/local.package.conf -fplugin Simple.NonExistentPlugin -package simple-plugin']) -test('plugins04', [extra_files(['HomePackagePlugin.hs'])], multimod_compile_fail, +test('plugins04', [extra_files(['HomePackagePlugin.hs']), + when(opsys('mingw32'), multi_cpu_race)], + multimod_compile_fail, ['plugins04', '-package ghc -fplugin HomePackagePlugin']) test('plugins05', [extra_files(['HomePackagePlugin.hs']), + when(opsys('mingw32'), multi_cpu_race), only_ways([config.ghc_plugin_way])], multimod_compile_and_run, ['plugins05', '-package ghc']) test('plugins06', [extra_files(['LinkerTicklingPlugin.hs']), + when(opsys('mingw32'), multi_cpu_race), unless(have_dynamic(), skip), only_ways([config.ghc_plugin_way])], multimod_compile_and_run, ['plugins06', '-package ghc']) test('plugins07', [extra_files(['rule-defining-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.plugins07 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins07']) test('plugins08', [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins08 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins08']) test('plugins09', [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins09 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins09']) test('plugins10', [expect_broken(15216), extra_files(['simple-plugin/', 'QuasiQuotation.hs']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins10 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins10']) test('plugins11', [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins11 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins11']) test('plugins12', [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins12 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins12']) test('plugins13', [extra_files(['simple-plugin/', 'PluginFilteredExport.hs']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins13 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins13']) test('plugins14', [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins14 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins14']) test('plugins15', [extra_files(['simple-plugin/', 'MetaRemoveHelper.hs']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins15 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins15']) test('T10420', [extra_files(['rule-defining-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.T10420 TOP={top}')], run_command, ['$MAKE -s --no-print-directory T10420']) test('T10294', [extra_files(['annotation-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294 TOP={top}')], run_command, ['$MAKE -s --no-print-directory T10294']) test('T10294a', [extra_files(['annotation-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294a TOP={top}')], run_command, ['$MAKE -s --no-print-directory T10294a']) test('frontend01', [extra_files(['FrontendPlugin.hs']), + when(opsys('mingw32'), multi_cpu_race), unless(have_dynamic(), expect_broken(10301))], run_command, ['$MAKE -s --no-print-directory frontend01']) @@ -101,11 +123,13 @@ test('T11244', test('T12567a', [extra_files(['T12567b.hs', 'simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T12567a TOP={top}')], run_command, ['$MAKE -s --no-print-directory T12567a']) test('T14335', [extra_files(['simple-plugin/', 'plugins01.hs']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins01 TOP={top}')], compile_fail, ['-package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin \ @@ -113,18 +137,21 @@ test('T14335', test('plugin-recomp-pure', [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') ], run_command, ['$MAKE -s --no-print-directory plugin-recomp-pure']) test('plugin-recomp-impure', [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') ], run_command, ['$MAKE -s --no-print-directory plugin-recomp-impure']) test('plugin-recomp-flags', [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') ], run_command, ['$MAKE -s --no-print-directory plugin-recomp-flags']) From git at git.haskell.org Wed Jul 18 20:26:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jul 2018 20:26:48 +0000 (UTC) Subject: [commit: ghc] master: stack: fix stack allocations on Windows (d0bbe1b) Message-ID: <20180718202648.3328B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d0bbe1bf351c8b85c310afb0dd1fb1f12f9474bf/ghc >--------------------------------------------------------------- commit d0bbe1bf351c8b85c310afb0dd1fb1f12f9474bf Author: Tamar Christina Date: Wed Jul 18 21:03:58 2018 +0100 stack: fix stack allocations on Windows Summary: On Windows one is not allowed to drop the stack by more than a page size. The reason for this is that the OS only allocates enough stack till what the TEB specifies. After that a guard page is placed and the rest of the virtual address space is unmapped. The intention is that doing stack allocations will cause you to hit the guard which will then map the next page in and move the guard. This is done to prevent what in the Linux world is known as stack clash vulnerabilities https://access.redhat.com/security/cve/cve-2017-1000364. There are modules in GHC for which the liveliness analysis thinks the reserved 8KB of spill slots isn't enough. One being DynFlags and the other being Cabal. Though I think the Cabal one is likely a bug: ``` 4d6544: 81 ec 00 46 00 00 sub $0x4600,%esp 4d654a: 8d 85 94 fe ff ff lea -0x16c(%ebp),%eax 4d6550: 3b 83 1c 03 00 00 cmp 0x31c(%ebx),%eax 4d6556: 0f 82 de 8d 02 00 jb 4ff33a <_cLpg_info+0x7a> 4d655c: c7 45 fc 14 3d 50 00 movl $0x503d14,-0x4(%ebp) 4d6563: 8b 75 0c mov 0xc(%ebp),%esi 4d6566: 83 c5 fc add $0xfffffffc,%ebp 4d6569: 66 f7 c6 03 00 test $0x3,%si 4d656e: 0f 85 a6 d7 02 00 jne 503d1a <_cLpb_info+0x6> 4d6574: 81 c4 00 46 00 00 add $0x4600,%esp ``` It allocates nearly 18KB of spill slots for a simple 4 line function and doesn't even use it. Note that this doesn't happen on x64 or when making a validate build. Only when making a build without a validate and build.mk. This and the allocation in DynFlags means the stack allocation will jump over the guard page into unmapped memory areas and GHC or an end program segfaults. The pagesize on x86 Windows is 4KB which means we hit it very easily for these two modules, which explains the total DOA of GHC 32bit for the past 3 releases and the "random" segfaults on Windows. ``` 0:000> bp 00503d29 0:000> gn Breakpoint 0 hit WARNING: Stack overflow detected. The unwound frames are extracted from outside normal stack bounds. eax=03b6b9c9 ebx=00dc90f0 ecx=03cac48c edx=03cac43d esi=03b6b9c9 edi=03abef40 eip=00503d29 esp=013e96fc ebp=03cf8f70 iopl=0 nv up ei pl nz na po nc cs=0023 ss=002b ds=002b es=002b fs=0053 gs=002b efl=00000202 setup+0x103d29: 00503d29 89442440 mov dword ptr [esp+40h],eax ss:002b:013e973c=???????? WARNING: Stack overflow detected. The unwound frames are extracted from outside normal stack bounds. WARNING: Stack overflow detected. The unwound frames are extracted from outside normal stack bounds. 0:000> !teb TEB at 00384000 ExceptionList: 013effcc StackBase: 013f0000 StackLimit: 013eb000 ``` This doesn't fix the liveliness analysis but does fix the allocations, by emitting a function call to `__chkstk_ms` when doing allocations of larger than a page, this will make sure the stack is probed every page so the kernel maps in the next page. `__chkstk_ms` is provided by `libGCC`, which is under the `GNU runtime exclusion license`, so it's safe to link against it, even for proprietary code. (Technically we already do since we link compiled C code in.) For allocations smaller than a page we drop the stack and probe the new address. This avoids the function call and still makes sure we hit the guard if needed. PS: In case anyone is Wondering why we didn't notice this before, it's because we only test x86_64 and on Windows 10. On x86_64 the page size is 8KB and also the kernel is a bit more lenient on Windows 10 in that it seems to catch the segfault and resize the stack if it was unmapped: ``` 0:000> t eax=03b6b9c9 ebx=00dc90f0 ecx=03cac48c edx=03cac43d esi=03b6b9c9 edi=03abef40 eip=00503d2d esp=013e96fc ebp=03cf8f70 iopl=0 nv up ei pl nz na po nc cs=0023 ss=002b ds=002b es=002b fs=0053 gs=002b efl=00000202 setup+0x103d2d: 00503d2d 8b461b mov eax,dword ptr [esi+1Bh] ds:002b:03b6b9e4=03cac431 0:000> !teb TEB at 00384000 ExceptionList: 013effcc StackBase: 013f0000 StackLimit: 013e9000 ``` Likely Windows 10 has a guard page larger than previous versions. This fixes the stack allocations, and as soon as I get the time I will look at the liveliness analysis. I find it highly unlikely that simple Cabal function requires ~2200 spill slots. Test Plan: ./validate Reviewers: simonmar, bgamari Reviewed By: bgamari Subscribers: AndreasK, rwbarton, thomie, carter GHC Trac Issues: #15154 Differential Revision: https://phabricator.haskell.org/D4917 >--------------------------------------------------------------- d0bbe1bf351c8b85c310afb0dd1fb1f12f9474bf compiler/nativeGen/Instruction.hs | 10 ++-- compiler/nativeGen/PPC/Instr.hs | 16 ++--- compiler/nativeGen/RegAlloc/Liveness.hs | 4 +- compiler/nativeGen/X86/Instr.hs | 100 ++++++++++++++++++++++++++++---- 4 files changed, 103 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 d0bbe1bf351c8b85c310afb0dd1fb1f12f9474bf From git at git.haskell.org Wed Jul 18 22:39:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jul 2018 22:39:31 +0000 (UTC) Subject: [commit: ghc] master: fix osReserveHeapMemory block alignment (e175aaf) Message-ID: <20180718223931.D844E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e175aaf6918bb2b497b83618dc4c270a0d231a1c/ghc >--------------------------------------------------------------- commit e175aaf6918bb2b497b83618dc4c270a0d231a1c Author: Sergei Trofimovich Date: Wed Jul 18 23:36:58 2018 +0100 fix osReserveHeapMemory block alignment Before the change osReserveHeapMemory() attempted to allocate chunks of memory via osTryReserveHeapMemory() not multiple of MBLOCK_SIZE in the following fallback code: ``` if (at == NULL) { *len -= *len / 8; ``` and caused assertion failure: ``` $ make fulltest TEST=T11607 WAY=threaded1 T11607: internal error: ASSERTION FAILED: file rts/posix/OSMem.c, line 457 (GHC version 8.7.20180716 for riscv64_unknown_linux) ``` The change applies alignment mask before each MBLOCK allocation attempt and fixes WAY=threaded1 test failures on qemu-riscv64. Signed-off-by: Sergei Trofimovich Test Plan: run 'make fulltest WAY=threaded1' Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4982 >--------------------------------------------------------------- e175aaf6918bb2b497b83618dc4c270a0d231a1c rts/posix/OSMem.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index e63e798..4063ad3 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -441,6 +441,8 @@ osTryReserveHeapMemory (W_ len, void *hint) void *base, *top; void *start, *end; + ASSERT((len & ~MBLOCK_MASK) == len); + /* We try to allocate len + MBLOCK_SIZE, because we need memory which is MBLOCK_SIZE aligned, and then we discard what we don't need */ @@ -517,6 +519,8 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len) attempt = 0; while (1) { + *len &= ~MBLOCK_MASK; + if (*len < MBLOCK_SIZE) { // Give up if the system won't even give us 16 blocks worth of heap barf("osReserveHeapMemory: Failed to allocate heap storage"); From git at git.haskell.org Thu Jul 19 10:23:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jul 2018 10:23:49 +0000 (UTC) Subject: [commit: ghc] master: Small spelling fixes for Unify.hs (176abdf) Message-ID: <20180719102349.C743B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/176abdf4126c949be7cd3aecd8b95c0fffe6d849/ghc >--------------------------------------------------------------- commit 176abdf4126c949be7cd3aecd8b95c0fffe6d849 Author: Sasa Bogicevic Date: Thu Jul 19 13:23:20 2018 +0300 Small spelling fixes for Unify.hs Reviewers: bgamari, osa1 Reviewed By: osa1 Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4985 >--------------------------------------------------------------- 176abdf4126c949be7cd3aecd8b95c0fffe6d849 compiler/types/Unify.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index a847452..2ab0734 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -85,7 +85,7 @@ How do you choose between them? 1. If you know that the kinds of the two types are eqType, use the Ty variant. It is more efficient, as it does less work. -2. If the kinds of variables in the template type might mention type families, +2. If the kinds of variables in the template type might mention type families, use the Ty variant (and do other work to make sure the kinds work out). These pure unification functions do a straightforward syntactic unification and do no complex reasoning about type @@ -96,9 +96,9 @@ How do you choose between them? families in kinds in the TyKi variant. You just might get match failure even though a reducing a type family would lead to success.) -3. Otherwise, if you're sure that the variable kinds to not mention +3. Otherwise, if you're sure that the variable kinds do not mention type families and you're not already sure that the kind of the template - equals the kind of the target, then use the TyKi versio.n + equals the kind of the target, then use the TyKi version. -} -- | @tcMatchTy t1 t2@ produces a substitution (over fvs(t1)) @@ -502,7 +502,7 @@ tc_unify_tys :: (TyVar -> BindFlag) -- NB: It's tempting to ASSERT here that, if we're not matching kinds, then -- the kinds of the types should be the same. However, this doesn't work, -- as the types may be a dependent telescope, where later types have kinds --- that mention variables occuring earlier in the list of types. Here's an +-- that mention variables occurring earlier in the list of types. Here's an -- example (from typecheck/should_fail/T12709): -- template: [rep :: RuntimeRep, a :: TYPE rep] -- target: [LiftedRep :: RuntimeRep, Int :: TYPE LiftedRep] From git at git.haskell.org Fri Jul 20 12:17:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jul 2018 12:17:54 +0000 (UTC) Subject: [commit: ghc] master: Fix #15423 by using pprAStmtContext (99f45e2) Message-ID: <20180720121754.A3ED93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99f45e2a751dda4fdf00256d397a2932d430f3a7/ghc >--------------------------------------------------------------- commit 99f45e2a751dda4fdf00256d397a2932d430f3a7 Author: Ryan Scott Date: Fri Jul 20 12:50:50 2018 +0200 Fix #15423 by using pprAStmtContext Summary: Previously, we were using `pprStmtContext` instead, which led to error messages missing indefinite articles where they were required. Test Plan: make test TEST="T13242a T7786 Typeable1" Reviewers: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15423 Differential Revision: https://phabricator.haskell.org/D4992 >--------------------------------------------------------------- 99f45e2a751dda4fdf00256d397a2932d430f3a7 compiler/hsSyn/HsExpr.hs | 2 +- testsuite/tests/ado/T13242a.stderr | 2 +- testsuite/tests/indexed-types/should_fail/T7786.stderr | 2 +- testsuite/tests/typecheck/should_run/Typeable1.stderr | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 96d86c8..a5c65fb 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -2804,7 +2804,7 @@ pprMatchContextNoun PatBindGuards = text "pattern binding guards" pprMatchContextNoun LambdaExpr = text "lambda abstraction" pprMatchContextNoun ProcExpr = text "arrow abstraction" pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in" - $$ pprStmtContext ctxt + $$ pprAStmtContext ctxt pprMatchContextNoun PatSyn = text "pattern synonym declaration" ----------------- diff --git a/testsuite/tests/ado/T13242a.stderr b/testsuite/tests/ado/T13242a.stderr index a8e6495..f31307d 100644 --- a/testsuite/tests/ado/T13242a.stderr +++ b/testsuite/tests/ado/T13242a.stderr @@ -4,7 +4,7 @@ T13242a.hs:10:5: error: ‘a’ is a rigid type variable bound by a pattern with constructor: A :: forall a. Eq a => a -> T, in a pattern binding in - 'do' block + a 'do' block at T13242a.hs:10:3-5 • In the expression: do A x <- undefined diff --git a/testsuite/tests/indexed-types/should_fail/T7786.stderr b/testsuite/tests/indexed-types/should_fail/T7786.stderr index af9ca89..a82a1ca 100644 --- a/testsuite/tests/indexed-types/should_fail/T7786.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7786.stderr @@ -30,7 +30,7 @@ T7786.hs:97:31: error: from the context: xxx ~ 'Empty bound by a pattern with constructor: Nil :: forall a. Sing 'Empty, in a pattern binding in - 'do' block + a 'do' block at T7786.hs:96:22-24 • In the second argument of ‘($)’, namely ‘Sub db k sub’ In a stmt of a 'do' block: return $ Sub db k sub diff --git a/testsuite/tests/typecheck/should_run/Typeable1.stderr b/testsuite/tests/typecheck/should_run/Typeable1.stderr index 77d2604..ec16681 100644 --- a/testsuite/tests/typecheck/should_run/Typeable1.stderr +++ b/testsuite/tests/typecheck/should_run/Typeable1.stderr @@ -9,7 +9,7 @@ Typeable1.hs:22:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessi (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t, in a pattern binding in - 'do' block + a 'do' block • In the pattern: App x y In a stmt of a 'do' block: App x y <- pure x In the expression: From git at git.haskell.org Fri Jul 20 14:55:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jul 2018 14:55:04 +0000 (UTC) Subject: [commit: ghc] master: Avoid redundant invocation of 'findTopDir' (f64f06b) Message-ID: <20180720145504.BC4F53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f64f06bebddd1dbfc6568f36fa1f91f758fa22f1/ghc >--------------------------------------------------------------- commit f64f06bebddd1dbfc6568f36fa1f91f758fa22f1 Author: Michael Sloan Date: Fri Jul 20 16:53:41 2018 +0200 Avoid redundant invocation of 'findTopDir' Summary: While working on [D904](https://phabricator.haskell.org/D4904), I noticed that 'findTopDir' was being invoked three times. This isn't a big problem, because it is usually very cheap. On windows, it does require some involved logic, though, so to me it would make sense to only run it once. Reviewers: bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4987 >--------------------------------------------------------------- f64f06bebddd1dbfc6568f36fa1f91f758fa22f1 compiler/main/GHC.hs | 6 ++++-- compiler/main/SysTools.hs | 16 +++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 2b25646..0e20e21 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -326,6 +326,7 @@ import HscTypes import CmdLineParser import DynFlags hiding (WarnReason(..)) import SysTools +import SysTools.BaseDir import Annotations import Module import Panic @@ -494,8 +495,9 @@ withCleanupSession ghc = ghc `gfinally` cleanup initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir = do { env <- liftIO $ - do { mySettings <- initSysTools mb_top_dir - ; myLlvmConfig <- initLlvmConfig mb_top_dir + do { top_dir <- findTopDir mb_top_dir + ; mySettings <- initSysTools top_dir + ; myLlvmConfig <- initLlvmConfig top_dir ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig) ; checkBrokenTablesNextToCode dflags ; setUnsafeGlobalDynFlags dflags diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index c3d154f..ff36c04 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -110,17 +110,16 @@ stuff. ************************************************************************ -} -initLlvmConfig :: Maybe String - -> IO LlvmConfig -initLlvmConfig mbMinusB +initLlvmConfig :: String + -> IO LlvmConfig +initLlvmConfig top_dir = do targets <- readAndParse "llvm-targets" mkLlvmTarget passes <- readAndParse "llvm-passes" id return (targets, passes) where readAndParse name builder = - do top_dir <- findTopDir mbMinusB - let llvmConfigFile = top_dir name + do let llvmConfigFile = top_dir name llvmConfigStr <- readFile llvmConfigFile case maybeReadFuzzy llvmConfigStr of Just s -> return (fmap builder <$> s) @@ -130,14 +129,13 @@ initLlvmConfig mbMinusB mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs) -initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix) +initSysTools :: String -- TopDir path -> IO Settings -- Set all the mutable variables above, holding -- (a) the system programs -- (b) the package-config file -- (c) the GHC usage message -initSysTools mbMinusB - = do top_dir <- findTopDir mbMinusB - -- see Note [topdir: How GHC finds its files] +initSysTools top_dir + = do -- see Note [topdir: How GHC finds its files] -- NB: top_dir is assumed to be in standard Unix -- format, '/' separated mtool_dir <- findToolDir top_dir From git at git.haskell.org Sat Jul 21 13:50:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Jul 2018 13:50:37 +0000 (UTC) Subject: [commit: ghc] master: Fix the TcLevel not being set correctly when finding valid hole fits (b202e7a) Message-ID: <20180721135037.B88053A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b202e7a48401bd8e805a92dcfe5ea059cbd8e41c/ghc >--------------------------------------------------------------- commit b202e7a48401bd8e805a92dcfe5ea059cbd8e41c Author: Matthías Páll Gissurarson Date: Sat Jul 21 15:48:53 2018 +0200 Fix the TcLevel not being set correctly when finding valid hole fits Summary: This fixes the problem revealed by a new assert as it relates to valid hole fits. However, tests `T10384`, `T14040a` and `TcStaticPointersFail02` still fail the assert, but they are unrelated to valid hole fits. Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15384 Differential Revision: https://phabricator.haskell.org/D4994 >--------------------------------------------------------------- b202e7a48401bd8e805a92dcfe5ea059cbd8e41c compiler/typecheck/TcHoleErrors.hs | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs index 16429fb..173abbd 100644 --- a/compiler/typecheck/TcHoleErrors.hs +++ b/compiler/typecheck/TcHoleErrors.hs @@ -29,7 +29,7 @@ import FV ( fvVarList, fvVarSet, unionFV, mkFVs, FV ) import Control.Arrow ( (&&&) ) import Control.Monad ( filterM, replicateM ) -import Data.List ( partition, sort, sortOn, nubBy, foldl' ) +import Data.List ( partition, sort, sortOn, nubBy ) import Data.Graph ( graphFromEdges, topSort ) import Data.Function ( on ) @@ -700,19 +700,17 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct = isFlexiTyVar tv | isMetaTyVar tv = isFlexi <$> readMetaTyVar tv isFlexiTyVar _ = return False - -- Takes a list of free variables and makes sure that the given action - -- is run with the right TcLevel and restores any Flexi type - -- variables after the action is run. + -- Takes a list of free variables and restores any Flexi type variables + -- in free_vars after the action is run. withoutUnification :: FV -> TcM a -> TcM a withoutUnification free_vars action = do { flexis <- filterM isFlexiTyVar fuvs - ; result <- setTcLevel deepestFreeTyVarLvl action + ; result <- action -- Reset any mutated free variables ; mapM_ restore flexis ; return result } where restore = flip writeTcRef Flexi . metaTyVarRef fuvs = fvVarList free_vars - deepestFreeTyVarLvl = foldl' max topTcLevel $ map tcTyVarLevel fuvs -- The real work happens here, where we invoke the type checker using -- tcCheckHoleFit to see whether the given type fits the hole. @@ -931,13 +929,25 @@ tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit emptyBag [] ty_a ty_b -- free type variables to avoid side-effects. tcCheckHoleFit :: Cts -- Any relevant Cts to the hole. -> [Implication] -- The nested implications of the hole + -- with the innermost implication first -> TcSigmaType -- The type of the hole. -> TcSigmaType -- The type to check whether fits. -> TcM (Bool, HsWrapper) tcCheckHoleFit _ _ hole_ty ty | hole_ty `eqType` ty = return (True, idHsWrapper) tcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $ - do { (wrp, wanted) <- captureConstraints $ tcSubType_NC ExprSigCtxt ty hole_ty + do { -- We wrap the subtype constraint in the implications to pass along the + -- givens, and so we must ensure that any nested implications and skolems + -- end up with the correct level. The implications are ordered so that + -- the innermost (the one with the highest level) is first, so it + -- suffices to get the level of the first one (or the current level, if + -- there are no implications involved). + innermost_lvl <- case implics of + [] -> getTcLevel + -- imp is the innermost implication + (imp:_) -> return (ic_tclvl imp) + ; (wrp, wanted) <- setTcLevel innermost_lvl $ captureConstraints $ + tcSubType_NC ExprSigCtxt ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted -- We add the relevantCts to the wanteds generated by the call to From git at git.haskell.org Sat Jul 21 19:46:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Jul 2018 19:46:49 +0000 (UTC) Subject: [commit: ghc] master: Harden fixST (5a49651) Message-ID: <20180721194649.C1E003A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a49651f3161473b383ec497af38e9daa022b9ac/ghc >--------------------------------------------------------------- commit 5a49651f3161473b383ec497af38e9daa022b9ac Author: David Feuer Date: Sat Jul 21 15:45:35 2018 -0400 Harden fixST Trac #15349 reveals that lazy blackholing can cause trouble for `fixST` much like it can for `fixIO`. Make `fixST` work just like `fixIO`. Reviewers: simonmar, hvr, bgamari Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15349 Differential Revision: https://phabricator.haskell.org/D4948 >--------------------------------------------------------------- 5a49651f3161473b383ec497af38e9daa022b9ac libraries/base/Control/Monad/Fix.hs | 2 +- libraries/base/Control/Monad/ST/Imp.hs | 56 ++++++++++++++++++++++++++++++++-- libraries/base/GHC/ST.hs | 15 ++------- libraries/base/tests/T15349.hs | 17 +++++++++++ libraries/base/tests/T15349.stderr | 1 + libraries/base/tests/all.T | 1 + 6 files changed, 75 insertions(+), 17 deletions(-) diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs index bb26984..a58e282 100644 --- a/libraries/base/Control/Monad/Fix.hs +++ b/libraries/base/Control/Monad/Fix.hs @@ -33,7 +33,7 @@ import Data.Ord ( Down(..) ) import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) ) import GHC.Generics import GHC.List ( head, tail ) -import GHC.ST +import Control.Monad.ST.Imp import System.IO -- | Monads having fixed points with a \'knot-tying\' semantics. diff --git a/libraries/base/Control/Monad/ST/Imp.hs b/libraries/base/Control/Monad/ST/Imp.hs index c053dcc..4d6b12c 100644 --- a/libraries/base/Control/Monad/ST/Imp.hs +++ b/libraries/base/Control/Monad/ST/Imp.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK hide #-} @@ -34,7 +35,56 @@ module Control.Monad.ST.Imp ( unsafeSTToIO ) where -import GHC.ST ( ST, runST, fixST, unsafeInterleaveST +import GHC.ST ( ST, runST, unsafeInterleaveST , unsafeDupableInterleaveST ) -import GHC.Base ( RealWorld ) -import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO ) +import GHC.Base ( RealWorld, ($), return ) +import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO + , unsafeDupableInterleaveIO ) +import GHC.MVar ( readMVar, putMVar, newEmptyMVar ) +import Control.Exception.Base + ( catch, throwIO, NonTermination (..) + , BlockedIndefinitelyOnMVar (..) ) + +-- | Allow the result of a state transformer computation to be used (lazily) +-- inside the computation. +-- +-- Note that if @f@ is strict, @'fixST' f = _|_ at . +fixST :: (a -> ST s a) -> ST s a +-- See Note [fixST] +fixST k = unsafeIOToST $ do + m <- newEmptyMVar + ans <- unsafeDupableInterleaveIO + (readMVar m `catch` \BlockedIndefinitelyOnMVar -> + throwIO NonTermination) + result <- unsafeSTToIO (k ans) + putMVar m result + return result + +{- Note [fixST] + ~~~~~~~~~~~~ + +For many years, we implemented fixST much like a pure fixpoint, +using liftST: + + fixST :: (a -> ST s a) -> ST s a + fixST k = ST $ \ s -> + let ans = liftST (k r) s + STret _ r = ans + in + case ans of STret s' x -> (# s', x #) + +We knew that lazy blackholing could cause the computation to be re-run if the +result was demanded strictly, but we thought that would be okay in the case of +ST. However, that is not the case (see Trac #15349). Notably, the first time +the computation is executed, it may mutate variables that cause it to behave +*differently* the second time it's run. That may allow it to terminate when it +should not. More frighteningly, Arseniy Alekseyev produced a somewhat contrived +example ( https://mail.haskell.org/pipermail/libraries/2018-July/028889.html ) +demonstrating that it can break reasonable assumptions in "trustworthy" code, +causing a memory safety violation. So now we implement fixST much like we do +fixIO. See also the implementation notes for fixIO. Simon Marlow wondered +whether we could get away with an IORef instead of an MVar. I believe we +cannot. The function passed to fixST may spark a parallel computation that +demands the final result. Such a computation should block until the final +result is available. +-} diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs index e9d79d9..9a17438 100644 --- a/libraries/base/GHC/ST.hs +++ b/libraries/base/GHC/ST.hs @@ -18,7 +18,7 @@ module GHC.ST ( ST(..), STret(..), STRep, - fixST, runST, + runST, -- * Unsafe functions liftST, unsafeInterleaveST, unsafeDupableInterleaveST @@ -92,8 +92,7 @@ instance Monoid a => Monoid (ST s a) where data STret s a = STret (State# s) a --- liftST is useful when we want a lifted result from an ST computation. See --- fixST below. +-- liftST is useful when we want a lifted result from an ST computation. liftST :: ST s a -> State# s -> STret s a liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r @@ -126,16 +125,6 @@ unsafeDupableInterleaveST (ST m) = ST ( \ s -> (# s, r #) ) --- | Allow the result of a state transformer computation to be used (lazily) --- inside the computation. --- Note that if @f@ is strict, @'fixST' f = _|_ at . -fixST :: (a -> ST s a) -> ST s a -fixST k = ST $ \ s -> - let ans = liftST (k r) s - STret _ r = ans - in - case ans of STret s' x -> (# s', x #) - -- | @since 2.01 instance Show (ST s a) where showsPrec _ _ = showString "<>" diff --git a/libraries/base/tests/T15349.hs b/libraries/base/tests/T15349.hs new file mode 100644 index 0000000..6674330 --- /dev/null +++ b/libraries/base/tests/T15349.hs @@ -0,0 +1,17 @@ +import Control.Monad.ST.Strict +import Control.Monad.Fix +import Data.STRef + +foo :: ST s Int +foo = do + ref <- newSTRef True + mfix $ \res -> do + x <- readSTRef ref + if x + then do + writeSTRef ref False + return $! (res + 5) + else return 10 + +main :: IO () +main = print $ runST foo diff --git a/libraries/base/tests/T15349.stderr b/libraries/base/tests/T15349.stderr new file mode 100644 index 0000000..9cb080d --- /dev/null +++ b/libraries/base/tests/T15349.stderr @@ -0,0 +1 @@ +T15349: <> diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 3d3ebbc..715d4c3 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -241,3 +241,4 @@ test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) test('T13167', normal, compile_and_run, ['']) +test('T15349', [exit_code(1)], compile_and_run, ['']) From git at git.haskell.org Sun Jul 22 15:04:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jul 2018 15:04:00 +0000 (UTC) Subject: [commit: ghc] master: Fix the GHCi debugger with ApplicativeDo (4ea9311) Message-ID: <20180722150400.23CDE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4ea9311cc5c3b99ea6915bee23f0a6776731f20e/ghc >--------------------------------------------------------------- commit 4ea9311cc5c3b99ea6915bee23f0a6776731f20e Author: Simon Marlow Date: Sun Jul 22 17:03:33 2018 +0200 Fix the GHCi debugger with ApplicativeDo Summary: `collectLStmtsBinders` was returning nothing for `ApplicativeStmts`, which caused the debugger to not track free variables in many cases when using `ApplicativeDo`. Test Plan: * new test case * validate Reviewers: bgamari, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15422 Differential Revision: https://phabricator.haskell.org/D4991 >--------------------------------------------------------------- 4ea9311cc5c3b99ea6915bee23f0a6776731f20e compiler/hsSyn/HsUtils.hs | 6 +++++- testsuite/tests/ghci.debugger/scripts/all.T | 2 ++ testsuite/tests/ghci.debugger/scripts/break029.hs | 6 ++++++ testsuite/tests/ghci.debugger/scripts/break029.script | 5 +++++ testsuite/tests/ghci.debugger/scripts/break029.stdout | 10 ++++++++++ 5 files changed, 28 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index a759f1a..eba21cf 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -1035,7 +1035,11 @@ collectStmtBinders (ParStmt _ xs _ _) = collectLStmtsBinders $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss] collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss -collectStmtBinders ApplicativeStmt{} = [] +collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args + where + collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat + collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat + collectArgBinders _ = [] collectStmtBinders XStmtLR{} = panic "collectStmtBinders" diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 496c637..7336311 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -105,3 +105,5 @@ test('T8557', normal, ghci_script, ['T8557.script']) test('T12458', normal, ghci_script, ['T12458.script']) test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)), ghci_script, ['T13825-debugger.script']) + +test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script']) diff --git a/testsuite/tests/ghci.debugger/scripts/break029.hs b/testsuite/tests/ghci.debugger/scripts/break029.hs new file mode 100644 index 0000000..7598d3f --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ApplicativeDo #-} + +f :: Int -> IO Int +f x = do + y <- return (x + 1) + return (y * 2) diff --git a/testsuite/tests/ghci.debugger/scripts/break029.script b/testsuite/tests/ghci.debugger/scripts/break029.script new file mode 100644 index 0000000..b2e70b1 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.script @@ -0,0 +1,5 @@ +:load break029.hs +:step f 3 +:step +:step +y diff --git a/testsuite/tests/ghci.debugger/scripts/break029.stdout b/testsuite/tests/ghci.debugger/scripts/break029.stdout new file mode 100644 index 0000000..c1d7047 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.stdout @@ -0,0 +1,10 @@ +Stopped in Main.f, break029.hs:(4,7)-(6,16) +_result :: IO Int = _ +x :: Int = 3 +Stopped in Main.f, break029.hs:5:8-21 +_result :: IO Int = _ +x :: Int = 3 +Stopped in Main.f, break029.hs:6:11-15 +_result :: Int = _ +y :: Int = _ +4 From git at git.haskell.org Sun Jul 22 15:34:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jul 2018 15:34:11 +0000 (UTC) Subject: [commit: ghc] master: Fix a major copy'n'paste error in LLVM CodeGen (f629442) Message-ID: <20180722153411.8DCA93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f629442be93f4608e6bb53bfe2264a406230c546/ghc >--------------------------------------------------------------- commit f629442be93f4608e6bb53bfe2264a406230c546 Author: Krzysztof Gogolewski Date: Sun Jul 22 17:33:32 2018 +0200 Fix a major copy'n'paste error in LLVM CodeGen Summary: In D4592, `AddWordC` is lowered as an unsigned subtraction instead of an unsigned addition when compiling with LLVM. This patch rectifies that. Reviewers: angerman, bgamari, monoidal Reviewed By: angerman, bgamari, monoidal Subscribers: osa1, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4969 >--------------------------------------------------------------- f629442be93f4608e6bb53bfe2264a406230c546 compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 +- testsuite/tests/numeric/should_run/all.T | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 678fffa..f25cb79 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -804,7 +804,7 @@ cmmPrimOpFunctions mop = do ++ showSDoc dflags (ppr $ widthToLlvmInt w) MO_Add2 w -> fsLit $ "llvm.uadd.with.overflow." ++ showSDoc dflags (ppr $ widthToLlvmInt w) - MO_AddWordC w -> fsLit $ "llvm.usub.with.overflow." + MO_AddWordC w -> fsLit $ "llvm.uadd.with.overflow." ++ showSDoc dflags (ppr $ widthToLlvmInt w) MO_SubWordC w -> fsLit $ "llvm.usub.with.overflow." ++ showSDoc dflags (ppr $ widthToLlvmInt w) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 140fa6c..eac0278 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -62,7 +62,7 @@ test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) -test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) +test('T10962', [omit_ways(['ghci']), extra_ways(['llvm'])], compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Sun Jul 22 16:58:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jul 2018 16:58:57 +0000 (UTC) Subject: [commit: ghc] master: Fix pretty-printing of data declarations in splices (3aa09cc) Message-ID: <20180722165857.374843A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3aa09cc5af9cacba91915c095f9652ee5ed31ec7/ghc >--------------------------------------------------------------- commit 3aa09cc5af9cacba91915c095f9652ee5ed31ec7 Author: Krzysztof Gogolewski Date: Sun Jul 22 18:58:33 2018 +0200 Fix pretty-printing of data declarations in splices Test Plan: validate Reviewers: RyanGlScott, bgamari Reviewed By: RyanGlScott Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15365 Differential Revision: https://phabricator.haskell.org/D4998 >--------------------------------------------------------------- 3aa09cc5af9cacba91915c095f9652ee5ed31ec7 compiler/hsSyn/HsDecls.hs | 4 ++-- testsuite/tests/th/T15365.hs | 31 +++++++++++++++++++++++++++++++ testsuite/tests/th/T15365.stderr | 33 +++++++++++++++++++++++++++++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 67 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 3f54d20..6dde482 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -757,7 +757,7 @@ pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context , hsep (map (ppr.unLoc) varsr)] | otherwise = hsep [ pprPrefixOcc (unLoc thing) , hsep (map (ppr.unLoc) (varl:varsr))] - pp_tyvars [] = ppr thing + pp_tyvars [] = pprPrefixOcc (unLoc thing) pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc @@ -2375,7 +2375,7 @@ type instance XXRoleAnnotDecl (GhcPass _) = NoExt instance (p ~ GhcPass pass, OutputableBndr (IdP p)) => Outputable (RoleAnnotDecl p) where ppr (RoleAnnotDecl _ ltycon roles) - = text "type role" <+> ppr ltycon <+> + = text "type role" <+> pprPrefixOcc (unLoc ltycon) <+> hsep (map (pp_role . unLoc) roles) where pp_role Nothing = underscore diff --git a/testsuite/tests/th/T15365.hs b/testsuite/tests/th/T15365.hs new file mode 100644 index 0000000..00ff2e6 --- /dev/null +++ b/testsuite/tests/th/T15365.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T15365 where + +$([d| type (|||) = Either + + (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + + type role (***) + data (***) + + class (???) + instance (???) + + data family ($$$) + data instance ($$$) + + type family (^^^) + type instance (^^^) = Int + + type family (###) where + (###) = Int + + pattern (:!!!) :: Bool + pattern (:!!!) = True + |]) diff --git a/testsuite/tests/th/T15365.stderr b/testsuite/tests/th/T15365.stderr new file mode 100644 index 0000000..3c85950 --- /dev/null +++ b/testsuite/tests/th/T15365.stderr @@ -0,0 +1,33 @@ +T15365.hs:(9,3)-(31,6): Splicing declarations + [d| (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + pattern (:!!!) :: Bool + pattern (:!!!) = True + + type (|||) = Either + data (***) + class (???) + data family ($$$) + type family (^^^) + type family (###) where + (###) = Int + + instance (???) + data instance ($$$) + type instance (^^^) = Int |] + ======> + type (|||) = Either + (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + type role (***) + data (***) + class (???) + instance (???) + data family ($$$) + data instance ($$$) + type family (^^^) + type instance (^^^) = Int + type family (###) where + (###) = Int + pattern (:!!!) :: Bool + pattern (:!!!) = True diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index b3f72c8..cd80a6c 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -418,6 +418,7 @@ test('T15243', normal, compile, ['-dsuppress-uniques']) test('T15321', normal, compile_fail, ['']) test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15365', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) # Note: T9693 should be only_ways(['ghci']) once it's fixed. test('T9693', expect_broken(9693), ghci_script, ['T9693.script']) test('T14471', normal, compile, ['']) From git at git.haskell.org Sun Jul 22 20:37:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jul 2018 20:37:48 +0000 (UTC) Subject: [commit: ghc] master: Disable T10962 on llvm for now (fd1cf1f) Message-ID: <20180722203748.E4EE83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fd1cf1f474626ebc715027d30fdb245cc41c39c4/ghc >--------------------------------------------------------------- commit fd1cf1f474626ebc715027d30fdb245cc41c39c4 Author: Krzysztof Gogolewski Date: Sun Jul 22 22:34:52 2018 +0200 Disable T10962 on llvm for now This breaks Harbormaster builds. >--------------------------------------------------------------- fd1cf1f474626ebc715027d30fdb245cc41c39c4 testsuite/tests/numeric/should_run/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index eac0278..80c1d0c 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -62,7 +62,7 @@ test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) -test('T10962', [omit_ways(['ghci']), extra_ways(['llvm'])], compile_and_run, ['-O2']) +test('T10962', omit_ways('ghci'), compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Sun Jul 22 20:51:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jul 2018 20:51:13 +0000 (UTC) Subject: [commit: ghc] master: fixup! Disable T10962 on llvm for now (a606750) Message-ID: <20180722205113.377203A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a606750b36862367d038813f9fe7170f93c36222/ghc >--------------------------------------------------------------- commit a606750b36862367d038813f9fe7170f93c36222 Author: Krzysztof Gogolewski Date: Sun Jul 22 22:50:06 2018 +0200 fixup! Disable T10962 on llvm for now >--------------------------------------------------------------- a606750b36862367d038813f9fe7170f93c36222 testsuite/tests/numeric/should_run/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 80c1d0c..140fa6c 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -62,7 +62,7 @@ test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) -test('T10962', omit_ways('ghci'), compile_and_run, ['-O2']) +test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Mon Jul 23 14:25:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jul 2018 14:25:38 +0000 (UTC) Subject: [commit: ghc] master: Fix some casts. (af62407) Message-ID: <20180723142538.70C723A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af624071fa063158d6e963e171280676f9c0a0b0/ghc >--------------------------------------------------------------- commit af624071fa063158d6e963e171280676f9c0a0b0 Author: Richard Eisenberg Date: Thu Jul 19 00:16:13 2018 -0400 Fix some casts. This fixes #15346, and is a team effort between Ryan Scott and myself (mostly Ryan). We discovered two errors related to FC's "push" rules, one in the TPush rule (as implemented in pushCoTyArg) and one in KPush rule (it shows up in liftCoSubstVarBndr). The solution: do what the paper says, instead of whatever random thoughts popped into my head as I was actually implementing. Also fixes #15419, which is actually the same underlying problem. Test case: dependent/should_compile/T{15346,15419}. >--------------------------------------------------------------- af624071fa063158d6e963e171280676f9c0a0b0 compiler/coreSyn/CoreOpt.hs | 6 +-- compiler/types/Coercion.hs | 2 +- testsuite/tests/dependent/should_compile/T15346.hs | 31 ++++++++++++ testsuite/tests/dependent/should_compile/T15419.hs | 55 ++++++++++++++++++++++ testsuite/tests/dependent/should_compile/all.T | 2 + 5 files changed, 92 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 8684c84..11cbd1e 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -979,7 +979,7 @@ pushCoTyArg co ty | isForAllTy tyL = ASSERT2( isForAllTy tyR, ppr co $$ ppr ty ) - Just (ty `mkCastTy` mkSymCo co1, MCo co2) + Just (ty `mkCastTy` co1, MCo co2) | otherwise = Nothing @@ -989,8 +989,8 @@ pushCoTyArg co ty -- tyL = forall (a1 :: k1). ty1 -- tyR = forall (a2 :: k2). ty2 - co1 = mkNthCo Nominal 0 co - -- co1 :: k1 ~N k2 + co1 = mkSymCo (mkNthCo Nominal 0 co) + -- co1 :: k2 ~N k1 -- Note that NthCo can extract a Nominal equality between the -- kinds of the types related by a coercion between forall-types. -- See the NthCo case in CoreLint. diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 2ca5151..1557ce0 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1812,7 +1812,7 @@ liftCoSubstVarBndrUsing fun lc@(LC subst cenv) old_var Pair k1 _ = coercionKind eta new_var = uniqAway (getTCvInScope subst) (setVarType old_var k1) - lifted = Refl (TyVarTy new_var) + lifted = GRefl Nominal (TyVarTy new_var) (MCo eta) new_cenv = extendVarEnv cenv old_var lifted -- | Is a var in the domain of a lifting context? diff --git a/testsuite/tests/dependent/should_compile/T15346.hs b/testsuite/tests/dependent/should_compile/T15346.hs new file mode 100644 index 0000000..3d8d49b --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15346.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeApplications #-} +module T15346 where + +import Data.Kind +import Data.Proxy + +----- + +type family Rep (a :: Type) :: Type +type instance Rep () = () + +type family PFrom (x :: a) :: Rep a + +----- + +class SDecide k where + test :: forall (a :: k). Proxy a + +instance SDecide () where + test = undefined + +test1 :: forall (a :: k). SDecide (Rep k) => Proxy a +test1 = seq (test @_ @(PFrom a)) Proxy + +test2 :: forall (a :: ()). Proxy a +test2 = test1 diff --git a/testsuite/tests/dependent/should_compile/T15419.hs b/testsuite/tests/dependent/should_compile/T15419.hs new file mode 100644 index 0000000..68f20e5 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15419.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} +module T15419 where + +import Data.Kind + +data Prod a b +data Proxy p = Proxy + +----- + +data family Sing :: forall k. k -> Type +data instance Sing x = STuple + +----- + +type family Rep1 (f :: k -> Type) :: k -> Type +type instance Rep1 ((,) a) = Prod a + +type family From1 (f :: Type -> Type) a (z :: f a) :: Rep1 f a +type family To1 (f :: Type -> Type) a (z :: Rep1 f a) :: f a + +class Generic1 (f :: Type -> Type) where + sFrom1 :: forall (a :: Type) (z :: f a). Proxy z -> Sing (From1 f a z) + sTo1 :: forall (a :: Type) (r :: Rep1 f a). Proxy r -> Proxy (To1 f a r :: f a) + +instance Generic1 ((,) a) where + sFrom1 Proxy = undefined + sTo1 Proxy = undefined + +----- + +type family Fmap (g :: b) (x :: f a) :: f b +type instance Fmap (g :: b) (x :: (u, a)) = To1 ((,) u) b (Fmap g (From1 ((,) u) a x)) + +class PFunctor (f :: Type -> Type) where + sFmap :: forall a b (g :: b) (x :: f a). + Proxy g -> Sing x -> Proxy (Fmap g x) + +instance PFunctor (Prod a) where + sFmap _ STuple = undefined + +sFmap1 :: forall (f :: Type -> Type) (u :: Type) (b :: Type) (g :: b) (x :: f u). + (Generic1 f, + PFunctor (Rep1 f), + Fmap g x ~ To1 f b (Fmap g (From1 f u x)) ) + => Proxy g -> Proxy x -> Proxy (Fmap g x) +sFmap1 sg sx = sTo1 (sFmap sg (sFrom1 sx)) + +sFmap2 :: forall (p :: Type) (a :: Type) (b :: Type) (g :: b) (x :: (p, a)). + Proxy g -> Proxy x -> Proxy (Fmap g x) +sFmap2 = sFmap1 diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 64782c0..4e096c1 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -51,3 +51,5 @@ test('T14845_compile', normal, compile, ['']) test('T14991', normal, compile, ['']) test('T15264', normal, compile, ['']) test('DkNameRes', normal, compile, ['']) +test('T15346', normal, compile, ['']) +test('T15419', normal, compile, ['']) From git at git.haskell.org Mon Jul 23 14:53:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jul 2018 14:53:59 +0000 (UTC) Subject: [commit: ghc] master: Stop marking soluble ~R# constraints as insoluble (f0d27f5) Message-ID: <20180723145359.077473A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f0d27f515ffbc476144d1d1dd1a71bf9fa93c94b/ghc >--------------------------------------------------------------- commit f0d27f515ffbc476144d1d1dd1a71bf9fa93c94b Author: Simon Peyton Jones Date: Mon Jul 23 15:33:13 2018 +0100 Stop marking soluble ~R# constraints as insoluble We had a constraint (a b ~R# Int), and were marking it as 'insoluble'. That's bad; it isn't. And it caused Trac #15431. Soultion is simple. I did a tiny refactor on can_eq_app, so that it is used only for nominal equalities. >--------------------------------------------------------------- f0d27f515ffbc476144d1d1dd1a71bf9fa93c94b compiler/typecheck/TcCanonical.hs | 39 +++++++++++++--------- testsuite/tests/typecheck/should_compile/T15431.hs | 15 +++++++++ .../tests/typecheck/should_compile/T15431a.hs | 12 +++++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 4 files changed, 53 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 42f28c7..c45afd2 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -894,11 +894,13 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel -- See Note [Canonicalising type applications] about why we require flat types can_eq_nc' True _rdr_env _envs ev eq_rel (AppTy t1 s1) _ ty2 _ - | Just (t2, s2) <- tcSplitAppTy_maybe ty2 - = can_eq_app ev eq_rel t1 s1 t2 s2 + | NomEq <- eq_rel + , Just (t2, s2) <- tcSplitAppTy_maybe ty2 + = can_eq_app ev t1 s1 t2 s2 can_eq_nc' True _rdr_env _envs ev eq_rel ty1 _ (AppTy t2 s2) _ - | Just (t1, s1) <- tcSplitAppTy_maybe ty1 - = can_eq_app ev eq_rel t1 s1 t2 s2 + | NomEq <- eq_rel + , Just (t1, s1) <- tcSplitAppTy_maybe ty1 + = can_eq_app ev t1 s1 t2 s2 -- No similarity in type structure detected. Flatten and try again. can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 @@ -908,9 +910,22 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } -- We've flattened and the types don't match. Give up. -can_eq_nc' True _rdr_env _envs ev _eq_rel _ ps_ty1 _ ps_ty2 +can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 = do { traceTcS "can_eq_nc' catch-all case" (ppr ps_ty1 $$ ppr ps_ty2) - ; canEqHardFailure ev ps_ty1 ps_ty2 } + ; case eq_rel of -- See Note [Unsolved equalities] + ReprEq -> continueWith (mkIrredCt ev) + NomEq -> continueWith (mkInsolubleCt ev) } + -- No need to call canEqFailure/canEqHardFailure because they + -- flatten, and the types involved here are already flat + +{- Note [Unsolved equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we have an unsolved equality like + (a b ~R# Int) +that is not necessarily insoluble! Maybe 'a' will turn out to be a newtype. +So we want to make it a potentially-soluble Irred not an insoluble one. +Missing this point is what caused Trac #15431 +-} --------------------------------- can_eq_nc_forall :: CtEvidence -> EqRel @@ -1220,8 +1235,8 @@ can_eq_newtype_nc ev swapped ty1 ((gres, co), ty1') ty2 ps_ty2 --------- -- ^ Decompose a type application. -- All input types must be flat. See Note [Canonicalising type applications] -can_eq_app :: CtEvidence -- :: s1 t1 ~r s2 t2 - -> EqRel -- r +-- Nominal equality only! +can_eq_app :: CtEvidence -- :: s1 t1 ~N s2 t2 -> Xi -> Xi -- s1 t1 -> Xi -> Xi -- s2 t2 -> TcS (StopOrContinue Ct) @@ -1229,13 +1244,7 @@ can_eq_app :: CtEvidence -- :: s1 t1 ~r s2 t2 -- AppTys only decompose for nominal equality, so this case just leads -- to an irreducible constraint; see typecheck/should_compile/T10494 -- See Note [Decomposing equality], note {4} -can_eq_app ev ReprEq _ _ _ _ - = do { traceTcS "failing to decompose representational AppTy equality" (ppr ev) - ; continueWith (mkIrredCt ev) } - -- no need to call canEqFailure, because that flattens, and the - -- types involved here are already flat - -can_eq_app ev NomEq s1 t1 s2 t2 +can_eq_app ev s1 t1 s2 t2 | CtDerived { ctev_loc = loc } <- ev = do { unifyDeriveds loc [Nominal, Nominal] [s1, t1] [s2, t2] ; stopWith ev "Decomposed [D] AppTy" } diff --git a/testsuite/tests/typecheck/should_compile/T15431.hs b/testsuite/tests/typecheck/should_compile/T15431.hs new file mode 100644 index 0000000..21fa4c4 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15431.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE GADTs, FlexibleContexts #-} + +module T15431 where + +import Data.Coerce + +data T t where + A :: Show (t a) => t a -> T t + B :: Coercible Int (t a) => t a -> T t + +f :: T t -> String +f (A t) = show t + +g :: T t -> Int +g (B t) = coerce t diff --git a/testsuite/tests/typecheck/should_compile/T15431a.hs b/testsuite/tests/typecheck/should_compile/T15431a.hs new file mode 100644 index 0000000..cf5a831 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15431a.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +module T15431a where + +import Data.Coerce +import Data.Functor.Identity + +g1 :: Coercible (t a) Int => t a -> Int +g1 = coerce + +g2 :: Coercible Int (t a) => t a -> Int +g2 = coerce diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 10295f5..6babe4e 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -640,3 +640,5 @@ def onlyHsParLocs(x): and not "" in loc) return '\n'.join(filteredLines) test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) +test('T15431', normal, compile, ['']) +test('T15431a', normal, compile, ['']) From git at git.haskell.org Tue Jul 24 10:21:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jul 2018 10:21:35 +0000 (UTC) Subject: [commit: ghc] master: Fix a nasty bug in piResultTys (e1b5a11) Message-ID: <20180724102135.D4E8B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1b5a1174e42e390855b153015ce5227b3251d89/ghc >--------------------------------------------------------------- commit e1b5a1174e42e390855b153015ce5227b3251d89 Author: Simon Peyton Jones Date: Tue Jul 24 08:57:34 2018 +0100 Fix a nasty bug in piResultTys I was failing to instantiate vigorously enough in Type.piResultTys and in the very similar function ToIface.toIfaceAppArgsX This caused Trac #15428. The fix is easy. See Note [Care with kind instantiation] in Type.hs >--------------------------------------------------------------- e1b5a1174e42e390855b153015ce5227b3251d89 compiler/iface/ToIface.hs | 8 ++-- compiler/types/Type.hs | 43 ++++++++++++++++++---- testsuite/tests/typecheck/should_compile/T15428.hs | 9 +++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 49 insertions(+), 12 deletions(-) diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index c6284d1..08ddf82 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -305,10 +305,10 @@ toIfaceAppArgsX fr kind ty_args go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps = IA_Vis (toIfaceTypeX fr t) (go env res ts) - go env (TyVarTy tv) ts - | Just ki <- lookupTyVar env tv = go env ki ts - go env kind (t:ts) = WARN( True, ppr kind $$ ppr ty_args ) - IA_Vis (toIfaceTypeX fr t) (go env kind ts) -- Ill-kinded + go env ty ts = ASSERT2( not (isEmptyTCvSubst env) + , ppr kind $$ ppr ty_args ) + go (zapTCvSubst env) (substTy env ty) ts + -- See Note [Care with kind instantiation] in Type.hs tidyToIfaceType :: TidyEnv -> Type -> IfaceType tidyToIfaceType env ty = toIfaceType (tidyType env ty) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index e96188f..a38bd1f 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1038,13 +1038,12 @@ piResultTys ty orig_args@(arg:args) | ForAllTy (TvBndr tv _) res <- ty = go (extendVarEnv tv_env tv arg) res args - | TyVarTy tv <- ty - , Just ty' <- lookupVarEnv tv_env tv - -- Deals with piResultTys (forall a. a) [forall b.b, Int] - = piResultTys ty' all_args - - | otherwise - = pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args) + | otherwise -- See Note [Care with kind instantiation] + = ASSERT2( not (isEmptyVarEnv tv_env) + , ppr ty $$ ppr orig_args $$ ppr all_args ) + go emptyTvSubstEnv + (substTy (mkTvSubst in_scope tv_env) ty) + all_args applyTysX :: [TyVar] -> Type -> [Type] -> Type -- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys @@ -1058,7 +1057,35 @@ applyTysX tvs body_ty arg_tys pp_stuff = vcat [ppr tvs, ppr body_ty, ppr arg_tys] n_tvs = length tvs -{- + + +{- Note [Care with kind instantiation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + T :: forall k. k +and we are finding the kind of + T (forall b. b -> b) * Int +Then + T (forall b. b->b) :: k[ k :-> forall b. b->b] + :: forall b. b -> b +So + T (forall b. b->b) * :: (b -> b)[ b :-> *] + :: * -> * + +In other words wwe must intantiate the forall! + +Similarly (Trac #154218) + S :: forall k f. k -> f k +and we are finding the kind of + S * (* ->) Int Bool +We have + S * (* ->) :: (k -> f k)[ k :-> *, f :-> (* ->)] + :: * -> * -> * +So again we must instantiate. + +The same thing happens in ToIface.toIfaceAppArgsX. + + --------------------------------------------------------------------- TyConApp ~~~~~~~~ diff --git a/testsuite/tests/typecheck/should_compile/T15428.hs b/testsuite/tests/typecheck/should_compile/T15428.hs new file mode 100644 index 0000000..a9d1cdd --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15428.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module T15428 where + +data Flurmp +type family Pure (x :: a) :: f a + +type T = Pure Flurmp Flurmp diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 6babe4e..9d5d7c1 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -642,3 +642,4 @@ def onlyHsParLocs(x): test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) test('T15431', normal, compile, ['']) test('T15431a', normal, compile, ['']) +test('T15428', normal, compile, ['']) From git at git.haskell.org Tue Jul 24 13:52:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jul 2018 13:52:04 +0000 (UTC) Subject: [commit: ghc] master: Suppress -Winaccessible-code in derived code (44a7b9b) Message-ID: <20180724135204.667A73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/44a7b9baa45c4ab939c7d996519b5e3de3e13c5a/ghc >--------------------------------------------------------------- commit 44a7b9baa45c4ab939c7d996519b5e3de3e13c5a Author: Ryan Scott Date: Tue Jul 24 14:40:42 2018 +0200 Suppress -Winaccessible-code in derived code Summary: It's rather unfortunate that derived code can produce inaccessible code warnings (as demonstrated in #8128, #8740, and #15398), since the programmer has no control over the generated code. This patch aims to suppress `-Winaccessible-code` in all derived code. It accomplishes this by doing the following: * Generalize the `ic_env :: TcLclEnv` field of `Implication` to be of type `Env TcGblEnc TcLclEnv` instead. This way, it also captures `DynFlags`, which record the flag state at the time the `Implication` was created. * When typechecking derived code, turn off `-Winaccessible-code`. This way, any insoluble given `Implication`s that are created when typechecking this derived code will remember that `-Winaccessible-code` was disabled. * During error reporting, consult the `DynFlags` of an `Implication` before making the decision to report an inaccessible code warning. Test Plan: make test TEST="T8128 T8740 T15398" Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: monoidal, rwbarton, thomie, carter GHC Trac Issues: #8128, #8740, #15398 Differential Revision: https://phabricator.haskell.org/D4993 >--------------------------------------------------------------- 44a7b9baa45c4ab939c7d996519b5e3de3e13c5a compiler/typecheck/TcErrors.hs | 33 +++++---- compiler/typecheck/TcInstDcls.hs | 84 ++++++++++++++++++---- compiler/typecheck/TcRnTypes.hs | 66 +++++++++++------ compiler/typecheck/TcSMonad.hs | 34 +++++---- compiler/typecheck/TcSimplify.hs | 39 +++++----- compiler/typecheck/TcUnify.hs | 38 +++++----- testsuite/tests/deriving/should_compile/T15398.hs | 20 ++++++ .../tests/deriving/should_compile/T8128.stderr | 14 ---- .../tests/deriving/should_compile/T8740.stderr | 18 ----- testsuite/tests/deriving/should_compile/all.T | 1 + 10 files changed, 209 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 44a7b9baa45c4ab939c7d996519b5e3de3e13c5a From git at git.haskell.org Tue Jul 24 15:44:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jul 2018 15:44:00 +0000 (UTC) Subject: [commit: ghc] branch 'wip/enable-freebsd-ci' created Message-ID: <20180724154400.896BA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/enable-freebsd-ci Referencing: 515bcc199ede9e3c49bf033f45a6dc8f1b4a7461 From git at git.haskell.org Tue Jul 24 15:44:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jul 2018 15:44:03 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: Disable GNUC_ATTR_HOT when compiling with DEBUG (6649bac) Message-ID: <20180724154403.5CD6C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/6649bac9add3722204df467bc52b0b82742f1709/ghc >--------------------------------------------------------------- commit 6649bac9add3722204df467bc52b0b82742f1709 Author: Ben Gamari Date: Sun Jul 22 10:08:48 2018 -0400 Disable GNUC_ATTR_HOT when compiling with DEBUG This makes gdb'ing much easier. >--------------------------------------------------------------- 6649bac9add3722204df467bc52b0b82742f1709 includes/Stg.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/includes/Stg.h b/includes/Stg.h index 2e02347..19069d8 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -196,7 +196,7 @@ #define GNUC3_ATTRIBUTE(at) #endif -#if __GNUC__ > 4 || __GNUC__ == 4 && __GNUC_MINOR__ >= 3 +#if !defined(DEBUG) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)) #define GNUC_ATTR_HOT __attribute__((hot)) #else #define GNUC_ATTR_HOT /* nothing */ From git at git.haskell.org Tue Jul 24 15:44:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jul 2018 15:44:06 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: circleci: Reenable FreeBSD (515bcc1) Message-ID: <20180724154406.30FE33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/515bcc199ede9e3c49bf033f45a6dc8f1b4a7461/ghc >--------------------------------------------------------------- commit 515bcc199ede9e3c49bf033f45a6dc8f1b4a7461 Author: Ben Gamari Date: Tue Jul 24 11:43:06 2018 -0400 circleci: Reenable FreeBSD >--------------------------------------------------------------- 515bcc199ede9e3c49bf033f45a6dc8f1b4a7461 .circleci/config.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 298162e..f7cc5a0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -285,8 +285,7 @@ workflows: jobs: - validate-x86_64-linux: *trigger_on_tags - # FreeBSD disabled: https://github.com/haskell/unix/issues/102 - # - validate-x86_64-freebsd + - validate-x86_64-freebsd - validate-x86_64-darwin: *trigger_on_tags - validate-x86_64-linux-llvm From git at git.haskell.org Tue Jul 24 21:27:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jul 2018 21:27:33 +0000 (UTC) Subject: [commit: ghc] master: Remove dead code in TcUnify (47561c9) Message-ID: <20180724212733.539053A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47561c917deb8818161cd73a11a17582ba38c2de/ghc >--------------------------------------------------------------- commit 47561c917deb8818161cd73a11a17582ba38c2de Author: Krzysztof Gogolewski Date: Tue Jul 24 23:26:56 2018 +0200 Remove dead code in TcUnify Summary: RelaxedPolyRec is not used anymore Test Plan: validate Reviewers: bgamari, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4983 >--------------------------------------------------------------- 47561c917deb8818161cd73a11a17582ba38c2de compiler/typecheck/TcUnify.hs | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 2e66d8a..4aa9ed4 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -17,7 +17,7 @@ module TcUnify ( buildImplicationFor, -- Various unifications - unifyType, unifyTheta, unifyKind, + unifyType, unifyKind, uType, promoteTcType, swapOverTyVars, canSolveByUnification, @@ -1235,18 +1235,6 @@ unifyKind thing ty1 ty2 = traceTc "ukind" (ppr ty1 $$ ppr ty2 $$ ppr thing) >> , uo_visible = True } -- also always from a visible context --------------- -unifyPred :: PredType -> PredType -> TcM TcCoercionN --- Actual and expected types -unifyPred = unifyType Nothing - ---------------- -unifyTheta :: TcThetaType -> TcThetaType -> TcM [TcCoercionN] --- Actual and expected types -unifyTheta theta1 theta2 - = do { checkTc (equalLength theta1 theta2) - (vcat [text "Contexts differ in length", - nest 2 $ parens $ text "Use RelaxedPolyRec to allow this"]) - ; zipWithM unifyPred theta1 theta2 } {- %************************************************************************ From git at git.haskell.org Tue Jul 24 21:59:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jul 2018 21:59:33 +0000 (UTC) Subject: [commit: ghc] master: Clone relevant constraints to avoid side-effects on HoleDests. Fixes #15370. (0dc86f6) Message-ID: <20180724215933.C1AF33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0dc86f6bc454253969dedc31bed477eded4cf82d/ghc >--------------------------------------------------------------- commit 0dc86f6bc454253969dedc31bed477eded4cf82d Author: Matthías Páll Gissurarson Date: Tue Jul 24 23:57:48 2018 +0200 Clone relevant constraints to avoid side-effects on HoleDests. Fixes #15370. Summary: When looking for valid hole fits, the constraints relevant to the hole may sometimes contain a HoleDest. Previously, these were not cloned, which could cause the filling of filled coercion hole being, which would cause an assert to fail. This is now fixed. Test Plan: Regression test included. Reviewers: simonpj, bgamari, goldfire Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15370 Differential Revision: https://phabricator.haskell.org/D5004 >--------------------------------------------------------------- 0dc86f6bc454253969dedc31bed477eded4cf82d compiler/typecheck/TcHoleErrors.hs | 13 ++++--- compiler/typecheck/TcMType.hs | 9 ++--- testsuite/tests/typecheck/should_compile/T15370.hs | 20 +++++++++++ .../tests/typecheck/should_compile/T15370.stderr | 42 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 77 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs index 173abbd..7dde74f 100644 --- a/compiler/typecheck/TcHoleErrors.hs +++ b/compiler/typecheck/TcHoleErrors.hs @@ -950,16 +950,21 @@ tcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $ tcSubType_NC ExprSigCtxt ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted - -- We add the relevantCts to the wanteds generated by the call to - -- tcSubType_NC, see Note [Relevant Constraints] - ; let w_rel_cts = addSimples wanted relevantCts - ; if isEmptyWC w_rel_cts + ; if isEmptyWC wanted && isEmptyBag relevantCts then traceTc "}" empty >> return (True, wrp) else do { fresh_binds <- newTcEvBinds + -- The relevant constraints may contain HoleDests, so we must + -- take care to clone them as well (to avoid #15370). + ; cloned_relevants <- mapBagM cloneSimple relevantCts -- We wrap the WC in the nested implications, see -- Note [Nested Implications] ; let outermost_first = reverse implics setWC = setWCAndBinds fresh_binds + -- We add the cloned relevants to the wanteds generated by + -- the call to tcSubType_NC, see Note [Relevant Constraints] + -- There's no need to clone the wanteds, because they are + -- freshly generated by `tcSubtype_NC`. + w_rel_cts = addSimples wanted cloned_relevants w_givens = foldr setWC w_rel_cts outermost_first ; traceTc "w_givens are: " $ ppr w_givens ; rem <- runTcSDeriveds $ simpl_top w_givens diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 8a96cb0..6e348d8 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -39,7 +39,7 @@ module TcMType ( -------------------------------- -- Creating new evidence variables newEvVar, newEvVars, newDict, - newWanted, newWanteds, cloneWanted, cloneWC, + newWanted, newWanteds, cloneWanted, cloneSimple, cloneWC, emitWanted, emitWantedEq, emitWantedEvVar, emitWantedEvVars, newTcEvBinds, newNoTcEvBinds, addTcEvBind, @@ -188,14 +188,15 @@ cloneWanted ct where ev = ctEvidence ct +cloneSimple :: Ct -> TcM Ct +cloneSimple = fmap mkNonCanonical . cloneWanted + cloneWC :: WantedConstraints -> TcM WantedConstraints cloneWC wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { simples' <- mapBagM clone_one simples + = do { simples' <- mapBagM cloneSimple simples ; implics' <- mapBagM clone_implic implics ; return (wc { wc_simple = simples', wc_impl = implics' }) } where - clone_one ct = do { ev <- cloneWanted ct; return (mkNonCanonical ev) } - clone_implic implic@(Implic { ic_wanted = inner_wanted }) = do { inner_wanted' <- cloneWC inner_wanted ; return (implic { ic_wanted = inner_wanted' }) } diff --git a/testsuite/tests/typecheck/should_compile/T15370.hs b/testsuite/tests/typecheck/should_compile/T15370.hs new file mode 100644 index 0000000..acccf03 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15370.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +module Bug where + +import Data.Type.Equality + +data S (a :: Either x y) + +mkRefl :: n :~: j +mkRefl = Refl + +right :: forall (r :: Either x y). + S r -> () +right no = + case mkRefl @x @y of + Refl -> no + _ diff --git a/testsuite/tests/typecheck/should_compile/T15370.stderr b/testsuite/tests/typecheck/should_compile/T15370.stderr new file mode 100644 index 0000000..f26cf92 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15370.stderr @@ -0,0 +1,42 @@ + +T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘n’ with ‘j’ + ‘n’ is a rigid type variable bound by + the type signature for: + mkRefl :: forall k (n :: k) (j :: k). n :~: j + at T15370.hs:13:1-17 + ‘j’ is a rigid type variable bound by + the type signature for: + mkRefl :: forall k (n :: k) (j :: k). n :~: j + at T15370.hs:13:1-17 + Expected type: n :~: j + Actual type: n :~: n + • In the expression: Refl + In an equation for ‘mkRefl’: mkRefl = Refl + • Relevant bindings include + mkRefl :: n :~: j (bound at T15370.hs:14:1) + +T15370.hs:20:13: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘S r’ with ‘()’ + Expected type: () + Actual type: S r + • In the expression: no + _ + In a case alternative: Refl -> no + _ + In the expression: case mkRefl @x @y of { Refl -> no + _ } + • Relevant bindings include + no :: S r (bound at T15370.hs:18:7) + right :: S r -> () (bound at T15370.hs:18:1) + +T15370.hs:20:18: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: S r + Where: ‘r’, ‘y’, ‘x’ are rigid type variables bound by + the type signature for: + right :: forall x y (r :: Either x y). S r -> () + at T15370.hs:(16,1)-(17,18) + • In the second argument of ‘(+)’, namely ‘_’ + In the expression: no + _ + In a case alternative: Refl -> no + _ + • Relevant bindings include + no :: S r (bound at T15370.hs:18:7) + right :: S r -> () (bound at T15370.hs:18:1) + Constraints include y ~ x (from T15370.hs:20:5-8) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 9d5d7c1..053f949 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -398,6 +398,7 @@ test('abstract_refinement_hole_fits', normal, compile, ['-fdefer-type-errors -fn test('free_monad_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2 -funclutter-valid-hole-fits']) test('constraint_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2 -funclutter-valid-hole-fits']) test('type_in_type_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) +test('T15370', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits']) test('T7408', normal, compile, ['']) test('UnboxStrictPrimitiveFields', normal, compile, ['']) test('T7541', normal, compile, ['']) From git at git.haskell.org Wed Jul 25 11:25:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 11:25:54 +0000 (UTC) Subject: [commit: ghc] master: Build more implications (6c19112) Message-ID: <20180725112554.84E373A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c19112ece09a098c71faac1f7a58dbb1e63ee71/ghc >--------------------------------------------------------------- commit 6c19112ece09a098c71faac1f7a58dbb1e63ee71 Author: Simon Peyton Jones Date: Wed Jul 25 09:51:38 2018 +0100 Build more implications The "non-local error" problem in Trac #14185 was due to the interaction of constraints from different function definitions. This patch makes a start towards fixing it. It adds TcUnify.alwaysBuildImplication to unconditionally build an implication in some cases, to keep the constraints from different functions separate. See the new Note [When to build an implication] in TcUnify. But a lot of error messages change, so for now I have set alwaysBuildImplication = False Result: no operational change at all. I'll get back to it! >--------------------------------------------------------------- 6c19112ece09a098c71faac1f7a58dbb1e63ee71 compiler/typecheck/TcUnify.hs | 61 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 53 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 4aa9ed4..dcc185c 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -1115,7 +1115,7 @@ checkConstraints :: SkolemInfo -> TcM (TcEvBinds, result) checkConstraints skol_info skol_tvs given thing_inside - = do { implication_needed <- implicationNeeded skol_tvs given + = do { implication_needed <- implicationNeeded skol_info skol_tvs given ; if implication_needed then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside @@ -1154,15 +1154,12 @@ checkTvConstraints skol_info m_telescope thing_inside ; return (skol_tvs, result) } -implicationNeeded :: [TcTyVar] -> [EvVar] -> TcM Bool --- With the solver producing unlifted equalities, we need --- to have an EvBindsVar for them when they might be deferred to --- runtime. Otherwise, they end up as top-level unlifted bindings, --- which are verboten. See also Note [Deferred errors for coercion holes] --- in TcErrors. cf Trac #14149 for an example of what goes wrong. -implicationNeeded skol_tvs given +implicationNeeded :: SkolemInfo -> [TcTyVar] -> [EvVar] -> TcM Bool +-- See Note [When to build an implication] +implicationNeeded skol_info skol_tvs given | null skol_tvs , null given + , not (alwaysBuildImplication skol_info) = -- Empty skolems and givens do { tc_lvl <- getTcLevel ; if not (isTopTcLevel tc_lvl) -- No implication needed if we are @@ -1177,6 +1174,23 @@ implicationNeeded skol_tvs given | otherwise -- Non-empty skolems or givens = return True -- Definitely need an implication +alwaysBuildImplication :: SkolemInfo -> Bool +-- See Note [When to build an implication] +alwaysBuildImplication _ = False + +{- Commmented out for now while I figure out about error messages. + See Trac #14185 + +alwaysBuildImplication (SigSkol ctxt _ _) + = case ctxt of + FunSigCtxt {} -> True -- RHS of a binding with a signature + _ -> False +alwaysBuildImplication (RuleSkol {}) = True +alwaysBuildImplication (InstSkol {}) = True +alwaysBuildImplication (FamInstSkol {}) = True +alwaysBuildImplication _ = False +-} + buildImplicationFor :: TcLevel -> SkolemInfo -> [TcTyVar] -> [EvVar] -> WantedConstraints -> TcM (Bag Implication, TcEvBinds) @@ -1205,6 +1219,37 @@ buildImplicationFor tclvl skol_info skol_tvs given wanted ; return (unitBag implic', TcEvBinds ev_binds_var) } +{- Note [When to build an implication] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have some 'skolems' and some 'givens', and we are +considering whether to wrap the constraints in their scope into an +implication. We must /always/ so if either 'skolems' or 'givens' are +non-empty. But what if both are empty? You might think we could +always drop the implication. Other things being equal, the fewer +implications the better. Less clutter and overhead. But we must +take care: + +* If we have an unsolved [W] g :: a ~# b, and -fdefer-type-errors, + we'll make a /term-level/ evidence binding for 'g = error "blah"'. + We must have an EvBindsVar those bindings!, otherwise they end up as + top-level unlifted bindings, which are verboten. This only matters + at top level, so we check for that + See also Note [Deferred errors for coercion holes] in TcErrors. + cf Trac #14149 for an example of what goes wrong. + +* If you have + f :: Int; f = f_blah + g :: Bool; g = g_blah + If we don't build an implication for f or g (no tyvars, no givens), + the constraints for f_blah and g_blah are solved together. And that + can yield /very/ confusing error messages, because we can get + [W] C Int b1 -- from f_blah + [W] C Int b2 -- from g_blan + and fundpes can yield [D] b1 ~ b2, even though the two functions have + literally nothing to do with each other. Trac #14185 is an example. + Building an implication keeps them separage. +-} + {- ************************************************************************ * * From git at git.haskell.org Wed Jul 25 11:25:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 11:25:58 +0000 (UTC) Subject: [commit: ghc] master: Set GenSigCtxt for the argument part of tcSubType (12c0f03) Message-ID: <20180725112558.34D343A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12c0f03a66bcd978bda6472384ddc0348c5a1d7a/ghc >--------------------------------------------------------------- commit 12c0f03a66bcd978bda6472384ddc0348c5a1d7a Author: Simon Peyton Jones Date: Wed Jul 25 09:55:36 2018 +0100 Set GenSigCtxt for the argument part of tcSubType The reason for this change is described in TcUnify Note [Settting the argument context], and Trac #15438. The only effect is on error messages, where it stops GHC reporting an outright falsity (about the type signature for a function) when it finds an errors in a higher-rank situation. The testsuite changes in this patch illustrate the problem. >--------------------------------------------------------------- 12c0f03a66bcd978bda6472384ddc0348c5a1d7a compiler/typecheck/TcUnify.hs | 32 ++++++++++++++++++++-- .../indexed-types/should_compile/Simple14.stderr | 4 +-- testsuite/tests/polykinds/T10503.stderr | 4 +-- testsuite/tests/polykinds/T9222.stderr | 2 +- .../tests/typecheck/should_compile/T7220a.stderr | 8 +++--- testsuite/tests/typecheck/should_fail/T15438.hs | 8 ++++++ .../tests/typecheck/should_fail/T15438.stderr | 11 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 59 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index dcc185c..2ed861c 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -758,8 +758,9 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected | not (isPredTy act_arg) , not (isPredTy exp_arg) = -- See Note [Co/contra-variance of subsumption checking] - do { res_wrap <- tc_sub_type_ds eq_orig inst_orig ctxt act_res exp_res - ; arg_wrap <- tc_sub_tc_type eq_orig given_orig ctxt exp_arg act_arg + do { res_wrap <- tc_sub_type_ds eq_orig inst_orig ctxt act_res exp_res + ; arg_wrap <- tc_sub_tc_type eq_orig given_orig GenSigCtxt exp_arg act_arg + -- GenSigCtxt: See Note [Setting the argument context] ; return (mkWpFun arg_wrap res_wrap exp_arg exp_res doc) } -- arg_wrap :: exp_arg ~> act_arg -- res_wrap :: act-res ~> exp_res @@ -808,6 +809,33 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected -- use versions without synonyms expanded unify = mkWpCastN <$> uType TypeLevel eq_orig ty_actual ty_expected +{- Note [Settting the argument context] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider we are doing the ambiguity check for the (bogus) + f :: (forall a b. C b => a -> a) -> Int + +We'll call + tcSubType ((forall a b. C b => a->a) -> Int ) + ((forall a b. C b => a->a) -> Int ) + +with a UserTypeCtxt of (FunSigCtxt "f"). Then we'll do the co/contra thing +on the argument type of the (->) -- and at that point we want to switch +to a UserTypeCtxt of GenSigCtxt. Why? + +* Error messages. If we stick with FunSigCtxt we get errors like + * Could not deduce: C b + from the context: C b0 + bound by the type signature for: + f :: forall a b. C b => a->a + But of course f does not have that type signature! + Example tests: T10508, T7220a, Simple14 + +* Implications. We may decide to build an implication for the whole + ambiguity check, but we don't need one for each level within it, + and TcUnify.alwaysBuildImplication checks the UserTypeCtxt. + See Note [When to build an implication] +-} + ----------------- -- needs both un-type-checked (for origins) and type-checked (for wrapping) -- expressions diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/indexed-types/should_compile/Simple14.stderr index 40d1d90..4c61d95 100644 --- a/testsuite/tests/indexed-types/should_compile/Simple14.stderr +++ b/testsuite/tests/indexed-types/should_compile/Simple14.stderr @@ -3,8 +3,8 @@ Simple14.hs:8:8: error: • Couldn't match type ‘z0’ with ‘z’ ‘z0’ is untouchable inside the constraints: x ~ y - bound by the type signature for: - eqE :: (x ~ y) => EQ_ z0 z0 + bound by a type expected by the context: + (x ~ y) => EQ_ z0 z0 at Simple14.hs:8:8-39 ‘z’ is a rigid type variable bound by the type signature for: diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr index 731a14b..2309cda 100644 --- a/testsuite/tests/polykinds/T10503.stderr +++ b/testsuite/tests/polykinds/T10503.stderr @@ -2,8 +2,8 @@ T10503.hs:8:6: error: • Could not deduce: k ~ * from the context: Proxy 'KProxy ~ Proxy 'KProxy - bound by the type signature for: - h :: (Proxy 'KProxy ~ Proxy 'KProxy) => r + bound by a type expected by the context: + (Proxy 'KProxy ~ Proxy 'KProxy) => r at T10503.hs:8:6-85 ‘k’ is a rigid type variable bound by the type signature for: diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr index be80a79..94e0c16 100644 --- a/testsuite/tests/polykinds/T9222.stderr +++ b/testsuite/tests/polykinds/T9222.stderr @@ -3,7 +3,7 @@ T9222.hs:14:3: error: • Couldn't match type ‘c0’ with ‘c’ ‘c0’ is untouchable inside the constraints: a ~ '(b0, c0) - bound by the type of the constructor ‘Want’: + bound by a type expected by the context: (a ~ '(b0, c0)) => Proxy b0 at T9222.hs:14:3-43 ‘c’ is a rigid type variable bound by diff --git a/testsuite/tests/typecheck/should_compile/T7220a.stderr b/testsuite/tests/typecheck/should_compile/T7220a.stderr index a1e865f..2b311c1 100644 --- a/testsuite/tests/typecheck/should_compile/T7220a.stderr +++ b/testsuite/tests/typecheck/should_compile/T7220a.stderr @@ -2,13 +2,13 @@ T7220a.hs:17:6: error: • Could not deduce (C a b) from the context: (C a0 b, TF b ~ Y) - bound by the type signature for: - f :: forall b. (C a0 b, TF b ~ Y) => b + bound by a type expected by the context: + forall b. (C a0 b, TF b ~ Y) => b at T7220a.hs:17:6-44 Possible fix: add (C a b) to the context of - the type signature for: - f :: forall b. (C a0 b, TF b ~ Y) => b + a type expected by the context: + forall b. (C a0 b, TF b ~ Y) => b • In the ambiguity check for ‘f’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: f :: (forall b. (C a b, TF b ~ Y) => b) -> X diff --git a/testsuite/tests/typecheck/should_fail/T15438.hs b/testsuite/tests/typecheck/should_fail/T15438.hs new file mode 100644 index 0000000..0f99538 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15438.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE MultiParamTypeClasses, RankNTypes #-} + +module T15438 where + +class C a b + +foo :: (forall a b. C a b => b -> b) -> Int +foo = error "urk" diff --git a/testsuite/tests/typecheck/should_fail/T15438.stderr b/testsuite/tests/typecheck/should_fail/T15438.stderr new file mode 100644 index 0000000..473d5dc --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15438.stderr @@ -0,0 +1,11 @@ + +T15438.hs:7:8: error: + • Could not deduce (C a0 b) + from the context: C a b + bound by a type expected by the context: + forall a b. C a b => b -> b + at T15438.hs:7:8-43 + The type variable ‘a0’ is ambiguous + • In the ambiguity check for ‘foo’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: foo :: (forall a b. C a b => b -> b) -> Int diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index b357b55..9a042ec 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -475,3 +475,4 @@ test('T14904a', normal, compile_fail, ['']) test('T14904b', normal, compile_fail, ['']) test('T15067', normal, compile_fail, ['']) test('T15330', normal, compile_fail, ['']) +test('T15438', normal, compile_fail, ['']) From git at git.haskell.org Wed Jul 25 11:26:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 11:26:01 +0000 (UTC) Subject: [commit: ghc] master: Improve error message on un-satisfied import (f7d3054) Message-ID: <20180725112601.1352B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7d3054a133247cea1f488993695d3cbb941f29d/ghc >--------------------------------------------------------------- commit f7d3054a133247cea1f488993695d3cbb941f29d Author: Simon Peyton Jones Date: Wed Jul 25 11:21:36 2018 +0100 Improve error message on un-satisfied import Consider import M( C( a,b,c ) ) where class C is defined as module M where class C x where a :: blah c :: blah Tnen (Trac #15413) we'd like to get an error message only about failing to import C( b ), not C( a,b,c ). This was fairly easy (and local) to do. Turned out that the existing tests mod81 and mod91 are adequate tests for the feature. >--------------------------------------------------------------- f7d3054a133247cea1f488993695d3cbb941f29d compiler/rename/RnNames.hs | 79 ++++++++++++++++++++++--------------- testsuite/tests/module/mod81.stderr | 4 +- testsuite/tests/module/mod91.stderr | 3 +- 3 files changed, 51 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 f7d3054a133247cea1f488993695d3cbb941f29d From git at git.haskell.org Wed Jul 25 11:26:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 11:26:04 +0000 (UTC) Subject: [commit: ghc] master: Treat isConstraintKind more consistently (c5d31df) Message-ID: <20180725112604.C13513A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5d31df70b16dc346b5860077c8bbe585ddb7a78/ghc >--------------------------------------------------------------- commit c5d31df70b16dc346b5860077c8bbe585ddb7a78 Author: Simon Peyton Jones Date: Wed Jul 25 11:35:43 2018 +0100 Treat isConstraintKind more consistently It turned out that we were not being consistent about our use of isConstraintKind. It's delicate, because the typechecker treats Constraint and Type as /distinct/, whereas they are the /same/ in the rest of the compiler (Trac #11715). And had it wrong, which led to Trac #15412. This patch does the following: * Rename isConstraintKind to tcIsConstraintKind returnsConstraintKind to tcReturnsConstraintKind to emphasise that they use the 'tcView' view of types. * Move these functions, and some related ones (tcIsLiftedTypeKind), from Kind.hs, to group together in Type.hs, alongside isPredTy. It feels very unsatisfactory that these 'tcX' functions live in Type, but it happens because isPredTy is called later in the compiler too. But it's a consequence of the 'Constraint vs Type' dilemma. >--------------------------------------------------------------- c5d31df70b16dc346b5860077c8bbe585ddb7a78 compiler/typecheck/ClsInst.hs | 3 +- compiler/typecheck/TcErrors.hs | 6 +- compiler/typecheck/TcHsType.hs | 9 +- compiler/typecheck/TcInstDcls.hs | 1 - compiler/typecheck/TcMType.hs | 5 +- compiler/typecheck/TcSplice.hs | 1 - compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcType.hs | 69 ++++++------ compiler/typecheck/TcValidity.hs | 8 +- compiler/types/Kind.hs | 31 +---- compiler/types/TyCoRep.hs | 22 +--- compiler/types/Type.hs | 125 ++++++++++++++------- compiler/types/Unify.hs | 1 - testsuite/tests/rename/should_fail/T5513.stderr | 2 +- testsuite/tests/typecheck/should_compile/T15412.hs | 17 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + 16 files changed, 156 insertions(+), 149 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c5d31df70b16dc346b5860077c8bbe585ddb7a78 From git at git.haskell.org Wed Jul 25 11:26:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 11:26:07 +0000 (UTC) Subject: [commit: ghc] master: tc-tracing only (a434bcb) Message-ID: <20180725112607.9671E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a434bcbc8049f3f98a1312f3001c93d415b5c4ae/ghc >--------------------------------------------------------------- commit a434bcbc8049f3f98a1312f3001c93d415b5c4ae Author: Simon Peyton Jones Date: Wed Jul 25 11:52:44 2018 +0100 tc-tracing only >--------------------------------------------------------------- a434bcbc8049f3f98a1312f3001c93d415b5c4ae compiler/typecheck/FunDeps.hs | 9 ++++++++- compiler/typecheck/TcInteract.hs | 3 ++- compiler/typecheck/TcSimplify.hs | 5 ++++- 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs index c8f0b1d..4052ccb 100644 --- a/compiler/typecheck/FunDeps.hs +++ b/compiler/typecheck/FunDeps.hs @@ -283,7 +283,14 @@ improveClsFD clas_tvs fd -> [] | otherwise - -> [(meta_tvs, fdeqs)] + -> -- pprTrace "iproveClsFD" (vcat + -- [ text "is_tvs =" <+> ppr qtvs + -- , text "tys_inst =" <+> ppr tys_inst + -- , text "tys_actual =" <+> ppr tys_actual + -- , text "ltys1 =" <+> ppr ltys1 + -- , text "ltys2 =" <+> ppr ltys2 + -- , text "subst =" <+> ppr subst ]) $ + [(meta_tvs, fdeqs)] -- We could avoid this substTy stuff by producing the eqn -- (qtvs, ls1++rs1, ls2++rs2) -- which will re-do the ls1/ls2 unification when the equation is diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 9b50b09..028b755 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1608,7 +1608,8 @@ interactTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv ; stopWith ev "Solved from inert" } | ReprEq <- eq_rel -- See Note [Do not unify representational equalities] - = continueWith workItem + = do { traceTcS "Not unifying representational equality" (ppr workItem) + ; continueWith workItem } | isGiven ev -- See Note [Touchables and givens] = continueWith workItem diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index fb5a70c..97da3dc 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1357,7 +1357,10 @@ solveWanteds :: WantedConstraints -> TcS WantedConstraints -- so that the inert set doesn't mindlessly propagate. -- NB: wc_simples may be wanted /or/ derived now solveWanteds wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { traceTcS "solveWanteds {" (ppr wc) + = do { cur_lvl <- TcS.getTcLevel + ; traceTcS "solveWanteds {" $ + vcat [ text "Level =" <+> ppr cur_lvl + , ppr wc ] ; wc1 <- solveSimpleWanteds simples -- Any insoluble constraints are in 'simples' and so get rewritten From git at git.haskell.org Wed Jul 25 11:26:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 11:26:10 +0000 (UTC) Subject: [commit: ghc] master: Fix and document cloneWC (857ef25) Message-ID: <20180725112610.795A53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/857ef25e3b077ac1cdf54e2e6f7adf9a1c83a31e/ghc >--------------------------------------------------------------- commit 857ef25e3b077ac1cdf54e2e6f7adf9a1c83a31e Author: Simon Peyton Jones Date: Wed Jul 25 11:47:45 2018 +0100 Fix and document cloneWC The cloneWC, cloneWanted, cloneImplication family are used by * TcHoleErrors * TcRule to clone the /bindings/ in a constraint, so that solving the constraint will not add bindings to the program. The idea is only to affect unifications. But I had it wrong -- I failed to clone the EvBindsVar of an implication. That gave an assert failure, I think, as well as useless dead code. The fix is easy. I'm not adding a test case. In the type 'TcEvidence.EvBindsVar', I also renamed the 'NoEvBindsVar' constructor to 'CoEvBindsVar'. It's not that we have /no/ evidence bindings, just that we can only have coercion bindings, done via HoleDest. >--------------------------------------------------------------- 857ef25e3b077ac1cdf54e2e6f7adf9a1c83a31e compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcEvidence.hs | 20 +++++++++--------- compiler/typecheck/TcHoleErrors.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 2 +- compiler/typecheck/TcInteract.hs | 4 ++-- compiler/typecheck/TcMType.hs | 42 +++++++++++++++++++++++++------------- compiler/typecheck/TcRnMonad.hs | 24 ++++++++++++++++------ 7 files changed, 61 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 857ef25e3b077ac1cdf54e2e6f7adf9a1c83a31e From git at git.haskell.org Wed Jul 25 11:26:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 11:26:13 +0000 (UTC) Subject: [commit: ghc] master: Comments only (0f5a63e) Message-ID: <20180725112613.4AB393A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f5a63e3d763f18c683f076e0e96396166863f56/ghc >--------------------------------------------------------------- commit 0f5a63e3d763f18c683f076e0e96396166863f56 Author: Simon Peyton Jones Date: Wed Jul 25 12:03:43 2018 +0100 Comments only >--------------------------------------------------------------- 0f5a63e3d763f18c683f076e0e96396166863f56 compiler/typecheck/TcSimplify.hs | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 97da3dc..5856c0f 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -2309,24 +2309,30 @@ Note [Which equalities to float] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Which equalities should we float? We want to float ones where there is a decent chance that floating outwards will allow unification to -happen. In particular: - - Float out homogeneous equalities of form (alpha ~ ty) or (ty ~ alpha), where +happen. In particular, float out equalities that are: +* Of form (alpha ~# ty) or (ty ~# alpha), where * alpha is a meta-tyvar. - * And 'alpha' is not a SigTv with 'ty' being a non-tyvar. In that case, floating out won't help either, and it may affect grouping of error messages. -Why homogeneous (i.e., the kinds of the types are the same)? Because heterogeneous -equalities have derived kind equalities. See Note [Equalities with incompatible kinds] -in TcCanonical. If we float out a hetero equality, then it will spit out the -same derived kind equality again, which might create duplicate error messages. -Instead, we do float out the kind equality (if it's worth floating out, as -above). If/when we solve it, we'll be able to rewrite the original hetero equality -to be homogeneous, and then perhaps make progress / float it out. The duplicate -error message was spotted in typecheck/should_fail/T7368. +* Homogeneous (both sides have the same kind). Why only homogeneous? + Because heterogeneous equalities have derived kind equalities. + See Note [Equalities with incompatible kinds] in TcCanonical. + If we float out a hetero equality, then it will spit out the same + derived kind equality again, which might create duplicate error + messages. + + Instead, we do float out the kind equality (if it's worth floating + out, as above). If/when we solve it, we'll be able to rewrite the + original hetero equality to be homogeneous, and then perhaps make + progress / float it out. The duplicate error message was spotted in + typecheck/should_fail/T7368. + +* Nominal. No point in floating (alpha ~R# ty), because we do not + unify representational equalities even if alpha is touchable. + See Note [Do not unify representational equalities] in TcInteract. Note [Skolem escape] ~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Wed Jul 25 13:26:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 13:26:37 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: circleci: Reenable FreeBSD (5c14884) Message-ID: <20180725132637.5D4C73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/5c14884e961ee96fa6d0b435031b1e50a1d6239c/ghc >--------------------------------------------------------------- commit 5c14884e961ee96fa6d0b435031b1e50a1d6239c Author: Ben Gamari Date: Tue Jul 24 11:43:06 2018 -0400 circleci: Reenable FreeBSD >--------------------------------------------------------------- 5c14884e961ee96fa6d0b435031b1e50a1d6239c .circleci/config.yml | 3 +-- .circleci/prepare-system.sh | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 298162e..f7cc5a0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -285,8 +285,7 @@ workflows: jobs: - validate-x86_64-linux: *trigger_on_tags - # FreeBSD disabled: https://github.com/haskell/unix/issues/102 - # - validate-x86_64-freebsd + - validate-x86_64-freebsd - validate-x86_64-darwin: *trigger_on_tags - validate-x86_64-linux-llvm diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index df0da01..34ad870 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -27,7 +27,7 @@ case "$(uname)" in # cross-compiling to FreeBSD add-apt-repository -y ppa:hvr/ghc apt-get update -qq - apt-get install -qy ghc-8.0.2 cabal-install-1.24 alex happy \ + apt-get install -qy ghc-8.0.2 cabal-install alex happy \ ncurses-dev git make automake autoconf gcc perl \ python3 texinfo xz-utils lbzip2 patch cabal update From git at git.haskell.org Wed Jul 25 13:31:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 13:31:15 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: circleci: Reenable FreeBSD (f8360a0) Message-ID: <20180725133115.DF2EB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/f8360a0db06246e189431e45487a429f82f7c1bb/ghc >--------------------------------------------------------------- commit f8360a0db06246e189431e45487a429f82f7c1bb Author: Ben Gamari Date: Tue Jul 24 11:43:06 2018 -0400 circleci: Reenable FreeBSD >--------------------------------------------------------------- f8360a0db06246e189431e45487a429f82f7c1bb .circleci/config.yml | 3 +-- .circleci/prepare-system.sh | 5 ++--- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 298162e..f7cc5a0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -285,8 +285,7 @@ workflows: jobs: - validate-x86_64-linux: *trigger_on_tags - # FreeBSD disabled: https://github.com/haskell/unix/issues/102 - # - validate-x86_64-freebsd + - validate-x86_64-freebsd - validate-x86_64-darwin: *trigger_on_tags - validate-x86_64-linux-llvm diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index df0da01..c8ae019 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -9,7 +9,6 @@ fail() { echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk -hackage_index_state="@1522046735" cat > mk/build.mk <> mk/build.mk From git at git.haskell.org Wed Jul 25 16:21:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 16:21:31 +0000 (UTC) Subject: [commit: ghc] master: Fix PrelRules.caseRules to account for out-of-range tags (9897f67) Message-ID: <20180725162131.8DA1F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9897f6783a58265d5eaef5fb06f04320c7737e87/ghc >--------------------------------------------------------------- commit 9897f6783a58265d5eaef5fb06f04320c7737e87 Author: Simon Peyton Jones Date: Wed Jul 25 16:41:16 2018 +0100 Fix PrelRules.caseRules to account for out-of-range tags As Trac #15436 points out, it is possible to get case dataToTag# (x :: T) of DEFAULT -> blah1 -1# -> blah2 0 -> blah3 The (-1#) alterantive is unreachable, because dataToTag# returns tags in the range [0..n-1] where n is the number of data constructors in type T. This actually made GHC crash; now we simply discard the unreachable alterantive. See Note [Unreachable caseRules alternatives] in PrelRules >--------------------------------------------------------------- 9897f6783a58265d5eaef5fb06f04320c7737e87 compiler/prelude/PrelRules.hs | 64 +++++++++++++++------- compiler/prelude/primops.txt.pp | 2 +- compiler/simplCore/SimplUtils.hs | 33 +++++++---- testsuite/tests/simplCore/should_run/T15436.hs | 21 +++++++ testsuite/tests/simplCore/should_run/T15436.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 1 + 6 files changed, 90 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9897f6783a58265d5eaef5fb06f04320c7737e87 From git at git.haskell.org Wed Jul 25 16:50:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jul 2018 16:50:54 +0000 (UTC) Subject: [commit: ghc] master: Comments only (4c571f3) Message-ID: <20180725165054.75C353A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c571f3321eb8f7a06dada4c37822c22bbdd148b/ghc >--------------------------------------------------------------- commit 4c571f3321eb8f7a06dada4c37822c22bbdd148b Author: Simon Peyton Jones Date: Wed Jul 25 17:50:28 2018 +0100 Comments only >--------------------------------------------------------------- 4c571f3321eb8f7a06dada4c37822c22bbdd148b compiler/deSugar/DsBinds.hs | 5 +++-- compiler/typecheck/TcRnTypes.hs | 12 +++++++++--- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index db7acfd..6524e10 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -184,8 +184,9 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_binds = binds, abs_sig = has_sig }) = do { ds_binds <- addDictsDs (listToBag dicts) $ dsLHsBinds binds - -- addDictsDs: push type constraints deeper - -- for inner pattern match check + -- addDictsDs: push type constraints deeper + -- for inner pattern match check + -- See Check, Note [Type and Term Equality Propagation] ; ds_ev_binds <- dsTcEvBinds_s ev_binds diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index e8f0762..6627c25 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -385,9 +385,15 @@ instance ContainsModule DsGblEnv where data DsLclEnv = DsLclEnv { dsl_meta :: DsMetaEnv, -- Template Haskell bindings dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs - dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, - dsl_pm_iter :: IORef Int -- no iterations for pmcheck + + -- See Note [Note [Type and Term Equality Propagation] in Check.hs + -- These two fields are augmented as we walk inwards, + -- through each patttern match in turn + dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching + dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + + dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far + -- We fail if this gets too big } -- Inside [| |] brackets, the desugarer looks From git at git.haskell.org Thu Jul 26 18:40:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 18:40:25 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: circleci: Reenable FreeBSD (9400c43) Message-ID: <20180726184025.8412B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/9400c43bcb433777cdba29caeb511941693b6348/ghc >--------------------------------------------------------------- commit 9400c43bcb433777cdba29caeb511941693b6348 Author: Ben Gamari Date: Tue Jul 24 11:43:06 2018 -0400 circleci: Reenable FreeBSD >--------------------------------------------------------------- 9400c43bcb433777cdba29caeb511941693b6348 .circleci/config.yml | 23 +++++++++++------------ .circleci/prepare-system.sh | 8 ++++---- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 298162e..c5b3fbf 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -283,18 +283,17 @@ workflows: version: 2 validate: jobs: - - validate-x86_64-linux: - *trigger_on_tags - # FreeBSD disabled: https://github.com/haskell/unix/issues/102 - # - validate-x86_64-freebsd - - validate-x86_64-darwin: - *trigger_on_tags - - validate-x86_64-linux-llvm - - validate-i386-linux: - *trigger_on_tags - - validate-hadrian-x86_64-linux - - validate-x86_64-fedora: - *trigger_on_tags + #- validate-x86_64-linux: + # *trigger_on_tags + - validate-x86_64-freebsd + #- validate-x86_64-darwin: + # *trigger_on_tags + #- validate-x86_64-linux-llvm + #- validate-i386-linux: + # *trigger_on_tags + #- validate-hadrian-x86_64-linux + #- validate-x86_64-fedora: + # *trigger_on_tags nightly: triggers: diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index df0da01..414f5a6 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -9,7 +9,6 @@ fail() { echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk -hackage_index_state="@1522046735" cat > mk/build.mk <> mk/build.mk echo 'WERROR=' >> mk/build.mk # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV + echo 'export PATH=/opt/ghc/8.4.3/bin:$PATH' >> $BASH_ENV else fail "TARGET=$target not supported" fi From git at git.haskell.org Thu Jul 26 21:35:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:35:57 +0000 (UTC) Subject: [commit: hadrian] master: Added support for testsuite (#602) (ef4137d) Message-ID: <20180726213557.D26543A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/ef4137d7e4a8f8f703278042e25f1ab0990ab4df >--------------------------------------------------------------- commit ef4137d7e4a8f8f703278042e25f1ab0990ab4df Author: Chitrak Raj Gupta Date: Wed Jun 13 15:58:25 2018 +0530 Added support for testsuite (#602) * Rule for testsuite dependencies * Separated validate builder arguments * Added RunTest config options * added support to set test speed with runtest * Fixed minor bug with testConfigs Removed indentation error * Added support for more testing features * Rectified Merge Errors * Removed need rule for Hp2ps * using all available threads * Minor Revision * Removed TestThread argument * Update Utilities.hs >--------------------------------------------------------------- ef4137d7e4a8f8f703278042e25f1ab0990ab4df src/CommandLine.hs | 85 ++++++++++++++++++++++++++++++---------- src/GHC.hs | 21 +++++----- src/GHC/Packages.hs | 15 +++---- src/Rules/Test.hs | 13 +++++- src/Settings/Builders/Make.hs | 23 ++++++++++- src/Settings/Builders/RunTest.hs | 35 +++++++++++++++-- src/Settings/Default.hs | 1 + 7 files changed, 150 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ef4137d7e4a8f8f703278042e25f1ab0990ab4df From git at git.haskell.org Thu Jul 26 21:35:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:35:59 +0000 (UTC) Subject: [commit: hadrian] master: Bump Shake version to 0.16.1. (#618) (ccf6453) Message-ID: <20180726213559.D6D953A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/ccf6453f33ef02213b1cc2f680698228e8485a7d >--------------------------------------------------------------- commit ccf6453f33ef02213b1cc2f680698228e8485a7d Author: Tao He Date: Wed Jun 13 18:31:26 2018 +0800 Bump Shake version to 0.16.1. (#618) The shake-0.16 can't be built with ghc-8.4.3, due to the Semigroup-Monoid-Proposal changes. shake-0.16.1 fixed that. >--------------------------------------------------------------- ccf6453f33ef02213b1cc2f680698228e8485a7d hadrian.cabal | 2 +- stack.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hadrian.cabal b/hadrian.cabal index 0bcbf1f..ef90c74 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -121,7 +121,7 @@ executable hadrian , mtl == 2.2.* , parsec >= 3.1 && < 3.2 , QuickCheck >= 2.6 && < 2.11 - , shake == 0.16.* + , shake >= 0.16.1 , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 diff --git a/stack.yaml b/stack.yaml index 663389f..61767bd 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,7 +10,7 @@ packages: - '../libraries/text' extra-deps: -- shake-0.16 +- shake-0.16.1 nix: enable: false From git at git.haskell.org Thu Jul 26 21:36:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:01 +0000 (UTC) Subject: [commit: hadrian] master: Add `gmp` and `ncurses` as nix dependencies (#616) (c51b92b) Message-ID: <20180726213601.DC9173A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/c51b92b59d638f0692b7649d1aad226c5b500a56 >--------------------------------------------------------------- commit c51b92b59d638f0692b7649d1aad226c5b500a56 Author: Sean Gillespie Date: Wed Jun 13 07:04:57 2018 -0400 Add `gmp` and `ncurses` as nix dependencies (#616) See #615 >--------------------------------------------------------------- c51b92b59d638f0692b7649d1aad226c5b500a56 shell.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/shell.nix b/shell.nix index f193000..041bf09 100644 --- a/shell.nix +++ b/shell.nix @@ -76,6 +76,8 @@ in [ hadrianPackages.hadrian nixpkgs.arcanist nixpkgs.git + nixpkgs.gmp.dev nixpkgs.gmp.out + nixpkgs.ncurses.dev nixpkgs.ncurses.out nixpkgs.python3Packages.sphinx nixpkgs.texlive.combined.scheme-basic (nixpkgs.haskell.packages.ghc822.ghcWithPackages From git at git.haskell.org Thu Jul 26 21:36:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:03 +0000 (UTC) Subject: [commit: hadrian] master: Minor revision (#619) (c866660) Message-ID: <20180726213603.E344F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/c866660513a23723209a81f07b1b859265fe33bf >--------------------------------------------------------------- commit c866660513a23723209a81f07b1b859265fe33bf Author: Andrey Mokhov Date: Thu Jun 14 01:43:31 2018 +0100 Minor revision (#619) See #540 >--------------------------------------------------------------- c866660513a23723209a81f07b1b859265fe33bf src/GHC.hs | 6 +- src/Hadrian/Haskell/Cabal/PackageData.hs | 69 ++++---- src/Hadrian/Haskell/Cabal/Parse.hs | 125 +++++++-------- src/Oracles/Flag.hs | 10 +- src/Rules/Generate.hs | 6 +- src/Rules/Program.hs | 4 +- src/Settings/Builders/GhcCabal.hs | 5 +- src/Settings/Builders/Hsc2Hs.hs | 4 +- src/Settings/Builders/RunTest.hs | 2 +- src/Settings/Packages.hs | 263 ++++++++++++++++++------------- src/Settings/Packages/Compiler.hs | 2 +- 11 files changed, 268 insertions(+), 228 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c866660513a23723209a81f07b1b859265fe33bf From git at git.haskell.org Thu Jul 26 21:36:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:05 +0000 (UTC) Subject: [commit: hadrian] master: Add test compiler option to test (#621) (0b35e12) Message-ID: <20180726213605.EA05F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/0b35e12f4d90227e62ac9a5c700b95ce40f70a3a >--------------------------------------------------------------- commit 0b35e12f4d90227e62ac9a5c700b95ce40f70a3a Author: Chitrak Raj Gupta Date: Fri Jun 15 03:23:24 2018 +0530 Add test compiler option to test (#621) * Rule for testsuite dependencies * Added RunTest config options * added support to set test speed with runtest * Added support for more testing features * Rectified Merge Errors * using all available threads * Minor Revision * Removed TestThread argument * Update Utilities.hs * Added support to choose test compiler * Minor Revision * Added comments * Update RunTest.hs * Update CommandLine.hs * Update RunTest.hs >--------------------------------------------------------------- 0b35e12f4d90227e62ac9a5c700b95ce40f70a3a src/CommandLine.hs | 17 +++++-- src/Oracles/Setting.hs | 2 + src/Rules/Test.hs | 1 - src/Settings/Builders/RunTest.hs | 105 ++++++++++++++++++++++++--------------- 4 files changed, 79 insertions(+), 46 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0b35e12f4d90227e62ac9a5c700b95ce40f70a3a From git at git.haskell.org Thu Jul 26 21:36:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:08 +0000 (UTC) Subject: [commit: hadrian] master: Refactor package-specific settings (#622) (2358090) Message-ID: <20180726213608.00CCB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/235809092b65d1631735b70e9ce9dd2e9ebab47d >--------------------------------------------------------------- commit 235809092b65d1631735b70e9ce9dd2e9ebab47d Author: Andrey Mokhov Date: Fri Jun 15 01:15:47 2018 +0100 Refactor package-specific settings (#622) * Minor clean up * Track rts.cabal * Move all package-specific settings to Settings.Packages, plus another revision, see #540 * Drop Rules.PackageData >--------------------------------------------------------------- 235809092b65d1631735b70e9ce9dd2e9ebab47d hadrian.cabal | 4 +- src/Base.hs | 7 +- src/Context.hs | 3 +- src/Context/{Paths.hs => Path.hs} | 14 ++- src/GHC.hs | 28 ++++- src/Rules.hs | 15 ++- src/Rules/Configure.hs | 9 +- src/Rules/Generate.hs | 3 +- src/Rules/Gmp.hs | 2 +- src/Rules/Libffi.hs | 21 ++-- src/Rules/PackageData.hs | 33 ----- src/Rules/Program.hs | 1 - src/Rules/Register.hs | 51 ++++---- src/Settings/Builders/Configure.hs | 2 +- src/Settings/Builders/Make.hs | 1 - src/Settings/Default.hs | 6 +- src/Settings/Packages.hs | 222 +++++++++++++++++++++++++++++++-- src/Settings/Packages/Base.hs | 12 -- src/Settings/Packages/Cabal.hs | 10 -- src/Settings/Packages/Compiler.hs | 45 ------- src/Settings/Packages/Ghc.hs | 13 -- src/Settings/Packages/GhcCabal.hs | 32 ----- src/Settings/Packages/GhcPkg.hs | 7 -- src/Settings/Packages/GhcPrim.hs | 12 -- src/Settings/Packages/Ghci.hs | 6 - src/Settings/Packages/Haddock.hs | 7 -- src/Settings/Packages/IntegerGmp.hs | 24 ---- src/Settings/Packages/Rts.hs | 236 ------------------------------------ src/Settings/Packages/RunGhc.hs | 9 -- 29 files changed, 307 insertions(+), 528 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 235809092b65d1631735b70e9ce9dd2e9ebab47d From git at git.haskell.org Thu Jul 26 21:36:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:10 +0000 (UTC) Subject: [commit: hadrian] master: Set more test arguments correctly (#625) (1906828) Message-ID: <20180726213610.061A63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/190682875096bb9eaa4205a05a6b53f73194b7f3 >--------------------------------------------------------------- commit 190682875096bb9eaa4205a05a6b53f73194b7f3 Author: Alp Mestanogullari Date: Fri Jun 15 15:09:57 2018 +0200 Set more test arguments correctly (#625) * attempt at setting some more test arguments correctly * use vanillaContext >--------------------------------------------------------------- 190682875096bb9eaa4205a05a6b53f73194b7f3 src/GHC.hs | 2 ++ src/Rules/Test.hs | 7 ++++++- src/Settings/Builders/RunTest.hs | 33 +++++++++++++++++++++------------ 3 files changed, 29 insertions(+), 13 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 9a160ce..5ee56fc 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -107,6 +107,8 @@ stage2Packages = return [haddock] testsuitePackages :: Action [Package] testsuitePackages = return [ checkApiAnnotations , checkPpr + , ghcPkg + , parallel , hp2ps ] -- | Given a 'Context', compute the name of the program that is built in it diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index c74cf58..faa79cb 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -71,7 +71,12 @@ needTestsuiteBuilders = do need targets where needfile :: Stage -> Package -> Action FilePath - needfile stage pkg = programPath =<< programContext stage pkg + needfile stage pkg + -- TODO (Alp): we might sometimes need more than vanilla! + -- This should therefore depend on what test ways + -- we are going to use, I suppose? + | isLibrary pkg = pkgConfFile (vanillaContext stage pkg) + | otherwise = programPath =<< programContext stage pkg needTestBuilders :: Action () needTestBuilders = do diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 53cf4ef..1feef05 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -8,7 +8,13 @@ import Oracles.Setting (setting) import Rules.Test import Settings.Builders.Common +oneZero :: String -> Bool -> String +oneZero lbl False = lbl ++ "=0" +oneZero lbl True = lbl ++ "=1" + -- Arguments to send to the runtest.py script. +-- +-- A lot of this mirrors what's achieved at testsuite/mk/test.mk. runTestBuilderArgs :: Args runTestBuilderArgs = builder RunTest ? do pkgs <- expr $ stagePackages Stage1 @@ -16,7 +22,12 @@ runTestBuilderArgs = builder RunTest ? do [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ] | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ] - debugged <- ghcDebugged <$> expr flavour + flav <- expr flavour + rtsways <- rtsWays flav + libways <- libraryWays flav + let hasRtsWay w = elem w rtsways + hasLibWay w = elem w libways + debugged = ghcDebugged flav withNativeCodeGen <- expr ghcWithNativeCodeGen withInterpreter <- expr ghcWithInterpreter @@ -33,6 +44,8 @@ runTestBuilderArgs = builder RunTest ? do ghcFlags <- expr runTestGhcFlags timeoutProg <- expr buildRoot <&> (-/- timeoutProgPath) + -- TODO: set CABAL_MINIMAL_BUILD/CABAL_PLUGIN_BUILD + mconcat [ arg $ "testsuite/driver/runtests.py" , arg $ "--rootdir=" ++ ("testsuite" -/- "tests") , pure ["--rootdir=" ++ test | test <- libTests] @@ -43,24 +56,20 @@ runTestBuilderArgs = builder RunTest ? do , arg "-e", arg $ "config.cleanup=False" -- Don't clean up. , arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged) , arg "-e", arg $ "ghc_debugged=" ++ quote (yesNo debugged) - , arg "-e", arg $ "ghc_with_native_codegen=" ++ zeroOne withNativeCodeGen + , arg "-e", arg $ oneZero "ghc_with_native_codegen" withNativeCodeGen , arg "-e", arg $ "config.have_interp=" ++ show withInterpreter , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised , arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags - , arg "-e", arg $ "ghc_with_vanilla=1" -- TODO: do we always build vanilla? - , arg "-e", arg $ "ghc_with_dynamic=0" -- TODO: support dynamic - , arg "-e", arg $ "ghc_with_profiling=0" -- TODO: support profiling - - , arg "-e", arg $ "config.have_vanilla=1" -- TODO: support other build context - , arg "-e", arg $ "config.have_dynamic=0" -- TODO: support dynamic - , arg "-e", arg $ "config.have_profiling=0" -- TODO: support profiling - , arg "-e", arg $ "ghc_with_smp=" ++ zeroOne withSMP + , arg "-e", arg $ oneZero "ghc_with_dynamic_rts" (hasRtsWay dynamic) + , arg "-e", arg $ oneZero "ghc_with_threaded_rts" (hasRtsWay threaded) + , arg "-e", arg $ oneZero "config.have_vanilla" (hasLibWay vanilla) + , arg "-e", arg $ oneZero "config.have_dynamic" (hasLibWay dynamic) + , arg "-e", arg $ oneZero "config.have_profiling" (hasLibWay profiling) + , arg "-e", arg $ oneZero "ghc_with_smp" withSMP , arg "-e", arg $ "ghc_with_llvm=0" -- TODO: support LLVM - , arg "-e", arg $ "ghc_with_threaded_rts=0" -- TODO: support threaded - , arg "-e", arg $ "ghc_with_dynamic_rts=0" -- TODO: support dynamic , arg "-e", arg $ "config.ghc_dynamic_by_default=False" -- TODO: support dynamic , arg "-e", arg $ "config.ghc_dynamic=False" -- TODO: support dynamic From git at git.haskell.org Thu Jul 26 21:36:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:12 +0000 (UTC) Subject: [commit: hadrian] master: Add config file and test speed options to testsuite (#624) (831e1ce) Message-ID: <20180726213612.0B7773A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/831e1ce04983f640a1234f7706fa4ba975ae6a92 >--------------------------------------------------------------- commit 831e1ce04983f640a1234f7706fa4ba975ae6a92 Author: Chitrak Raj Gupta Date: Fri Jun 15 20:11:40 2018 +0530 Add config file and test speed options to testsuite (#624) * Added option to specify config file * Added speed setting for validation * Revision >--------------------------------------------------------------- 831e1ce04983f640a1234f7706fa4ba975ae6a92 src/CommandLine.hs | 50 ++++++++++++++++++++++++---------------- src/Settings/Builders/Make.hs | 9 +++++++- src/Settings/Builders/RunTest.hs | 6 ++--- 3 files changed, 41 insertions(+), 24 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 18ddbbc..76e2357 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -45,31 +45,33 @@ defaultCommandLineArgs = CommandLineArgs -- | These arguments are used by the `test` target. data TestArgs = TestArgs - { testCompiler :: String - , testConfigs :: [String] - , testJUnit :: Maybe FilePath - , testOnly :: Maybe String - , testOnlyPerf :: Bool - , testSkipPerf :: Bool - , testSpeed :: TestSpeed - , testSummary :: Maybe FilePath - , testVerbosity:: Maybe String - , testWays :: [String] } + { testCompiler :: String + , testConfigFile :: String + , testConfigs :: [String] + , testJUnit :: Maybe FilePath + , testOnly :: Maybe String + , testOnlyPerf :: Bool + , testSkipPerf :: Bool + , testSpeed :: TestSpeed + , testSummary :: Maybe FilePath + , testVerbosity :: Maybe String + , testWays :: [String] } deriving (Eq, Show) -- | Default value for `TestArgs`. defaultTestArgs :: TestArgs defaultTestArgs = TestArgs - { testCompiler = "stage2" - , testConfigs = [] - , testJUnit = Nothing - , testOnly = Nothing - , testOnlyPerf = False - , testSkipPerf = False - , testSpeed = Average - , testSummary = Nothing - , testVerbosity= Nothing - , testWays = [] } + { testCompiler = "stage2" + , testConfigFile = "testsuite/config/ghc" + , testConfigs = [] + , testJUnit = Nothing + , testOnly = Nothing + , testOnlyPerf = False + , testSkipPerf = False + , testSpeed = Fast + , testSummary = Nothing + , testVerbosity = Nothing + , testWays = [] } readConfigure :: Either String (CommandLineArgs -> CommandLineArgs) readConfigure = Right $ \flags -> flags { configure = True } @@ -136,6 +138,12 @@ readTestConfig config = let configs = conf : testConfigs (testArgs flags) in flags { testArgs = (testArgs flags) { testConfigs = configs } } +readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) +readTestConfigFile filepath = + maybe (Left "Cannot parse test-speed") (Right . set) filepath + where + set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } } + readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } } @@ -197,6 +205,8 @@ optDescrs = "Generate split objects (requires a full clean rebuild)." , Option [] ["test-compiler"] (OptArg readTestCompiler "TEST_COMPILER") "Use given compiler [Default=stage2]." + , Option [] ["test-config-file"] (OptArg readTestConfigFile "CONFIG_FILE") + "congiguration file for testsuite. Default=testsuite/config/ghc" , Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG") "Configurations to run test, in key=value format." , Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT") diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index f366b83..a27e4b4 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -4,6 +4,7 @@ import GHC import Oracles.Setting import Rules.Gmp import Settings.Builders.Common +import CommandLine makeBuilderArgs :: Args makeBuilderArgs = do @@ -23,7 +24,8 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do compiler <- expr $ fullpath ghc checkPpr <- expr $ fullpath checkPpr checkApiAnnotations <- expr $ fullpath checkApiAnnotations - return [ "fast" + args <- expr $ userSetting defaultTestArgs + return [ setTestSpeed $ testSpeed args , "THREADS=" ++ show threads , "TEST_HC=" ++ (top -/- compiler) , "CHECK_PPR=" ++ (top -/- checkPpr) @@ -33,3 +35,8 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do fullpath :: Package -> Action FilePath fullpath pkg = programPath =<< programContext Stage1 pkg +-- | Support for speed of validation +setTestSpeed :: TestSpeed -> String +setTestSpeed Fast = "fasttest" +setTestSpeed Average = "test" +setTestSpeed Slow = "slowtest" diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 1feef05..41da284 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -80,7 +80,6 @@ runTestBuilderArgs = builder RunTest ? do , arg "-e", arg $ "config.arch=" ++ show arch , arg "-e", arg $ "config.platform=" ++ show platform - , arg "--config-file=testsuite/config/ghc" , arg "--config", arg $ "gs=gs" -- Use the default value as in test.mk , arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg) , arg $ "--threads=" ++ show threads @@ -94,7 +93,8 @@ getTestArgs = do bindir <- expr $ setBinaryDirectory (testCompiler args) compiler <- expr $ setCompiler (testCompiler args) globalVerbosity <- shakeVerbosity <$> expr getShakeOptions - let testOnlyArg = case testOnly args of + let configFileArg= ["--config-file=" ++ (testConfigFile args)] + testOnlyArg = case testOnly args of Just cases -> map ("--only=" ++) (words cases) Nothing -> [] onlyPerfArg = if testOnlyPerf args @@ -120,7 +120,7 @@ getTestArgs = do haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")] hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")] hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")] - pure $ testOnlyArg ++ speedArg + pure $ configFileArg ++ testOnlyArg ++ speedArg ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg , junitArg, verbosityArg ] ++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg From git at git.haskell.org Thu Jul 26 21:36:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:14 +0000 (UTC) Subject: [commit: hadrian] master: Read the `main-is` field from the cabal file for executables (#627) (f319243) Message-ID: <20180726213614.110893A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/f3192439950ba3a3af58410c331d2492322dd4ab >--------------------------------------------------------------- commit f3192439950ba3a3af58410c331d2492322dd4ab Author: Tao He Date: Mon Jun 18 22:53:38 2018 +0800 Read the `main-is` field from the cabal file for executables (#627) * For executables, we should read the `main-is` field from the cabal file. Previously, we simply treat file name for `Main` module as `Main.hs` to build executable. That doesn't work for the `timeout` program. This patch fixes the problem. * Add comments about the processing of `main-is` field from .cabal file. >--------------------------------------------------------------- f3192439950ba3a3af58410c331d2492322dd4ab src/Hadrian/Haskell/Cabal/PackageData.hs | 1 + src/Hadrian/Haskell/Cabal/Parse.hs | 19 ++++++++++++------- src/Oracles/ModuleFiles.hs | 26 ++++++++++++++++++++++++-- 3 files changed, 37 insertions(+), 9 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/PackageData.hs b/src/Hadrian/Haskell/Cabal/PackageData.hs index d4cd41a..d54809e 100644 --- a/src/Hadrian/Haskell/Cabal/PackageData.hs +++ b/src/Hadrian/Haskell/Cabal/PackageData.hs @@ -10,6 +10,7 @@ data PackageData = PackageData , name :: PackageName , version :: String , componentId :: String + , mainIs :: Maybe (String, FilePath) -- ("Main", filepath) , modules :: [String] , otherModules :: [String] , synopsis :: String diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 9e6b875..1f54035 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -54,13 +54,13 @@ import Settings parseCabalPkgId :: FilePath -> IO String parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file -biModules :: C.PackageDescription -> (C.BuildInfo, [C.ModuleName]) -biModules pd = go [ comp | comp@(bi,_) <- +biModules :: C.PackageDescription -> (C.BuildInfo, [C.ModuleName], Maybe (C.ModuleName, String)) +biModules pd = go [ comp | comp@(bi,_,_) <- (map libBiModules . maybeToList $ C.library pd) ++ (map exeBiModules $ C.executables pd) , C.buildable bi ] where - libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib) + libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib, Nothing) exeBiModules exe = (C.buildInfo exe, -- If "main-is: ..." is not a .hs or .lhs file, do not -- inject "Main" into the modules. This does not respect @@ -68,7 +68,9 @@ biModules pd = go [ comp | comp@(bi,_) <- -- Distribution.Simple.GHC for the glory details. if takeExtension (C.modulePath exe) `elem` [".hs", ".lhs"] then C.main : C.exeModules exe - else C.exeModules exe) + -- The module `Main` still need to be kept in `modules` of PD. + else C.exeModules exe, + Just (C.main, C.modulePath exe)) go [] = error "No buildable component found." go [x] = x go _ = error "Cannot handle more than one buildinfo yet." @@ -243,15 +245,18 @@ parsePackageData context at Context {..} = do -- there. So we filter out gcc-lib from the RTS's library-dirs here. _ -> error "No (or multiple) GHC rts package is registered!" - buildInfo = fst (biModules pd') + (buildInfo, modules, mainIs) = biModules pd' in return $ PackageData { dependencies = deps , name = C.unPackageName . C.pkgName . C.package $ pd' , version = C.display . C.pkgVersion . C.package $ pd' , componentId = C.localCompatPackageKey lbi' - , modules = map C.display . snd . biModules $ pd' - , otherModules = map C.display . C.otherModules $ buildInfo + , mainIs = case mainIs of + Just (mod, filepath) -> Just (C.display mod, filepath) + Nothing -> Nothing + , modules = map C.display $ modules + , otherModules = map C.display . C.otherModules $ buildInfo , synopsis = C.synopsis pd' , description = C.description pd' , srcDirs = C.hsSourceDirs buildInfo diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index fc3d72e..f167de0 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -124,10 +124,15 @@ moduleFilesOracle = void $ do void . addOracle $ \(ModuleFiles (stage, package)) -> do let context = vanillaContext stage package srcDirs <- interpretInContext context (getPackageData PD.srcDirs) + mainIs <- interpretInContext context (getPackageData PD.mainIs) + let removeMain = case mainIs of + Just (mod, _) -> delete mod + Nothing -> id modules <- fmap sort $ interpretInContext context (getPackageData PD.modules) autogen <- autogenPath context let dirs = autogen : map (pkgPath package -/-) srcDirs - modDirFiles = groupSort $ map decodeModule modules + -- Don't resolve the file path for module `Main` twice. + modDirFiles = groupSort $ map decodeModule $ removeMain modules result <- concatForM dirs $ \dir -> do todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles forM todo $ \(mDir, mFiles) -> do @@ -136,7 +141,24 @@ moduleFilesOracle = void $ do let cmp f = compare (dropExtension f) found = intersectOrd cmp files mFiles return (map (fullDir -/-) found, mDir) - let pairs = sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ] + + -- For a BuildInfo, it may be a library, which deosn't have the `Main` + -- module, or an executable, which must have the `Main` module and the + -- file path of `Main` module is indicated by the `main-is` field in it's + -- .cabal file. + -- + -- For `Main` module, the file name may not be `Main.hs`, unlike other + -- exposed modules. We could get the file path by the module name for + -- other exposed modules, but for `Main`, we must resolve the file path + -- via the `main-is` field in the .cabal file. + mainpairs <- case mainIs of + Just (mod, filepath) -> + concatForM dirs $ \dir -> do + found <- doesFileExist (dir -/- filepath) + return [(mod, unifyPath $ dir -/- filepath) | found] + Nothing -> return [] + + let pairs = sort $ mainpairs ++ [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ] multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ] unless (null multi) $ do let (m, f1, f2) = head multi From git at git.haskell.org Thu Jul 26 21:36:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:16 +0000 (UTC) Subject: [commit: hadrian] master: Implement build rules for testsuite/timeout (#499) (48b81a3) Message-ID: <20180726213616.1602C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/48b81a3a523468416d07874fdaacbe597c895247 >--------------------------------------------------------------- commit 48b81a3a523468416d07874fdaacbe597c895247 Author: Tao He Date: Tue Jun 19 00:07:11 2018 +0800 Implement build rules for testsuite/timeout (#499) >--------------------------------------------------------------- 48b81a3a523468416d07874fdaacbe597c895247 src/GHC.hs | 3 ++- src/GHC/Packages.hs | 4 +++- src/Rules/Test.hs | 51 +++++++++++++++++++++++++-------------------------- 3 files changed, 30 insertions(+), 28 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 5ee56fc..f115829 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -109,7 +109,8 @@ testsuitePackages = return [ checkApiAnnotations , checkPpr , ghcPkg , parallel - , hp2ps ] + , hp2ps + , timeout ] -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index c9c6f2b..cb005ce 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -17,7 +17,8 @@ ghcPackages = , ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps , hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl , parsec, parallel, pretty, process, rts, runGhc, stm, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml ] + , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , timeout ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -81,6 +82,7 @@ unlit = hsUtil "unlit" unix = hsLib "unix" win32 = hsLib "Win32" xhtml = hsLib "xhtml" +timeout = hsUtil "timeout" `setPath` "testsuite/timeout" -- | Construct a Haskell library package, e.g. @array at . hsLib :: PackageName -> Package diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index faa79cb..4b408c0 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -3,6 +3,7 @@ module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where import Base import Expression import GHC +import GHC.Packages (timeout) import Oracles.Flag import Oracles.Setting import Settings @@ -14,25 +15,6 @@ import System.Environment -- TODO: clean up after testing testRules :: Rules () testRules = do - root <- buildRootRules - - root -/- timeoutPyPath ~> do - copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPyPath) - - -- TODO windows is still not supported. - -- - -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23 - root -/- timeoutProgPath ~> do - python <- builderPath Python - need [root -/- timeoutPyPath] - let script = unlines - [ "#!/usr/bin/env sh" - , "exec " ++ python ++ " $0.py \"$@\"" - ] - liftIO $ do - writeFile (root -/- timeoutProgPath) script - makeExecutable (root -/- timeoutProgPath) - "validate" ~> do needTestBuilders build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] [] @@ -40,9 +22,6 @@ testRules = do "test" ~> do needTestBuilders - -- Prepare the timeout program. - need [ root -/- timeoutProgPath ] - -- TODO This approach doesn't work. -- Set environment variables for test's Makefile. env <- sequence @@ -78,6 +57,28 @@ needTestsuiteBuilders = do | isLibrary pkg = pkgConfFile (vanillaContext stage pkg) | otherwise = programPath =<< programContext stage pkg +-- | Build the timeout program. +-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23 +timeoutProgBuilder :: Action () +timeoutProgBuilder = do + root <- buildRoot + windows <- windowsHost + if windows + then do + prog <- programPath =<< programContext Stage1 timeout + need [ prog ] + copyFile prog (root -/- timeoutProgPath) + else do + python <- builderPath Python + copyFile "testsuite/timeout/timeout.py" (root -/- "test/bin/timeout.py") + let script = unlines + [ "#!/usr/bin/env sh" + , "exec " ++ python ++ " $0.py \"$@\"" + ] + liftIO $ do + writeFile (root -/- timeoutProgPath) script + makeExecutable (root -/- timeoutProgPath) + needTestBuilders :: Action () needTestBuilders = do needBuilder $ Ghc CompileHs Stage2 @@ -85,6 +86,7 @@ needTestBuilders = do needBuilder Hpc needBuilder (Hsc2Hs Stage1) needTestsuiteBuilders + timeoutProgBuilder -- | Extra flags to send to the Haskell compiler to run tests. runTestGhcFlags :: Action String @@ -116,8 +118,5 @@ runTestGhcFlags = do , pure "-dno-debug-output" ] -timeoutPyPath :: FilePath -timeoutPyPath = "test/bin/timeout.py" - timeoutProgPath :: FilePath -timeoutProgPath = "test/bin/timeout" <.> exe +timeoutProgPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe From git at git.haskell.org Thu Jul 26 21:36:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:18 +0000 (UTC) Subject: [commit: hadrian] master: Add new featues to binary distribution (#623) (233a638) Message-ID: <20180726213618.1B02D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/233a638978832b795aff24d8a75ab37fa17bd0c2 >--------------------------------------------------------------- commit 233a638978832b795aff24d8a75ab37fa17bd0c2 Author: Chitrak Raj Gupta Date: Mon Jun 18 22:53:47 2018 +0530 Add new featues to binary distribution (#623) * Added featues to binary distribution * Minor revision * Using takeFileName instead of basename * Update BinaryDist.hs >--------------------------------------------------------------- 233a638978832b795aff24d8a75ab37fa17bd0c2 src/Rules/BinaryDist.hs | 173 ++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 167 insertions(+), 6 deletions(-) diff --git a/src/Rules/BinaryDist.hs b/src/Rules/BinaryDist.hs index db73622..e922bfe 100644 --- a/src/Rules/BinaryDist.hs +++ b/src/Rules/BinaryDist.hs @@ -37,6 +37,9 @@ bindistRules = do -- other machine. need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) + need $ map ((bindistFilesDir -/- "wrappers") -/-) ["check-api-annotations" + , "check-ppr", "ghc", "ghc-iserv", "ghc-pkg", "ghc-split" + , "ghci", "haddock", "hpc", "hp2ps", "hsc2hs", "runhaskell"] -- finally, we create the archive, at -- /bindist/ghc-X.Y.Z-platform.tar.xz @@ -62,6 +65,9 @@ bindistRules = do root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> writeFile' makefilePath bindistMakefile + root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> + writeFile' wrapperPath $ wrapper (takeFileName wrapperPath) + -- copy over the various configure-related files needed for a working -- './configure [...] && make install' workflow -- (see the list of files needed in the 'binary-dist' rule above, before @@ -83,7 +89,7 @@ bindistInstallFiles :: [FilePath] bindistInstallFiles = [ "config.sub", "config.guess", "install-sh" , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in" - , "settings.in", "README", "INSTALL" + , "mk" -/- "project.mk.in", "settings.in", "README", "INSTALL" ] -- | Auxiliary function that gives us a 'Filepath' we can 'need' for @@ -106,16 +112,171 @@ bindistMakefile = unlines , ".SUFFIXES:" , "" , "include mk/install.mk" + , "include mk/config.mk" , "" , ".PHONY: default" , "default:" , "\t at echo 'Run \"make install\" to install'" , "\t at false" , "" + , "#------------------------------------------------------------------------------" + , "# INSTALL RULES" + , "" + , "# Hacky function to check equality of two strings" + , "# TODO : find if a better function exists" + , "eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))" + , "" + , "define installscript" + , "# $1 = package name" + , "# $2 = wrapper path" + , "# $3 = bindir" + , "# $4 = ghcbindir" + , "# $5 = Executable binary path" + , "# $6 = Library Directory" + , "# $7 = Docs Directory" + , "# $8 = Includes Directory" + , "# We are installing wrappers to programs by searching corresponding wrappers." + , "# If wrapper is not found, we are attaching the common wrapper to it " + , "# This implementation is a bit hacky and depends on consistency of program" + , "# names. For hadrian build this will work as programs have a consistent " + , "# naming procefure. This file is tested on Linux(Ubuntu)" + , "# TODO : Check implementation in other distributions" + , "\trm -f $2" + , "\t$(CREATE_SCRIPT) $2" + , "\t at echo \"#!$(SHELL)\" >> $2" + , "\t at echo \"exedir=\\\"$4\\\"\" >> $2" + , "\t at echo \"exeprog=\\\"$1\\\"\" >> $2" + , "\t at echo \"executablename=\\\"$5\\\"\" >> $2" + , "\t at echo \"bindir=\\\"$3\\\"\" >> $2" + , "\t at echo \"libdir=\\\"$6\\\"\" >> $2" + , "\t at echo \"docdir=\\\"$7\\\"\" >> $2" + , "\t at echo \"includedir=\\\"$8\\\"\" >> $2" + , "\t at echo \"\" >> $2 " + , "\tcat wrappers/$1 >> $2" + , "\t$(EXECUTABLE_FILE) $2 ;" + , "endef" + , "" + , "# QUESTION : should we use shell commands?" + , "" + , "# Due to the fact that package database is configured relatively" + , "# We do not change the relative paths of executables and libraries" + , "# But instead use wrapper scripts whenever necessary" + , "LIBPARENT = $(shell dirname $(libdir))" + , "GHCBINDIR = \"$(LIBPARENT)/bin\"" + , "" , ".PHONY: install" - , "install:" - , "\tmkdir -p $(prefix)" - , "\tcp settings lib/settings" - , "\tcp -R bin $(prefix)/" - , "\tcp -R lib $(prefix)/" + , "install: install_bin install_lib" + , "" + , "# Check if we need to install docs" + , "ifeq \"DOCS\" \"YES\"" + , "install: install_docs" + , "endif" + , "" + , "# If the relative path of binaries and libraries are altered, we will need to" + , "# install additional wrapper scripts at bindir." + , "ifneq \"$(LIBPARENT)/bin\" \"$(bindir)\"" + , "install: install_wrappers" + , "endif" + , "" + , "# We need to install binaries relative to libraries." + , "BINARIES = $(wildcard ./bin/*)" + , "install_bin:" + , "\t at echo \"Copying Binaries to $(GHCBINDIR)\"" + , "\t$(INSTALL_DIR) \"$(GHCBINDIR)\"" + , "\tfor i in $(BINARIES); do \\" + , "\t\tcp -R $$i \"$(GHCBINDIR)\"; \\" + , "\tdone" + , "" + , "LIBRARIES = $(wildcard ./lib/*)" + , "install_lib:" + , "\t at echo \"Copying libraries to $(libdir)\"" + , "\t$(INSTALL_DIR) \"$(libdir)\"" + , "\tfor i in $(LIBRARIES); do \\" + , "\t\tcp -R $$i \"$(libdir)/\"; \\" + , "\tdone" + , "" + , "DOCS = $(wildcard ./docs/*)" + , "install_docs:" + , "\t at echo \"Copying libraries to $(docdir)\"" + , "\t$(INSTALL_DIR) \"$(docdir)\"" + , "\tfor i in $(DOCS); do \\" + , "\t\tcp -R $$i \"$(docdir)/\"; \\" + , "\tdone" + , "" + , "BINARY_NAMES=$(shell ls ./bin/)" + , "install_wrappers:" + , "\t at echo \"Installing Wrapper scripts\"" + , "\t$(INSTALL_DIR) \"$(bindir)\"" + , "\t$(foreach p, $(BINARY_NAMES),\\" + , "\t\t$(call installscript,$p,$(bindir)/$p,$(bindir),$(GHCBINDIR),$(GHCBINDIR)/$p,$(libdir),$(docdir),$(includedir)))" + , "" + , "# END INSTALL" + , "# -----------------------------------------------------------------------------" ] + +wrapper :: FilePath -> String +wrapper "ghc" = ghcWrapper +wrapper "ghc-pkg" = ghcPkgWrapper +wrapper "ghci" = ghciWrapper +wrapper "haddock" = haddockWrapper +wrapper "hsc2hs" = hsc2hsWrapper +wrapper "runhaskell" = runhaskellWrapper +wrapper _ = commonWrapper + +-- | Wrapper scripts for different programs. Common is default wrapper. + +ghcWrapper :: String +ghcWrapper = unlines + [ "exec \"$executablename\" -B\"$libdir\" ${1+\"$@\"}" + ] + +ghcPkgWrapper :: String +ghcPkgWrapper = unlines + [ "PKGCONF=\"$libdir/package.conf.d\"" + , "exec \"$executablename\" --global-package-db \"$PKGCONF\" ${1+\"$@\"}" + ] + +ghciWrapper :: String +ghciWrapper = unlines + ["exec \"$executablename\" --interactive \"$@\"" + ] + +haddockWrapper :: String +haddockWrapper = unlines + ["exec \"$executablename\" -B\"$libdir\" -l\"$libdir\" ${1+\"$@\"}" + ] + +commonWrapper :: String +commonWrapper = unlines + ["exec \"$executablename\" ${1+\"$@\"}" + ] + +hsc2hsWrapper :: String +hsc2hsWrapper = unlines + [ "HSC2HS_EXTRA=\"--cflag=-fno-stack-protector --lflag=-fuse-ld=gold\"" + , "tflag=\"--template=$libdir/template-hsc.h\"" + , "Iflag=\"-I$includedir/\"" + , "for arg do" + , " case \"$arg\" in" + , "# On OS X, we need to specify -m32 or -m64 in order to get gcc to" + , "# build binaries for the right target. We do that by putting it in" + , "# HSC2HS_EXTRA. When cabal runs hsc2hs, it passes a flag saying which" + , "# gcc to use, so if we set HSC2HS_EXTRA= then we don't get binaries" + , "# for the right platform. So for now we just don't set HSC2HS_EXTRA=" + , "# but we probably want to revisit how this works in the future." + , "# -c*) HSC2HS_EXTRA=;;" + , "# --cc=*) HSC2HS_EXTRA=;;" + , " -t*) tflag=;;" + , " --template=*) tflag=;;" + , " --) break;;" + , " esac" + , "done" + , "exec \"$executablename\" ${tflag:+\"$tflag\"} $HSC2HS_EXTRA ${1+\"$@\"} \"$Iflag\"" + ] + +runhaskellWrapper :: String +runhaskellWrapper = unlines + ["exec \"$executablename\" -f \"$exedir/ghc\" ${1+\"$@\"}" + ] + + From git at git.haskell.org Thu Jul 26 21:36:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:20 +0000 (UTC) Subject: [commit: hadrian] master: Remove more validation errors (#628) (d4b9c1f) Message-ID: <20180726213620.258B53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/d4b9c1fbc3ab2b8e4eb844505724538cfab0d399 >--------------------------------------------------------------- commit d4b9c1fbc3ab2b8e4eb844505724538cfab0d399 Author: Chitrak Raj Gupta Date: Wed Jun 20 17:44:53 2018 +0530 Remove more validation errors (#628) * Improved GhcCabal library arguments * setting enviornment for extra programs * Copied necessary programs * Added support to generate ghcconfig We will need it for properly configuring python command Some revisions * Using ghcconfig file for test parameters * minor changes * minor revision * Update Ghc.hs >--------------------------------------------------------------- d4b9c1fbc3ab2b8e4eb844505724538cfab0d399 hadrian.cabal | 1 + src/GHC.hs | 7 ++-- src/Oracles/TestSettings.hs | 73 +++++++++++++++++++++++++++++++++++++ src/Rules/Test.hs | 75 ++++++++++++++++++++++++++++++--------- src/Settings/Builders/GhcCabal.hs | 10 ++++-- src/Settings/Builders/RunTest.hs | 41 +++++++++++++-------- 6 files changed, 170 insertions(+), 37 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d4b9c1fbc3ab2b8e4eb844505724538cfab0d399 From git at git.haskell.org Thu Jul 26 21:36:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:22 +0000 (UTC) Subject: [commit: hadrian] master: Add includes to bindist (#632) (36c9781) Message-ID: <20180726213622.2A8E03A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/36c9781b8251610dadf79a5e2c6b948e5abaabce >--------------------------------------------------------------- commit 36c9781b8251610dadf79a5e2c6b948e5abaabce Author: Chitrak Raj Gupta Date: Wed Jun 20 18:39:20 2018 +0530 Add includes to bindist (#632) * adding include directories * Adding includes * Shipping ghci >--------------------------------------------------------------- 36c9781b8251610dadf79a5e2c6b948e5abaabce src/Context.hs | 2 +- src/Rules/BinaryDist.hs | 55 ++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 44 insertions(+), 13 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index 9142125..eaca3bb 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -7,7 +7,7 @@ module Context ( withHsPackage, -- * Paths - contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, + contextDir, buildPath, buildDir, pkgId, pkgInplaceConfig, pkgSetupConfigFile, pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, contextPath, getContextPath, libDir, libPath ) where diff --git a/src/Rules/BinaryDist.hs b/src/Rules/BinaryDist.hs index e922bfe..c9273ec 100644 --- a/src/Rules/BinaryDist.hs +++ b/src/Rules/BinaryDist.hs @@ -1,5 +1,6 @@ module Rules.BinaryDist where +import Context import Expression import GHC import Oracles.Setting @@ -14,19 +15,25 @@ bindistRules = do -- We 'need' all binaries and libraries targets <- mapM pkgTarget =<< stagePackages Stage1 need targets - - version <- setting ProjectVersion + version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull + hostOs <- setting BuildOs + hostArch <- setting BuildArch + rtsDir <- pkgId $ vanillaContext Stage1 rts let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform + distDir = hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version + rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir + -/- "include" -- we create the bindist directory at /bindist/ghc-X.Y.Z-platform/ -- and populate it with a stage2 build createDirectory bindistFilesDir copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir + copyDirectory (rtsIncludeDir) bindistFilesDir {- SHOULD WE SHIP DOCS? need ["docs"] copyDirectory (root -/- "docs") bindistFilesDir @@ -39,7 +46,8 @@ bindistRules = do (["configure", "Makefile"] ++ bindistInstallFiles) need $ map ((bindistFilesDir -/- "wrappers") -/-) ["check-api-annotations" , "check-ppr", "ghc", "ghc-iserv", "ghc-pkg", "ghc-split" - , "ghci", "haddock", "hpc", "hp2ps", "hsc2hs", "runhaskell"] + , "ghci-script", "ghci", "haddock", "hpc", "hp2ps", "hsc2hs" + , "runhaskell"] -- finally, we create the archive, at -- /bindist/ghc-X.Y.Z-platform.tar.xz @@ -89,7 +97,7 @@ bindistInstallFiles :: [FilePath] bindistInstallFiles = [ "config.sub", "config.guess", "install-sh" , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in" - , "mk" -/- "project.mk.in", "settings.in", "README", "INSTALL" + , "mk" -/- "project.mk", "settings.in", "README", "INSTALL" ] -- | Auxiliary function that gives us a 'Filepath' we can 'need' for @@ -165,7 +173,7 @@ bindistMakefile = unlines , "GHCBINDIR = \"$(LIBPARENT)/bin\"" , "" , ".PHONY: install" - , "install: install_bin install_lib" + , "install: install_bin install_lib install_includes" , "" , "# Check if we need to install docs" , "ifeq \"DOCS\" \"YES\"" @@ -186,6 +194,12 @@ bindistMakefile = unlines , "\tfor i in $(BINARIES); do \\" , "\t\tcp -R $$i \"$(GHCBINDIR)\"; \\" , "\tdone" + , "\t at echo \"Copying and installing ghci\"" + , "\trm -f $(GHCBINDIR)/dir" + , "\t$(CREATE_SCRIPT) $(GHCBINDIR)/ghci" + , "\t at echo \"#!$(SHELL)\" >> $(GHCBINDIR)/ghci" + , "\tcat wrappers/ghci-script >> $(GHCBINDIR)/ghci" + , "\t$(EXECUTABLE_FILE) $(GHCBINDIR)/ghci" , "" , "LIBRARIES = $(wildcard ./lib/*)" , "install_lib:" @@ -195,6 +209,14 @@ bindistMakefile = unlines , "\t\tcp -R $$i \"$(libdir)/\"; \\" , "\tdone" , "" + , "INCLUDES = $(wildcard ./include/*)" + , "install_includes:" + , "\t at echo \"Copying libraries to $(includedir)\"" + , "\t$(INSTALL_DIR) \"$(includedir)\"" + , "\tfor i in $(INCLUDES); do \\" + , "\t\tcp -R $$i \"$(includedir)/\"; \\" + , "\tdone" + , "" , "DOCS = $(wildcard ./docs/*)" , "install_docs:" , "\t at echo \"Copying libraries to $(docdir)\"" @@ -215,13 +237,14 @@ bindistMakefile = unlines ] wrapper :: FilePath -> String -wrapper "ghc" = ghcWrapper -wrapper "ghc-pkg" = ghcPkgWrapper -wrapper "ghci" = ghciWrapper -wrapper "haddock" = haddockWrapper -wrapper "hsc2hs" = hsc2hsWrapper -wrapper "runhaskell" = runhaskellWrapper -wrapper _ = commonWrapper +wrapper "ghc" = ghcWrapper +wrapper "ghc-pkg" = ghcPkgWrapper +wrapper "ghci" = ghciWrapper +wrapper "ghci-script" = ghciScriptWrapper +wrapper "haddock" = haddockWrapper +wrapper "hsc2hs" = hsc2hsWrapper +wrapper "runhaskell" = runhaskellWrapper +wrapper _ = commonWrapper -- | Wrapper scripts for different programs. Common is default wrapper. @@ -279,4 +302,12 @@ runhaskellWrapper = unlines ["exec \"$executablename\" -f \"$exedir/ghc\" ${1+\"$@\"}" ] +-- | We need to ship ghci executable, which basically just calls ghc with +-- | --interactive flag. +ghciScriptWrapper :: String +ghciScriptWrapper = unlines + [ "DIR=`dirname \"$0\"`" + , "executable=\"$DIR/ghc\"" + , "exec $executable --interactive \"$@\"" + ] From git at git.haskell.org Thu Jul 26 21:36:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:24 +0000 (UTC) Subject: [commit: hadrian] master: Make Cabal install unconditional in build.cabal.sh (#633) (bbdd69b) Message-ID: <20180726213624.2F5183A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/bbdd69bdaa48df99b90ffb95d1725abc72eae66b >--------------------------------------------------------------- commit bbdd69bdaa48df99b90ffb95d1725abc72eae66b Author: Chitrak Raj Gupta Date: Sat Jun 23 03:06:58 2018 +0530 Make Cabal install unconditional in build.cabal.sh (#633) * adding include directories * Adding includes * Stable cabal sandbox build >--------------------------------------------------------------- bbdd69bdaa48df99b90ffb95d1725abc72eae66b build.cabal.sh | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/build.cabal.sh b/build.cabal.sh index d2bdb85..fe390af 100755 --- a/build.cabal.sh +++ b/build.cabal.sh @@ -61,12 +61,13 @@ else if ! ( "$CABAL" sandbox hc-pkg list > /dev/null 2>&1); then "$CABAL" sandbox init "$CABAL" sandbox add-source ../libraries/Cabal/Cabal - "$CABAL" install \ - --dependencies-only \ - --disable-library-profiling \ - --disable-shared fi + "$CABAL" install \ + --dependencies-only \ + --disable-library-profiling \ + --disable-shared + "$CABAL" run hadrian -- \ --lint \ --directory "$absoluteRoot/.." \ From git at git.haskell.org Thu Jul 26 21:36:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:26 +0000 (UTC) Subject: [commit: hadrian] master: Fix timeout building rule for Linux (#638) (843790e) Message-ID: <20180726213626.34BDD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/843790ea9b3f33494a4dfbfc19efac68b6b3a7ea >--------------------------------------------------------------- commit 843790ea9b3f33494a4dfbfc19efac68b6b3a7ea Author: Alp Mestanogullari Date: Wed Jun 27 17:31:52 2018 +0200 Fix timeout building rule for Linux (#638) >--------------------------------------------------------------- 843790ea9b3f33494a4dfbfc19efac68b6b3a7ea src/GHC.hs | 21 ++++++++++++--------- src/Rules/Test.hs | 11 +++++------ src/Settings/Builders/RunTest.hs | 1 - 3 files changed, 17 insertions(+), 16 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 9b453e5..f84d3d6 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -105,15 +105,18 @@ stage2Packages = return [haddock] -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return [ checkApiAnnotations - , checkPpr - , ghci - , ghcPkg - , hp2ps - , iserv - , parallel - , runGhc - , timeout ] +testsuitePackages = do + win <- windowsHost + return $ + [ checkApiAnnotations + , checkPpr + , ghci + , ghcPkg + , hp2ps + , iserv + , parallel + , runGhc ] ++ + [ timeout | win ] -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index d8d644e..6a04c1e 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -29,6 +29,8 @@ testRules = do cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath) [ ghcPath ] + root -/- timeoutProgPath ~> timeoutProgBuilder + "validate" ~> do needTestBuilders build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] [] @@ -38,7 +40,7 @@ testRules = do -- TODO : Should we remove the previosly generated config file? -- Prepare Ghc configuration file for input compiler. - need [ root -/- ghcConfigPath ] + need [ root -/- ghcConfigPath, root -/- timeoutProgPath ] -- TODO This approach doesn't work. -- Set environment variables for test's Makefile. @@ -93,13 +95,12 @@ timeoutProgBuilder = do copyFile prog (root -/- timeoutProgPath) else do python <- builderPath Python - copyFile "testsuite/timeout/timeout.py" (root -/- "test/bin/timeout.py") + copyFile "testsuite/timeout/timeout.py" (root -/- timeoutProgPath <.> "py") let script = unlines [ "#!/usr/bin/env sh" , "exec " ++ python ++ " $0.py \"$@\"" ] - liftIO $ do - writeFile (root -/- timeoutProgPath) script + writeFile' (root -/- timeoutProgPath) script makeExecutable (root -/- timeoutProgPath) needTestBuilders :: Action () @@ -108,7 +109,6 @@ needTestBuilders = do needBuilder $ GhcPkg Update Stage1 needBuilder Hpc needBuilder (Hsc2Hs Stage1) - timeoutProgBuilder needTestsuitePackages -- | Extra flags to send to the Haskell compiler to run tests. @@ -160,4 +160,3 @@ needfile stage pkg -- we are going to use, I suppose? | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic) | otherwise = programPath =<< programContext stage pkg - diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 9f30848..6c0c52f 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -173,4 +173,3 @@ parentPath path = let upPath = init $ splitOn "/" path -- | TODO: move to hadrian utilities. fullpath :: Stage -> Package -> Action FilePath fullpath stage pkg = programPath =<< programContext stage pkg - From git at git.haskell.org Thu Jul 26 21:36:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:28 +0000 (UTC) Subject: [commit: hadrian] master: Switch to the fixed Cabal branch in CI and add a fix for Natural (#640) (e5773fa) Message-ID: <20180726213628.3A0B93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/e5773fa623331233385020b23eef3a5788e7e227 >--------------------------------------------------------------- commit e5773fa623331233385020b23eef3a5788e7e227 Author: Alp Mestanogullari Date: Wed Jun 27 21:59:54 2018 +0200 Switch to the fixed Cabal branch in CI and add a fix for Natural (#640) * use @quasicomputational's Cabal branch in CI for the time being * workaround can't-use-Natural-in-base >--------------------------------------------------------------- e5773fa623331233385020b23eef3a5788e7e227 .travis.yml | 7 +++++++ appveyor.yml | 7 +++++++ circle.yml | 4 ++++ src/Settings/Packages.hs | 9 ++++++++- 4 files changed, 26 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index f80bca6..8416e00 100644 --- a/.travis.yml +++ b/.travis.yml @@ -104,6 +104,13 @@ install: - mv .git ghc/hadrian - cd ghc/hadrian && git reset --hard HEAD && cd .. + # We checkout a patched Cabal. + # See: https://github.com/snowleopard/hadrian/issues/634 + - cd libraries/Cabal/ + - git remote add quasicomputational https://github.com/quasicomputational/cabal.git + - git fetch quasicomputational && git checkout cwd-independent-check + - cd ../../ + cache: directories: - $HOME/.cabal diff --git a/appveyor.yml b/appveyor.yml index 1a18abe..a1ac6c4 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -20,6 +20,13 @@ install: # Copy new Hadrian into ./ghc/hadrian - cp -r new-hadrian ghc\hadrian + # We checkout a patched Cabal. + # See: https://github.com/snowleopard/hadrian/issues/634 + - cd ghc/libraries/Cabal/ + - git remote add quasicomputational https://github.com/quasicomputational/cabal.git + - git fetch quasicomputational && git checkout cwd-independent-check + - cd ../../../ + # Install Alex and Happy - set PATH=C:\Users\appveyor\AppData\Roaming\local\bin;%PATH% - ghc\hadrian\stack install --install-ghc alex happy > nul diff --git a/circle.yml b/circle.yml index 10b9094..998e46d 100644 --- a/circle.yml +++ b/circle.yml @@ -31,6 +31,10 @@ compile: # in CircleCI is a separate process, thus you can't "cd" for the other lines - cd ghc/hadrian; git reset --hard HEAD + # We checkout a patched Cabal. + # See: https://github.com/snowleopard/hadrian/issues/634 + - cd ghc/libraries/Cabal/ && git remote add quasicomputational https://github.com/quasicomputational/cabal.git && git fetch quasicomputational && git checkout cwd-independent-check + - cd ghc; ./boot && PATH=~/.cabal/bin:$PATH ./configure # XXX: export PATH doesn't work well either, so we use inline env diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index 6a23bb7..f1f0e61 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -27,8 +27,15 @@ packageArgs = do -- This fixes the 'unknown symbol stat' issue. -- See: https://github.com/snowleopard/hadrian/issues/259. - , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ] + , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" + -- See https://ghc.haskell.org/trac/ghc/ticket/15286 and + -- https://phabricator.haskell.org/D4880 + , builder (Ghc CompileHs) ? mconcat + [ input "//Natural.hs" ? pure ["-O0", "-fno-omit-interface-pragmas"] + , input "//Num.hs" ? pure ["-O0", "-fno-ignore-interface-pragmas"] + ] + ] ------------------------------ bytestring ------------------------------ , package bytestring ? builder CabalFlags ? intLib == integerSimple ? arg "integer-simple" From git at git.haskell.org Thu Jul 26 21:36:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:30 +0000 (UTC) Subject: [commit: hadrian] master: Fixes building with stack within recent versions of ghc repo (#646) (23dc432) Message-ID: <20180726213630.3EC1E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/23dc432a3f6cafc20499ad98882ed33f25a8f271 >--------------------------------------------------------------- commit 23dc432a3f6cafc20499ad98882ed33f25a8f271 Author: Michael Sloan Date: Thu Jul 19 06:30:52 2018 -0700 Fixes building with stack within recent versions of ghc repo (#646) >--------------------------------------------------------------- 23dc432a3f6cafc20499ad98882ed33f25a8f271 stack.yaml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/stack.yaml b/stack.yaml index 61767bd..d506426 100644 --- a/stack.yaml +++ b/stack.yaml @@ -12,6 +12,16 @@ packages: extra-deps: - shake-0.16.1 +# This is necessary to build until happy's version bounds are updated to work +# with the new Cabal version. Stack's error message explains the issue: +# +# In the dependencies for happy-1.19.9: +# Cabal-2.3.0.0 from stack configuration does not match <2.2 (latest matching version is 2.0.1.1) +# needed due to hadrian-0.1.0.0 -> happy-1.19.9 +# +# TODO: Remove this once it's no longer necessary +allow-newer: true + nix: enable: false packages: From git at git.haskell.org Thu Jul 26 21:36:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jul 2018 21:36:32 +0000 (UTC) Subject: [commit: hadrian] master: Implement the equivalent of D4955 (#648) (165f03e) Message-ID: <20180726213632.43ABE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/165f03e90f5090ecbeeee1ef00c3a7338bfa306b >--------------------------------------------------------------- commit 165f03e90f5090ecbeeee1ef00c3a7338bfa306b Author: Alp Mestanogullari Date: Fri Jul 20 15:08:53 2018 +0200 Implement the equivalent of D4955 (#648) * implement the equivalent of D4991 for hadrian * use stage2 instead of stage == Stage2 >--------------------------------------------------------------- 165f03e90f5090ecbeeee1ef00c3a7338bfa306b src/Settings/Packages.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index f1f0e61..360de3e 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -75,10 +75,11 @@ packageArgs = do , ghcProfiled <$> flavour ? notStage0 ? arg "--ghc-pkg-option=--force" ] - , builder CabalFlags ? mconcat + , builder CabalFlags ? mconcat [ ghcWithNativeCodeGen ? arg "ncg" , ghcWithInterpreter ? notStage0 ? arg "ghci" - , flag CrossCompiling ? arg "-terminfo" ] + , flag CrossCompiling ? arg "-terminfo" + , stage2 ? arg "integer-simple" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] From git at git.haskell.org Fri Jul 27 06:40:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:16 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14880' created Message-ID: <20180727064016.4698F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14880 Referencing: 3caf3dd4b3a73c019d6767d10a218c353a3f8ca7 From git at git.haskell.org Fri Jul 27 06:40:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:19 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Test #14904 in dependent/should_compile/T14904 (fc29fb5) Message-ID: <20180727064019.9F15C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/fc29fb511de397f61d6dce70e89f1eca149cc531/ghc >--------------------------------------------------------------- commit fc29fb511de397f61d6dce70e89f1eca149cc531 Author: Richard Eisenberg Date: Mon Apr 2 15:53:42 2018 -0400 Test #14904 in dependent/should_compile/T14904 >--------------------------------------------------------------- fc29fb511de397f61d6dce70e89f1eca149cc531 testsuite/tests/dependent/should_compile/T14904.hs | 11 +++++++++++ testsuite/tests/dependent/should_compile/all.T | 1 + 2 files changed, 12 insertions(+) diff --git a/testsuite/tests/dependent/should_compile/T14904.hs b/testsuite/tests/dependent/should_compile/T14904.hs new file mode 100644 index 0000000..e61170e --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14904.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, RankNTypes, TypeInType #-} + +module T14904 where + +import Data.Kind + +type family F (f :: forall a. g a) where + F (f :: forall a. g a) = Int + +type family F' f :: Type where + F' ((f :: forall a. g a) :: forall a. g a) = Int diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 5874d2e..6574a00 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -32,3 +32,4 @@ test('T14720', normal, compile, ['']) test('T14066a', normal, compile, ['']) test('T14749', normal, compile, ['']) test('T14991', normal, compile, ['']) +test('T14904', expect_broken(14904), compile, ['']) From git at git.haskell.org Fri Jul 27 06:40:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:23 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Fix #14880. (aa1ee00) Message-ID: <20180727064023.2D13F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/aa1ee003df880618643e91da87344b6d9400207b/ghc >--------------------------------------------------------------- commit aa1ee003df880618643e91da87344b6d9400207b Author: Richard Eisenberg Date: Mon Apr 23 12:18:26 2018 -0400 Fix #14880. This fix is described in Note [Removing variables with bound kinds] in TcType. This commit also changes split_dvs to close over kinds at the end, which seems more performant than walking over the kind of every tyvar occurrence. >--------------------------------------------------------------- aa1ee003df880618643e91da87344b6d9400207b compiler/typecheck/TcType.hs | 86 +++++++++++++++++----- .../tests/dependent/should_compile/T14066a.stderr | 2 +- testsuite/tests/dependent/should_compile/T14880.hs | 15 ++++ testsuite/tests/dependent/should_compile/all.T | 1 + testsuite/tests/ghci/should_run/T12549.stdout | 2 +- 5 files changed, 84 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc aa1ee003df880618643e91da87344b6d9400207b From git at git.haskell.org Fri Jul 27 06:40:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:25 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Change tyCoVarsOfType to close over kinds at end (6d4cb46) Message-ID: <20180727064026.006283A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/6d4cb46331bac13a8b56cf636534257c39cb8532/ghc >--------------------------------------------------------------- commit 6d4cb46331bac13a8b56cf636534257c39cb8532 Author: Richard Eisenberg Date: Wed May 30 16:50:09 2018 -0400 Change tyCoVarsOfType to close over kinds at end This change improved both efficiency and correctness. See new text in Note [Free variables of types] in TyCoRep. This was suggested on #14880, though there is no known program which causes the correctness bug. >--------------------------------------------------------------- 6d4cb46331bac13a8b56cf636534257c39cb8532 compiler/typecheck/TcTyDecls.hs | 3 +- compiler/types/TyCoRep.hs | 193 ++++++++++++++++++---------------------- compiler/types/Type.hs | 2 +- 3 files changed, 92 insertions(+), 106 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6d4cb46331bac13a8b56cf636534257c39cb8532 From git at git.haskell.org Fri Jul 27 06:40:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:28 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Fix newtype instance GADTs (16944e6) Message-ID: <20180727064028.BF4F63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/16944e6c462d782671d719ace1b8430070e9b2bd/ghc >--------------------------------------------------------------- commit 16944e6c462d782671d719ace1b8430070e9b2bd Author: Richard Eisenberg Date: Wed May 30 21:49:41 2018 -0400 Fix newtype instance GADTs >--------------------------------------------------------------- 16944e6c462d782671d719ace1b8430070e9b2bd compiler/basicTypes/MkId.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 7e55520..15ce5c2 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -569,10 +569,17 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con -- Passing Nothing here allows the wrapper to inline when -- unsaturated. wrap_unf = mkInlineUnfolding wrap_rhs + + -- Newtype "workers" already have any family coercion applied + -- (see the definition of newtype_unf in mkDataConWorkId), so + -- we don't want to apply the coercion again. + casted_body | isNewTyCon tycon = wrap_body + | otherwise = wrapFamInstBody tycon res_ty_args $ + wrap_body + wrap_rhs = mkLams wrap_tvs $ mkLams wrap_args $ - wrapFamInstBody tycon res_ty_args $ - wrap_body + casted_body ; return (DCR { dcr_wrap_id = wrap_id , dcr_boxer = mk_boxer boxers From git at git.haskell.org Fri Jul 27 06:40:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:31 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Bugfixing (cd504ab) Message-ID: <20180727064031.9386A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/cd504ab248795ca15d48a98afea12959fc4c9c66/ghc >--------------------------------------------------------------- commit cd504ab248795ca15d48a98afea12959fc4c9c66 Author: Richard Eisenberg Date: Wed May 30 23:30:48 2018 -0400 Bugfixing >--------------------------------------------------------------- cd504ab248795ca15d48a98afea12959fc4c9c66 compiler/rename/RnTypes.hs | 5 ++-- compiler/typecheck/TcType.hs | 28 +++++++--------------- compiler/types/TyCoRep.hs | 2 -- compiler/utils/FV.hs | 3 ++- compiler/utils/UniqDFM.hs | 13 +++++++--- .../partial-sigs/should_compile/T12844.stderr | 2 +- testsuite/tests/polykinds/T11821a.stderr | 2 +- testsuite/tests/polykinds/T14265.stderr | 2 +- 8 files changed, 26 insertions(+), 31 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cd504ab248795ca15d48a98afea12959fc4c9c66 From git at git.haskell.org Fri Jul 27 06:40:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:34 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Bugfixing (3d085b4) Message-ID: <20180727064034.6CBAF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/3d085b4ac152972a5bad57dcb1f9c9c75d10348c/ghc >--------------------------------------------------------------- commit 3d085b4ac152972a5bad57dcb1f9c9c75d10348c Author: Richard Eisenberg Date: Thu May 31 19:39:16 2018 -0400 Bugfixing >--------------------------------------------------------------- 3d085b4ac152972a5bad57dcb1f9c9c75d10348c compiler/typecheck/TcTyClsDecls.hs | 50 +++++-------------- compiler/typecheck/TcType.hs | 5 ++ compiler/typecheck/TcValidity.hs | 56 ++++++++++++++++------ compiler/types/TyCoRep.hs | 44 +++++++++-------- .../tests/backpack/should_compile/bkp31.stderr | 6 +-- .../tests/backpack/should_compile/bkp32.stderr | 8 ++-- .../tests/backpack/should_compile/bkp51.stderr | 6 +-- .../tests/backpack/should_fail/bkpfail21.stderr | 4 +- .../tests/dependent/should_compile/T14066a.stderr | 2 +- .../tests/dependent/should_fail/T14066g.stderr | 2 +- testsuite/tests/ghci/should_run/T12549.stdout | 2 +- .../partial-sigs/should_compile/T12844.stderr | 2 +- .../tests/partial-sigs/should_fail/T14040a.stderr | 8 ++-- .../tests/partial-sigs/should_fail/T14584.stderr | 2 +- .../tests/partial-sigs/should_fail/T14584a.stderr | 2 +- .../tests/patsyn/should_compile/T14394.stdout | 2 +- .../tests/simplCore/should_compile/T4908.stderr | 18 +++---- .../tests/simplCore/should_compile/T7785.stderr | 2 +- .../simplCore/should_compile/spec-inline.stderr | 32 ++++++------- .../tests/typecheck/should_fail/T14350.stderr | 4 +- 20 files changed, 135 insertions(+), 122 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3d085b4ac152972a5bad57dcb1f9c9c75d10348c From git at git.haskell.org Fri Jul 27 06:40:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:37 +0000 (UTC) Subject: [commit: ghc] wip/T14880: bugfixes (3732bfc) Message-ID: <20180727064037.42BEA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/3732bfc8f8a210b6ef75cbc2c55d8df37d0863ea/ghc >--------------------------------------------------------------- commit 3732bfc8f8a210b6ef75cbc2c55d8df37d0863ea Author: Richard Eisenberg Date: Thu May 31 22:41:59 2018 -0400 bugfixes >--------------------------------------------------------------- 3732bfc8f8a210b6ef75cbc2c55d8df37d0863ea compiler/typecheck/TcTyClsDecls.hs | 23 +++++++++++++---------- compiler/typecheck/TcValidity.hs | 11 +++++++---- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 58d8df6..8175c32 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -421,14 +421,16 @@ kcTyClGroup decls user_tyvars = tcTyConUserTyVars tc -- See Note [checkValidDependency] - ; checkValidDependency tc_binders tc_res_kind + ; dependency_ok <- checkValidDependency tc_binders tc_res_kind -- See Note [Bad telescopes] in TcValidity - ; checkValidTelescope tc_binders user_tyvars + ; telescope_ok <- checkValidTelescope tc_binders user_tyvars ; kvs <- kindGeneralize (mkTyConKind tc_binders tc_res_kind) -- See Note [Bad telescopes] in TcValidity - ; checkKvsToGeneralize kvs tc_binders user_tyvars + ; when (telescope_ok && dependency_ok) $ + -- avoid double-reporting trouble as in dependent/should_fail/BadTelescope3 + checkKvsToGeneralize kvs tc_binders user_tyvars ; let all_binders = mkNamedTyConBinders Inferred kvs ++ tc_binders @@ -3102,15 +3104,16 @@ Type -> k -> Type, where k is unbound. (It won't use a forall for a -- | See Note [checkValidDependency] checkValidDependency :: [TyConBinder] -- zonked -> TcKind -- zonked (result kind) - -> TcM () + -> TcM Bool -- True <=> everything is ok checkValidDependency binders res_kind - = go (tyCoVarsOfType res_kind) (reverse binders) + = go (tyCoVarsOfType res_kind) (reverse binders) True where go :: TyCoVarSet -- fvs from scope -> [TyConBinder] -- binders, in reverse order - -> TcM () - go _ [] = return () -- all set - go fvs (tcb : tcbs) + -> Bool -- everything OK so far + -> TcM Bool + go _ [] ok = return ok -- all set + go fvs (tcb : tcbs) ok | not (isNamedTyConBinder tcb) && tcb_var `elemVarSet` fvs = do { setSrcSpan (getSrcSpan tcb_var) $ addErrTc (vcat [ text "Type constructor argument" <+> quotes (ppr tcb_var) <+> @@ -3121,10 +3124,10 @@ checkValidDependency binders res_kind 2 (vcat (map pp_binder binders)) , text "Suggestion: use" <+> quotes (ppr tcb_var) <+> text "in a kind to make the dependency clearer." ]) - ; go new_fvs tcbs } + ; go new_fvs tcbs False } | otherwise - = go new_fvs tcbs + = go new_fvs tcbs ok where new_fvs = fvs `delVarSet` tcb_var `unionVarSet` tyCoVarsOfType tcb_kind diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 85b540b..7686035 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1881,14 +1881,17 @@ check works for `forall x y z.` written in a type. -- k in a's type.) See also Note [Bad telescopes]. checkValidTelescope :: [TyConBinder] -- explicit vars (zonked) -> SDoc -- original, user-written telescope - -> TcM () + -> TcM Bool -- True <=> everything is OK checkValidTelescope tvbs user_tyvars - = do { let tvs = binderVars tvbs - ; unless (go [] emptyVarSet tvs) $ + = do { unless all_ok $ addErr $ - bad_telescope_err tvs user_tyvars } + bad_telescope_err tvs user_tyvars + ; return all_ok } where + tvs = binderVars tvbs + all_ok = go [] emptyVarSet tvs + go :: [TyVar] -- misplaced variables -> TyVarSet -> [TyVar] -> Bool go errs in_scope [] = null (filter (`elemVarSet` in_scope) errs) From git at git.haskell.org Fri Jul 27 06:40:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:40 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Resotre nondeterministic tyCoVarsOfTypr (8e9cb72) Message-ID: <20180727064040.1AD683A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/8e9cb72ef0f4940a31d00861d80e621ec3092513/ghc >--------------------------------------------------------------- commit 8e9cb72ef0f4940a31d00861d80e621ec3092513 Author: Richard Eisenberg Date: Fri Jun 1 19:10:17 2018 -0400 Resotre nondeterministic tyCoVarsOfTypr >--------------------------------------------------------------- 8e9cb72ef0f4940a31d00861d80e621ec3092513 compiler/basicTypes/VarSet.hs | 14 ++- compiler/typecheck/TcMType.hs | 14 +-- compiler/typecheck/TcSplice.hs | 4 +- compiler/typecheck/TcType.hs | 3 +- compiler/types/TyCoRep.hs | 262 ++++++++++++++++++++++++++++------------- compiler/types/Type.hs | 4 +- 6 files changed, 197 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 8e9cb72ef0f4940a31d00861d80e621ec3092513 From git at git.haskell.org Fri Jul 27 06:40:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:42 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Clarify some comments (4d8f5c1) Message-ID: <20180727064042.DB6723A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/4d8f5c11032f68c54d71cc5d56a34fb98379280a/ghc >--------------------------------------------------------------- commit 4d8f5c11032f68c54d71cc5d56a34fb98379280a Author: Richard Eisenberg Date: Fri Jun 15 21:29:56 2018 -0400 Clarify some comments >--------------------------------------------------------------- 4d8f5c11032f68c54d71cc5d56a34fb98379280a compiler/typecheck/TcType.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 40ca031..bfe9df0 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1158,7 +1158,9 @@ candidateQTyVarsOfType ty = closeOverKindsCQTvs $ -- NB: *not* closed over kinds -- See Note [Closing over free variable kinds] in TyCoRep split_dvs :: Bool -- True <=> consider every fv in Type to be dependent - -> VarSet -> CandidatesQTvs -> Type -> CandidatesQTvs + -> VarSet -- These variables have been locally bound + -- See Note [Removing variables with bound kinds] + -> CandidatesQTvs -> Type -> CandidatesQTvs split_dvs is_dep bound dvs ty = go dvs ty where From git at git.haskell.org Fri Jul 27 06:40:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 06:40:45 +0000 (UTC) Subject: [commit: ghc] wip/T14880: Fix egregious error from last commit (3caf3dd) Message-ID: <20180727064045.AD3E73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880 Link : http://ghc.haskell.org/trac/ghc/changeset/3caf3dd4b3a73c019d6767d10a218c353a3f8ca7/ghc >--------------------------------------------------------------- commit 3caf3dd4b3a73c019d6767d10a218c353a3f8ca7 Author: Richard Eisenberg Date: Fri Jun 15 21:51:05 2018 -0400 Fix egregious error from last commit I accidentally reversed the polarity of a key test in the Type module. >--------------------------------------------------------------- 3caf3dd4b3a73c019d6767d10a218c353a3f8ca7 compiler/types/Type.hs | 2 +- testsuite/tests/simplCore/should_compile/T3234.stderr | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 3c58b3f..dffbaf3 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -2042,7 +2042,7 @@ isValidJoinPointType arity ty where valid_under tvs arity ty | arity == 0 - = tvs `intersectsVarSet` tyCoVarsOfType ty + = not (tvs `intersectsVarSet` tyCoVarsOfType ty) | Just (t, ty') <- splitForAllTy_maybe ty = valid_under (tvs `extendVarSet` t) (arity-1) ty' | Just (_, res_ty) <- splitFunTy_maybe ty diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr index 223650a..6468463 100644 --- a/testsuite/tests/simplCore/should_compile/T3234.stderr +++ b/testsuite/tests/simplCore/should_compile/T3234.stderr @@ -58,8 +58,8 @@ Total ticks: 52 1 b 1 c 1 n - 1 b 1 a + 1 b 1 k 1 z 1 g From git at git.haskell.org Fri Jul 27 09:07:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 09:07:00 +0000 (UTC) Subject: [commit: ghc] master: Refactor (~) to reduce the suerpclass stack (f265008) Message-ID: <20180727090700.13E353A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f265008fb6f70830e7e92ce563f6d83833cef071/ghc >--------------------------------------------------------------- commit f265008fb6f70830e7e92ce563f6d83833cef071 Author: Simon Peyton Jones Date: Fri Jul 27 09:01:46 2018 +0100 Refactor (~) to reduce the suerpclass stack The constraint (~) used to be (effectively): class a ~~ b => (a :: k) ~ (b :: k) but, with this patch, it is now defined uniformly with (~~) and Coercible like this: class a ~# b => (a :: k) ~ (b :: k) Result: * One less superclass selection when goinng from (~) to (~#) Better for compile time and better for debugging with -ddump-simpl * The code for (~), (~~), and Coercible looks uniform, and appears together, e.g. in TysWiredIn and ClsInst.matchGlobalInst. Previously the code for (~) was different, and unique. Not only is this simpler, but it also makes the compiler a bit faster; T12227: 9% less allocation T12545: 7% less allocation This patch fixes Trac #15421 >--------------------------------------------------------------- f265008fb6f70830e7e92ce563f6d83833cef071 compiler/main/HscTypes.hs | 3 +- compiler/parser/Parser.y | 3 +- compiler/parser/RdrHsSyn.hs | 4 +- compiler/prelude/PrelNames.hs | 40 +++++------- compiler/prelude/PrelRules.hs | 6 +- compiler/prelude/TysPrim.hs | 25 ++++---- compiler/prelude/TysWiredIn.hs | 72 ++++++++++++++++------ compiler/typecheck/ClsInst.hs | 24 +++++--- compiler/typecheck/Inst.hs | 9 +-- compiler/typecheck/TcValidity.hs | 2 +- libraries/base/Data/Type/Equality.hs | 24 -------- libraries/ghc-prim/GHC/Types.hs | 6 ++ testsuite/tests/ghci/scripts/T10059.stdout | 13 ++-- .../indexed-types/should_compile/T7837.stderr | 3 +- testsuite/tests/perf/compiler/all.T | 6 +- testsuite/tests/roles/should_compile/Roles3.stderr | 3 +- testsuite/tests/th/T10828.stderr | 6 +- 17 files changed, 130 insertions(+), 119 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f265008fb6f70830e7e92ce563f6d83833cef071 From git at git.haskell.org Fri Jul 27 09:07:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 09:07:02 +0000 (UTC) Subject: [commit: ghc] master: Small refactor in desugar of pattern matching (45cfe65) Message-ID: <20180727090702.F25C13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/45cfe6514afb47c26883687e25ff7eb1e40c5a52/ghc >--------------------------------------------------------------- commit 45cfe6514afb47c26883687e25ff7eb1e40c5a52 Author: Simon Peyton Jones Date: Fri Jul 27 09:17:20 2018 +0100 Small refactor in desugar of pattern matching In reviewing Phab:D4968 for Trac #15385 I saw a small but simple refactor to avoid unnecessary work in the desugarer. This patch just arranges to call matchSinglePatVar v ... rather than matchSinglePat (Var v) ... The more specialised function already existed, as match_single_pat_var I also added more comments about decideBangHood >--------------------------------------------------------------- 45cfe6514afb47c26883687e25ff7eb1e40c5a52 compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsListComp.hs | 2 +- compiler/deSugar/DsMonad.hs | 3 +++ compiler/deSugar/DsUtils.hs | 46 +++++++++++++++++++++++++++++++++--------- compiler/deSugar/Match.hs | 21 ++++++++++--------- 5 files changed, 54 insertions(+), 20 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 45cfe6514afb47c26883687e25ff7eb1e40c5a52 From git at git.haskell.org Fri Jul 27 13:07:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 13:07:10 +0000 (UTC) Subject: [commit: ghc] branch 'wip/monoidal/odd-linking' created Message-ID: <20180727130710.C93403A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/monoidal/odd-linking Referencing: be534b04202e00c259763dae5d5fc761beb9d8a4 From git at git.haskell.org Fri Jul 27 13:07:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 13:07:14 +0000 (UTC) Subject: [commit: ghc] wip/monoidal/odd-linking: first version of test (be534b0) Message-ID: <20180727130714.50C283A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/monoidal/odd-linking Link : http://ghc.haskell.org/trac/ghc/changeset/be534b04202e00c259763dae5d5fc761beb9d8a4/ghc >--------------------------------------------------------------- commit be534b04202e00c259763dae5d5fc761beb9d8a4 Author: Krzysztof Gogolewski Date: Sat Jul 21 02:00:46 2018 +0200 first version of test >--------------------------------------------------------------- be534b04202e00c259763dae5d5fc761beb9d8a4 compiler/main/Ar.hs | 11 +++++++++-- testsuite/tests/cabal/.gitignore | 1 + testsuite/tests/cabal/Makefile | 10 ++++++++++ testsuite/tests/{driver/T10219.hspp => cabal/T15396.hs} | 0 testsuite/tests/cabal/T15396.pkg | 6 ++++++ testsuite/tests/cabal/T15396.stdout | 3 +++ testsuite/tests/cabal/all.T | 2 ++ testsuite/tests/cabal/libT15396_odd.a | 2 ++ 8 files changed, 33 insertions(+), 2 deletions(-) diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs index 51655c0..cf3a02e 100644 --- a/compiler/main/Ar.hs +++ b/compiler/main/Ar.hs @@ -95,7 +95,7 @@ getBSDArchEntries = do st_size <- getPaddedInt <$> getByteString 10 end <- getByteString 2 when (end /= "\x60\x0a") $ - fail "Invalid archive header end marker" + fail $ "[BSD Archive] Invalid archive header end marker for name: " ++ C.unpack name off1 <- liftM fromIntegral bytesRead :: Get Int -- BSD stores extended filenames, by writing #1/ into the -- name field, the first @length@ bytes then represent the file name @@ -106,6 +106,10 @@ getBSDArchEntries = do return $ C.unpack $ C.takeWhile (/= ' ') name off2 <- liftM fromIntegral bytesRead :: Get Int file <- getByteString (st_size - (off2 - off1)) + -- data sections are two byte aligned (see Trac #15396) + when (odd st_size) $ + void (getByteString 1) + rest <- getBSDArchEntries return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest @@ -128,8 +132,11 @@ getGNUArchEntries extInfo = do st_size <- getPaddedInt <$> getByteString 10 end <- getByteString 2 when (end /= "\x60\x0a") $ - fail "Invalid archive header end marker" + fail $ "[GNU Archive] Invalid archive header end marker for name: " ++ C.unpack name file <- getByteString st_size + -- data sections are two byte aligned (see Trac #15396) + when (odd st_size) $ + void (getByteString 1) name <- return . C.unpack $ if C.unpack (C.take 1 name) == "/" then case C.takeWhile (/= ' ') name of diff --git a/testsuite/tests/cabal/.gitignore b/testsuite/tests/cabal/.gitignore new file mode 100644 index 0000000..b26082d --- /dev/null +++ b/testsuite/tests/cabal/.gitignore @@ -0,0 +1 @@ +!libT15396_odd.a diff --git a/testsuite/tests/cabal/Makefile b/testsuite/tests/cabal/Makefile index 791e326..b39c38d 100644 --- a/testsuite/tests/cabal/Makefile +++ b/testsuite/tests/cabal/Makefile @@ -295,3 +295,13 @@ T13703: '$(GHC_PKG)' --no-user-package-db -f T13703.package.conf register --force test13703b.pkg 2>/dev/null '$(GHC_PKG)' --no-user-package-db -f T13703.package.conf field z-p-z-q lib-name '$(GHC_PKG)' --no-user-package-db -f T13703.package.conf field z-p-z-r lib-name + +PKGCONFT15396=localT15396.package.conf +LOCAL_GHC_PKGT15396 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONFT15396) + +T15396: + rm -rf $(PKGCONFT15396) T15396.hs T15396.o T15396.hi + $(LOCAL_GHC_PKGT15396) init $(PKGCONFT15396) + $(LOCAL_GHC_PKGT15396) register --force T15396.pkg + echo "main = return ()" >T15396.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFT15396) T15396.hs -package T15396 -staticlib diff --git a/testsuite/tests/driver/T10219.hspp b/testsuite/tests/cabal/T15396.hs similarity index 100% copy from testsuite/tests/driver/T10219.hspp copy to testsuite/tests/cabal/T15396.hs diff --git a/testsuite/tests/cabal/T15396.pkg b/testsuite/tests/cabal/T15396.pkg new file mode 100644 index 0000000..c088cde --- /dev/null +++ b/testsuite/tests/cabal/T15396.pkg @@ -0,0 +1,6 @@ +name: T15396 +version: 1 +id: T15396-1-XXX +key: T15396-1-XXX +extra-libraries: T15396_odd +library-dirs: ${pkgroot} diff --git a/testsuite/tests/cabal/T15396.stdout b/testsuite/tests/cabal/T15396.stdout new file mode 100644 index 0000000..61b2dd6 --- /dev/null +++ b/testsuite/tests/cabal/T15396.stdout @@ -0,0 +1,3 @@ +Reading package info from "T15396.pkg" ... done. +[1 of 1] Compiling Main ( T15396.hs, T15396.o ) +Linking T15396.a ... diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T index 5f1b308..38e0c17 100644 --- a/testsuite/tests/cabal/all.T +++ b/testsuite/tests/cabal/all.T @@ -57,3 +57,5 @@ test('shadow', [], run_command, ['$MAKE -s --no-print-directory shadow']) test('T12485a', [extra_files(['shadow1.pkg', 'shadow2.pkg', 'shadow3.pkg'])], run_command, ['$MAKE -s --no-print-directory T12485a']) test('T13703', [extra_files(['test13703a.pkg', 'test13703b.pkg'])], run_command, ['$MAKE -s --no-print-directory T13703']) + +test('T15396', [extra_files(['T15396.pkg', 'libT15396_odd.a'])], run_command, ['$MAKE -s --no-print-directory T15396']) diff --git a/testsuite/tests/cabal/libT15396_odd.a b/testsuite/tests/cabal/libT15396_odd.a new file mode 100644 index 0000000..749b80d --- /dev/null +++ b/testsuite/tests/cabal/libT15396_odd.a @@ -0,0 +1,2 @@ +! +NAMENAMENAMENAME0000000000000000000000000000000000000000000` From git at git.haskell.org Fri Jul 27 16:28:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 16:28:54 +0000 (UTC) Subject: [commit: ghc] master: rts: Flush eventlog in hs_init_ghc (fixes #15440) (7a3e1b2) Message-ID: <20180727162854.D01DF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a3e1b25ff9a570851a59c4cf3600daa49867b9b/ghc >--------------------------------------------------------------- commit 7a3e1b25ff9a570851a59c4cf3600daa49867b9b Author: Mitsutoshi Aoe Date: Thu Jul 26 14:50:51 2018 +0900 rts: Flush eventlog in hs_init_ghc (fixes #15440) Without this change RTS typically doesn't flush some important events until the process terminates or it doesn't write them at all in case it terminates abnormally. Here is a list of such events: * EVENT_WALL_CLOCK_TIME * EVENT_OS_PROCESS_PID * EVENT_OS_PROCESS_PPID * EVENT_RTS_IDENTIFIER * EVENT_PROGRAM_ARGS * EVENT_PROGRAM_ENV >--------------------------------------------------------------- 7a3e1b25ff9a570851a59c4cf3600daa49867b9b rts/RtsStartup.c | 1 + rts/Trace.c | 7 +++++++ rts/Trace.h | 4 ++++ 3 files changed, 12 insertions(+) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 7eb98a8..0cb1ff9 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -237,6 +237,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) /* Trace some basic information about the process */ traceWallClockTime(); traceOSProcessInfo(); + flushTrace(); /* initialize the storage manager */ initStorage(); diff --git a/rts/Trace.c b/rts/Trace.c index 71403f8..02c177f 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -130,6 +130,13 @@ void resetTracing (void) } } +void flushTrace (void) +{ + if (eventlog_enabled) { + flushEventLog(); + } +} + void tracingAddCapapilities (uint32_t from, uint32_t to) { if (eventlog_enabled) { diff --git a/rts/Trace.h b/rts/Trace.h index a72248a..d53e92c 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -295,6 +295,8 @@ void traceHeapProfSampleCostCentre(StgWord8 profile_id, CostCentreStack *stack, StgWord residency); #endif /* PROFILING */ +void flushTrace(void); + #else /* !TRACING */ #define traceSchedEvent(cap, tag, tso, other) /* nothing */ @@ -331,6 +333,8 @@ void traceHeapProfSampleCostCentre(StgWord8 profile_id, #define traceHeapProfSampleCostCentre(profile_id, stack, residency) /* nothing */ #define traceHeapProfSampleString(profile_id, label, residency) /* nothing */ +#define flushTrace() /* nothing */ + #endif /* TRACING */ // If DTRACE is enabled, but neither DEBUG nor TRACING, we need a C land From git at git.haskell.org Fri Jul 27 16:28:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 16:28:57 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock submodule (890f646) Message-ID: <20180727162857.A3B3B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/890f6468eb3594e75ea8d08424e9eecb7ab48ecb/ghc >--------------------------------------------------------------- commit 890f6468eb3594e75ea8d08424e9eecb7ab48ecb Author: Ben Gamari Date: Fri Jul 27 11:40:30 2018 -0400 Bump haddock submodule >--------------------------------------------------------------- 890f6468eb3594e75ea8d08424e9eecb7ab48ecb utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index e3926b5..612f44f 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit e3926b50ab8a7269fd6904b06e881745f08bc5d6 +Subproject commit 612f44f9a582b1f7c8a9ba709651bce83692b60b From git at git.haskell.org Fri Jul 27 16:29:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 16:29:00 +0000 (UTC) Subject: [commit: ghc] master: Make :doc work for the ghc library (25e1ea9) Message-ID: <20180727162900.773E73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/25e1ea997524b1d9f9b1fc065b17e618b8f16f18/ghc >--------------------------------------------------------------- commit 25e1ea997524b1d9f9b1fc065b17e618b8f16f18 Author: Simon Jakobi Date: Thu Jul 26 17:17:17 2018 -0400 Make :doc work for the ghc library We already include -haddock in the GhcLibHcOpts in order to include the boot libraries' docs in their .hi-files. By including -haddock in the GhcStage2HcOpts and GhcStage3HcOpts, we make the docs for the ghc library also available to the GHCi :doc command. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4913 >--------------------------------------------------------------- 25e1ea997524b1d9f9b1fc065b17e618b8f16f18 mk/config.mk.in | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index c97f551..90579fb 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -66,9 +66,12 @@ GhcHcOpts=-Rghc-timing # override options from $(GhcHcOpts). # # See Note [Stage number in build variables]. +# +# -haddock is needed so the GHCi :doc command can find docs +# in the .hi-files for the ghc library GhcStage1HcOpts= -GhcStage2HcOpts=-O2 -GhcStage3HcOpts=-O2 +GhcStage2HcOpts=-O2 -haddock +GhcStage3HcOpts=-O2 -haddock # Note [Stage number in build variables]. From git at git.haskell.org Fri Jul 27 16:29:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 16:29:03 +0000 (UTC) Subject: [commit: ghc] master: Fail instead of panic-ing when qAddTopDecls has conversion error (774f366) Message-ID: <20180727162903.EE1BE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/774f366ebe58023fc50ba346894227b14816fe67/ghc >--------------------------------------------------------------- commit 774f366ebe58023fc50ba346894227b14816fe67 Author: Michael Sloan Date: Thu Jul 26 17:18:22 2018 -0400 Fail instead of panic-ing when qAddTopDecls has conversion error See https://ghc.haskell.org/trac/ghc/ticket/14627 for an example where GHC panics when using qAddTopDecls on [d| f = Bool |]. Instead, it should be a normal error message, and that's what this change is for. It does not entirely resolve Trac#14627, since "Illegal variable name: 'bool'" isn't a very good error for this cirumstance. Test Plan: Manually tested. Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4914 >--------------------------------------------------------------- 774f366ebe58023fc50ba346894227b14816fe67 compiler/typecheck/TcSplice.hs | 4 +++- testsuite/tests/th/TH_invalid_add_top_decl.hs | 8 ++++++++ testsuite/tests/th/TH_invalid_add_top_decl.stderr | 5 +++++ testsuite/tests/th/all.T | 1 + 4 files changed, 17 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 31695e3..5e50dac 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -894,7 +894,9 @@ instance TH.Quasi TcM where l <- getSrcSpanM let either_hval = convertToHsDecls l thds ds <- case either_hval of - Left exn -> pprPanic "qAddTopDecls: can't convert top-level declarations" exn + Left exn -> failWithTc $ + hang (text "Error in a declaration passed to addTopDecls:") + 2 exn Right ds -> return ds mapM_ (checkTopDecl . unLoc) ds th_topdecls_var <- fmap tcg_th_topdecls getGblEnv diff --git a/testsuite/tests/th/TH_invalid_add_top_decl.hs b/testsuite/tests/th/TH_invalid_add_top_decl.hs new file mode 100644 index 0000000..b13d873 --- /dev/null +++ b/testsuite/tests/th/TH_invalid_add_top_decl.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +$(do + invalidDecl <- valD (varP (mkName "emptyDo")) (normalB (doE [])) [] + addTopDecls [invalidDecl] + return []) diff --git a/testsuite/tests/th/TH_invalid_add_top_decl.stderr b/testsuite/tests/th/TH_invalid_add_top_decl.stderr new file mode 100644 index 0000000..9124c2d --- /dev/null +++ b/testsuite/tests/th/TH_invalid_add_top_decl.stderr @@ -0,0 +1,5 @@ + +TH_invalid_add_top_decl.hs:5:3: + Error in a declaration passed to addTopDecls: + Empty stmt list in do-block + When splicing a TH declaration: emptyDo = do diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index cd80a6c..0fddd44 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -424,3 +424,4 @@ test('T9693', expect_broken(9693), ghci_script, ['T9693.script']) test('T14471', normal, compile, ['']) test('TH_rebindableAdo', normal, compile, ['']) test('T14627', normal, compile_fail, ['']) +test('TH_invalid_add_top_decl', normal, compile_fail, ['']) From git at git.haskell.org Fri Jul 27 16:29:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 16:29:07 +0000 (UTC) Subject: [commit: ghc] master: Add a script for running a ghci that can load and run ghc (13d40ff) Message-ID: <20180727162907.CEEBF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/13d40ff65b4171c4f0adac10577667d05074441a/ghc >--------------------------------------------------------------- commit 13d40ff65b4171c4f0adac10577667d05074441a Author: Michael Sloan Date: Thu Jul 26 17:17:41 2018 -0400 Add a script for running a ghci that can load and run ghc Add scripts and .ghci files for loading GHC into GHCi Major credit to Csongor Kiss who wrote nearly all of settings.ghci Some small modifications to GHC are needed to make this work, and this diff depends on [D4986](https://phabricator.haskell.org/D4986) being merged. Test Plan: Manual for now. I have some thoughts on how to run the entire testsuite against GHC-in-GHCi. Reviewers: alpmestan, mpickering, goldfire, bgamari, erikd Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4904 >--------------------------------------------------------------- 13d40ff65b4171c4f0adac10577667d05074441a .ghcid | 7 +++++++ utils/ghc-in-ghci/inner.ghci | 1 + utils/ghc-in-ghci/load-main.ghci | 1 + utils/ghc-in-ghci/run.sh | 36 +++++++++++++++++++++++++++++++++++ utils/ghc-in-ghci/settings.ghci | 41 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 86 insertions(+) diff --git a/.ghcid b/.ghcid new file mode 100644 index 0000000..f751a6f --- /dev/null +++ b/.ghcid @@ -0,0 +1,7 @@ +--command utils/ghc-in-ghci/run.sh +--reload compiler +--reload ghc +--reload includes +--restart utils/ghc-in-ghci/run.sh +--restart utils/ghc-in-ghci/load-main.ghci +--restart utils/ghc-in-ghci/settings.ghci diff --git a/utils/ghc-in-ghci/inner.ghci b/utils/ghc-in-ghci/inner.ghci new file mode 100644 index 0000000..72834c9 --- /dev/null +++ b/utils/ghc-in-ghci/inner.ghci @@ -0,0 +1 @@ +:set prompt "%s [inner]> " diff --git a/utils/ghc-in-ghci/load-main.ghci b/utils/ghc-in-ghci/load-main.ghci new file mode 100644 index 0000000..a798557 --- /dev/null +++ b/utils/ghc-in-ghci/load-main.ghci @@ -0,0 +1 @@ +:load Main diff --git a/utils/ghc-in-ghci/run.sh b/utils/ghc-in-ghci/run.sh new file mode 100755 index 0000000..2dda647 --- /dev/null +++ b/utils/ghc-in-ghci/run.sh @@ -0,0 +1,36 @@ +#!/bin/sh -xe + +# Runs ghc-stage2 with GHCi settings that allow GHC to be loaded and run in the +# interpreter. Options provided on the command-line will be passed directly to +# the GHCi invocation. + +# Note that this script is intended to be run from the root of the GHC repo, +# like this: + +# ./utils/ghc-in-ghci/run.sh + +# This is substantially faster than doing an actual compile, and so can aid in +# tighter development iterations. It can be made even faster by specifying "-jN" +# for parallelism. Typically choosing an N value close to the number of logical +# CPU cores you have leads to faster loads. Here's how to specify -j: + +# ./utils/ghc-in-ghci/run.sh -j4 + +# The script will also run `:load Main`, to load GHC's main module. After that, +# running `main` will run an inner GHCi, because there is a default `:set args +# --interactive ...`. To override this, use `:set args ...` or `:main ...`. + +# If you don't want to wait for `:load Main`, since you want to load some other +# module, then you can use `Ctrl+C` to cancel the initial load. + + +export _GHC_TOP_DIR=./inplace/lib + +exec ./inplace/bin/ghc-stage2 \ + --interactive \ + -ghci-script ./utils/ghc-in-ghci/settings.ghci \ + -ghci-script ./utils/ghc-in-ghci/load-main.ghci \ + -odir ./ghci-tmp \ + -hidir ./ghci-tmp \ + +RTS -A128m -RTS \ + "$@" diff --git a/utils/ghc-in-ghci/settings.ghci b/utils/ghc-in-ghci/settings.ghci new file mode 100644 index 0000000..1348274 --- /dev/null +++ b/utils/ghc-in-ghci/settings.ghci @@ -0,0 +1,41 @@ +:set -icompiler/backpack +:set -icompiler/basicTypes +:set -icompiler/cmm +:set -icompiler/codeGen +:set -icompiler/coreSyn +:set -icompiler/deSugar +:set -icompiler/ghci +:set -icompiler/hsSyn +:set -icompiler/iface +:set -icompiler/llvmGen +:set -icompiler/main +:set -icompiler/nativeGen +:set -icompiler/parser +:set -icompiler/prelude +:set -icompiler/profiling +:set -icompiler/rename +:set -icompiler/simplCore +:set -icompiler/simplStg +:set -icompiler/specialise +:set -icompiler/stgSyn +:set -icompiler/stranal +:set -icompiler/typecheck +:set -icompiler/types +:set -icompiler/utils +:set -icompiler/vectorise +:set -ighc +:set -Icompiler +:set -Icompiler/stage2 +:set -Icompiler/stage2/build +:set -icompiler/stage2/build +:set -Iincludes +:set -Iincludes/dist-derivedconstants/header +:set -package=ghc-boot-th +:set -DSTAGE=2 +:set -DGHCI +:set -DGHC_LOADED_INTO_GHCI +:set -XNoImplicitPrelude + +-- Setup args so that running "main" will run ghci and set the prompt to +-- indicate that it is an inner ghci. +:set args --interactive -ghci-script utils/ghc-in-ghci/inner.ghci From git at git.haskell.org Fri Jul 27 17:43:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:33 +0000 (UTC) Subject: [commit: ghc] master: Add an expect_broken test for #14185 (3581212) Message-ID: <20180727174333.63B883A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3581212e3a5ba42114f47ed83a96322e0e8028ab/ghc >--------------------------------------------------------------- commit 3581212e3a5ba42114f47ed83a96322e0e8028ab Author: Krzysztof Gogolewski Date: Thu Jul 26 17:20:29 2018 -0400 Add an expect_broken test for #14185 Test Plan: validate Reviewers: goldfire, bgamari, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14185 Differential Revision: https://phabricator.haskell.org/D4981 >--------------------------------------------------------------- 3581212e3a5ba42114f47ed83a96322e0e8028ab testsuite/tests/typecheck/should_compile/T14185.hs | 30 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 31 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T14185.hs b/testsuite/tests/typecheck/should_compile/T14185.hs new file mode 100644 index 0000000..41e47d2 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14185.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, TypeFamilies, + FunctionalDependencies, KindSignatures, PolyKinds, DataKinds, + UndecidableInstances #-} +module T14185 where + +import GHC.Types +import GHC.Prim + + +class Unbox (t :: *) (r :: TYPE k) | t -> r, r -> t where + unbox :: t -> r + box :: r -> t + +instance Unbox Int Int# where + unbox (I# i) = i + box i = I# i + +instance Unbox Char Char# where + unbox (C# c) = c + box c = C# c + +instance (Unbox a a', Unbox b b') => Unbox (a,b) (# a', b' #) where + unbox (a,b) = (# unbox a, unbox b #) + box (# a, b #) = (box a, box b) + +testInt :: Int +testInt = box (unbox 1) + +testTup :: (Int, Char) +testTup = box (unbox (1, 'a')) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index dfa8520..2fb5429 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -625,6 +625,7 @@ test('T14735', normal, compile, ['']) test('T15180', normal, compile, ['']) test('T15232', normal, compile, ['']) test('T13833', normal, compile, ['']) +test('T14185', expect_broken(14185), compile, ['']) def onlyHsParLocs(x): """ From git at git.haskell.org Fri Jul 27 17:43:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:36 +0000 (UTC) Subject: [commit: ghc] master: Fix gcCAFs() (e431d75) Message-ID: <20180727174336.364BB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e431d75f8350f25159f9aaa49fe9a504e94bc0a4/ghc >--------------------------------------------------------------- commit e431d75f8350f25159f9aaa49fe9a504e94bc0a4 Author: Simon Marlow Date: Thu Jul 26 17:19:54 2018 -0400 Fix gcCAFs() The test here should have been changed after D1106. It was harmless but we caught fewer GC'd CAFs than we should have. Test Plan: Using `nofib/imaginary/primes` compiled with `-debug`. Before: ``` > ./primes 100 +RTS -G1 -A32k -DG CAF gc'd at 0x0x7b0960 CAF gc'd at 0x0x788728 CAF gc'd at 0x0x790db0 CAF gc'd at 0x0x790de0 12 CAFs live CAF gc'd at 0x0x788880 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 547 CAF gc'd at 0x0x7995c8 13 CAFs live ``` After: ``` > ./primes 100 +RTS -G1 -A32k -DG CAF gc'd at 0x0x7b0960 CAF gc'd at 0x0x788728 CAF gc'd at 0x0x790db0 CAF gc'd at 0x0x790de0 12 CAFs live CAF gc'd at 0x0x788880 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 12 CAFs live 547 CAF gc'd at 0x0x7995c8 CAF gc'd at 0x0x790ea0 12 CAFs live ``` Reviewers: bgamari, osa1, erikd, noamz Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4963 >--------------------------------------------------------------- e431d75f8350f25159f9aaa49fe9a504e94bc0a4 rts/sm/GC.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 67eba93..742ae36 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -1846,7 +1846,10 @@ static void gcCAFs(void) info = get_itbl((StgClosure*)p); ASSERT(info->type == IND_STATIC); - if (p->static_link == NULL) { + // See Note [STATIC_LINK fields] in Storage.h + // This condition identifies CAFs that have just been GC'd and + // don't have static_link==3 which means they should be ignored. + if ((((StgWord)(p->static_link)&STATIC_BITS) | prev_static_flag) != 3) { debugTrace(DEBUG_gccafs, "CAF gc'd at 0x%p", p); SET_INFO((StgClosure*)p,&stg_GCD_CAF_info); // stub it if (prev == NULL) { From git at git.haskell.org Fri Jul 27 17:43:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:39 +0000 (UTC) Subject: [commit: ghc] master: Run StgCse after unarise, fixes #15300 (3c311e5) Message-ID: <20180727174339.0B1AF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c311e50e760c3ba00dc9692ad1536c79820598d/ghc >--------------------------------------------------------------- commit 3c311e50e760c3ba00dc9692ad1536c79820598d Author: Ömer Sinan Ağacan Date: Thu Jul 26 17:19:35 2018 -0400 Run StgCse after unarise, fixes #15300 Given two unboxed sum terms: (# 1 | #) :: (# Int | Int# #) (# 1 | #) :: (# Int | Int #) These two terms are not equal as they unarise to different unboxed tuples. However StgCse was thinking that these are equal, and replacing one of these with a binder to the other. To not deal with unboxed sums in StgCse we now do it after unarise. For StgCse to maintain post-unarise invariants we factor-out case binder in-scopeness check to `stgCaseBndrInScope` and use it in StgCse. Also did some refactoring in SimplStg. Another way to fix this would be adding a special case in StgCse to not bring unboxed sum binders in scope: diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6c740ca4cb..93a0f8f6ad 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -332,7 +332,11 @@ stgCseExpr env (StgLetNoEscape binds body) stgCseAlt :: CseEnv -> OutId -> InStgAlt -> OutStgAlt stgCseAlt env case_bndr (DataAlt dataCon, args, rhs) = let (env1, args') = substBndrs env args - env2 = addDataCon case_bndr dataCon (map StgVarArg args') env1 + env2 + | isUnboxedSumCon dataCon + = env1 + | otherwise + = addDataCon case_bndr dataCon (map StgVarArg args') env1 -- see note [Case 2: CSEing case binders] rhs' = stgCseExpr env2 rhs in (DataAlt dataCon, args', rhs') I think this patch seems better in that it doesn't add a special case to StgCse. Test Plan: Validate. I tried to come up with a minimal example but failed. I thought a simple program like data T = T (# Int | Int #) (# Int# | Int #) case T (# 1 | #) (# 1 | #) of ... should be enough to trigger this bug, but for some reason StgCse doesn't do anything on this program. Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15300 Differential Revision: https://phabricator.haskell.org/D4962 >--------------------------------------------------------------- 3c311e50e760c3ba00dc9692ad1536c79820598d compiler/simplStg/SimplStg.hs | 26 ++++++++------------------ compiler/simplStg/StgCse.hs | 20 +++++++++++++++----- compiler/stgSyn/StgLint.hs | 10 +--------- compiler/stgSyn/StgSyn.hs | 13 +++++++++++++ testsuite/tests/simplStg/should_compile/all.T | 4 +--- 5 files changed, 38 insertions(+), 35 deletions(-) diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index 854bb92..36bf510 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -21,7 +21,6 @@ import StgCse ( stgCse ) import DynFlags import ErrUtils -import SrcLoc import UniqSupply ( mkSplitUniqSupply ) import Outputable import Control.Monad @@ -34,27 +33,19 @@ stg2stg dflags binds = do { showPass dflags "Stg2Stg" ; us <- mkSplitUniqSupply 'g' - ; when (dopt Opt_D_verbose_stg2stg dflags) - (putLogMsg dflags NoReason SevDump noSrcSpan - (defaultDumpStyle dflags) (text "VERBOSE STG-TO-STG:")) - - ; binds' <- end_pass "Stg2Stg" binds - -- Do the main business! - ; processed_binds <- foldM do_stg_pass binds' (getStgToDo dflags) - ; dumpIfSet_dyn dflags Opt_D_dump_stg "Pre unarise:" - (pprStgTopBindings processed_binds) - - ; let un_binds = unarise us processed_binds + (pprStgTopBindings binds) + ; stg_linter False "Pre-unarise" binds + ; let un_binds = unarise us binds ; stg_linter True "Unarise" un_binds ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" (pprStgTopBindings un_binds) - ; return un_binds - } + ; foldM do_stg_pass un_binds (getStgToDo dflags) + } where stg_linter unarised @@ -65,8 +56,7 @@ stg2stg dflags binds do_stg_pass binds to_do = case to_do of D_stg_stats -> - trace (showStgStats binds) - end_pass "StgStats" binds + trace (showStgStats binds) (return binds) StgCSE -> {-# SCC "StgCse" #-} @@ -78,8 +68,8 @@ stg2stg dflags binds end_pass what binds2 = do -- report verbosely, if required dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what - (vcat (map ppr binds2)) - stg_linter False what binds2 + (pprStgTopBindings binds2) + stg_linter True what binds2 return binds2 -- ----------------------------------------------------------------------------- diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6c740ca..1ae1213 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -302,7 +302,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) env2 | StgApp trivial_scrut [] <- scrut' = addTrivCaseBndr bndr trivial_scrut env1 -- See Note [Trivial case scrutinee] | otherwise = env1 - alts' = map (stgCseAlt env2 bndr') alts + alts' = map (stgCseAlt env2 ty bndr') alts -- A constructor application. @@ -329,14 +329,24 @@ stgCseExpr env (StgLetNoEscape binds body) -- Case alternatives -- Extend the CSE environment -stgCseAlt :: CseEnv -> OutId -> InStgAlt -> OutStgAlt -stgCseAlt env case_bndr (DataAlt dataCon, args, rhs) +stgCseAlt :: CseEnv -> AltType -> OutId -> InStgAlt -> OutStgAlt +stgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs) = let (env1, args') = substBndrs env args - env2 = addDataCon case_bndr dataCon (map StgVarArg args') env1 + env2 + -- To avoid dealing with unboxed sums StgCse runs after unarise and + -- should maintain invariants listed in Note [Post-unarisation + -- invariants]. One of the invariants is that some binders are not + -- used (unboxed tuple case binders) which is what we check with + -- `stgCaseBndrInScope` here. If the case binder is not in scope we + -- don't add it to the CSE env. See also #15300. + | stgCaseBndrInScope ty True -- CSE runs after unarise + = addDataCon case_bndr dataCon (map StgVarArg args') env1 + | otherwise + = env1 -- see note [Case 2: CSEing case binders] rhs' = stgCseExpr env2 rhs in (DataAlt dataCon, args', rhs') -stgCseAlt env _ (altCon, args, rhs) +stgCseAlt env _ _ (altCon, args, rhs) = let (env1, args') = substBndrs env args rhs' = stgCseExpr env1 rhs in (altCon, args', rhs') diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs index bb2064a..58f14a1 100644 --- a/compiler/stgSyn/StgLint.hs +++ b/compiler/stgSyn/StgLint.hs @@ -172,15 +172,7 @@ lintStgExpr (StgCase scrut bndr alts_type alts) = do lintStgExpr scrut lf <- getLintFlags - let in_scope = - case alts_type of - AlgAlt _ -> True - PrimAlt _ -> True - -- Case binders of unboxed tuple or unboxed sum type always dead - -- after the unariser has run. - -- See Note [Post-unarisation invariants]. - MultiValAlt _ -> not (lf_unarised lf) - PolyAlt -> True + let in_scope = stgCaseBndrInScope alts_type (lf_unarised lf) addInScopeVars [bndr | in_scope] (mapM_ lintAlt alts) diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs index 608a028..eb905f7 100644 --- a/compiler/stgSyn/StgSyn.hs +++ b/compiler/stgSyn/StgSyn.hs @@ -39,6 +39,7 @@ module StgSyn ( isDllConApp, stgArgType, stripStgTicksTop, + stgCaseBndrInScope, pprStgBinding, pprStgTopBindings ) where @@ -155,6 +156,18 @@ stripStgTicksTop p = go [] where go ts (StgTick t e) | p t = go (t:ts) e go ts other = (reverse ts, other) +-- | Given an alt type and whether the program is unarised, return whether the +-- case binder is in scope. +-- +-- Case binders of unboxed tuple or unboxed sum type always dead after the +-- unariser has run. See Note [Post-unarisation invariants]. +stgCaseBndrInScope :: AltType -> Bool {- ^ unarised? -} -> Bool +stgCaseBndrInScope alt_ty unarised = + case alt_ty of + AlgAlt _ -> True + PrimAlt _ -> True + MultiValAlt _ -> not unarised + PolyAlt -> True {- ************************************************************************ diff --git a/testsuite/tests/simplStg/should_compile/all.T b/testsuite/tests/simplStg/should_compile/all.T index 19fa513..2cb8974 100644 --- a/testsuite/tests/simplStg/should_compile/all.T +++ b/testsuite/tests/simplStg/should_compile/all.T @@ -17,6 +17,4 @@ def checkStgString(needle): return "%s not contained in -ddump-simpl\n" % needle return normalise_errmsg_fun(norm) - - -test('T13588', [ checkStgString('case') ] , compile, ['-ddump-stg']) +test('T13588', [ checkStgString('case') ] , compile, ['-dverbose-stg2stg']) From git at git.haskell.org Fri Jul 27 17:43:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:41 +0000 (UTC) Subject: [commit: ghc] master: Fix endian issues in ghc-heap (d7cb1bb) Message-ID: <20180727174341.D90EB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7cb1bbc26719cf6082abe0d91d80be466e25bfc/ghc >--------------------------------------------------------------- commit d7cb1bbc26719cf6082abe0d91d80be466e25bfc Author: Peter Trommler Date: Thu Jul 26 17:23:22 2018 -0400 Fix endian issues in ghc-heap In test heap_all arity and n_args were swapped on big endian systems. Take care of endianness when reading parts of a machine word from a `Word`. This fixes one out of 36 failing tests reported in #15399. Test Plan: validate Reviewers: simonmar, bgamari, hvr, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15399 Differential Revision: https://phabricator.haskell.org/D5001 >--------------------------------------------------------------- d7cb1bbc26719cf6082abe0d91d80be466e25bfc compiler/ghci/RtClosureInspect.hs | 9 ++++++--- libraries/ghc-heap/GHC/Exts/Heap.hs | 17 +++++++++++++++++ 2 files changed, 23 insertions(+), 3 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index b761407..5b4a10f 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -818,6 +818,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 -- StgCmmLayout.mkVirtHeapOffsetsWithPadding dflags <- getDynFlags let word_size = wORD_SIZE dflags + big_endian = wORDS_BIGENDIAN dflags size_b = primRepSizeB dflags rep -- Align the start offset (eg, 2-byte value should be 2-byte -- aligned). But not more than to a word. The offset calculation @@ -826,7 +827,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 !aligned_idx = roundUpTo arr_i (min word_size size_b) !new_arr_i = aligned_idx + size_b ws | size_b < word_size = - [index size_b aligned_idx word_size] + [index size_b aligned_idx word_size big_endian] | otherwise = let (q, r) = size_b `quotRem` word_size in ASSERT( r == 0 ) @@ -841,7 +842,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 (error "unboxedTupleTerm: no HValue for unboxed tuple") terms -- Extract a sub-word sized field from a word - index item_size_b index_b word_size = + index item_size_b index_b word_size big_endian = (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes where mask :: Word @@ -852,7 +853,9 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 _ -> panic ("Weird byte-index: " ++ show index_b) (q,r) = index_b `quotRem` word_size word = array!!q - moveBytes = r * 8 + moveBytes = if big_endian + then word_size - (r + item_size_b) * 8 + else r * 8 -- | Fast, breadth-first Type reconstruction diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs index 9dc1f94..535596f 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap.hs +++ b/libraries/ghc-heap/GHC/Exts/Heap.hs @@ -62,6 +62,8 @@ import GHC.Exts import GHC.Int import GHC.Word +#include "ghcconfig.h" + class HasHeapRep (a :: TYPE rep) where getClosureData :: a -> IO Closure @@ -169,8 +171,13 @@ getClosure x = do fail $ "Expected at least 2 raw words to AP" let splitWord = rawWds !! 0 pure $ APClosure itbl +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else (fromIntegral splitWord) (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif (head pts) (tail pts) PAP -> do @@ -181,8 +188,13 @@ getClosure x = do fail "Expected at least 2 raw words to PAP" let splitWord = rawWds !! 0 pure $ PAPClosure itbl +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else (fromIntegral splitWord) (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif (head pts) (tail pts) AP_STACK -> do @@ -214,8 +226,13 @@ getClosure x = do ++ show (length rawWds) let splitWord = rawWds !! 3 pure $ BCOClosure itbl (pts !! 0) (pts !! 1) (pts !! 2) +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else (fromIntegral splitWord) (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif (drop 4 rawWds) ARR_WORDS -> do From git at git.haskell.org Fri Jul 27 17:43:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:44 +0000 (UTC) Subject: [commit: ghc] master: rts: More forceful cc debugging flags (ccdc032) Message-ID: <20180727174344.AB8473A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ccdc03286141bb8d365f122702dfd1f73376a402/ghc >--------------------------------------------------------------- commit ccdc03286141bb8d365f122702dfd1f73376a402 Author: Ben Gamari Date: Thu Jul 26 17:21:48 2018 -0400 rts: More forceful cc debugging flags Reviewers: simonmar, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4999 >--------------------------------------------------------------- ccdc03286141bb8d365f122702dfd1f73376a402 rts/ghc.mk | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rts/ghc.mk b/rts/ghc.mk index 6154720..7de796a 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -154,7 +154,9 @@ rts_dist_$1_CC_OPTS := $$(GhcRtsCcOpts) # The per-way CC_OPTS ifneq "$$(findstring debug, $1)" "" rts_dist_$1_HC_OPTS += -O0 -rts_dist_$1_CC_OPTS += -fno-omit-frame-pointer -g -O0 +rts_dist_$1_CC_OPTS += -fno-omit-frame-pointer -O0 -g3 +# Useful to ensure that inline functions can be called within GDB +rts_dist_$1_CC_OPTS += -fkeep-inline-functions endif ifneq "$$(findstring dyn, $1)" "" From git at git.haskell.org Fri Jul 27 17:43:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:47 +0000 (UTC) Subject: [commit: ghc] master: Disable GNUC_ATTR_HOT when compiling with DEBUG (40e9ec9) Message-ID: <20180727174347.7CD823A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/40e9ec982a6f133243ca74ac7353b9be39e18c72/ghc >--------------------------------------------------------------- commit 40e9ec982a6f133243ca74ac7353b9be39e18c72 Author: Ben Gamari Date: Thu Jul 26 17:23:12 2018 -0400 Disable GNUC_ATTR_HOT when compiling with DEBUG Test Plan: Validate Reviewers: simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5000 >--------------------------------------------------------------- 40e9ec982a6f133243ca74ac7353b9be39e18c72 includes/Stg.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/includes/Stg.h b/includes/Stg.h index 2e02347..19069d8 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -196,7 +196,7 @@ #define GNUC3_ATTRIBUTE(at) #endif -#if __GNUC__ > 4 || __GNUC__ == 4 && __GNUC_MINOR__ >= 3 +#if !defined(DEBUG) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)) #define GNUC_ATTR_HOT __attribute__((hot)) #else #define GNUC_ATTR_HOT /* nothing */ From git at git.haskell.org Fri Jul 27 17:43:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:50 +0000 (UTC) Subject: [commit: ghc] master: Modifications to support loading GHC into GHCi (60ecf43) Message-ID: <20180727174350.4F2E63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60ecf43a5a0b1cc732560058a06ca5b2f2e27773/ghc >--------------------------------------------------------------- commit 60ecf43a5a0b1cc732560058a06ca5b2f2e27773 Author: Michael Sloan Date: Thu Jul 26 17:21:08 2018 -0400 Modifications to support loading GHC into GHCi This change was previously part of [D4904](https://phabricator.haskell.org/D4904), but is being split off to aid in getting this reviewed and merged. * The compiler code is built with `NoImplicitPrelude`, but GHCi's modules are incompatible with it. So, this adds the pragma to all GHCi modules that didn't have it, and adds imports of Prelude. * In order to run GHC within itself, a `call of 'initGCStatistics` needed to be skipped. This uses CPP to skip it when `-DGHC_LOADED_INTO_GHCI` is set. * There is an environment variable workaround suggested by Ben Gamari [1], where `_GHC_TOP_DIR` can be used to specify GHC's top dir if `-B` isn't provided. This can be used to solve a problem where the GHC being run within GHCi attempts to look in `inplace/lib/lib/` instead of `inplace/lib/`. [1]: https://phabricator.haskell.org/D4904#135438 Reviewers: goldfire, bgamari, erikd, alpmestan Reviewed By: alpmestan Subscribers: alpmestan, lelf, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4986 >--------------------------------------------------------------- 60ecf43a5a0b1cc732560058a06ca5b2f2e27773 compiler/main/SysTools/BaseDir.hs | 22 ++++++++++++++++------ ghc/GHCi/Leak.hs | 1 + ghc/GHCi/UI/Tags.hs | 5 +++-- ghc/Main.hs | 14 ++++++++++++++ ghc/ghc-bin.cabal.in | 5 +++++ .../template-haskell/Language/Haskell/TH/Lib.hs | 1 + .../Language/Haskell/TH/Lib/Internal.hs | 1 + .../Language/Haskell/TH/Lib/Map.hs | 2 ++ .../template-haskell/Language/Haskell/TH/Quote.hs | 1 + .../template-haskell/Language/Haskell/TH/Syntax.hs | 1 + libraries/template-haskell/template-haskell.cabal | 5 +++++ 11 files changed, 50 insertions(+), 8 deletions(-) diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index 85635df..625baec 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -22,6 +22,7 @@ import GhcPrelude import Panic +import System.Environment (lookupEnv) import System.FilePath import Data.List @@ -115,12 +116,21 @@ findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix). -> IO String -- TopDir (in Unix format '/' separated) findTopDir (Just minusb) = return (normalise minusb) findTopDir Nothing - = do -- Get directory of executable - maybe_exec_dir <- getBaseDir - case maybe_exec_dir of - -- "Just" on Windows, "Nothing" on unix - Nothing -> throwGhcExceptionIO (InstallationError "missing -B option") - Just dir -> return dir + = do -- The _GHC_TOP_DIR environment variable can be used to specify + -- the top dir when the -B argument is not specified. It is not + -- intended for use by users, it was added specifically for the + -- purpose of running GHC within GHCi. + maybe_env_top_dir <- lookupEnv "_GHC_TOP_DIR" + case maybe_env_top_dir of + Just env_top_dir -> return env_top_dir + Nothing -> do + -- Get directory of executable + maybe_exec_dir <- getBaseDir + case maybe_exec_dir of + -- "Just" on Windows, "Nothing" on unix + Nothing -> throwGhcExceptionIO $ + InstallationError "missing -B option" + Just dir -> return dir getBaseDir :: IO (Maybe String) #if defined(mingw32_HOST_OS) diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs index aec1ab5..47fed9c 100644 --- a/ghc/GHCi/Leak.hs +++ b/ghc/GHCi/Leak.hs @@ -16,6 +16,7 @@ import GHC.Types (IO (..)) import HscTypes import Outputable import Platform (target32Bit) +import Prelude import System.Mem import System.Mem.Weak import UniqDFM diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs index d8af7f8..09a8406 100644 --- a/ghc/GHCi/UI/Tags.hs +++ b/ghc/GHCi/UI/Tags.hs @@ -25,13 +25,14 @@ import OccName (pprOccName) import ConLike import MonadUtils +import Control.Monad import Data.Function +import Data.List import Data.Maybe import Data.Ord import DriverPhases import Panic -import Data.List -import Control.Monad +import Prelude import System.Directory import System.IO import System.IO.Error diff --git a/ghc/Main.hs b/ghc/Main.hs index 276546b..ea80910 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -74,6 +74,7 @@ import Control.Monad import Data.Char import Data.List import Data.Maybe +import Prelude ----------------------------------------------------------------------------- -- ToDo: @@ -929,5 +930,18 @@ people since we're linking GHC dynamically, but most things themselves link statically. -} +-- If GHC_LOADED_INTO_GHCI is not set when GHC is loaded into GHCi, then +-- running it causes an error like this: +-- +-- Loading temp shared object failed: +-- /tmp/ghc13836_0/libghc_1872.so: undefined symbol: initGCStatistics +-- +-- Skipping the foreign call fixes this problem, and the outer GHCi +-- should have already made this call anyway. +#if defined(GHC_LOADED_INTO_GHCI) +initGCStatistics :: IO () +initGCStatistics = return () +#else foreign import ccall safe "initGCStatistics" initGCStatistics :: IO () +#endif diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 85a9250..5c51058 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -84,3 +84,8 @@ Executable ghc CPP NondecreasingIndentation TupleSections + + -- This should match the default-extensions used in 'ghc.cabal'. This way, + -- GHCi can be used to load it all at once. + Default-Extensions: + NoImplicitPrelude diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs index b7966ce..b0aa580 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs @@ -151,6 +151,7 @@ import Language.Haskell.TH.Lib.Internal hiding import Language.Haskell.TH.Syntax import Control.Monad (liftM2) +import Prelude -- All definitions below represent the "old" API, since their definitions are -- different in Language.Haskell.TH.Lib.Internal. Please think carefully before diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs index cac8ea8..0ddfddf 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs @@ -18,6 +18,7 @@ import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) import qualified Language.Haskell.TH.Syntax as TH import Control.Monad( liftM, liftM2 ) import Data.Word( Word8 ) +import Prelude ---------------------------------------------------------- -- * Type synonyms diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs index ac24151..b11139c 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs @@ -16,6 +16,8 @@ module Language.Haskell.TH.Lib.Map , Language.Haskell.TH.Lib.Map.lookup ) where +import Prelude + data Map k a = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a) | Tip diff --git a/libraries/template-haskell/Language/Haskell/TH/Quote.hs b/libraries/template-haskell/Language/Haskell/TH/Quote.hs index 91e3739..4ff5a20 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Quote.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Quote.hs @@ -21,6 +21,7 @@ module Language.Haskell.TH.Quote( ) where import Language.Haskell.TH.Syntax +import Prelude -- | The 'QuasiQuoter' type, a value @q@ of this type can be used -- in the syntax @[q| ... string to parse ...|]@. In fact, for diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index f5f60c3..4e0a1c9 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -41,6 +41,7 @@ import GHC.Lexeme ( startsVarSym, startsVarId ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions import Numeric.Natural +import Prelude import qualified Control.Monad.Fail as Fail diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index 6cd156c..2b2c5db 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -60,3 +60,8 @@ Library -- We need to set the unit ID to template-haskell (without a -- version number) as it's magic. ghc-options: -this-unit-id template-haskell + + -- This should match the default-extensions used in 'ghc.cabal'. This way, + -- GHCi can be used to load it along with the compiler. + Default-Extensions: + NoImplicitPrelude From git at git.haskell.org Fri Jul 27 17:43:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 17:43:53 +0000 (UTC) Subject: [commit: ghc] master: update core-spec for GRefl and re-factored Refl (e5f3de2) Message-ID: <20180727174353.226713A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e5f3de2cf2f52e7079cbee624ae91beecf663f87/ghc >--------------------------------------------------------------- commit e5f3de2cf2f52e7079cbee624ae91beecf663f87 Author: ningning Date: Thu Jul 26 17:20:42 2018 -0400 update core-spec for GRefl and re-factored Refl Ticket #15192 introduced the generalized reflexive coercion `GRefl` and nominal reflexive `Refl`, and removed `CoherenceCo`. Update core-spec accordingly. Not sure about notations though; suggestions on more concise notations would be great. Test Plan: Read core-spec.pdf Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4984 >--------------------------------------------------------------- e5f3de2cf2f52e7079cbee624ae91beecf663f87 docs/core-spec/CoreLint.ott | 16 ++++++++++------ docs/core-spec/CoreSyn.ott | 14 +++++++++++--- docs/core-spec/OpSem.ott | 4 ++-- docs/core-spec/core-spec.mng | 22 ++++++++++++++++++---- docs/core-spec/core-spec.pdf | Bin 354354 -> 356480 bytes 5 files changed, 41 insertions(+), 15 deletions(-) diff --git a/docs/core-spec/CoreLint.ott b/docs/core-spec/CoreLint.ott index d18525a..6ace483 100644 --- a/docs/core-spec/CoreLint.ott +++ b/docs/core-spec/CoreLint.ott @@ -217,7 +217,16 @@ by G |-ty t : k ---------------------- :: Refl -G |-co _R : t k~R k t +G |-co : t k~Nom k t + +G |-ty t : k +---------------------- :: GReflMRefl +G |-co R MRefl : t k~R k t + +G |-ty t : k1 +G |-co g : k1 *~Nom * k2 +---------------------- :: GReflMCo +G |-co R MCo g : t k1~R k2 (t |> g) G |-co g1 : s1 k1~R k'1 t1 G |-co g2 : s2 k2~R k'2 t2 @@ -339,11 +348,6 @@ G |-ty t2 : k' G |-co C ind : s2 k~R0 k' t2 G |-co g : t1 k1~R k2 t2 -G |-ty t1 |> h : k1' ----------------------------------- :: CoherenceCo -G |-co g |> h : t1 |> h k1'~R k2 t2 - -G |-co g : t1 k1~R k2 t2 -------------------------- :: KindCo G |-co kind g : k1 *~Nom * k2 diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott index 57ed6e2..b11730c 100644 --- a/docs/core-spec/CoreSyn.ott +++ b/docs/core-spec/CoreSyn.ott @@ -138,8 +138,10 @@ t {{ tex \tau }}, k {{ tex \kappa }}, s {{ tex \sigma }}, phi {{ tex \phi }} %% COERCIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coderef{types/TyCoRep.lhs}{Coercion} }} - | < t > _ R :: :: Refl {{ com \ctor{Refl}: Reflexivity }} - {{ tex {\langle [[t]] \rangle}_{[[R]]} }} + | < t > :: :: Refl {{ com \ctor{Refl}: Nominal Reflexivity }} + {{ tex {\langle [[t]] \rangle} }} + | < t > R mg :: :: GRefl {{ com \ctor{GRefl}: Generalized Reflexivity }} + {{ tex {\langle [[t]] \rangle}^{[[mg]]}_{[[R]]} }} | T RA :: :: TyConAppCo {{ com \ctor{TyConAppCo}: Type constructor application }} | g1 g2 :: :: AppCo {{ com \ctor{AppCo}: Application }} | forall z : h . g :: :: ForAllCo {{ com \ctor{ForAllCo}: Polymorphism }} @@ -156,7 +158,6 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder {{ tex \textsf{nth}^{[[I]]}_{[[R]]}\,[[g]] }} | LorR g :: :: LRCo {{ com \ctor{LRCo}: Left/right projection }} | g @ h :: :: InstCo {{ com \ctor{InstCo}: Instantiation }} - | g |> h :: :: CoherenceCo {{ com \ctor{CoherenceCo}: Coherence }} | kind g :: :: KindCo {{ com \ctor{KindCo}: Kind extraction }} | sub g :: :: SubCo {{ com \ctor{SubCo}: Sub-role --- convert nominal to representational }} | ( g ) :: M :: Parens {{ com Parentheses }} @@ -170,6 +171,11 @@ prov :: 'UnivCoProvenance_' ::= {{ com \ctor{UnivCo} provenance, \coderef{types/ | ProofIrrelProv :: :: ProofIrrelProv {{ com From proof irrelevance }} {{ tex \mathsf{irrel} }} +mg {{ tex m }} :: 'MCoercion_' ::= {{ com A possibly reflexive coercion , \coderef{types/TyCoRep.lhs}{MCoercion} }} + | MRefl :: :: MRefl {{ com \ctor{MRefl}: A trivial reflexive coercion }} + | MCo g :: :: MCo {{ com \ctor{MCo}: Other coercions }} + {{ tex [[g]] }} + LorR :: 'LeftOrRight_' ::= {{ com left or right deconstructor, \coderef{types/TyCoRep.lhs}{LeftOrRight} }} | Left :: :: CLeft {{ com \ctor{CLeft}: Left projection }} | Right :: :: CRight {{ com \ctor{CRight}: Right projection }} @@ -397,6 +403,8 @@ terminals :: 'terminals_' ::= | classifiesTypeWithValues :: :: ctwv {{ tex \textsf{classifiesTypeWithValues} }} | 0 :: :: zero {{ tex 0 }} | +1 :: :: succ {{ tex +1 }} + | MRefl :: :: mrefl {{ tex \cdot }} + | MCo :: :: mco %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Formulae %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/docs/core-spec/OpSem.ott b/docs/core-spec/OpSem.ott index 389c5e8..b9dc4ff 100644 --- a/docs/core-spec/OpSem.ott +++ b/docs/core-spec/OpSem.ott @@ -52,7 +52,7 @@ not e2 is_a_coercion g' = sym (nth Nom 0 g) t' = t |> g' -------------------------------------------------------- :: TPush -((\n.e) |> g) t --> ((\n.e) t') |> (g @ (_Nom |> g')) +((\n.e) |> g) t --> ((\n.e) t') |> (g @ (sym Nom MCo g')) % g : ((t1 ~rho# t2) -> t3) ~Rep# ((t4 ~rho# t5) -> t6) % g2 : t3 ~Rep# t6 @@ -103,7 +103,7 @@ case e as n return t of --> u[n |-> e] T k'~Rep# k T = coercionKind g = tyConRoles T forall . forall . $ -> T = dataConRepType K - (t1cc $ nth Raa aa g] // aa /> _Nom] // bb />) // cc /> + (t1cc $ nth Raa aa g] // aa /> ] // bb />) // cc /> --------------------------- :: CasePush case (K ) |> g as n return t2 of --> \\ case K as n return t2 of diff --git a/docs/core-spec/core-spec.mng b/docs/core-spec/core-spec.mng index 19dabcb..952a172 100644 --- a/docs/core-spec/core-spec.mng +++ b/docs/core-spec/core-spec.mng @@ -207,14 +207,14 @@ We use the notation $[[t1 k1~#k2 t2]]$ to stand for $[[(~#) k1 k2 t1 t2]]$. Invariants on coercions: \begin{itemize} -\item $[[_R]]$ is used; never $[[_R _Nom]]$. -\item If $[[_R]]$ is applied to some coercions, at least one of which is not -reflexive, use $[[T_R ]]$, never $[[_R g1 g2]] \ldots$. +\item $[[]]$ is used; never $[[ ]]$. +\item If $[[]]$ is applied to some coercions, at least one of which is not +reflexive, use $[[T_R ]]$, never $[[ g1 g2]] \ldots$. \item The $[[T]]$ in $[[T_R ]]$ is never a type synonym, though it could be a type function. \item Every non-reflexive coercion coerces between two distinct types. \item The name in a coercion must be a term-level name (\ctor{Id}). -\item The contents of $[[_R]]$ must not be a coercion. In other words, +\item The contents of $[[]]$ must not be a coercion. In other words, the payload in a \texttt{Refl} must not be built with \texttt{CoercionTy}. \end{itemize} @@ -232,6 +232,20 @@ for more background. \gram{\ottR} +The \texttt{GRefl} constructor taks an $[[mg]]$. It wraps a kind coercion, which +might be reflexive or any coercion: + +\gram{\ottmg} + +A nominal reflexive coercion is quite common, so we keep the special form +\texttt{Refl}. Invariants on reflexive coercions: + +\begin{itemize} +\item Always use $[[]]$; never $[[ Nom MRefl]]$. +\item All invariants on $[[]]$ hold for $[[ R MRefl]]$. +\item Use $[[ Rep MRefl]]$; never $[[sub ]]$. +\end{itemize} + Is it a left projection or a right projection? \gram{\ottLorR} diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf index 21a8852..a0a73cb 100644 Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ From git at git.haskell.org Fri Jul 27 18:44:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 18:44:00 +0000 (UTC) Subject: [commit: ghc] master: Remove dead code in testsuite driver (2cb08d7) Message-ID: <20180727184400.24AF73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2cb08d72d938fa6fdf46da032980af8c4973a0be/ghc >--------------------------------------------------------------- commit 2cb08d72d938fa6fdf46da032980af8c4973a0be Author: Krzysztof Gogolewski Date: Fri Jul 27 18:40:26 2018 +0200 Remove dead code in testsuite driver Test Plan: validate Reviewers: bgamari, O7 GHC - Testsuite Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4972 >--------------------------------------------------------------- 2cb08d72d938fa6fdf46da032980af8c4973a0be testsuite/driver/runtests.py | 4 ---- testsuite/driver/testlib.py | 21 ++++----------------- testsuite/driver/testutil.py | 14 -------------- 3 files changed, 4 insertions(+), 35 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 4e275c5..e9cce94 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -4,13 +4,10 @@ # (c) Simon Marlow 2002 # -from __future__ import print_function - import argparse import signal import sys import os -import string import shutil import tempfile import time @@ -55,7 +52,6 @@ parser.add_argument("--only", action="append", help="just this test (can be give parser.add_argument("--way", action="append", help="just this way") parser.add_argument("--skipway", action="append", help="skip this way") parser.add_argument("--threads", type=int, help="threads to run simultaneously") -parser.add_argument("--check-files-written", help="check files aren't written by multiple tests") # NOTE: This doesn't seem to exist? parser.add_argument("--verbose", type=int, choices=[0,1,2,3,4,5], help="verbose (Values 0 through 5 accepted)") parser.add_argument("--skip-perf-tests", action="store_true", help="skip performance tests") parser.add_argument("--junit", type=argparse.FileType('wb'), help="output testsuite summary in JUnit format") diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index f7863c3..f99c6ed 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -3,13 +3,9 @@ # (c) Simon Marlow 2002 # -from __future__ import print_function - import io import shutil import os -import errno -import string import re import traceback import time @@ -25,26 +21,22 @@ from testglobals import * from testutil import * extra_src_files = {'T4198': ['exitminus1.c']} # TODO: See #12223 +global pool_sema if config.use_threads: import threading - try: - import thread - except ImportError: # Python 3 - import _thread as thread + pool_sema = threading.BoundedSemaphore(value=config.threads) global wantToStop wantToStop = False -global pool_sema -if config.use_threads: - pool_sema = threading.BoundedSemaphore(value=config.threads) - def stopNow(): global wantToStop wantToStop = True + def stopping(): return wantToStop + # Options valid for the current test only (these get reset to # testdir_testopts after each test). @@ -504,7 +496,6 @@ def no_check_hp(name, opts): def filter_stdout_lines( regex ): """ Filter lines of stdout with the given regular expression """ - import re def f( name, opts ): _normalise_fun(name, opts, lambda s: '\n'.join(re.findall(regex, s))) return f @@ -1823,9 +1814,6 @@ def runCmd(cmd, stdin=None, stdout=None, stderr=None, timeout_multiplier=1.0, pr cmd = cmd.format(**config.__dict__) if_verbose(3, cmd + ('< ' + os.path.basename(stdin) if stdin else '')) - # declare the buffers to a default - stdin_buffer = None - stdin_file = io.open(stdin, 'rb') if stdin else None stdout_buffer = b'' stderr_buffer = b'' @@ -1949,7 +1937,6 @@ def find_expected_file(name, suff): if config.msys: import stat - import time def cleanup(): testdir = getTestOpts().testdir max_attempts = 5 diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index dcba177..104bbff 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -1,4 +1,3 @@ -import errno import os import platform import subprocess @@ -25,15 +24,6 @@ def getStdout(cmd_and_args): raise Exception("stderr from command: %s\nOutput:\n%s\n" % (cmd_and_args, stderr)) return stdout -def mkdirp(path): - try: - os.makedirs(path) - except OSError as e: - if e.errno == errno.EEXIST and os.path.isdir(path): - pass - else: - raise - def lndir(srcdir, dstdir): # Create symlinks for all files in src directory. # Not all developers might have lndir installed. @@ -60,10 +50,6 @@ else: link_or_copy_file = os.symlink class Watcher(object): - global pool - global evt - global sync_lock - def __init__(self, count): self.pool = count self.evt = threading.Event() From git at git.haskell.org Fri Jul 27 18:44:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 18:44:46 +0000 (UTC) Subject: [commit: packages/terminfo] tag '0.4.1.2' created Message-ID: <20180727184446.56DA13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo New tag : 0.4.1.2 Referencing: 74f76d182f06e330d27d47f250b9b16242bf1164 From git at git.haskell.org Fri Jul 27 18:44:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 18:44:48 +0000 (UTC) Subject: [commit: packages/terminfo] : Bump version to 0.4.1.2. (27e8275) Message-ID: <20180727184448.5C5143A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo On branch : Link : http://git.haskell.org/packages/terminfo.git/commitdiff/27e82750fac178fc6e049fe44be6de45f24814ae >--------------------------------------------------------------- commit 27e82750fac178fc6e049fe44be6de45f24814ae Author: Judah Jacobson Date: Thu Jul 26 22:59:48 2018 -0700 Bump version to 0.4.1.2. >--------------------------------------------------------------- 27e82750fac178fc6e049fe44be6de45f24814ae terminfo.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/terminfo.cabal b/terminfo.cabal index ae819c4..5d3c324 100644 --- a/terminfo.cabal +++ b/terminfo.cabal @@ -1,6 +1,6 @@ Name: terminfo Cabal-Version: >=1.10 -Version: 0.4.1.1 +Version: 0.4.1.2 Category: User Interfaces License: BSD3 License-File: LICENSE From git at git.haskell.org Fri Jul 27 18:45:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 18:45:12 +0000 (UTC) Subject: [commit: packages/terminfo] master's head updated: Bump version to 0.4.1.2. (27e8275) Message-ID: <20180727184512.7C1733A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo Branch 'master' now includes: 27e8275 Bump version to 0.4.1.2. From git at git.haskell.org Fri Jul 27 21:25:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jul 2018 21:25:14 +0000 (UTC) Subject: [commit: ghc] master: Fix Ar crashing on odd-sized object files (Trac #15396) (754c3a5) Message-ID: <20180727212514.7FAE83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/754c3a55a603b155fa5d9a282de73d41a4694ffc/ghc >--------------------------------------------------------------- commit 754c3a55a603b155fa5d9a282de73d41a4694ffc Author: Krzysztof Gogolewski Date: Fri Jul 27 22:10:52 2018 +0200 Fix Ar crashing on odd-sized object files (Trac #15396) Summary: All the work was done by Moritz Angermann. Test Plan: validate Reviewers: angerman, RyanGlScott, bgamari Reviewed By: angerman Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15396 Differential Revision: https://phabricator.haskell.org/D5013 >--------------------------------------------------------------- 754c3a55a603b155fa5d9a282de73d41a4694ffc compiler/main/Ar.hs | 13 +++++++++++-- testsuite/tests/driver/T15396.hs | 8 ++++++++ testsuite/tests/driver/T15396.stdout | 1 + testsuite/tests/driver/all.T | 2 ++ 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs index 51655c0..9ead053 100644 --- a/compiler/main/Ar.hs +++ b/compiler/main/Ar.hs @@ -95,7 +95,8 @@ getBSDArchEntries = do st_size <- getPaddedInt <$> getByteString 10 end <- getByteString 2 when (end /= "\x60\x0a") $ - fail "Invalid archive header end marker" + fail ("[BSD Archive] Invalid archive header end marker for name: " ++ + C.unpack name) off1 <- liftM fromIntegral bytesRead :: Get Int -- BSD stores extended filenames, by writing #1/ into the -- name field, the first @length@ bytes then represent the file name @@ -106,6 +107,10 @@ getBSDArchEntries = do return $ C.unpack $ C.takeWhile (/= ' ') name off2 <- liftM fromIntegral bytesRead :: Get Int file <- getByteString (st_size - (off2 - off1)) + -- data sections are two byte aligned (see Trac #15396) + when (odd st_size) $ + void (getByteString 1) + rest <- getBSDArchEntries return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest @@ -128,8 +133,12 @@ getGNUArchEntries extInfo = do st_size <- getPaddedInt <$> getByteString 10 end <- getByteString 2 when (end /= "\x60\x0a") $ - fail "Invalid archive header end marker" + fail ("[BSD Archive] Invalid archive header end marker for name: " ++ + C.unpack name) file <- getByteString st_size + -- data sections are two byte aligned (see Trac #15396) + when (odd st_size) $ + void (getByteString 1) name <- return . C.unpack $ if C.unpack (C.take 1 name) == "/" then case C.takeWhile (/= ' ') name of diff --git a/testsuite/tests/driver/T15396.hs b/testsuite/tests/driver/T15396.hs new file mode 100644 index 0000000..9ab9f6e --- /dev/null +++ b/testsuite/tests/driver/T15396.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} +import Ar + +-- obtained from echo -n \0 > x.o && ar -q b.a x.o && cat b.a +archive = "!\nx.o/ 0 0 0 644 1 \ +\`\n0\nx.o/ 0 0 0 644 1 `\n0\n" + +main = print (parseAr archive) diff --git a/testsuite/tests/driver/T15396.stdout b/testsuite/tests/driver/T15396.stdout new file mode 100644 index 0000000..65edafa --- /dev/null +++ b/testsuite/tests/driver/T15396.stdout @@ -0,0 +1 @@ +Archive [ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"},ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"}] diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 714b6c4..6397598 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -278,3 +278,5 @@ test('T13604a', [], run_command, ['$MAKE -s --no-print-directory T13604a']) test('inline-check', omit_ways(['hpc', 'profasm']) , compile , ['-dinline-check foo -O -ddebug-output']) + +test('T15396', normal, compile_and_run, ['-package ghc']) From git at git.haskell.org Sat Jul 28 15:48:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jul 2018 15:48:22 +0000 (UTC) Subject: [commit: ghc] master: Fix Git commit ID detection in Git worktrees (3539561) Message-ID: <20180728154822.EAF993A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3539561b24b78aee2b37280ddf6bb64e2db3a67d/ghc >--------------------------------------------------------------- commit 3539561b24b78aee2b37280ddf6bb64e2db3a67d Author: Sylvain Henry Date: Sat Jul 28 17:48:04 2018 +0200 Fix Git commit ID detection in Git worktrees Summary: When using a Git worktree, ".git" is a file, not a directory Reviewers: bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, thomie, erikd, carter Differential Revision: https://phabricator.haskell.org/D5016 >--------------------------------------------------------------- 3539561b24b78aee2b37280ddf6bb64e2db3a67d aclocal.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index eef4dc7..1412350 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1546,7 +1546,7 @@ if test "$RELEASE" = "NO"; then fi AC_MSG_CHECKING([for GHC Git commit id]) - if test -d .git; then + if test -e .git; then git_commit_id=`git rev-parse HEAD` if test -n "$git_commit_id" 2>&1 >/dev/null; then true; else AC_MSG_ERROR([failed to detect revision: check that git is in your path]) From git at git.haskell.org Sun Jul 29 12:23:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jul 2018 12:23:37 +0000 (UTC) Subject: [commit: ghc] master: Fix #15453: bug in ForAllCo case in opt_trans_rule (11de438) Message-ID: <20180729122337.454DB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/11de4380c2f16f374c6e8fbacf8dce00376e7efb/ghc >--------------------------------------------------------------- commit 11de4380c2f16f374c6e8fbacf8dce00376e7efb Author: Ningning Xie Date: Sun Jul 29 13:15:33 2018 +0200 Fix #15453: bug in ForAllCo case in opt_trans_rule Summary: Given ``` co1 = \/ tv1 : eta1. r1 co2 = \/ tv2 : eta2. r2 ``` We would like to optimize `co1; co2` so we push transitivity inside forall. It should be ``` \/tv1 : (eta1;eta2). (r1; r2[tv2 |-> tv1 |> eta1]) ``` It is implemented in the ForAllCo case in opt_trans_rule in OptCoercion. However current implementation is not right: ``` r2' = substCoWithUnchecked [tv2] [TyVarTy tv1] r2 -- ill-kinded! ``` This patch corrects it to be ``` r2' = substCoWithUnchecked [tv2] [mkCastTy (TyVarTy tv1) eta1] r2 ``` Test Plan: validate Reviewers: bgamari, goldfire, RyanGlScott Reviewed By: RyanGlScott Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15453 Differential Revision: https://phabricator.haskell.org/D5018 >--------------------------------------------------------------- 11de4380c2f16f374c6e8fbacf8dce00376e7efb compiler/types/OptCoercion.hs | 7 +++++- testsuite/tests/simplCore/should_compile/T15453.hs | 25 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 3 files changed, 32 insertions(+), 1 deletion(-) diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index 70ae469..5dd7c0c 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -606,11 +606,16 @@ opt_trans_rule is co1 co2 where push_trans tv1 eta1 r1 tv2 eta2 r2 + -- Given: + -- co1 = \/ tv1 : eta1. r1 + -- co2 = \/ tv2 : eta2. r2 + -- Wanted: + -- \/tv1 : (eta1;eta2). (r1; r2[tv2 |-> tv1 |> eta1]) = fireTransRule "EtaAllTy" co1 co2 $ mkForAllCo tv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2') where is' = is `extendInScopeSet` tv1 - r2' = substCoWithUnchecked [tv2] [TyVarTy tv1] r2 + r2' = substCoWithUnchecked [tv2] [mkCastTy (TyVarTy tv1) eta1] r2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 diff --git a/testsuite/tests/simplCore/should_compile/T15453.hs b/testsuite/tests/simplCore/should_compile/T15453.hs new file mode 100644 index 0000000..a452bef --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15453.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T15453 where + +import Data.Kind +import Data.Proxy +import Data.Type.Equality + +type family S :: Type where + S = T +type family T :: Type where + T = Int + +f :: (forall (x :: S). Proxy x) :~: (forall (x :: T). Proxy x) +f = Refl + +g :: (forall (x :: T). Proxy x) :~: (forall (x :: Int). Proxy x) +g = Refl + +h :: (forall (x :: S). Proxy x) :~: (forall (x :: Int). Proxy x) +h = f `trans` g diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 58e9893..d4eaf19 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -316,3 +316,4 @@ test('T15005', normal, compile, ['-O']) # we omit profiling because it affects the optimiser and makes the test fail test('T15056', [extra_files(['T15056a.hs']), omit_ways(['profasm'])], multimod_compile, ['T15056', '-O -v0 -ddump-rule-firings']) test('T15186', normal, multimod_compile, ['T15186', '-v0']) +test('T15453', normal, compile, ['-dcore-lint -O1']) From git at git.haskell.org Mon Jul 30 12:55:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 12:55:56 +0000 (UTC) Subject: [commit: ghc] master: Fix #15385 by using addDictsDs in matchGuards (9d388eb) Message-ID: <20180730125556.5A9333A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d388eb83e797fd28e14868009c4786f3f1a8aa6/ghc >--------------------------------------------------------------- commit 9d388eb83e797fd28e14868009c4786f3f1a8aa6 Author: Ryan Scott Date: Mon Jul 30 08:47:39 2018 -0400 Fix #15385 by using addDictsDs in matchGuards Summary: When coverage checking pattern-matches, we rely on the call sites in the desugarer to populate the local dictionaries and term evidence in scope using `addDictsDs` and `addTmCsDs`. But it turns out that only the call site for desugaring `case` expressions was actually doing this properly. In another part of the desugarer, `matchGuards` (which handles pattern guards), it did not update the local dictionaries in scope at all, leading to #15385. Fixing this is relatively straightforward: just augment the `BindStmt` case of `matchGuards` to use `addDictsDs` and `addTmCsDs`. Accomplishing this took a little bit of import/export tweaking: * We now need to export `collectEvVarsPat` from `HsPat.hs`. * To avoid an import cycle with `Check.hs`, I moved `isTrueLHsExpr` from `DsGRHSs.hs` to `DsUtils.hs`, which resides lower on the import chain. Test Plan: make test TEST=T15385 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15385 Differential Revision: https://phabricator.haskell.org/D4968 >--------------------------------------------------------------- 9d388eb83e797fd28e14868009c4786f3f1a8aa6 compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsGRHSs.hs | 49 +++++++----------------- compiler/deSugar/DsUtils.hs | 32 +++++++++++++++- compiler/deSugar/Match.hs-boot | 4 +- compiler/hsSyn/HsPat.hs | 2 +- testsuite/tests/pmcheck/should_compile/T15385.hs | 21 ++++++++++ testsuite/tests/pmcheck/should_compile/all.T | 2 + 7 files changed, 72 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9d388eb83e797fd28e14868009c4786f3f1a8aa6 From git at git.haskell.org Mon Jul 30 15:37:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 15:37:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE (575caf5) Message-ID: <20180730153725.D7AA63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/575caf56518f8d54a1cb54398890618bcf1e9bfd/ghc >--------------------------------------------------------------- commit 575caf56518f8d54a1cb54398890618bcf1e9bfd Author: Ben Gamari Date: Tue Oct 24 12:19:08 2017 -0400 base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE As noted in #14346, touch# may be optimized away when the simplifier can see that the continuation passed to allocaBytes will not return. Marking CPS-style functions with NOINLINE ensures that the simplier can't draw any unsound conclusions. Ultimately the right solution here will be to do away with touch# and instead introduce a scoped primitive as is suggested in #14375. (cherry picked from commit 404bf05ed3193e918875cd2f6c95ae0da5989be2) (cherry picked from commit 7409e28c513054b735b6a86dfab4fdab212aaf8f) >--------------------------------------------------------------- 575caf56518f8d54a1cb54398890618bcf1e9bfd libraries/base/Foreign/Marshal/Alloc.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/libraries/base/Foreign/Marshal/Alloc.hs b/libraries/base/Foreign/Marshal/Alloc.hs index 2a3c756..10b6d36 100644 --- a/libraries/base/Foreign/Marshal/Alloc.hs +++ b/libraries/base/Foreign/Marshal/Alloc.hs @@ -123,6 +123,19 @@ alloca = doAlloca undefined doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b' doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy) +-- Note [NOINLINE for touch#] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously +-- fragile in the presence of simplification (see #14346). In particular, the +-- simplifier may drop the continuation containing the touch# if it can prove +-- that the action passed to allocaBytes will not return. The hack introduced to +-- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the +-- simplifier can't see the divergence. +-- +-- These can be removed once #14375 is fixed, which suggests that we instead do +-- away with touch# in favor of a primitive that will capture the scoping left +-- implicit in the case of touch#. + -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic @@ -141,6 +154,8 @@ allocaBytes (I# size) action = IO $ \ s0 -> case touch# barr# s3 of { s4 -> (# s4, r #) }}}}} +-- See Note [NOINLINE for touch#] +{-# NOINLINE allocaBytes #-} allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> @@ -152,6 +167,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> case touch# barr# s3 of { s4 -> (# s4, r #) }}}}} +-- See Note [NOINLINE for touch#] +{-# NOINLINE allocaBytesAligned #-} -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b at . The returned pointer From git at git.haskell.org Mon Jul 30 20:39:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 20:39:01 +0000 (UTC) Subject: [commit: ghc] master: GHC doesn't handle ./ prefixed paths correctly (#12674) (a7c8acd) Message-ID: <20180730203901.B47A93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a7c8acda5c7ad99fa983bbd5e59480ab5e633c54/ghc >--------------------------------------------------------------- commit a7c8acda5c7ad99fa983bbd5e59480ab5e633c54 Author: roland Date: Mon Jul 30 21:34:20 2018 +0100 GHC doesn't handle ./ prefixed paths correctly (#12674) Summary: If a filename starts with a hypen, GHC keeps the prefixed "./" path. Test Plan: make test TEST=T12674 Reviewers: Phyx, nomeata, bgamari, erikd Reviewed By: Phyx Subscribers: rwbarton, thomie, carter GHC Trac Issues: #12674 Differential Revision: https://phabricator.haskell.org/D5009 >--------------------------------------------------------------- a7c8acda5c7ad99fa983bbd5e59480ab5e633c54 ghc/Main.hs | 20 +++++++++++++++++--- testsuite/tests/driver/T12674/-T12674.hs | 10 ++++++++++ testsuite/tests/driver/T12674/-T12674c.c | 6 ++++++ testsuite/tests/driver/T12674/T12674.stdout | 1 + testsuite/tests/driver/T12674/T12674w.stdout | 1 + testsuite/tests/driver/T12674/all.T | 5 +++++ 6 files changed, 40 insertions(+), 3 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index ea80910..03ac60d 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -213,9 +213,23 @@ main' postLoadMode dflags0 args flagWarnings = do let -- To simplify the handling of filepaths, we normalise all filepaths right - -- away - e.g., for win32 platforms, backslashes are converted - -- into forward slashes. - normal_fileish_paths = map (normalise . unLoc) fileish_args + -- away. Note the asymmetry of FilePath.normalise: + -- Linux: p/q -> p/q; p\q -> p\q + -- Windows: p/q -> p\q; p\q -> p\q + -- #12674: Filenames starting with a hypen get normalised from ./-foo.hs + -- to -foo.hs. We have to re-prepend the current directory. + normalise_hyp fp + | strt_dot_sl && "-" `isPrefixOf` nfp = cur_dir ++ nfp + | otherwise = nfp + where +#if defined(mingw32_HOST_OS) + strt_dot_sl = "./" `isPrefixOf` fp || ".\\" `isPrefixOf` fp +#else + strt_dot_sl = "./" `isPrefixOf` fp +#endif + cur_dir = '.' : [pathSeparator] + nfp = normalise fp + normal_fileish_paths = map (normalise_hyp . unLoc) fileish_args (srcs, objs) = partition_args normal_fileish_paths [] [] dflags5 = dflags4 { ldInputs = map (FileOption "") objs diff --git a/testsuite/tests/driver/T12674/-T12674.hs b/testsuite/tests/driver/T12674/-T12674.hs new file mode 100644 index 0000000..11a7c54 --- /dev/null +++ b/testsuite/tests/driver/T12674/-T12674.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP #-} +import Foreign.C +foreign import ccall unsafe "test" test :: CInt -> IO () + +main :: IO () +-- Use conditional language to test passing a file with a filename +-- starting with a hyphen to the preprocessor. +#if defined(__GLASGOW_HASKELL__) +main = test 3 +#endif diff --git a/testsuite/tests/driver/T12674/-T12674c.c b/testsuite/tests/driver/T12674/-T12674c.c new file mode 100644 index 0000000..3b38c58 --- /dev/null +++ b/testsuite/tests/driver/T12674/-T12674c.c @@ -0,0 +1,6 @@ +#include +void test(int arg +) +{ + printf("Result %i\n", arg ); +} diff --git a/testsuite/tests/driver/T12674/T12674.stdout b/testsuite/tests/driver/T12674/T12674.stdout new file mode 100644 index 0000000..76239dd --- /dev/null +++ b/testsuite/tests/driver/T12674/T12674.stdout @@ -0,0 +1 @@ +Result 3 diff --git a/testsuite/tests/driver/T12674/T12674w.stdout b/testsuite/tests/driver/T12674/T12674w.stdout new file mode 100644 index 0000000..76239dd --- /dev/null +++ b/testsuite/tests/driver/T12674/T12674w.stdout @@ -0,0 +1 @@ +Result 3 diff --git a/testsuite/tests/driver/T12674/all.T b/testsuite/tests/driver/T12674/all.T new file mode 100644 index 0000000..0f9e205 --- /dev/null +++ b/testsuite/tests/driver/T12674/all.T @@ -0,0 +1,5 @@ +test('T12674', [extra_files(['-T12674.hs', '-T12674c.c'])], + multi_compile, ['./-T12674.hs', [('././-T12674c.c', '')], '-v0']) +test('T12674w', [extra_files(['-T12674.hs', '-T12674c.c']), + unless(opsys('mingw32'), skip)], + multi_compile, ['.\\\-T12674.hs', [('.\\\.\\\-T12674c.c', '')], '-v0']) From git at git.haskell.org Mon Jul 30 21:59:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 21:59:40 +0000 (UTC) Subject: [commit: ghc] master: Bump terminfo submodule to 0.4.1.2 (c626246) Message-ID: <20180730215940.A81113A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6262464c5d80ff2897577c0b2a25d89fd5da0bf/ghc >--------------------------------------------------------------- commit c6262464c5d80ff2897577c0b2a25d89fd5da0bf Author: Ben Gamari Date: Fri Jul 27 09:57:52 2018 -0400 Bump terminfo submodule to 0.4.1.2 >--------------------------------------------------------------- c6262464c5d80ff2897577c0b2a25d89fd5da0bf libraries/terminfo | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/terminfo b/libraries/terminfo index 72a08c5..27e8275 160000 --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 72a08c5435c332bdfd0444dd3ab3fad96e401da1 +Subproject commit 27e82750fac178fc6e049fe44be6de45f24814ae From git at git.haskell.org Mon Jul 30 21:59:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 21:59:55 +0000 (UTC) Subject: [commit: ghc] master: Fix minor formatting issue in users_guide/bugs.rst (a698bbf) Message-ID: <20180730215955.021313A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a698bbfe47c4ae5c93fc54c033072d1bbd7abf17/ghc >--------------------------------------------------------------- commit a698bbfe47c4ae5c93fc54c033072d1bbd7abf17 Author: Josh Price <2855417+WhistlePayer at users.noreply.github.com> Date: Fri Jul 27 00:00:31 2018 -0400 Fix minor formatting issue in users_guide/bugs.rst >--------------------------------------------------------------- a698bbfe47c4ae5c93fc54c033072d1bbd7abf17 docs/users_guide/bugs.rst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst index 3cfc023..aee8dc5 100644 --- a/docs/users_guide/bugs.rst +++ b/docs/users_guide/bugs.rst @@ -351,12 +351,14 @@ The Haskell Report demands that, for infix operators ``%``, the following identities hold: :: + (% expr) = \x -> x % expr (expr %) = \x -> expr % x However, the second law is violated in the presence of undefined operators, :: + (%) = error "urk" (() %) `seq` () -- urk (\x -> () % x) `seq` () -- OK, result () From git at git.haskell.org Mon Jul 30 22:00:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:00:14 +0000 (UTC) Subject: [commit: ghc] master: base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE (56590db) Message-ID: <20180730220014.EAEF23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/56590db07a776ce81eb89d4a4d86bd0f953fb44e/ghc >--------------------------------------------------------------- commit 56590db07a776ce81eb89d4a4d86bd0f953fb44e Author: Ben Gamari Date: Tue Oct 24 12:19:08 2017 -0400 base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE As noted in #14346, touch# may be optimized away when the simplifier can see that the continuation passed to allocaBytes will not return. Marking CPS-style functions with NOINLINE ensures that the simplier can't draw any unsound conclusions. Ultimately the right solution here will be to do away with touch# and instead introduce a scoped primitive as is suggested in #14375. Note: This was present in 8.2 but was never merged to 8.4 in hopes that we would have #14375 implemented in time. This meant that the issue regressed again in 8.4. Thankfully we caught it in time to fix it for 8.6. (cherry picked from commit 404bf05ed3193e918875cd2f6c95ae0da5989be2) >--------------------------------------------------------------- 56590db07a776ce81eb89d4a4d86bd0f953fb44e libraries/base/Foreign/Marshal/Alloc.hs | 17 +++++++++++++++++ testsuite/tests/perf/should_run/all.T | 3 ++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/libraries/base/Foreign/Marshal/Alloc.hs b/libraries/base/Foreign/Marshal/Alloc.hs index 48ed7fb..c32f0b6 100644 --- a/libraries/base/Foreign/Marshal/Alloc.hs +++ b/libraries/base/Foreign/Marshal/Alloc.hs @@ -116,6 +116,19 @@ alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b alloca = allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a)) +-- Note [NOINLINE for touch#] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously +-- fragile in the presence of simplification (see #14346). In particular, the +-- simplifier may drop the continuation containing the touch# if it can prove +-- that the action passed to allocaBytes will not return. The hack introduced to +-- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the +-- simplifier can't see the divergence. +-- +-- These can be removed once #14375 is fixed, which suggests that we instead do +-- away with touch# in favor of a primitive that will capture the scoping left +-- implicit in the case of touch#. + -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic @@ -134,6 +147,8 @@ allocaBytes (I# size) action = IO $ \ s0 -> case touch# barr# s3 of { s4 -> (# s4, r #) }}}}} +-- See Note [NOINLINE for touch#] +{-# NOINLINE allocaBytes #-} allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> @@ -145,6 +160,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> case touch# barr# s3 of { s4 -> (# s4, r #) }}}}} +-- See Note [NOINLINE for touch#] +{-# NOINLINE allocaBytesAligned #-} -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b at . The returned pointer diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 7a52492..9705a08 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -466,11 +466,12 @@ test('T9203', # 2016-04-06 84345136 (i386/Debian) not sure # 2017-03-24 77969268 (x86/Linux, 64-bit machine) probably join points - , (wordsize(64), 84620888, 5) ]), + , (wordsize(64), 98360576, 5) ]), # was 95747304 # 2019-09-10 94547280 post-AMP cleanup # 2015-10-28 95451192 emit Typeable at definition site # 2016-12-19 84620888 Join points + # 2018-07-30 98360576 it's unclear only_ways(['normal'])], compile_and_run, ['-O2']) From git at git.haskell.org Mon Jul 30 22:22:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:22:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: #15387 Fix setting testsuite verbose to zero (655c617) Message-ID: <20180730222242.E48403A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/655c6175268352f00f142f98a8b58488cc953480/ghc >--------------------------------------------------------------- commit 655c6175268352f00f142f98a8b58488cc953480 Author: Antti Siponen Date: Sun Jul 15 21:47:42 2018 +0200 #15387 Fix setting testsuite verbose to zero (cherry picked from commit 0d6ef6d71e5077eb217456fdd8a515a8cab724ad) >--------------------------------------------------------------- 655c6175268352f00f142f98a8b58488cc953480 testsuite/driver/runtests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 811a6e0..4e275c5 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -104,7 +104,7 @@ if args.threads: config.threads = args.threads config.use_threads = True -if args.verbose: +if args.verbose is not None: config.verbose = args.verbose config.skip_perf_tests = args.skip_perf_tests From git at git.haskell.org Mon Jul 30 22:22:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:22:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Revert "Do not imply NoStarIsType by TypeOperators/TypeInType" (c677442) Message-ID: <20180730222253.D2CEA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/c67744211ada6479e0f9d5ca4188a08cd36d6919/ghc >--------------------------------------------------------------- commit c67744211ada6479e0f9d5ca4188a08cd36d6919 Author: Ben Gamari Date: Mon Jul 16 19:32:23 2018 -0400 Revert "Do not imply NoStarIsType by TypeOperators/TypeInType" This reverts commit abd6622324733c67b05e0cbd0c8c3d12c6332f61. >--------------------------------------------------------------- c67744211ada6479e0f9d5ca4188a08cd36d6919 compiler/basicTypes/RdrName.hs | 23 +++++++++------ compiler/main/DynFlags.hs | 15 ++++++---- compiler/parser/Lexer.x | 5 ++++ compiler/parser/RdrHsSyn.hs | 20 ++----------- compiler/rename/RnEnv.hs | 3 +- docs/users_guide/8.6.1-notes.rst | 3 +- docs/users_guide/glasgow_exts.rst | 6 ++-- libraries/base/GHC/TypeNats.hs | 1 - testsuite/tests/dependent/ghci/T14238.stdout | 2 +- .../partial-sigs/should_compile/T15039b.stderr | 33 +++++++++++++--------- .../partial-sigs/should_compile/T15039d.stderr | 33 +++++++++++++--------- .../tests/partial-sigs/should_fail/T14584.stderr | 2 +- testsuite/tests/polykinds/T10134.hs | 6 ++-- testsuite/tests/th/TH_unresolvedInfix.hs | 1 - testsuite/tests/th/TH_unresolvedInfix_Lib.hs | 1 - .../typecheck/should_compile/TcTypeNatSimple.hs | 16 +++++------ .../should_compile/type_in_type_hole_fits.hs | 4 +-- .../typecheck/should_run/TcTypeNatSimpleRun.hs | 6 ++-- .../tests/warnings/should_compile/StarBinder.hs | 5 ---- .../warnings/should_compile/StarBinder.stderr | 10 ------- testsuite/tests/warnings/should_compile/all.T | 2 -- 21 files changed, 96 insertions(+), 101 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c67744211ada6479e0f9d5ca4188a08cd36d6919 From git at git.haskell.org Mon Jul 30 22:23:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:23:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Do not imply NoStarIsType by TypeOperators/TypeInType (bb5aa61) Message-ID: <20180730222306.0DB283A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/bb5aa616905727a7c73bc323164d6812e093c2dc/ghc >--------------------------------------------------------------- commit bb5aa616905727a7c73bc323164d6812e093c2dc Author: Vladislav Zavialov Date: Mon Jul 16 18:46:52 2018 -0400 Do not imply NoStarIsType by TypeOperators/TypeInType Implementation of the "Embrace TypeInType" proposal was done according to the spec, which specified that TypeOperators must imply NoStarIsType. This implication was meant to prevent breakage and to be removed in 2 releases. However, compiling head.hackage has shown that this implication only magnified the breakage, so there is no reason to have it in the first place. To remain in compliance with the three-release policy, we add a workaround to define the (*) type operator even when -XStarIsType is on. Test Plan: ./validate Reviewers: bgamari, RyanGlScott, goldfire, phadej, hvr Reviewed By: bgamari, RyanGlScott Subscribers: harpocrates, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4865 (cherry picked from commit 65c186f0fdde95fd7c63ab9bd9b33a0213dba7d1) >--------------------------------------------------------------- bb5aa616905727a7c73bc323164d6812e093c2dc compiler/basicTypes/RdrName.hs | 23 ++++++--------- compiler/main/DynFlags.hs | 15 ++++------ compiler/parser/Lexer.x | 5 ---- compiler/parser/RdrHsSyn.hs | 20 +++++++++++-- compiler/rename/RnEnv.hs | 3 +- docs/users_guide/8.6.1-notes.rst | 3 +- docs/users_guide/glasgow_exts.rst | 8 ++---- docs/users_guide/using-warnings.rst | 31 ++++++++++++++++++++ libraries/base/GHC/TypeNats.hs | 1 + testsuite/tests/dependent/ghci/T14238.stdout | 2 +- .../partial-sigs/should_compile/T15039b.stderr | 33 +++++++++------------- .../partial-sigs/should_compile/T15039d.stderr | 33 +++++++++------------- testsuite/tests/polykinds/T10134.hs | 6 ++-- testsuite/tests/th/TH_unresolvedInfix.hs | 1 + testsuite/tests/th/TH_unresolvedInfix_Lib.hs | 1 + .../typecheck/should_compile/TcTypeNatSimple.hs | 16 +++++------ .../should_compile/type_in_type_hole_fits.hs | 4 +-- .../typecheck/should_run/TcTypeNatSimpleRun.hs | 6 ++-- .../tests/warnings/should_compile/StarBinder.hs | 5 ++++ .../warnings/should_compile/StarBinder.stderr | 10 +++++++ testsuite/tests/warnings/should_compile/all.T | 2 ++ 21 files changed, 132 insertions(+), 96 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bb5aa616905727a7c73bc323164d6812e093c2dc From git at git.haskell.org Mon Jul 30 22:26:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:26:14 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: TTG typo: XFieldOcc should be XCFieldOcc (10fa804) Message-ID: <20180730222614.4474B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/10fa80418286fb5ec9a1b78edc872ccd004d4499/ghc >--------------------------------------------------------------- commit 10fa80418286fb5ec9a1b78edc872ccd004d4499 Author: Alan Zimmerman Date: Sun Jul 15 19:35:51 2018 +0200 TTG typo: XFieldOcc should be XCFieldOcc In the following data FieldOcc pass = FieldOcc { extFieldOcc :: XFieldOcc pass , rdrNameFieldOcc :: Located RdrName -- ^ See Note [Located RdrNames] in HsExpr } | XFieldOcc (XXFieldOcc pass) we are using XFieldOcc for both the extFieldOcc type and the extra constructor. The first one should be XCFieldOcc Updates haddock submodule closes #15386 (cherry picked from commit 926954196f9ffd7b89cba53061b39ef996e1650c) >--------------------------------------------------------------- 10fa80418286fb5ec9a1b78edc872ccd004d4499 compiler/hsSyn/HsExtension.hs | 4 ++-- compiler/hsSyn/HsPat.hs | 4 ++-- compiler/hsSyn/HsTypes.hs | 12 ++++++------ utils/haddock | 2 +- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index a23b973..a7c467d 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -973,11 +973,11 @@ type ForallXConDeclField (c :: * -> Constraint) (x :: *) = -- --------------------------------------------------------------------- -type family XFieldOcc x +type family XCFieldOcc x type family XXFieldOcc x type ForallXFieldOcc (c :: * -> Constraint) (x :: *) = - ( c (XFieldOcc x) + ( c (XCFieldOcc x) , c (XXFieldOcc x) ) diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 866b0e2..faefb84 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -444,14 +444,14 @@ data HsRecField' id arg = HsRecField { -- -- See also Note [Disambiguating record fields] in TcExpr. -hsRecFields :: HsRecFields p arg -> [XFieldOcc p] +hsRecFields :: HsRecFields p arg -> [XCFieldOcc p] hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds) -- Probably won't typecheck at once, things have changed :/ hsRecFieldsArgs :: HsRecFields p arg -> [arg] hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds) -hsRecFieldSel :: HsRecField pass arg -> Located (XFieldOcc pass) +hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass) hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl hsRecFieldId :: HsRecField GhcTc arg -> Located Id diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index cbaa9fb..3512bf7 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -1136,19 +1136,19 @@ type LFieldOcc pass = Located (FieldOcc pass) -- Represents an *occurrence* of an unambiguous field. We store -- both the 'RdrName' the user originally wrote, and after the -- renamer, the selector function. -data FieldOcc pass = FieldOcc { extFieldOcc :: XFieldOcc pass +data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass , rdrNameFieldOcc :: Located RdrName -- ^ See Note [Located RdrNames] in HsExpr } | XFieldOcc (XXFieldOcc pass) -deriving instance (p ~ GhcPass pass, Eq (XFieldOcc p)) => Eq (FieldOcc p) -deriving instance (p ~ GhcPass pass, Ord (XFieldOcc p)) => Ord (FieldOcc p) +deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq (FieldOcc p) +deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p) -type instance XFieldOcc GhcPs = NoExt -type instance XFieldOcc GhcRn = Name -type instance XFieldOcc GhcTc = Id +type instance XCFieldOcc GhcPs = NoExt +type instance XCFieldOcc GhcRn = Name +type instance XCFieldOcc GhcTc = Id type instance XXFieldOcc (GhcPass _) = NoExt diff --git a/utils/haddock b/utils/haddock index 679f612..9765c10 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 679f61210b18acd6299687fca66c81196ca358a5 +Subproject commit 9765c10a27013b5c9168ee507d1f3b34cb4be26f From git at git.haskell.org Mon Jul 30 22:26:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:26:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: split-obj: disable split-objects on Windows. (f14c087) Message-ID: <20180730222624.622643A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/f14c087a8b88c39e3567af1dde7c2368a5391333/ghc >--------------------------------------------------------------- commit f14c087a8b88c39e3567af1dde7c2368a5391333 Author: Tamar Christina Date: Mon Jul 16 20:04:04 2018 -0400 split-obj: disable split-objects on Windows. A change has caused GHC to generate excessive specializations. This is making GHC generate 1800 splits for a simple GHC.Prim module, which means 1800 fork/exec calls. Due to this compilation times on Windows with split-objs on take over 24 hours to complete depending on your disk speed. Also the end compiler compiling medium to large project is also much slower. So I think we need to just disable split-objects. As there's nothing that can be done about this. Test Plan: ./validate Reviewers: bgamari Subscribers: tdammers, rwbarton, thomie, erikd, carter GHC Trac Issues: #15051 Differential Revision: https://phabricator.haskell.org/D4915 (cherry picked from commit 53649947223f197cf93e26393486f578d56c46c6) >--------------------------------------------------------------- f14c087a8b88c39e3567af1dde7c2368a5391333 configure.ac | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/configure.ac b/configure.ac index 1f98407..8b24135 100644 --- a/configure.ac +++ b/configure.ac @@ -710,6 +710,12 @@ cygwin32|mingw32) else AC_PATH_PROG([PerlCmd],[perl]) fi + # because of Trac #15051 SplitObjs is useless on Windows. It regresses + # build times to days for a build, and this effect is also there for end users + # of GHC. So unfortunately we have to disable it, even without having + # split-sections. Though the compile time hit for split-sections should be + # tiny compared to this so maybe we should enable it for x86_64. + SplitObjsBroken=YES ;; *) AC_PATH_PROG([PerlCmd],[perl]) From git at git.haskell.org Mon Jul 30 22:26:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:26:34 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Add an expect_broken test for #14185 (dafffdc) Message-ID: <20180730222634.ECBD53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/dafffdc0f6e7088276af5842300526dd8e1506b8/ghc >--------------------------------------------------------------- commit dafffdc0f6e7088276af5842300526dd8e1506b8 Author: Krzysztof Gogolewski Date: Thu Jul 26 17:20:29 2018 -0400 Add an expect_broken test for #14185 Test Plan: validate Reviewers: goldfire, bgamari, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14185 Differential Revision: https://phabricator.haskell.org/D4981 (cherry picked from commit 3581212e3a5ba42114f47ed83a96322e0e8028ab) >--------------------------------------------------------------- dafffdc0f6e7088276af5842300526dd8e1506b8 testsuite/tests/typecheck/should_compile/T14185.hs | 30 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 31 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T14185.hs b/testsuite/tests/typecheck/should_compile/T14185.hs new file mode 100644 index 0000000..41e47d2 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14185.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, TypeFamilies, + FunctionalDependencies, KindSignatures, PolyKinds, DataKinds, + UndecidableInstances #-} +module T14185 where + +import GHC.Types +import GHC.Prim + + +class Unbox (t :: *) (r :: TYPE k) | t -> r, r -> t where + unbox :: t -> r + box :: r -> t + +instance Unbox Int Int# where + unbox (I# i) = i + box i = I# i + +instance Unbox Char Char# where + unbox (C# c) = c + box c = C# c + +instance (Unbox a a', Unbox b b') => Unbox (a,b) (# a', b' #) where + unbox (a,b) = (# unbox a, unbox b #) + box (# a, b #) = (box a, box b) + +testInt :: Int +testInt = box (unbox 1) + +testTup :: (Int, Char) +testTup = box (unbox (1, 'a')) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 10295f5..1cc8cd8 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -624,6 +624,7 @@ test('T14735', normal, compile, ['']) test('T15180', normal, compile, ['']) test('T15232', normal, compile, ['']) test('T13833', normal, compile, ['']) +test('T14185', expect_broken(14185), compile, ['']) def onlyHsParLocs(x): """ From git at git.haskell.org Mon Jul 30 22:26:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:26:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Run StgCse after unarise, fixes #15300 (72dc798) Message-ID: <20180730222645.5D93B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/72dc7989a25ed6ec4ab9d3adfeefc15425acbf57/ghc >--------------------------------------------------------------- commit 72dc7989a25ed6ec4ab9d3adfeefc15425acbf57 Author: Ömer Sinan Ağacan Date: Thu Jul 26 17:19:35 2018 -0400 Run StgCse after unarise, fixes #15300 Given two unboxed sum terms: (# 1 | #) :: (# Int | Int# #) (# 1 | #) :: (# Int | Int #) These two terms are not equal as they unarise to different unboxed tuples. However StgCse was thinking that these are equal, and replacing one of these with a binder to the other. To not deal with unboxed sums in StgCse we now do it after unarise. For StgCse to maintain post-unarise invariants we factor-out case binder in-scopeness check to `stgCaseBndrInScope` and use it in StgCse. Also did some refactoring in SimplStg. Another way to fix this would be adding a special case in StgCse to not bring unboxed sum binders in scope: diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6c740ca4cb..93a0f8f6ad 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -332,7 +332,11 @@ stgCseExpr env (StgLetNoEscape binds body) stgCseAlt :: CseEnv -> OutId -> InStgAlt -> OutStgAlt stgCseAlt env case_bndr (DataAlt dataCon, args, rhs) = let (env1, args') = substBndrs env args - env2 = addDataCon case_bndr dataCon (map StgVarArg args') env1 + env2 + | isUnboxedSumCon dataCon + = env1 + | otherwise + = addDataCon case_bndr dataCon (map StgVarArg args') env1 -- see note [Case 2: CSEing case binders] rhs' = stgCseExpr env2 rhs in (DataAlt dataCon, args', rhs') I think this patch seems better in that it doesn't add a special case to StgCse. Test Plan: Validate. I tried to come up with a minimal example but failed. I thought a simple program like data T = T (# Int | Int #) (# Int# | Int #) case T (# 1 | #) (# 1 | #) of ... should be enough to trigger this bug, but for some reason StgCse doesn't do anything on this program. Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15300 Differential Revision: https://phabricator.haskell.org/D4962 (cherry picked from commit 3c311e50e760c3ba00dc9692ad1536c79820598d) >--------------------------------------------------------------- 72dc7989a25ed6ec4ab9d3adfeefc15425acbf57 compiler/simplStg/SimplStg.hs | 26 ++++++++------------------ compiler/simplStg/StgCse.hs | 20 +++++++++++++++----- compiler/stgSyn/StgLint.hs | 10 +--------- compiler/stgSyn/StgSyn.hs | 13 +++++++++++++ testsuite/tests/simplStg/should_compile/all.T | 4 +--- 5 files changed, 38 insertions(+), 35 deletions(-) diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index 854bb92..36bf510 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -21,7 +21,6 @@ import StgCse ( stgCse ) import DynFlags import ErrUtils -import SrcLoc import UniqSupply ( mkSplitUniqSupply ) import Outputable import Control.Monad @@ -34,27 +33,19 @@ stg2stg dflags binds = do { showPass dflags "Stg2Stg" ; us <- mkSplitUniqSupply 'g' - ; when (dopt Opt_D_verbose_stg2stg dflags) - (putLogMsg dflags NoReason SevDump noSrcSpan - (defaultDumpStyle dflags) (text "VERBOSE STG-TO-STG:")) - - ; binds' <- end_pass "Stg2Stg" binds - -- Do the main business! - ; processed_binds <- foldM do_stg_pass binds' (getStgToDo dflags) - ; dumpIfSet_dyn dflags Opt_D_dump_stg "Pre unarise:" - (pprStgTopBindings processed_binds) - - ; let un_binds = unarise us processed_binds + (pprStgTopBindings binds) + ; stg_linter False "Pre-unarise" binds + ; let un_binds = unarise us binds ; stg_linter True "Unarise" un_binds ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" (pprStgTopBindings un_binds) - ; return un_binds - } + ; foldM do_stg_pass un_binds (getStgToDo dflags) + } where stg_linter unarised @@ -65,8 +56,7 @@ stg2stg dflags binds do_stg_pass binds to_do = case to_do of D_stg_stats -> - trace (showStgStats binds) - end_pass "StgStats" binds + trace (showStgStats binds) (return binds) StgCSE -> {-# SCC "StgCse" #-} @@ -78,8 +68,8 @@ stg2stg dflags binds end_pass what binds2 = do -- report verbosely, if required dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what - (vcat (map ppr binds2)) - stg_linter False what binds2 + (pprStgTopBindings binds2) + stg_linter True what binds2 return binds2 -- ----------------------------------------------------------------------------- diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6c740ca..1ae1213 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -302,7 +302,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) env2 | StgApp trivial_scrut [] <- scrut' = addTrivCaseBndr bndr trivial_scrut env1 -- See Note [Trivial case scrutinee] | otherwise = env1 - alts' = map (stgCseAlt env2 bndr') alts + alts' = map (stgCseAlt env2 ty bndr') alts -- A constructor application. @@ -329,14 +329,24 @@ stgCseExpr env (StgLetNoEscape binds body) -- Case alternatives -- Extend the CSE environment -stgCseAlt :: CseEnv -> OutId -> InStgAlt -> OutStgAlt -stgCseAlt env case_bndr (DataAlt dataCon, args, rhs) +stgCseAlt :: CseEnv -> AltType -> OutId -> InStgAlt -> OutStgAlt +stgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs) = let (env1, args') = substBndrs env args - env2 = addDataCon case_bndr dataCon (map StgVarArg args') env1 + env2 + -- To avoid dealing with unboxed sums StgCse runs after unarise and + -- should maintain invariants listed in Note [Post-unarisation + -- invariants]. One of the invariants is that some binders are not + -- used (unboxed tuple case binders) which is what we check with + -- `stgCaseBndrInScope` here. If the case binder is not in scope we + -- don't add it to the CSE env. See also #15300. + | stgCaseBndrInScope ty True -- CSE runs after unarise + = addDataCon case_bndr dataCon (map StgVarArg args') env1 + | otherwise + = env1 -- see note [Case 2: CSEing case binders] rhs' = stgCseExpr env2 rhs in (DataAlt dataCon, args', rhs') -stgCseAlt env _ (altCon, args, rhs) +stgCseAlt env _ _ (altCon, args, rhs) = let (env1, args') = substBndrs env args rhs' = stgCseExpr env1 rhs in (altCon, args', rhs') diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs index bb2064a..58f14a1 100644 --- a/compiler/stgSyn/StgLint.hs +++ b/compiler/stgSyn/StgLint.hs @@ -172,15 +172,7 @@ lintStgExpr (StgCase scrut bndr alts_type alts) = do lintStgExpr scrut lf <- getLintFlags - let in_scope = - case alts_type of - AlgAlt _ -> True - PrimAlt _ -> True - -- Case binders of unboxed tuple or unboxed sum type always dead - -- after the unariser has run. - -- See Note [Post-unarisation invariants]. - MultiValAlt _ -> not (lf_unarised lf) - PolyAlt -> True + let in_scope = stgCaseBndrInScope alts_type (lf_unarised lf) addInScopeVars [bndr | in_scope] (mapM_ lintAlt alts) diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs index 608a028..eb905f7 100644 --- a/compiler/stgSyn/StgSyn.hs +++ b/compiler/stgSyn/StgSyn.hs @@ -39,6 +39,7 @@ module StgSyn ( isDllConApp, stgArgType, stripStgTicksTop, + stgCaseBndrInScope, pprStgBinding, pprStgTopBindings ) where @@ -155,6 +156,18 @@ stripStgTicksTop p = go [] where go ts (StgTick t e) | p t = go (t:ts) e go ts other = (reverse ts, other) +-- | Given an alt type and whether the program is unarised, return whether the +-- case binder is in scope. +-- +-- Case binders of unboxed tuple or unboxed sum type always dead after the +-- unariser has run. See Note [Post-unarisation invariants]. +stgCaseBndrInScope :: AltType -> Bool {- ^ unarised? -} -> Bool +stgCaseBndrInScope alt_ty unarised = + case alt_ty of + AlgAlt _ -> True + PrimAlt _ -> True + MultiValAlt _ -> not unarised + PolyAlt -> True {- ************************************************************************ diff --git a/testsuite/tests/simplStg/should_compile/all.T b/testsuite/tests/simplStg/should_compile/all.T index 19fa513..2cb8974 100644 --- a/testsuite/tests/simplStg/should_compile/all.T +++ b/testsuite/tests/simplStg/should_compile/all.T @@ -17,6 +17,4 @@ def checkStgString(needle): return "%s not contained in -ddump-simpl\n" % needle return normalise_errmsg_fun(norm) - - -test('T13588', [ checkStgString('case') ] , compile, ['-ddump-stg']) +test('T13588', [ checkStgString('case') ] , compile, ['-dverbose-stg2stg']) From git at git.haskell.org Mon Jul 30 22:26:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:26:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: rts: Flush eventlog in hs_init_ghc (fixes #15440) (50e4e48) Message-ID: <20180730222655.8B3283A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/50e4e48bb0d63aaa4c62f5ca0f01d5fb7587ec84/ghc >--------------------------------------------------------------- commit 50e4e48bb0d63aaa4c62f5ca0f01d5fb7587ec84 Author: Mitsutoshi Aoe Date: Thu Jul 26 14:50:51 2018 +0900 rts: Flush eventlog in hs_init_ghc (fixes #15440) Without this change RTS typically doesn't flush some important events until the process terminates or it doesn't write them at all in case it terminates abnormally. Here is a list of such events: * EVENT_WALL_CLOCK_TIME * EVENT_OS_PROCESS_PID * EVENT_OS_PROCESS_PPID * EVENT_RTS_IDENTIFIER * EVENT_PROGRAM_ARGS * EVENT_PROGRAM_ENV (cherry picked from commit 7a3e1b25ff9a570851a59c4cf3600daa49867b9b) >--------------------------------------------------------------- 50e4e48bb0d63aaa4c62f5ca0f01d5fb7587ec84 rts/RtsStartup.c | 1 + rts/Trace.c | 7 +++++++ rts/Trace.h | 4 ++++ 3 files changed, 12 insertions(+) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 7eb98a8..0cb1ff9 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -237,6 +237,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) /* Trace some basic information about the process */ traceWallClockTime(); traceOSProcessInfo(); + flushTrace(); /* initialize the storage manager */ initStorage(); diff --git a/rts/Trace.c b/rts/Trace.c index 71403f8..02c177f 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -130,6 +130,13 @@ void resetTracing (void) } } +void flushTrace (void) +{ + if (eventlog_enabled) { + flushEventLog(); + } +} + void tracingAddCapapilities (uint32_t from, uint32_t to) { if (eventlog_enabled) { diff --git a/rts/Trace.h b/rts/Trace.h index a72248a..d53e92c 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -295,6 +295,8 @@ void traceHeapProfSampleCostCentre(StgWord8 profile_id, CostCentreStack *stack, StgWord residency); #endif /* PROFILING */ +void flushTrace(void); + #else /* !TRACING */ #define traceSchedEvent(cap, tag, tso, other) /* nothing */ @@ -331,6 +333,8 @@ void traceHeapProfSampleCostCentre(StgWord8 profile_id, #define traceHeapProfSampleCostCentre(profile_id, stack, residency) /* nothing */ #define traceHeapProfSampleString(profile_id, label, residency) /* nothing */ +#define flushTrace() /* nothing */ + #endif /* TRACING */ // If DTRACE is enabled, but neither DEBUG nor TRACING, we need a C land From git at git.haskell.org Mon Jul 30 22:27:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:27:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump terminfo submodule to 0.4.1.2 (9a190ca) Message-ID: <20180730222706.002993A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/9a190caf8a6b2873df9849f328ef7ae48ffd064c/ghc >--------------------------------------------------------------- commit 9a190caf8a6b2873df9849f328ef7ae48ffd064c Author: Ben Gamari Date: Fri Jul 27 09:57:52 2018 -0400 Bump terminfo submodule to 0.4.1.2 (cherry picked from commit b2852a440cac3310bbe443a9010949dbea94e7db) >--------------------------------------------------------------- 9a190caf8a6b2873df9849f328ef7ae48ffd064c libraries/terminfo | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/terminfo b/libraries/terminfo index 72a08c5..27e8275 160000 --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 72a08c5435c332bdfd0444dd3ab3fad96e401da1 +Subproject commit 27e82750fac178fc6e049fe44be6de45f24814ae From git at git.haskell.org Mon Jul 30 22:27:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:27:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix endian issues in ghc-heap (3795b45) Message-ID: <20180730222716.3110F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/3795b454f4b788e23fee89d81a187db089183e06/ghc >--------------------------------------------------------------- commit 3795b454f4b788e23fee89d81a187db089183e06 Author: Peter Trommler Date: Thu Jul 26 17:23:22 2018 -0400 Fix endian issues in ghc-heap In test heap_all arity and n_args were swapped on big endian systems. Take care of endianness when reading parts of a machine word from a `Word`. This fixes one out of 36 failing tests reported in #15399. Test Plan: validate Reviewers: simonmar, bgamari, hvr, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15399 Differential Revision: https://phabricator.haskell.org/D5001 (cherry picked from commit d7cb1bbc26719cf6082abe0d91d80be466e25bfc) >--------------------------------------------------------------- 3795b454f4b788e23fee89d81a187db089183e06 compiler/ghci/RtClosureInspect.hs | 9 ++++++--- libraries/ghc-heap/GHC/Exts/Heap.hs | 17 +++++++++++++++++ 2 files changed, 23 insertions(+), 3 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index e8d5aab..fa9f520 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -780,6 +780,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 -- StgCmmLayout.mkVirtHeapOffsetsWithPadding dflags <- getDynFlags let word_size = wORD_SIZE dflags + big_endian = wORDS_BIGENDIAN dflags size_b = primRepSizeB dflags rep -- Align the start offset (eg, 2-byte value should be 2-byte -- aligned). But not more than to a word. The offset calculation @@ -788,7 +789,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 !aligned_idx = roundUpTo arr_i (min word_size size_b) !new_arr_i = aligned_idx + size_b ws | size_b < word_size = - [index size_b aligned_idx word_size] + [index size_b aligned_idx word_size big_endian] | otherwise = let (q, r) = size_b `quotRem` word_size in ASSERT( r == 0 ) @@ -803,7 +804,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 (error "unboxedTupleTerm: no HValue for unboxed tuple") terms -- Extract a sub-word sized field from a word - index item_size_b index_b word_size = + index item_size_b index_b word_size big_endian = (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes where mask :: Word @@ -814,7 +815,9 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 _ -> panic ("Weird byte-index: " ++ show index_b) (q,r) = index_b `quotRem` word_size word = array!!q - moveBytes = r * 8 + moveBytes = if big_endian + then word_size - (r + item_size_b) * 8 + else r * 8 -- Fast, breadth-first Type reconstruction diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs index 9dc1f94..535596f 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap.hs +++ b/libraries/ghc-heap/GHC/Exts/Heap.hs @@ -62,6 +62,8 @@ import GHC.Exts import GHC.Int import GHC.Word +#include "ghcconfig.h" + class HasHeapRep (a :: TYPE rep) where getClosureData :: a -> IO Closure @@ -169,8 +171,13 @@ getClosure x = do fail $ "Expected at least 2 raw words to AP" let splitWord = rawWds !! 0 pure $ APClosure itbl +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else (fromIntegral splitWord) (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif (head pts) (tail pts) PAP -> do @@ -181,8 +188,13 @@ getClosure x = do fail "Expected at least 2 raw words to PAP" let splitWord = rawWds !! 0 pure $ PAPClosure itbl +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else (fromIntegral splitWord) (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif (head pts) (tail pts) AP_STACK -> do @@ -214,8 +226,13 @@ getClosure x = do ++ show (length rawWds) let splitWord = rawWds !! 3 pure $ BCOClosure itbl (pts !! 0) (pts !! 1) (pts !! 2) +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else (fromIntegral splitWord) (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif (drop 4 rawWds) ARR_WORDS -> do From git at git.haskell.org Mon Jul 30 22:27:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:27:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix minor formatting issue in users_guide/bugs.rst (4c158ee) Message-ID: <20180730222726.64F603A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/4c158eeb7ec4c8be38475ea4736465025c52dbb4/ghc >--------------------------------------------------------------- commit 4c158eeb7ec4c8be38475ea4736465025c52dbb4 Author: Josh Price <2855417+WhistlePayer at users.noreply.github.com> Date: Fri Jul 27 00:00:31 2018 -0400 Fix minor formatting issue in users_guide/bugs.rst (cherry picked from commit fb11a104018dfb4065fd91c549fec6d46fa77945) >--------------------------------------------------------------- 4c158eeb7ec4c8be38475ea4736465025c52dbb4 docs/users_guide/bugs.rst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst index 3cfc023..aee8dc5 100644 --- a/docs/users_guide/bugs.rst +++ b/docs/users_guide/bugs.rst @@ -351,12 +351,14 @@ The Haskell Report demands that, for infix operators ``%``, the following identities hold: :: + (% expr) = \x -> x % expr (expr %) = \x -> expr % x However, the second law is violated in the presence of undefined operators, :: + (%) = error "urk" (() %) `seq` () -- urk (\x -> () % x) `seq` () -- OK, result () From git at git.haskell.org Mon Jul 30 22:27:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:27:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE (3ec1d93) Message-ID: <20180730222736.A5F693A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/3ec1d931218e603ba1622faa2b52884b2477a7db/ghc >--------------------------------------------------------------- commit 3ec1d931218e603ba1622faa2b52884b2477a7db Author: Ben Gamari Date: Tue Oct 24 12:19:08 2017 -0400 base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE As noted in #14346, touch# may be optimized away when the simplifier can see that the continuation passed to allocaBytes will not return. Marking CPS-style functions with NOINLINE ensures that the simplier can't draw any unsound conclusions. Ultimately the right solution here will be to do away with touch# and instead introduce a scoped primitive as is suggested in #14375. (cherry picked from commit 404bf05ed3193e918875cd2f6c95ae0da5989be2) >--------------------------------------------------------------- 3ec1d931218e603ba1622faa2b52884b2477a7db libraries/base/Foreign/Marshal/Alloc.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/libraries/base/Foreign/Marshal/Alloc.hs b/libraries/base/Foreign/Marshal/Alloc.hs index 48ed7fb..c32f0b6 100644 --- a/libraries/base/Foreign/Marshal/Alloc.hs +++ b/libraries/base/Foreign/Marshal/Alloc.hs @@ -116,6 +116,19 @@ alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b alloca = allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a)) +-- Note [NOINLINE for touch#] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously +-- fragile in the presence of simplification (see #14346). In particular, the +-- simplifier may drop the continuation containing the touch# if it can prove +-- that the action passed to allocaBytes will not return. The hack introduced to +-- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the +-- simplifier can't see the divergence. +-- +-- These can be removed once #14375 is fixed, which suggests that we instead do +-- away with touch# in favor of a primitive that will capture the scoping left +-- implicit in the case of touch#. + -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic @@ -134,6 +147,8 @@ allocaBytes (I# size) action = IO $ \ s0 -> case touch# barr# s3 of { s4 -> (# s4, r #) }}}}} +-- See Note [NOINLINE for touch#] +{-# NOINLINE allocaBytes #-} allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> @@ -145,6 +160,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> case touch# barr# s3 of { s4 -> (# s4, r #) }}}}} +-- See Note [NOINLINE for touch#] +{-# NOINLINE allocaBytesAligned #-} -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b at . The returned pointer From git at git.haskell.org Mon Jul 30 22:27:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:27:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: base: Fix documentation of System.Environment.Blank (386aad8) Message-ID: <20180730222746.D90123A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/386aad8a0c8c655165c3c2eaeb89d027949992a6/ghc >--------------------------------------------------------------- commit 386aad8a0c8c655165c3c2eaeb89d027949992a6 Author: Ben Gamari Date: Mon Jul 30 17:27:13 2018 -0400 base: Fix documentation of System.Environment.Blank >--------------------------------------------------------------- 386aad8a0c8c655165c3c2eaeb89d027949992a6 libraries/base/System/Environment/Blank.hsc | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/libraries/base/System/Environment/Blank.hsc b/libraries/base/System/Environment/Blank.hsc index ebca1ef..637a039 100644 --- a/libraries/base/System/Environment/Blank.hsc +++ b/libraries/base/System/Environment/Blank.hsc @@ -18,19 +18,15 @@ -- -- The matrix of platforms that: -- --- * support putenv("FOO") to unset environment variables, --- * support putenv("FOO=") to unset environment variables or set them +-- * support @putenv("FOO")@ to unset environment variables, +-- * support @putenv("FOO=")@ to unset environment variables or set them -- to blank values, --- * support unsetenv to unset environment variables, --- * support setenv to set environment variables, +-- * support @unsetenv@ to unset environment variables, +-- * support @setenv@ to set environment variables, -- * etc. -- --- is very complicated. I think AIX is screwed, but we don't support it. --- The whole situation with setenv(3), unsetenv(3), and putenv(3) is not --- good. Even mingw32 adds its own crap to the pile, but luckily, we can --- just use Windows' native environment functions to sidestep the issue. --- --- #12494 +-- is very complicated. Some platforms don't support unsetting of environment +-- variables at all. -- ----------------------------------------------------------------------------- @@ -87,7 +83,7 @@ throwInvalidArgument :: String -> IO a throwInvalidArgument from = throwIO (mkIOError InvalidArgument from Nothing Nothing) --- | `System.Environment.lookupEnv`. +-- | Similar to 'System.Environment.lookupEnv'. getEnv :: String -> IO (Maybe String) #ifdef mingw32_HOST_OS getEnv = (<$> getEnvironment) . lookup @@ -102,8 +98,8 @@ getEnvDefault :: IO String {- ^ variable value or fallback value -} getEnvDefault name fallback = fromMaybe fallback <$> getEnv name --- | Like `System.Environment.setEnv`, but allows blank environment values --- and mimics the function signature of `System.Posix.Env.setEnv` from the +-- | Like 'System.Environment.setEnv', but allows blank environment values +-- and mimics the function signature of 'System.Posix.Env.setEnv' from the -- @unix@ package. setEnv :: String {- ^ variable name -} -> @@ -144,8 +140,9 @@ foreign import ccall unsafe "setenv" c_setenv :: CString -> CString -> CInt -> IO CInt #endif --- | Like `System.Environment.unsetEnv`, but allows for the removal of --- blank environment variables. +-- | Like 'System.Environment.unsetEnv', but allows for the removal of +-- blank environment variables. May throw an exception if the underlying +-- platform doesn't support unsetting of environment variables. unsetEnv :: String -> IO () #if defined(mingw32_HOST_OS) unsetEnv key = withCWString key $ \k -> do From git at git.haskell.org Mon Jul 30 22:27:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jul 2018 22:27:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: testsuite: Fix up testsuite (26a7f85) Message-ID: <20180730222757.187AD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/26a7f850d15b91ad68d1e28d467faba00bb79144/ghc >--------------------------------------------------------------- commit 26a7f850d15b91ad68d1e28d467faba00bb79144 Author: Ben Gamari Date: Mon Jul 30 17:42:49 2018 -0400 testsuite: Fix up testsuite >--------------------------------------------------------------- 26a7f850d15b91ad68d1e28d467faba00bb79144 testsuite/tests/partial-sigs/should_fail/T14584.stderr | 2 +- testsuite/tests/perf/haddock/all.T | 3 ++- testsuite/tests/perf/should_run/all.T | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr index c53c822..b7531aa 100644 --- a/testsuite/tests/partial-sigs/should_fail/T14584.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr @@ -11,7 +11,7 @@ T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)] act @_ @_ @act (fromSing @m (sing @m @a :: Sing _)) T14584.hs:56:50: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Expected kind ‘m1’, but ‘a’ has kind ‘Type’ + • Expected kind ‘m1’, but ‘a’ has kind ‘*’ • In the type ‘a’ In the second argument of ‘fromSing’, namely ‘(sing @m @a :: Sing _)’ diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 393a697..1ad98c7 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -10,7 +10,7 @@ test('haddock.base', # 2017-02-19 24286343184 (x64/Windows) - Generalize kind of (->) # 2017-12-24 18733710728 (x64/Windows) - Unknown - ,(wordsize(64), 24662232152, 5) + ,(wordsize(64), 26201242752, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -52,6 +52,7 @@ test('haddock.base', # 2018-04-20: 18971030224 (x86_64/Linux) - Cache coercion roles # 2018-05-14: 21123660336 (amd64/Linux) - D4659: strictness to fix space leaks # 2018-06-14: 24662232152 (amd64/Linux) - Bump haddock + # 2018-07-30: 26201242752 (amd64/Linux) - Bump haddock ,(platform('i386-unknown-mingw32'), 2885173512, 5) # 2013-02-10: 3358693084 (x86/Windows) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 0e7996ef..fb81376 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -465,11 +465,12 @@ test('T9203', # 2016-04-06 84345136 (i386/Debian) not sure # 2017-03-24 77969268 (x86/Linux, 64-bit machine) probably join points - , (wordsize(64), 84620888, 5) ]), + , (wordsize(64), 98360576, 5) ]), # was 95747304 # 2019-09-10 94547280 post-AMP cleanup # 2015-10-28 95451192 emit Typeable at definition site # 2016-12-19 84620888 Join points + # 2018-07-30 98360576 it's unclear only_ways(['normal'])], compile_and_run, ['-O2']) From git at git.haskell.org Tue Jul 31 11:32:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 11:32:56 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14880-reinstate-fv-1' created Message-ID: <20180731113256.BF20C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14880-reinstate-fv-1 Referencing: c11a053dbef8b91184832ba8c2ee9723f8c79620 From git at git.haskell.org Tue Jul 31 11:32:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 11:32:59 +0000 (UTC) Subject: [commit: ghc] wip/T14880-reinstate-fv-1: Reinstate using FV for getting free vars (c11a053) Message-ID: <20180731113259.909F53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880-reinstate-fv-1 Link : http://ghc.haskell.org/trac/ghc/changeset/c11a053dbef8b91184832ba8c2ee9723f8c79620/ghc >--------------------------------------------------------------- commit c11a053dbef8b91184832ba8c2ee9723f8c79620 Author: Tobias Dammers Date: Mon Jul 30 09:29:22 2018 +0200 Reinstate using FV for getting free vars >--------------------------------------------------------------- c11a053dbef8b91184832ba8c2ee9723f8c79620 compiler/types/TyCoRep.hs | 86 +++++++++++++++++++++++++---------------------- 1 file changed, 45 insertions(+), 41 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 9d8c7a8..410429c 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1532,50 +1532,54 @@ type TyCoVarSetNotClosed = TyCoVarSet -- determinism info) and then drop the determinism. This is boring boiler plate code, but this -- is measurably faster than going via FV. tcvs_of_type :: Type -> TyCoVarSetNotClosed -tcvs_of_type (TyVarTy v) = unitVarSet v -tcvs_of_type (TyConApp _ tys) = mapUnionVarSet tcvs_of_type tys -tcvs_of_type (LitTy {}) = emptyVarSet -tcvs_of_type (AppTy fun arg) = tcvs_of_type fun `unionVarSet` tcvs_of_type arg -tcvs_of_type (FunTy arg res) = tcvs_of_type arg `unionVarSet` tcvs_of_type res -tcvs_of_type (ForAllTy (TvBndr tv _) ty) = tcvs_of_type ty `delVarSet` tv - `unionVarSet` tcvs_of_type (tyVarKind tv) -tcvs_of_type (CastTy ty co) = tcvs_of_type ty `unionVarSet` tcvs_of_co co -tcvs_of_type (CoercionTy co) = tcvs_of_co co - +tcvs_of_type = fvVarSet . fvs_of_type +-- tcvs_of_type (TyVarTy v) = unitVarSet v +-- tcvs_of_type (TyConApp _ tys) = mapUnionVarSet tcvs_of_type tys +-- tcvs_of_type (LitTy {}) = emptyVarSet +-- tcvs_of_type (AppTy fun arg) = tcvs_of_type fun `unionVarSet` tcvs_of_type arg +-- tcvs_of_type (FunTy arg res) = tcvs_of_type arg `unionVarSet` tcvs_of_type res +-- tcvs_of_type (ForAllTy (TvBndr tv _) ty) = tcvs_of_type ty `delVarSet` tv +-- `unionVarSet` tcvs_of_type (tyVarKind tv) +-- tcvs_of_type (CastTy ty co) = tcvs_of_type ty `unionVarSet` tcvs_of_co co +-- tcvs_of_type (CoercionTy co) = tcvs_of_co co +-- tcvs_of_types :: [Type] -> TyCoVarSetNotClosed -tcvs_of_types = mapUnionVarSet tcvs_of_type - +tcvs_of_types = fvVarSet . fvs_of_types +-- tcvs_of_types = mapUnionVarSet tcvs_of_type +-- tcvs_of_co :: Coercion -> TyCoVarSetNotClosed -tcvs_of_co (Refl _ ty) = tcvs_of_type ty -tcvs_of_co (TyConAppCo _ _ cos) = tcvs_of_cos cos -tcvs_of_co (AppCo co arg) = tcvs_of_co co `unionVarSet` tcvs_of_co arg -tcvs_of_co (ForAllCo tv kind_co co) = tcvs_of_co co `delVarSet` tv - `unionVarSet` tcvs_of_co kind_co -tcvs_of_co (FunCo _ co1 co2) = tcvs_of_co co1 `unionVarSet` tcvs_of_co co2 -tcvs_of_co (CoVarCo v) = unitVarSet v -tcvs_of_co (HoleCo h) = unitVarSet (coHoleCoVar h) - -- See Note [CoercionHoles and coercion free variables] -tcvs_of_co (AxiomInstCo _ _ cos) = tcvs_of_cos cos -tcvs_of_co (UnivCo p _ t1 t2) = tcvs_of_prov p `unionVarSet` tcvs_of_type t1 - `unionVarSet` tcvs_of_type t2 -tcvs_of_co (SymCo co) = tcvs_of_co co -tcvs_of_co (TransCo co1 co2) = tcvs_of_co co1 `unionVarSet` tcvs_of_co co2 -tcvs_of_co (NthCo _ _ co) = tcvs_of_co co -tcvs_of_co (LRCo _ co) = tcvs_of_co co -tcvs_of_co (InstCo co arg) = tcvs_of_co co `unionVarSet` tcvs_of_co arg -tcvs_of_co (CoherenceCo c1 c2) = tcvs_of_co c1 `unionVarSet` tcvs_of_co c2 -tcvs_of_co (KindCo co) = tcvs_of_co co -tcvs_of_co (SubCo co) = tcvs_of_co co -tcvs_of_co (AxiomRuleCo _ cs) = tcvs_of_cos cs - +tcvs_of_co = fvVarSet . fvs_of_co +-- tcvs_of_co (Refl _ ty) = tcvs_of_type ty +-- tcvs_of_co (TyConAppCo _ _ cos) = tcvs_of_cos cos +-- tcvs_of_co (AppCo co arg) = tcvs_of_co co `unionVarSet` tcvs_of_co arg +-- tcvs_of_co (ForAllCo tv kind_co co) = tcvs_of_co co `delVarSet` tv +-- `unionVarSet` tcvs_of_co kind_co +-- tcvs_of_co (FunCo _ co1 co2) = tcvs_of_co co1 `unionVarSet` tcvs_of_co co2 +-- tcvs_of_co (CoVarCo v) = unitVarSet v +-- tcvs_of_co (HoleCo h) = unitVarSet (coHoleCoVar h) +-- -- See Note [CoercionHoles and coercion free variables] +-- tcvs_of_co (AxiomInstCo _ _ cos) = tcvs_of_cos cos +-- tcvs_of_co (UnivCo p _ t1 t2) = tcvs_of_prov p `unionVarSet` tcvs_of_type t1 +-- `unionVarSet` tcvs_of_type t2 +-- tcvs_of_co (SymCo co) = tcvs_of_co co +-- tcvs_of_co (TransCo co1 co2) = tcvs_of_co co1 `unionVarSet` tcvs_of_co co2 +-- tcvs_of_co (NthCo _ _ co) = tcvs_of_co co +-- tcvs_of_co (LRCo _ co) = tcvs_of_co co +-- tcvs_of_co (InstCo co arg) = tcvs_of_co co `unionVarSet` tcvs_of_co arg +-- tcvs_of_co (CoherenceCo c1 c2) = tcvs_of_co c1 `unionVarSet` tcvs_of_co c2 +-- tcvs_of_co (KindCo co) = tcvs_of_co co +-- tcvs_of_co (SubCo co) = tcvs_of_co co +-- tcvs_of_co (AxiomRuleCo _ cs) = tcvs_of_cos cs +-- tcvs_of_cos :: [Coercion] -> TyCoVarSetNotClosed -tcvs_of_cos = mapUnionVarSet tcvs_of_co - -tcvs_of_prov :: UnivCoProvenance -> TyCoVarSetNotClosed -tcvs_of_prov UnsafeCoerceProv = emptyVarSet -tcvs_of_prov (PhantomProv co) = tcvs_of_co co -tcvs_of_prov (ProofIrrelProv co) = tcvs_of_co co -tcvs_of_prov (PluginProv _) = emptyVarSet +tcvs_of_cos = fvVarSet . fvs_of_cos +-- tcvs_of_cos = mapUnionVarSet tcvs_of_co +-- +-- tcvs_of_prov :: UnivCoProvenance -> TyCoVarSetNotClosed +-- tcvs_of_prov UnsafeCoerceProv = emptyVarSet +-- tcvs_of_prov (PhantomProv co) = tcvs_of_co co +-- tcvs_of_prov (ProofIrrelProv co) = tcvs_of_co co +-- tcvs_of_prov (PluginProv _) = emptyVarSet -- | `tyCoFVsOfType` that returns free variables of a type in a deterministic -- set. For explanation of why using `VarSet` is not deterministic see From git at git.haskell.org Tue Jul 31 12:20:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 12:20:00 +0000 (UTC) Subject: [commit: ghc] master: Don't inline functions with RULES too early (2110738) Message-ID: <20180731122000.084273A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2110738b280543698407924a16ac92b6d804dc36/ghc >--------------------------------------------------------------- commit 2110738b280543698407924a16ac92b6d804dc36 Author: Simon Peyton Jones Date: Mon Jul 30 13:43:56 2018 +0100 Don't inline functions with RULES too early Trac #15445 showed that a function with an automatically generated specialisation RULE coudl be inlined before the RULE had a chance to fire. This patch attaches a NOINLINE[2] activation to the Id, to stop this happening. >--------------------------------------------------------------- 2110738b280543698407924a16ac92b6d804dc36 compiler/basicTypes/BasicTypes.hs | 10 +++++ compiler/basicTypes/MkId.hs | 2 +- compiler/specialise/Rules.hs | 49 ++++++++++++++++++---- compiler/stranal/WorkWrap.hs | 4 +- testsuite/tests/simplCore/should_compile/T15445.hs | 8 ++++ .../tests/simplCore/should_compile/T15445.stderr | 13 ++++++ .../tests/simplCore/should_compile/T15445a.hs | 10 +++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 8 files changed, 87 insertions(+), 10 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2110738b280543698407924a16ac92b6d804dc36 From git at git.haskell.org Tue Jul 31 12:20:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 12:20:05 +0000 (UTC) Subject: [commit: ghc] master: Add the paper "Evidence normalisation in System FC" (3a06561) Message-ID: <20180731122005.A9B873A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3a065617b168813ec7e356ddd4eb25d125e9ff59/ghc >--------------------------------------------------------------- commit 3a065617b168813ec7e356ddd4eb25d125e9ff59 Author: Simon Peyton Jones Date: Tue Jul 31 13:17:58 2018 +0100 Add the paper "Evidence normalisation in System FC" https://www.microsoft.com/en-us/research/publication/evidence-normalization-system-fc-2/ This is with a view to editing it to include new developments in the coerion infrastructure. >--------------------------------------------------------------- 3a065617b168813ec7e356ddd4eb25d125e9ff59 docs/opt-coercion/Makefile | 9 + docs/{storage-mgt => opt-coercion}/code.sty | 2 + docs/opt-coercion/denot.sty | 120 + docs/opt-coercion/fc-normalization-rta.bib | 7157 +++++++++++++++++++++++++++ docs/opt-coercion/fc-normalization-rta.tex | 1627 ++++++ docs/opt-coercion/lipics.cls | 647 +++ docs/opt-coercion/prooftree.sty | 347 ++ 7 files changed, 9909 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 3a065617b168813ec7e356ddd4eb25d125e9ff59 From git at git.haskell.org Tue Jul 31 15:48:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 15:48:40 +0000 (UTC) Subject: [commit: ghc] master: rts: Disable -fkeep-inline-functions due to lack of support on Clang (80b8540) Message-ID: <20180731154840.505A93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80b8540b8ce99036acd26d76052bd603cd68fd0b/ghc >--------------------------------------------------------------- commit 80b8540b8ce99036acd26d76052bd603cd68fd0b Author: Ben Gamari Date: Mon Jul 30 20:48:21 2018 -0400 rts: Disable -fkeep-inline-functions due to lack of support on Clang But keep it as a comment since it is quite useful yet not very discoverable. >--------------------------------------------------------------- 80b8540b8ce99036acd26d76052bd603cd68fd0b rts/ghc.mk | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/rts/ghc.mk b/rts/ghc.mk index 7de796a..532c9aa 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -155,8 +155,9 @@ rts_dist_$1_CC_OPTS := $$(GhcRtsCcOpts) ifneq "$$(findstring debug, $1)" "" rts_dist_$1_HC_OPTS += -O0 rts_dist_$1_CC_OPTS += -fno-omit-frame-pointer -O0 -g3 -# Useful to ensure that inline functions can be called within GDB -rts_dist_$1_CC_OPTS += -fkeep-inline-functions +# Useful to ensure that inline functions can be called within GDB but not +# supported by clang +#rts_dist_$1_CC_OPTS += -fkeep-inline-functions endif ifneq "$$(findstring dyn, $1)" "" From git at git.haskell.org Tue Jul 31 15:48:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 15:48:54 +0000 (UTC) Subject: [commit: ghc] master: Enable two-step allocator on FreeBSD (123aeb9) Message-ID: <20180731154854.E8DE93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/123aeb916cba93018039e583d42408dae80a6dc9/ghc >--------------------------------------------------------------- commit 123aeb916cba93018039e583d42408dae80a6dc9 Author: Ben Gamari Date: Mon Jul 30 18:01:40 2018 -0400 Enable two-step allocator on FreeBSD Simplify #ifdef nesting and use MAP_GUARD on FreeBSD and similar systems. This allows the two-step allocator to be used on FreeBSD, fixing #15348. >--------------------------------------------------------------- 123aeb916cba93018039e583d42408dae80a6dc9 rts/posix/OSMem.c | 141 ++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 88 insertions(+), 53 deletions(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 4063ad3..3c4455e 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -49,6 +49,29 @@ #include #endif +#ifndef MAP_FAILED +# define MAP_FAILED ((void *)-1) +#endif + +#if defined(hpux_HOST_OS) +# ifndef MAP_ANON +# define MAP_ANON MAP_ANONYMOUS +# endif +#endif + +#ifndef darwin_HOST_OS +# undef RESERVE_FLAGS +# if defined(MAP_GUARD) +# define RESERVE_FLAGS MAP_GUARD /* FreeBSD */ +# elif defined(MAP_NORESERVE) +# define RESERVE_FLAGS MAP_NORESERVE | MAP_ANON | MAP_PRIVATE; +# else +# if defined(USE_LARGE_ADDRESS_SPACE) +# error USE_LARGE_ADDRESS_SPACE needs MAP_NORESERVE or MAP_GUARD +# endif +# endif +#endif + static void *next_request = 0; void osMemInit(void) @@ -102,8 +125,10 @@ void osMemInit(void) The naming is chosen from the Win32 API (VirtualAlloc) which does the same thing and has done so forever, while support for this in Unix systems has only been added recently and is hidden in the posix portability mess. - It is confusing because to get the reserve behavior we need MAP_NORESERVE - (which tells the kernel not to allocate backing space), but heh... + The Linux manpage suggests that mmap must be passed MAP_NORESERVE in order + to get reservation-only behavior. It is confusing because to get the reserve + behavior we need MAP_NORESERVE (which tells the kernel not to allocate backing + space), but heh... */ enum { @@ -112,6 +137,44 @@ enum MEM_RESERVE_AND_COMMIT = MEM_RESERVE | MEM_COMMIT }; +#if defined(linux_HOST_OS) +static void * +linux_retry_mmap(int operation, W_ size, void *ret, void *addr, int prot, int flags) +{ + if (addr != 0 && (operation & MEM_RESERVE)) { + // Try again with no hint address. + // It's not clear that this can ever actually help, + // but since our alternative is to abort, we may as well try. + ret = mmap(0, size, prot, flags, -1, 0); + } + if (ret == MAP_FAILED && errno == EPERM) { + // Linux is not willing to give us any mapping, + // so treat this as an out-of-memory condition + // (really out of virtual address space). + errno = ENOMEM; + } + return ret; +} +#endif /* defined(linux_HOST_OS) */ + +static void +post_mmap_madvise(int operation, W_ size, void *ret) +{ +#if defined(MADV_WILLNEED) + if (operation & MEM_COMMIT) { + madvise(ret, size, MADV_WILLNEED); +# if defined(MADV_DODUMP) + madvise(ret, size, MADV_DODUMP); +# endif + } else { + madvise(ret, size, MADV_DONTNEED); +# if defined(MADV_DONTDUMP) + madvise(ret, size, MADV_DONTDUMP); +# endif + } +#endif +} + /* Returns NULL on failure; errno set */ static void * my_mmap (void *addr, W_ size, int operation) @@ -153,71 +216,43 @@ my_mmap (void *addr, W_ size, int operation) VM_PROT_READ|VM_PROT_WRITE); } -#else +#else /* defined(darwin_HOST_OS) */ int prot, flags; - if (operation & MEM_COMMIT) + if (operation & MEM_COMMIT) { prot = PROT_READ | PROT_WRITE; - else + } else { prot = PROT_NONE; - if (operation == MEM_RESERVE) -# if defined(MAP_NORESERVE) - flags = MAP_NORESERVE; + } + + if (operation == MEM_RESERVE) { +# if defined(RESERVE_FLAGS) + flags = RESERVE_FLAGS; # else -# if defined(USE_LARGE_ADDRESS_SPACE) -# error USE_LARGE_ADDRESS_SPACE needs MAP_NORESERVE -# endif errorBelch("my_mmap(,,MEM_RESERVE) not supported on this platform"); # endif - else if (operation == MEM_COMMIT) - flags = MAP_FIXED; - else - flags = 0; + } else if (operation == MEM_COMMIT) { + flags = MAP_FIXED | MAP_ANON | MAP_PRIVATE; + } else { + flags = MAP_ANON | MAP_PRIVATE; + } -#if defined(hpux_HOST_OS) - ret = mmap(addr, size, prot, flags | MAP_ANONYMOUS | MAP_PRIVATE, -1, 0); -#elif defined(linux_HOST_OS) - ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); - if (ret == (void *)-1 && errno == EPERM) { + ret = mmap(addr, size, prot, flags, -1, 0); +# if defined(linux_HOST_OS) + if (ret == MAP_FAILED && errno == EPERM) { // Linux may return EPERM if it tried to give us // a chunk of address space below mmap_min_addr, // See Trac #7500. - if (addr != 0 && (operation & MEM_RESERVE)) { - // Try again with no hint address. - // It's not clear that this can ever actually help, - // but since our alternative is to abort, we may as well try. - ret = mmap(0, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); - } - if (ret == (void *)-1 && errno == EPERM) { - // Linux is not willing to give us any mapping, - // so treat this as an out-of-memory condition - // (really out of virtual address space). - errno = ENOMEM; - } + ret = linux_retry_mmap(operation, size, ret, addr, prot, flags); } - - if (ret != (void *)-1) { - if (operation & MEM_COMMIT) { - madvise(ret, size, MADV_WILLNEED); -#if defined(MADV_DODUMP) - madvise(ret, size, MADV_DODUMP); -#endif - } else { - madvise(ret, size, MADV_DONTNEED); -#if defined(MADV_DONTDUMP) - madvise(ret, size, MADV_DONTDUMP); -#endif - } - } - -#else - ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); -#endif -#endif - - if (ret == (void *)-1) { +# endif + if (ret == MAP_FAILED) { return NULL; } + // Map in committed pages rather than take a fault for each chunk. + // Also arrange to include them in core-dump files. + post_mmap_madvise(operation, size, ret); +#endif /* defined(darwin_HOST_OS) */ return ret; } From git at git.haskell.org Tue Jul 31 15:49:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 15:49:11 +0000 (UTC) Subject: [commit: ghc] master: doc: Fix command for creating a shared library. (cb8efe7) Message-ID: <20180731154911.93E1F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cb8efe708c57e5c91c592956de7e58d2c5ca5065/ghc >--------------------------------------------------------------- commit cb8efe708c57e5c91c592956de7e58d2c5ca5065 Author: Mathieu Boespflug Date: Sat Jul 28 07:33:13 2018 +0200 doc: Fix command for creating a shared library. The previous command did not work. The `-o` flag was missing. Moreover, without `-dynamic`, the `-shared` flag will raise obscure link errors because GHC will try to use static objects when creating the shared library. >--------------------------------------------------------------- cb8efe708c57e5c91c592956de7e58d2c5ca5065 docs/users_guide/packages.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index 7a54b4a..632162f 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -1056,7 +1056,7 @@ extra indirection). .. code-block:: sh - ghc -shared libHSfoo-1.0-ghcGHCVersion.so A.o B.o C.o + ghc -shared -dynamic -o libHSfoo-1.0-ghcGHCVersion.so A.o B.o C.o Using GHC's version number in the shared object name allows different library versions compiled by different GHC versions to be installed From git at git.haskell.org Tue Jul 31 15:49:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 15:49:26 +0000 (UTC) Subject: [commit: ghc] master: Bump Cabal submodule (6d2a9ec) Message-ID: <20180731154926.281A33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d2a9ec2bb14c6a2f58f515b3cf011d0ab450745/ghc >--------------------------------------------------------------- commit 6d2a9ec2bb14c6a2f58f515b3cf011d0ab450745 Author: Ben Gamari Date: Mon Jul 30 19:46:13 2018 -0400 Bump Cabal submodule >--------------------------------------------------------------- 6d2a9ec2bb14c6a2f58f515b3cf011d0ab450745 libraries/Cabal | 2 +- testsuite/tests/driver/T4437.hs | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 8fbacca..2a3175f 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 8fbacca029f3ad764576aefb610a0408c4b6aaad +Subproject commit 2a3175f886b86697194256f55c9487b7cfb4dc92 diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index a75990e..2818851 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -41,9 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRuleTransitional", "DerivingVia", "EmptyDataDeriving", - "GeneralisedNewtypeDeriving", - "StarIsType", -- FIXME: add StarIsType to cabal - "QuantifiedConstraints"] + "GeneralisedNewtypeDeriving"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", From git at git.haskell.org Tue Jul 31 15:49:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 15:49:41 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #14346 (f8e5da9) Message-ID: <20180731154941.71EB43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f8e5da92c0160a675e1666a5d6ed6a8ffcae193c/ghc >--------------------------------------------------------------- commit f8e5da92c0160a675e1666a5d6ed6a8ffcae193c Author: Sylvain Henry Date: Tue Jul 31 11:02:20 2018 -0400 testsuite: Add test for #14346 >--------------------------------------------------------------- f8e5da92c0160a675e1666a5d6ed6a8ffcae193c testsuite/tests/codeGen/should_run/T14346.hs | 21 +++++++++++++++++++++ testsuite/tests/codeGen/should_run/all.T | 1 + 2 files changed, 22 insertions(+) diff --git a/testsuite/tests/codeGen/should_run/T14346.hs b/testsuite/tests/codeGen/should_run/T14346.hs new file mode 100644 index 0000000..b61b92b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14346.hs @@ -0,0 +1,21 @@ +module Main where + +import Control.Concurrent +import Control.Monad +import Data.Word +import Foreign.Marshal.Alloc +import Foreign.Storable +import Numeric +import GHC.Ptr + +main :: IO () +main = do + replicateM_ 49 $ threadDelay 1 + _ <- forkIO $ do + allocaBytes 4 $ \p -> do + forever $ do + poke p (0xDEADBEEF :: Word32) + threadDelay 10 + x <- peek p + unless (x == 0xDEADBEEF) $ putStrLn (showHex x "") + threadDelay 1000000 diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 2495c1d..60f86d7 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -171,3 +171,4 @@ test('T13825-unit', ['-package ghc']) test('T14619', normal, compile_and_run, ['']) test('T14754', normal, compile_and_run, ['']) +test('T14346', only_ways(['threaded1','threaded2']), compile_and_run, ['-O -threaded']) From git at git.haskell.org Tue Jul 31 15:49:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 15:49:57 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Document default +RTS -I value (0e34a9f) Message-ID: <20180731154957.30C813A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e34a9f3e77108c5561fb183e59230a2fc3d1615/ghc >--------------------------------------------------------------- commit 0e34a9f3e77108c5561fb183e59230a2fc3d1615 Author: Ben Gamari Date: Tue Jul 31 11:33:50 2018 -0400 users-guide: Document default +RTS -I value As mentioned in #15402. [no ci] Test Plan: Read it. Reviewers: alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15402 Differential Revision: https://phabricator.haskell.org/D5027 >--------------------------------------------------------------- 0e34a9f3e77108c5561fb183e59230a2fc3d1615 docs/users_guide/runtime_control.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index 92bc739..797c7e2 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -535,7 +535,7 @@ performance. .. rts-flag:: -I ⟨seconds⟩ - :default: 0.3 seconds + :default: 0.3 seconds in the threaded runtime, 0 in the non-threaded runtime .. index:: single: idle GC From git at git.haskell.org Tue Jul 31 15:50:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 15:50:15 +0000 (UTC) Subject: [commit: ghc] master: base: Fix documentation of System.Environment.Blank (5e103a1) Message-ID: <20180731155015.3BA113A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e103a1e8a5b23eafbaf825c255b919e8205d87b/ghc >--------------------------------------------------------------- commit 5e103a1e8a5b23eafbaf825c255b919e8205d87b Author: Ben Gamari Date: Tue Jul 31 11:34:01 2018 -0400 base: Fix documentation of System.Environment.Blank This documentation was a bit unprofessional and the markup wasn't correct. Reviewers: hvr, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5026 >--------------------------------------------------------------- 5e103a1e8a5b23eafbaf825c255b919e8205d87b libraries/base/System/Environment/Blank.hsc | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/libraries/base/System/Environment/Blank.hsc b/libraries/base/System/Environment/Blank.hsc index ebca1ef..637a039 100644 --- a/libraries/base/System/Environment/Blank.hsc +++ b/libraries/base/System/Environment/Blank.hsc @@ -18,19 +18,15 @@ -- -- The matrix of platforms that: -- --- * support putenv("FOO") to unset environment variables, --- * support putenv("FOO=") to unset environment variables or set them +-- * support @putenv("FOO")@ to unset environment variables, +-- * support @putenv("FOO=")@ to unset environment variables or set them -- to blank values, --- * support unsetenv to unset environment variables, --- * support setenv to set environment variables, +-- * support @unsetenv@ to unset environment variables, +-- * support @setenv@ to set environment variables, -- * etc. -- --- is very complicated. I think AIX is screwed, but we don't support it. --- The whole situation with setenv(3), unsetenv(3), and putenv(3) is not --- good. Even mingw32 adds its own crap to the pile, but luckily, we can --- just use Windows' native environment functions to sidestep the issue. --- --- #12494 +-- is very complicated. Some platforms don't support unsetting of environment +-- variables at all. -- ----------------------------------------------------------------------------- @@ -87,7 +83,7 @@ throwInvalidArgument :: String -> IO a throwInvalidArgument from = throwIO (mkIOError InvalidArgument from Nothing Nothing) --- | `System.Environment.lookupEnv`. +-- | Similar to 'System.Environment.lookupEnv'. getEnv :: String -> IO (Maybe String) #ifdef mingw32_HOST_OS getEnv = (<$> getEnvironment) . lookup @@ -102,8 +98,8 @@ getEnvDefault :: IO String {- ^ variable value or fallback value -} getEnvDefault name fallback = fromMaybe fallback <$> getEnv name --- | Like `System.Environment.setEnv`, but allows blank environment values --- and mimics the function signature of `System.Posix.Env.setEnv` from the +-- | Like 'System.Environment.setEnv', but allows blank environment values +-- and mimics the function signature of 'System.Posix.Env.setEnv' from the -- @unix@ package. setEnv :: String {- ^ variable name -} -> @@ -144,8 +140,9 @@ foreign import ccall unsafe "setenv" c_setenv :: CString -> CString -> CInt -> IO CInt #endif --- | Like `System.Environment.unsetEnv`, but allows for the removal of --- blank environment variables. +-- | Like 'System.Environment.unsetEnv', but allows for the removal of +-- blank environment variables. May throw an exception if the underlying +-- platform doesn't support unsetting of environment variables. unsetEnv :: String -> IO () #if defined(mingw32_HOST_OS) unsetEnv key = withCWString key $ \k -> do From git at git.haskell.org Tue Jul 31 19:59:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 19:59:21 +0000 (UTC) Subject: [commit: packages/hpc] master: Bump time upper bound (2678098) Message-ID: <20180731195921.19E923A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/26780988735bdb8fdbeffb59c4a8d585b9e46c3e >--------------------------------------------------------------- commit 26780988735bdb8fdbeffb59c4a8d585b9e46c3e Author: Ben Gamari Date: Tue Jul 31 15:58:32 2018 -0400 Bump time upper bound >--------------------------------------------------------------- 26780988735bdb8fdbeffb59c4a8d585b9e46c3e hpc.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hpc.cabal b/hpc.cabal index ba676a7..7a37bfb 100644 --- a/hpc.cabal +++ b/hpc.cabal @@ -39,5 +39,5 @@ Library containers >= 0.4.1 && < 0.7, directory >= 1.1 && < 1.4, filepath >= 1 && < 1.5, - time >= 1.2 && < 1.9 + time >= 1.2 && < 1.10 ghc-options: -Wall From git at git.haskell.org Tue Jul 31 20:34:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:14 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: testsuite: Add test for #14346 (9660912) Message-ID: <20180731203414.AA8833A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/9660912278d748b92ab91e25b12a96319b1f98cd/ghc >--------------------------------------------------------------- commit 9660912278d748b92ab91e25b12a96319b1f98cd Author: Sylvain Henry Date: Tue Jul 31 11:02:20 2018 -0400 testsuite: Add test for #14346 (cherry picked from commit f8e5da92c0160a675e1666a5d6ed6a8ffcae193c) >--------------------------------------------------------------- 9660912278d748b92ab91e25b12a96319b1f98cd testsuite/tests/codeGen/should_run/T14346.hs | 21 +++++++++++++++++++++ testsuite/tests/codeGen/should_run/all.T | 1 + 2 files changed, 22 insertions(+) diff --git a/testsuite/tests/codeGen/should_run/T14346.hs b/testsuite/tests/codeGen/should_run/T14346.hs new file mode 100644 index 0000000..b61b92b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14346.hs @@ -0,0 +1,21 @@ +module Main where + +import Control.Concurrent +import Control.Monad +import Data.Word +import Foreign.Marshal.Alloc +import Foreign.Storable +import Numeric +import GHC.Ptr + +main :: IO () +main = do + replicateM_ 49 $ threadDelay 1 + _ <- forkIO $ do + allocaBytes 4 $ \p -> do + forever $ do + poke p (0xDEADBEEF :: Word32) + threadDelay 10 + x <- peek p + unless (x == 0xDEADBEEF) $ putStrLn (showHex x "") + threadDelay 1000000 diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 2495c1d..60f86d7 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -171,3 +171,4 @@ test('T13825-unit', ['-package ghc']) test('T14619', normal, compile_and_run, ['']) test('T14754', normal, compile_and_run, ['']) +test('T14346', only_ways(['threaded1','threaded2']), compile_and_run, ['-O -threaded']) From git at git.haskell.org Tue Jul 31 20:34:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix a nasty bug in piResultTys (a107cce) Message-ID: <20180731203418.12CF83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/a107cced37cb95c661b7c7cca1171b33eedf18a9/ghc >--------------------------------------------------------------- commit a107cced37cb95c661b7c7cca1171b33eedf18a9 Author: Simon Peyton Jones Date: Tue Jul 24 08:57:34 2018 +0100 Fix a nasty bug in piResultTys I was failing to instantiate vigorously enough in Type.piResultTys and in the very similar function ToIface.toIfaceAppArgsX This caused Trac #15428. The fix is easy. See Note [Care with kind instantiation] in Type.hs (cherry picked from commit e1b5a1174e42e390855b153015ce5227b3251d89) >--------------------------------------------------------------- a107cced37cb95c661b7c7cca1171b33eedf18a9 compiler/iface/ToIface.hs | 8 ++-- compiler/types/Type.hs | 43 ++++++++++++++++++---- testsuite/tests/typecheck/should_compile/T15428.hs | 9 +++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 49 insertions(+), 12 deletions(-) diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index d148e9a..dc9ea71 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -291,10 +291,10 @@ toIfaceTcArgsX fr tc ty_args go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps = ITC_Vis (toIfaceTypeX fr t) (go env res ts) - go env (TyVarTy tv) ts - | Just ki <- lookupTyVar env tv = go env ki ts - go env kind (t:ts) = WARN( True, ppr tc $$ ppr (tyConKind tc) $$ ppr ty_args ) - ITC_Vis (toIfaceTypeX fr t) (go env kind ts) -- Ill-kinded + go env ty ts = ASSERT2( not (isEmptyTCvSubst env) + , ppr (tyConKind tc) $$ ppr ty_args ) + go (zapTCvSubst env) (substTy env ty) ts + -- See Note [Care with kind instantiation] in Type.hs tidyToIfaceType :: TidyEnv -> Type -> IfaceType tidyToIfaceType env ty = toIfaceType (tidyType env ty) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 601eadb..ab0a449 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1032,13 +1032,12 @@ piResultTys ty orig_args@(arg:args) | ForAllTy (TvBndr tv _) res <- ty = go (extendVarEnv tv_env tv arg) res args - | TyVarTy tv <- ty - , Just ty' <- lookupVarEnv tv_env tv - -- Deals with piResultTys (forall a. a) [forall b.b, Int] - = piResultTys ty' all_args - - | otherwise - = pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args) + | otherwise -- See Note [Care with kind instantiation] + = ASSERT2( not (isEmptyVarEnv tv_env) + , ppr ty $$ ppr orig_args $$ ppr all_args ) + go emptyTvSubstEnv + (substTy (mkTvSubst in_scope tv_env) ty) + all_args applyTysX :: [TyVar] -> Type -> [Type] -> Type -- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys @@ -1052,7 +1051,35 @@ applyTysX tvs body_ty arg_tys pp_stuff = vcat [ppr tvs, ppr body_ty, ppr arg_tys] n_tvs = length tvs -{- + + +{- Note [Care with kind instantiation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + T :: forall k. k +and we are finding the kind of + T (forall b. b -> b) * Int +Then + T (forall b. b->b) :: k[ k :-> forall b. b->b] + :: forall b. b -> b +So + T (forall b. b->b) * :: (b -> b)[ b :-> *] + :: * -> * + +In other words wwe must intantiate the forall! + +Similarly (Trac #154218) + S :: forall k f. k -> f k +and we are finding the kind of + S * (* ->) Int Bool +We have + S * (* ->) :: (k -> f k)[ k :-> *, f :-> (* ->)] + :: * -> * -> * +So again we must instantiate. + +The same thing happens in ToIface.toIfaceAppArgsX. + + --------------------------------------------------------------------- TyConApp ~~~~~~~~ diff --git a/testsuite/tests/typecheck/should_compile/T15428.hs b/testsuite/tests/typecheck/should_compile/T15428.hs new file mode 100644 index 0000000..a9d1cdd --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15428.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module T15428 where + +data Flurmp +type family Pure (x :: a) :: f a + +type T = Pure Flurmp Flurmp diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 1cc8cd8..1124247 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -641,3 +641,4 @@ def onlyHsParLocs(x): and not "" in loc) return '\n'.join(filteredLines) test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) +test('T15428', normal, compile, ['']) From git at git.haskell.org Tue Jul 31 20:34:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix a major copy'n'paste error in LLVM CodeGen (9a4ac75) Message-ID: <20180731203420.D1FF13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/9a4ac7567835c4ddf90d44500d4be7ddcaef4334/ghc >--------------------------------------------------------------- commit 9a4ac7567835c4ddf90d44500d4be7ddcaef4334 Author: Krzysztof Gogolewski Date: Sun Jul 22 17:33:32 2018 +0200 Fix a major copy'n'paste error in LLVM CodeGen Summary: In D4592, `AddWordC` is lowered as an unsigned subtraction instead of an unsigned addition when compiling with LLVM. This patch rectifies that. Reviewers: angerman, bgamari, monoidal Reviewed By: angerman, bgamari, monoidal Subscribers: osa1, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4969 (cherry picked from commit f629442be93f4608e6bb53bfe2264a406230c546) >--------------------------------------------------------------- 9a4ac7567835c4ddf90d44500d4be7ddcaef4334 compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 +- testsuite/tests/numeric/should_run/all.T | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 678fffa..f25cb79 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -804,7 +804,7 @@ cmmPrimOpFunctions mop = do ++ showSDoc dflags (ppr $ widthToLlvmInt w) MO_Add2 w -> fsLit $ "llvm.uadd.with.overflow." ++ showSDoc dflags (ppr $ widthToLlvmInt w) - MO_AddWordC w -> fsLit $ "llvm.usub.with.overflow." + MO_AddWordC w -> fsLit $ "llvm.uadd.with.overflow." ++ showSDoc dflags (ppr $ widthToLlvmInt w) MO_SubWordC w -> fsLit $ "llvm.usub.with.overflow." ++ showSDoc dflags (ppr $ widthToLlvmInt w) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 140fa6c..eac0278 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -62,7 +62,7 @@ test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) -test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) +test('T10962', [omit_ways(['ghci']), extra_ways(['llvm'])], compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Tue Jul 31 20:34:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:23 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: stack: fix stack allocations on Windows (b6a2c0d) Message-ID: <20180731203423.A92663A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/b6a2c0d90ceb1e2d68e9517306671b0c6f6ac7dc/ghc >--------------------------------------------------------------- commit b6a2c0d90ceb1e2d68e9517306671b0c6f6ac7dc Author: Tamar Christina Date: Wed Jul 18 21:03:58 2018 +0100 stack: fix stack allocations on Windows Summary: On Windows one is not allowed to drop the stack by more than a page size. The reason for this is that the OS only allocates enough stack till what the TEB specifies. After that a guard page is placed and the rest of the virtual address space is unmapped. The intention is that doing stack allocations will cause you to hit the guard which will then map the next page in and move the guard. This is done to prevent what in the Linux world is known as stack clash vulnerabilities https://access.redhat.com/security/cve/cve-2017-1000364. There are modules in GHC for which the liveliness analysis thinks the reserved 8KB of spill slots isn't enough. One being DynFlags and the other being Cabal. Though I think the Cabal one is likely a bug: ``` 4d6544: 81 ec 00 46 00 00 sub $0x4600,%esp 4d654a: 8d 85 94 fe ff ff lea -0x16c(%ebp),%eax 4d6550: 3b 83 1c 03 00 00 cmp 0x31c(%ebx),%eax 4d6556: 0f 82 de 8d 02 00 jb 4ff33a <_cLpg_info+0x7a> 4d655c: c7 45 fc 14 3d 50 00 movl $0x503d14,-0x4(%ebp) 4d6563: 8b 75 0c mov 0xc(%ebp),%esi 4d6566: 83 c5 fc add $0xfffffffc,%ebp 4d6569: 66 f7 c6 03 00 test $0x3,%si 4d656e: 0f 85 a6 d7 02 00 jne 503d1a <_cLpb_info+0x6> 4d6574: 81 c4 00 46 00 00 add $0x4600,%esp ``` It allocates nearly 18KB of spill slots for a simple 4 line function and doesn't even use it. Note that this doesn't happen on x64 or when making a validate build. Only when making a build without a validate and build.mk. This and the allocation in DynFlags means the stack allocation will jump over the guard page into unmapped memory areas and GHC or an end program segfaults. The pagesize on x86 Windows is 4KB which means we hit it very easily for these two modules, which explains the total DOA of GHC 32bit for the past 3 releases and the "random" segfaults on Windows. ``` 0:000> bp 00503d29 0:000> gn Breakpoint 0 hit WARNING: Stack overflow detected. The unwound frames are extracted from outside normal stack bounds. eax=03b6b9c9 ebx=00dc90f0 ecx=03cac48c edx=03cac43d esi=03b6b9c9 edi=03abef40 eip=00503d29 esp=013e96fc ebp=03cf8f70 iopl=0 nv up ei pl nz na po nc cs=0023 ss=002b ds=002b es=002b fs=0053 gs=002b efl=00000202 setup+0x103d29: 00503d29 89442440 mov dword ptr [esp+40h],eax ss:002b:013e973c=???????? WARNING: Stack overflow detected. The unwound frames are extracted from outside normal stack bounds. WARNING: Stack overflow detected. The unwound frames are extracted from outside normal stack bounds. 0:000> !teb TEB at 00384000 ExceptionList: 013effcc StackBase: 013f0000 StackLimit: 013eb000 ``` This doesn't fix the liveliness analysis but does fix the allocations, by emitting a function call to `__chkstk_ms` when doing allocations of larger than a page, this will make sure the stack is probed every page so the kernel maps in the next page. `__chkstk_ms` is provided by `libGCC`, which is under the `GNU runtime exclusion license`, so it's safe to link against it, even for proprietary code. (Technically we already do since we link compiled C code in.) For allocations smaller than a page we drop the stack and probe the new address. This avoids the function call and still makes sure we hit the guard if needed. PS: In case anyone is Wondering why we didn't notice this before, it's because we only test x86_64 and on Windows 10. On x86_64 the page size is 8KB and also the kernel is a bit more lenient on Windows 10 in that it seems to catch the segfault and resize the stack if it was unmapped: ``` 0:000> t eax=03b6b9c9 ebx=00dc90f0 ecx=03cac48c edx=03cac43d esi=03b6b9c9 edi=03abef40 eip=00503d2d esp=013e96fc ebp=03cf8f70 iopl=0 nv up ei pl nz na po nc cs=0023 ss=002b ds=002b es=002b fs=0053 gs=002b efl=00000202 setup+0x103d2d: 00503d2d 8b461b mov eax,dword ptr [esi+1Bh] ds:002b:03b6b9e4=03cac431 0:000> !teb TEB at 00384000 ExceptionList: 013effcc StackBase: 013f0000 StackLimit: 013e9000 ``` Likely Windows 10 has a guard page larger than previous versions. This fixes the stack allocations, and as soon as I get the time I will look at the liveliness analysis. I find it highly unlikely that simple Cabal function requires ~2200 spill slots. Test Plan: ./validate Reviewers: simonmar, bgamari Reviewed By: bgamari Subscribers: AndreasK, rwbarton, thomie, carter GHC Trac Issues: #15154 Differential Revision: https://phabricator.haskell.org/D4917 (cherry picked from commit d0bbe1bf351c8b85c310afb0dd1fb1f12f9474bf) >--------------------------------------------------------------- b6a2c0d90ceb1e2d68e9517306671b0c6f6ac7dc compiler/nativeGen/Instruction.hs | 10 ++-- compiler/nativeGen/PPC/Instr.hs | 16 ++--- compiler/nativeGen/RegAlloc/Liveness.hs | 4 +- compiler/nativeGen/X86/Instr.hs | 100 ++++++++++++++++++++++++++++---- 4 files changed, 103 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 b6a2c0d90ceb1e2d68e9517306671b0c6f6ac7dc From git at git.haskell.org Tue Jul 31 20:34:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix the GHCi debugger with ApplicativeDo (d170083) Message-ID: <20180731203427.4CAF63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/d170083be4c8ad0ce6a3d00ce5891341fde774b8/ghc >--------------------------------------------------------------- commit d170083be4c8ad0ce6a3d00ce5891341fde774b8 Author: Simon Marlow Date: Sun Jul 22 17:03:33 2018 +0200 Fix the GHCi debugger with ApplicativeDo Summary: `collectLStmtsBinders` was returning nothing for `ApplicativeStmts`, which caused the debugger to not track free variables in many cases when using `ApplicativeDo`. Test Plan: * new test case * validate Reviewers: bgamari, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15422 Differential Revision: https://phabricator.haskell.org/D4991 (cherry picked from commit 4ea9311cc5c3b99ea6915bee23f0a6776731f20e) >--------------------------------------------------------------- d170083be4c8ad0ce6a3d00ce5891341fde774b8 compiler/hsSyn/HsUtils.hs | 6 +++++- testsuite/tests/ghci.debugger/scripts/all.T | 2 ++ testsuite/tests/ghci.debugger/scripts/break029.hs | 6 ++++++ testsuite/tests/ghci.debugger/scripts/break029.script | 5 +++++ testsuite/tests/ghci.debugger/scripts/break029.stdout | 10 ++++++++++ 5 files changed, 28 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index a759f1a..eba21cf 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -1035,7 +1035,11 @@ collectStmtBinders (ParStmt _ xs _ _) = collectLStmtsBinders $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss] collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss -collectStmtBinders ApplicativeStmt{} = [] +collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args + where + collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat + collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat + collectArgBinders _ = [] collectStmtBinders XStmtLR{} = panic "collectStmtBinders" diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index f2e2658..dd122ca 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -99,3 +99,5 @@ test('T8557', normal, ghci_script, ['T8557.script']) test('T12458', normal, ghci_script, ['T12458.script']) test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)), ghci_script, ['T13825-debugger.script']) + +test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script']) diff --git a/testsuite/tests/ghci.debugger/scripts/break029.hs b/testsuite/tests/ghci.debugger/scripts/break029.hs new file mode 100644 index 0000000..7598d3f --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ApplicativeDo #-} + +f :: Int -> IO Int +f x = do + y <- return (x + 1) + return (y * 2) diff --git a/testsuite/tests/ghci.debugger/scripts/break029.script b/testsuite/tests/ghci.debugger/scripts/break029.script new file mode 100644 index 0000000..b2e70b1 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.script @@ -0,0 +1,5 @@ +:load break029.hs +:step f 3 +:step +:step +y diff --git a/testsuite/tests/ghci.debugger/scripts/break029.stdout b/testsuite/tests/ghci.debugger/scripts/break029.stdout new file mode 100644 index 0000000..c1d7047 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.stdout @@ -0,0 +1,10 @@ +Stopped in Main.f, break029.hs:(4,7)-(6,16) +_result :: IO Int = _ +x :: Int = 3 +Stopped in Main.f, break029.hs:5:8-21 +_result :: IO Int = _ +x :: Int = 3 +Stopped in Main.f, break029.hs:6:11-15 +_result :: Int = _ +y :: Int = _ +4 From git at git.haskell.org Tue Jul 31 20:34:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix Ar crashing on odd-sized object files (Trac #15396) (0480507) Message-ID: <20180731203430.BAC6C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/04805078763d6c7347d4cecf33d7e14099790793/ghc >--------------------------------------------------------------- commit 04805078763d6c7347d4cecf33d7e14099790793 Author: Krzysztof Gogolewski Date: Fri Jul 27 22:10:52 2018 +0200 Fix Ar crashing on odd-sized object files (Trac #15396) Summary: All the work was done by Moritz Angermann. Test Plan: validate Reviewers: angerman, RyanGlScott, bgamari Reviewed By: angerman Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15396 Differential Revision: https://phabricator.haskell.org/D5013 (cherry picked from commit 754c3a55a603b155fa5d9a282de73d41a4694ffc) >--------------------------------------------------------------- 04805078763d6c7347d4cecf33d7e14099790793 compiler/main/Ar.hs | 13 +++++++++++-- testsuite/tests/driver/T15396.hs | 8 ++++++++ testsuite/tests/driver/T15396.stdout | 1 + testsuite/tests/driver/all.T | 2 ++ 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs index 51655c0..9ead053 100644 --- a/compiler/main/Ar.hs +++ b/compiler/main/Ar.hs @@ -95,7 +95,8 @@ getBSDArchEntries = do st_size <- getPaddedInt <$> getByteString 10 end <- getByteString 2 when (end /= "\x60\x0a") $ - fail "Invalid archive header end marker" + fail ("[BSD Archive] Invalid archive header end marker for name: " ++ + C.unpack name) off1 <- liftM fromIntegral bytesRead :: Get Int -- BSD stores extended filenames, by writing #1/ into the -- name field, the first @length@ bytes then represent the file name @@ -106,6 +107,10 @@ getBSDArchEntries = do return $ C.unpack $ C.takeWhile (/= ' ') name off2 <- liftM fromIntegral bytesRead :: Get Int file <- getByteString (st_size - (off2 - off1)) + -- data sections are two byte aligned (see Trac #15396) + when (odd st_size) $ + void (getByteString 1) + rest <- getBSDArchEntries return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest @@ -128,8 +133,12 @@ getGNUArchEntries extInfo = do st_size <- getPaddedInt <$> getByteString 10 end <- getByteString 2 when (end /= "\x60\x0a") $ - fail "Invalid archive header end marker" + fail ("[BSD Archive] Invalid archive header end marker for name: " ++ + C.unpack name) file <- getByteString st_size + -- data sections are two byte aligned (see Trac #15396) + when (odd st_size) $ + void (getByteString 1) name <- return . C.unpack $ if C.unpack (C.take 1 name) == "/" then case C.takeWhile (/= ' ') name of diff --git a/testsuite/tests/driver/T15396.hs b/testsuite/tests/driver/T15396.hs new file mode 100644 index 0000000..9ab9f6e --- /dev/null +++ b/testsuite/tests/driver/T15396.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} +import Ar + +-- obtained from echo -n \0 > x.o && ar -q b.a x.o && cat b.a +archive = "!\nx.o/ 0 0 0 644 1 \ +\`\n0\nx.o/ 0 0 0 644 1 `\n0\n" + +main = print (parseAr archive) diff --git a/testsuite/tests/driver/T15396.stdout b/testsuite/tests/driver/T15396.stdout new file mode 100644 index 0000000..65edafa --- /dev/null +++ b/testsuite/tests/driver/T15396.stdout @@ -0,0 +1 @@ +Archive [ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"},ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"}] diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 714b6c4..6397598 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -278,3 +278,5 @@ test('T13604a', [], run_command, ['$MAKE -s --no-print-directory T13604a']) test('inline-check', omit_ways(['hpc', 'profasm']) , compile , ['-dinline-check foo -O -ddebug-output']) + +test('T15396', normal, compile_and_run, ['-package ghc']) From git at git.haskell.org Tue Jul 31 20:34:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15423 by using pprAStmtContext (ff839f2) Message-ID: <20180731203433.910F83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/ff839f20029b7f8742de05f7b49bf4117921db9c/ghc >--------------------------------------------------------------- commit ff839f20029b7f8742de05f7b49bf4117921db9c Author: Ryan Scott Date: Fri Jul 20 12:50:50 2018 +0200 Fix #15423 by using pprAStmtContext Summary: Previously, we were using `pprStmtContext` instead, which led to error messages missing indefinite articles where they were required. Test Plan: make test TEST="T13242a T7786 Typeable1" Reviewers: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15423 Differential Revision: https://phabricator.haskell.org/D4992 (cherry picked from commit 99f45e2a751dda4fdf00256d397a2932d430f3a7) >--------------------------------------------------------------- ff839f20029b7f8742de05f7b49bf4117921db9c compiler/hsSyn/HsExpr.hs | 2 +- testsuite/tests/ado/T13242a.stderr | 2 +- testsuite/tests/indexed-types/should_fail/T7786.stderr | 2 +- testsuite/tests/typecheck/should_run/Typeable1.stderr | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 96d86c8..a5c65fb 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -2804,7 +2804,7 @@ pprMatchContextNoun PatBindGuards = text "pattern binding guards" pprMatchContextNoun LambdaExpr = text "lambda abstraction" pprMatchContextNoun ProcExpr = text "arrow abstraction" pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in" - $$ pprStmtContext ctxt + $$ pprAStmtContext ctxt pprMatchContextNoun PatSyn = text "pattern synonym declaration" ----------------- diff --git a/testsuite/tests/ado/T13242a.stderr b/testsuite/tests/ado/T13242a.stderr index a8e6495..f31307d 100644 --- a/testsuite/tests/ado/T13242a.stderr +++ b/testsuite/tests/ado/T13242a.stderr @@ -4,7 +4,7 @@ T13242a.hs:10:5: error: ‘a’ is a rigid type variable bound by a pattern with constructor: A :: forall a. Eq a => a -> T, in a pattern binding in - 'do' block + a 'do' block at T13242a.hs:10:3-5 • In the expression: do A x <- undefined diff --git a/testsuite/tests/indexed-types/should_fail/T7786.stderr b/testsuite/tests/indexed-types/should_fail/T7786.stderr index af9ca89..a82a1ca 100644 --- a/testsuite/tests/indexed-types/should_fail/T7786.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7786.stderr @@ -30,7 +30,7 @@ T7786.hs:97:31: error: from the context: xxx ~ 'Empty bound by a pattern with constructor: Nil :: forall a. Sing 'Empty, in a pattern binding in - 'do' block + a 'do' block at T7786.hs:96:22-24 • In the second argument of ‘($)’, namely ‘Sub db k sub’ In a stmt of a 'do' block: return $ Sub db k sub diff --git a/testsuite/tests/typecheck/should_run/Typeable1.stderr b/testsuite/tests/typecheck/should_run/Typeable1.stderr index 77d2604..ec16681 100644 --- a/testsuite/tests/typecheck/should_run/Typeable1.stderr +++ b/testsuite/tests/typecheck/should_run/Typeable1.stderr @@ -9,7 +9,7 @@ Typeable1.hs:22:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessi (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t, in a pattern binding in - 'do' block + a 'do' block • In the pattern: App x y In a stmt of a 'do' block: App x y <- pure x In the expression: From git at git.haskell.org Tue Jul 31 20:34:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:37 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix PrelRules.caseRules to account for out-of-range tags (851f334) Message-ID: <20180731203437.612E33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/851f3341953587d9fd2e471994b37ad81f132b1a/ghc >--------------------------------------------------------------- commit 851f3341953587d9fd2e471994b37ad81f132b1a Author: Simon Peyton Jones Date: Wed Jul 25 16:41:16 2018 +0100 Fix PrelRules.caseRules to account for out-of-range tags As Trac #15436 points out, it is possible to get case dataToTag# (x :: T) of DEFAULT -> blah1 -1# -> blah2 0 -> blah3 The (-1#) alterantive is unreachable, because dataToTag# returns tags in the range [0..n-1] where n is the number of data constructors in type T. This actually made GHC crash; now we simply discard the unreachable alterantive. See Note [Unreachable caseRules alternatives] in PrelRules (cherry picked from commit 9897f6783a58265d5eaef5fb06f04320c7737e87) >--------------------------------------------------------------- 851f3341953587d9fd2e471994b37ad81f132b1a compiler/prelude/PrelRules.hs | 64 +++++++++++++++------- compiler/prelude/primops.txt.pp | 2 +- compiler/simplCore/SimplUtils.hs | 33 +++++++---- testsuite/tests/simplCore/should_run/T15436.hs | 21 +++++++ testsuite/tests/simplCore/should_run/T15436.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 1 + 6 files changed, 90 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 851f3341953587d9fd2e471994b37ad81f132b1a From git at git.haskell.org Tue Jul 31 20:34:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix pretty-printing of data declarations in splices (4c044ed) Message-ID: <20180731203440.C8C143A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/4c044ed12d1d2e92580b587ae3a5ad001c1e6173/ghc >--------------------------------------------------------------- commit 4c044ed12d1d2e92580b587ae3a5ad001c1e6173 Author: Krzysztof Gogolewski Date: Sun Jul 22 18:58:33 2018 +0200 Fix pretty-printing of data declarations in splices Test Plan: validate Reviewers: RyanGlScott, bgamari Reviewed By: RyanGlScott Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15365 Differential Revision: https://phabricator.haskell.org/D4998 (cherry picked from commit 3aa09cc5af9cacba91915c095f9652ee5ed31ec7) >--------------------------------------------------------------- 4c044ed12d1d2e92580b587ae3a5ad001c1e6173 compiler/hsSyn/HsDecls.hs | 4 ++-- testsuite/tests/th/T15365.hs | 31 +++++++++++++++++++++++++++++++ testsuite/tests/th/T15365.stderr | 33 +++++++++++++++++++++++++++++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 67 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 12ebfad..277a6d3 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -757,7 +757,7 @@ pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context , hsep (map (ppr.unLoc) varsr)] | otherwise = hsep [ pprPrefixOcc (unLoc thing) , hsep (map (ppr.unLoc) (varl:varsr))] - pp_tyvars [] = ppr thing + pp_tyvars [] = pprPrefixOcc (unLoc thing) pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc @@ -2325,7 +2325,7 @@ type instance XXRoleAnnotDecl (GhcPass _) = NoExt instance (p ~ GhcPass pass, OutputableBndr (IdP p)) => Outputable (RoleAnnotDecl p) where ppr (RoleAnnotDecl _ ltycon roles) - = text "type role" <+> ppr ltycon <+> + = text "type role" <+> pprPrefixOcc (unLoc ltycon) <+> hsep (map (pp_role . unLoc) roles) where pp_role Nothing = underscore diff --git a/testsuite/tests/th/T15365.hs b/testsuite/tests/th/T15365.hs new file mode 100644 index 0000000..00ff2e6 --- /dev/null +++ b/testsuite/tests/th/T15365.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T15365 where + +$([d| type (|||) = Either + + (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + + type role (***) + data (***) + + class (???) + instance (???) + + data family ($$$) + data instance ($$$) + + type family (^^^) + type instance (^^^) = Int + + type family (###) where + (###) = Int + + pattern (:!!!) :: Bool + pattern (:!!!) = True + |]) diff --git a/testsuite/tests/th/T15365.stderr b/testsuite/tests/th/T15365.stderr new file mode 100644 index 0000000..3c85950 --- /dev/null +++ b/testsuite/tests/th/T15365.stderr @@ -0,0 +1,33 @@ +T15365.hs:(9,3)-(31,6): Splicing declarations + [d| (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + pattern (:!!!) :: Bool + pattern (:!!!) = True + + type (|||) = Either + data (***) + class (???) + data family ($$$) + type family (^^^) + type family (###) where + (###) = Int + + instance (???) + data instance ($$$) + type instance (^^^) = Int |] + ======> + type (|||) = Either + (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + type role (***) + data (***) + class (???) + instance (???) + data family ($$$) + data instance ($$$) + type family (^^^) + type instance (^^^) = Int + type family (###) where + (###) = Int + pattern (:!!!) :: Bool + pattern (:!!!) = True diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index b3d53ac..f6656c4 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -418,3 +418,4 @@ test('T15243', normal, compile, ['-dsuppress-uniques']) test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15321', normal, compile_fail, ['']) +test('T15365', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Tue Jul 31 20:34:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix Git commit ID detection in Git worktrees (2a162eb) Message-ID: <20180731203443.961A13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/2a162ebac445b629b3ba6621ce81a746b5dd98d7/ghc >--------------------------------------------------------------- commit 2a162ebac445b629b3ba6621ce81a746b5dd98d7 Author: Sylvain Henry Date: Sat Jul 28 17:48:04 2018 +0200 Fix Git commit ID detection in Git worktrees Summary: When using a Git worktree, ".git" is a file, not a directory Reviewers: bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, thomie, erikd, carter Differential Revision: https://phabricator.haskell.org/D5016 (cherry picked from commit 3539561b24b78aee2b37280ddf6bb64e2db3a67d) >--------------------------------------------------------------- 2a162ebac445b629b3ba6621ce81a746b5dd98d7 aclocal.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index 11c7acd..87b7e85 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1546,7 +1546,7 @@ if test "$RELEASE" = "NO"; then fi AC_MSG_CHECKING([for GHC Git commit id]) - if test -d .git; then + if test -e .git; then git_commit_id=`git rev-parse HEAD` if test -n "$git_commit_id" 2>&1 >/dev/null; then true; else AC_MSG_ERROR([failed to detect revision: check that git is in your path]) From git at git.haskell.org Tue Jul 31 20:34:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Harden fixST (39ab54c) Message-ID: <20180731203447.0A2C73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/39ab54c969fa5ca58392f039aa8f790932b9257a/ghc >--------------------------------------------------------------- commit 39ab54c969fa5ca58392f039aa8f790932b9257a Author: David Feuer Date: Sat Jul 21 15:45:35 2018 -0400 Harden fixST Trac #15349 reveals that lazy blackholing can cause trouble for `fixST` much like it can for `fixIO`. Make `fixST` work just like `fixIO`. Reviewers: simonmar, hvr, bgamari Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15349 Differential Revision: https://phabricator.haskell.org/D4948 (cherry picked from commit 5a49651f3161473b383ec497af38e9daa022b9ac) >--------------------------------------------------------------- 39ab54c969fa5ca58392f039aa8f790932b9257a libraries/base/Control/Monad/Fix.hs | 2 +- libraries/base/Control/Monad/ST/Imp.hs | 56 ++++++++++++++++++++++++++++++++-- libraries/base/GHC/ST.hs | 15 ++------- libraries/base/tests/T15349.hs | 17 +++++++++++ libraries/base/tests/T15349.stderr | 1 + libraries/base/tests/all.T | 1 + 6 files changed, 75 insertions(+), 17 deletions(-) diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs index bb26984..a58e282 100644 --- a/libraries/base/Control/Monad/Fix.hs +++ b/libraries/base/Control/Monad/Fix.hs @@ -33,7 +33,7 @@ import Data.Ord ( Down(..) ) import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) ) import GHC.Generics import GHC.List ( head, tail ) -import GHC.ST +import Control.Monad.ST.Imp import System.IO -- | Monads having fixed points with a \'knot-tying\' semantics. diff --git a/libraries/base/Control/Monad/ST/Imp.hs b/libraries/base/Control/Monad/ST/Imp.hs index c053dcc..4d6b12c 100644 --- a/libraries/base/Control/Monad/ST/Imp.hs +++ b/libraries/base/Control/Monad/ST/Imp.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK hide #-} @@ -34,7 +35,56 @@ module Control.Monad.ST.Imp ( unsafeSTToIO ) where -import GHC.ST ( ST, runST, fixST, unsafeInterleaveST +import GHC.ST ( ST, runST, unsafeInterleaveST , unsafeDupableInterleaveST ) -import GHC.Base ( RealWorld ) -import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO ) +import GHC.Base ( RealWorld, ($), return ) +import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO + , unsafeDupableInterleaveIO ) +import GHC.MVar ( readMVar, putMVar, newEmptyMVar ) +import Control.Exception.Base + ( catch, throwIO, NonTermination (..) + , BlockedIndefinitelyOnMVar (..) ) + +-- | Allow the result of a state transformer computation to be used (lazily) +-- inside the computation. +-- +-- Note that if @f@ is strict, @'fixST' f = _|_ at . +fixST :: (a -> ST s a) -> ST s a +-- See Note [fixST] +fixST k = unsafeIOToST $ do + m <- newEmptyMVar + ans <- unsafeDupableInterleaveIO + (readMVar m `catch` \BlockedIndefinitelyOnMVar -> + throwIO NonTermination) + result <- unsafeSTToIO (k ans) + putMVar m result + return result + +{- Note [fixST] + ~~~~~~~~~~~~ + +For many years, we implemented fixST much like a pure fixpoint, +using liftST: + + fixST :: (a -> ST s a) -> ST s a + fixST k = ST $ \ s -> + let ans = liftST (k r) s + STret _ r = ans + in + case ans of STret s' x -> (# s', x #) + +We knew that lazy blackholing could cause the computation to be re-run if the +result was demanded strictly, but we thought that would be okay in the case of +ST. However, that is not the case (see Trac #15349). Notably, the first time +the computation is executed, it may mutate variables that cause it to behave +*differently* the second time it's run. That may allow it to terminate when it +should not. More frighteningly, Arseniy Alekseyev produced a somewhat contrived +example ( https://mail.haskell.org/pipermail/libraries/2018-July/028889.html ) +demonstrating that it can break reasonable assumptions in "trustworthy" code, +causing a memory safety violation. So now we implement fixST much like we do +fixIO. See also the implementation notes for fixIO. Simon Marlow wondered +whether we could get away with an IORef instead of an MVar. I believe we +cannot. The function passed to fixST may spark a parallel computation that +demands the final result. Such a computation should block until the final +result is available. +-} diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs index e9d79d9..9a17438 100644 --- a/libraries/base/GHC/ST.hs +++ b/libraries/base/GHC/ST.hs @@ -18,7 +18,7 @@ module GHC.ST ( ST(..), STret(..), STRep, - fixST, runST, + runST, -- * Unsafe functions liftST, unsafeInterleaveST, unsafeDupableInterleaveST @@ -92,8 +92,7 @@ instance Monoid a => Monoid (ST s a) where data STret s a = STret (State# s) a --- liftST is useful when we want a lifted result from an ST computation. See --- fixST below. +-- liftST is useful when we want a lifted result from an ST computation. liftST :: ST s a -> State# s -> STret s a liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r @@ -126,16 +125,6 @@ unsafeDupableInterleaveST (ST m) = ST ( \ s -> (# s, r #) ) --- | Allow the result of a state transformer computation to be used (lazily) --- inside the computation. --- Note that if @f@ is strict, @'fixST' f = _|_ at . -fixST :: (a -> ST s a) -> ST s a -fixST k = ST $ \ s -> - let ans = liftST (k r) s - STret _ r = ans - in - case ans of STret s' x -> (# s', x #) - -- | @since 2.01 instance Show (ST s a) where showsPrec _ _ = showString "<>" diff --git a/libraries/base/tests/T15349.hs b/libraries/base/tests/T15349.hs new file mode 100644 index 0000000..6674330 --- /dev/null +++ b/libraries/base/tests/T15349.hs @@ -0,0 +1,17 @@ +import Control.Monad.ST.Strict +import Control.Monad.Fix +import Data.STRef + +foo :: ST s Int +foo = do + ref <- newSTRef True + mfix $ \res -> do + x <- readSTRef ref + if x + then do + writeSTRef ref False + return $! (res + 5) + else return 10 + +main :: IO () +main = print $ runST foo diff --git a/libraries/base/tests/T15349.stderr b/libraries/base/tests/T15349.stderr new file mode 100644 index 0000000..9cb080d --- /dev/null +++ b/libraries/base/tests/T15349.stderr @@ -0,0 +1 @@ +T15349: <> diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 3d3ebbc..715d4c3 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -241,3 +241,4 @@ test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) test('T13167', normal, compile_and_run, ['']) +test('T15349', [exit_code(1)], compile_and_run, ['']) From git at git.haskell.org Tue Jul 31 20:34:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Stop marking soluble ~R# constraints as insoluble (09abd1c) Message-ID: <20180731203450.7336E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/09abd1c420532c4274ddaeb5dfa54d7a9123d172/ghc >--------------------------------------------------------------- commit 09abd1c420532c4274ddaeb5dfa54d7a9123d172 Author: Simon Peyton Jones Date: Mon Jul 23 15:33:13 2018 +0100 Stop marking soluble ~R# constraints as insoluble We had a constraint (a b ~R# Int), and were marking it as 'insoluble'. That's bad; it isn't. And it caused Trac #15431. Soultion is simple. I did a tiny refactor on can_eq_app, so that it is used only for nominal equalities. (cherry picked from commit f0d27f515ffbc476144d1d1dd1a71bf9fa93c94b) >--------------------------------------------------------------- 09abd1c420532c4274ddaeb5dfa54d7a9123d172 compiler/typecheck/TcCanonical.hs | 39 +++++++++++++--------- testsuite/tests/typecheck/should_compile/T15431.hs | 15 +++++++++ .../tests/typecheck/should_compile/T15431a.hs | 12 +++++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 4 files changed, 53 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index a8fff6b..188065f 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -894,11 +894,13 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel -- See Note [Canonicalising type applications] about why we require flat types can_eq_nc' True _rdr_env _envs ev eq_rel (AppTy t1 s1) _ ty2 _ - | Just (t2, s2) <- tcSplitAppTy_maybe ty2 - = can_eq_app ev eq_rel t1 s1 t2 s2 + | NomEq <- eq_rel + , Just (t2, s2) <- tcSplitAppTy_maybe ty2 + = can_eq_app ev t1 s1 t2 s2 can_eq_nc' True _rdr_env _envs ev eq_rel ty1 _ (AppTy t2 s2) _ - | Just (t1, s1) <- tcSplitAppTy_maybe ty1 - = can_eq_app ev eq_rel t1 s1 t2 s2 + | NomEq <- eq_rel + , Just (t1, s1) <- tcSplitAppTy_maybe ty1 + = can_eq_app ev t1 s1 t2 s2 -- No similarity in type structure detected. Flatten and try again. can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 @@ -908,9 +910,22 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } -- We've flattened and the types don't match. Give up. -can_eq_nc' True _rdr_env _envs ev _eq_rel _ ps_ty1 _ ps_ty2 +can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 = do { traceTcS "can_eq_nc' catch-all case" (ppr ps_ty1 $$ ppr ps_ty2) - ; canEqHardFailure ev ps_ty1 ps_ty2 } + ; case eq_rel of -- See Note [Unsolved equalities] + ReprEq -> continueWith (mkIrredCt ev) + NomEq -> continueWith (mkInsolubleCt ev) } + -- No need to call canEqFailure/canEqHardFailure because they + -- flatten, and the types involved here are already flat + +{- Note [Unsolved equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we have an unsolved equality like + (a b ~R# Int) +that is not necessarily insoluble! Maybe 'a' will turn out to be a newtype. +So we want to make it a potentially-soluble Irred not an insoluble one. +Missing this point is what caused Trac #15431 +-} --------------------------------- can_eq_nc_forall :: CtEvidence -> EqRel @@ -1220,8 +1235,8 @@ can_eq_newtype_nc ev swapped ty1 ((gres, co), ty1') ty2 ps_ty2 --------- -- ^ Decompose a type application. -- All input types must be flat. See Note [Canonicalising type applications] -can_eq_app :: CtEvidence -- :: s1 t1 ~r s2 t2 - -> EqRel -- r +-- Nominal equality only! +can_eq_app :: CtEvidence -- :: s1 t1 ~N s2 t2 -> Xi -> Xi -- s1 t1 -> Xi -> Xi -- s2 t2 -> TcS (StopOrContinue Ct) @@ -1229,13 +1244,7 @@ can_eq_app :: CtEvidence -- :: s1 t1 ~r s2 t2 -- AppTys only decompose for nominal equality, so this case just leads -- to an irreducible constraint; see typecheck/should_compile/T10494 -- See Note [Decomposing equality], note {4} -can_eq_app ev ReprEq _ _ _ _ - = do { traceTcS "failing to decompose representational AppTy equality" (ppr ev) - ; continueWith (mkIrredCt ev) } - -- no need to call canEqFailure, because that flattens, and the - -- types involved here are already flat - -can_eq_app ev NomEq s1 t1 s2 t2 +can_eq_app ev s1 t1 s2 t2 | CtDerived { ctev_loc = loc } <- ev = do { unifyDeriveds loc [Nominal, Nominal] [s1, t1] [s2, t2] ; stopWith ev "Decomposed [D] AppTy" } diff --git a/testsuite/tests/typecheck/should_compile/T15431.hs b/testsuite/tests/typecheck/should_compile/T15431.hs new file mode 100644 index 0000000..21fa4c4 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15431.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE GADTs, FlexibleContexts #-} + +module T15431 where + +import Data.Coerce + +data T t where + A :: Show (t a) => t a -> T t + B :: Coercible Int (t a) => t a -> T t + +f :: T t -> String +f (A t) = show t + +g :: T t -> Int +g (B t) = coerce t diff --git a/testsuite/tests/typecheck/should_compile/T15431a.hs b/testsuite/tests/typecheck/should_compile/T15431a.hs new file mode 100644 index 0000000..cf5a831 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15431a.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +module T15431a where + +import Data.Coerce +import Data.Functor.Identity + +g1 :: Coercible (t a) Int => t a -> Int +g1 = coerce + +g2 :: Coercible Int (t a) => t a -> Int +g2 = coerce diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 1124247..4bf7fa0 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -642,3 +642,5 @@ def onlyHsParLocs(x): return '\n'.join(filteredLines) test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) test('T15428', normal, compile, ['']) +test('T15431', normal, compile, ['']) +test('T15431a', normal, compile, ['']) From git at git.haskell.org Tue Jul 31 20:34:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jul 2018 20:34:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Suppress -Winaccessible-code in derived code (8bed140) Message-ID: <20180731203454.056233A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/8bed140099f8ab78e3e728fd2e50dd73d7210e84/ghc >--------------------------------------------------------------- commit 8bed140099f8ab78e3e728fd2e50dd73d7210e84 Author: Ryan Scott Date: Tue Jul 24 14:40:42 2018 +0200 Suppress -Winaccessible-code in derived code Summary: It's rather unfortunate that derived code can produce inaccessible code warnings (as demonstrated in #8128, #8740, and #15398), since the programmer has no control over the generated code. This patch aims to suppress `-Winaccessible-code` in all derived code. It accomplishes this by doing the following: * Generalize the `ic_env :: TcLclEnv` field of `Implication` to be of type `Env TcGblEnc TcLclEnv` instead. This way, it also captures `DynFlags`, which record the flag state at the time the `Implication` was created. * When typechecking derived code, turn off `-Winaccessible-code`. This way, any insoluble given `Implication`s that are created when typechecking this derived code will remember that `-Winaccessible-code` was disabled. * During error reporting, consult the `DynFlags` of an `Implication` before making the decision to report an inaccessible code warning. Test Plan: make test TEST="T8128 T8740 T15398" Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: monoidal, rwbarton, thomie, carter GHC Trac Issues: #8128, #8740, #15398 Differential Revision: https://phabricator.haskell.org/D4993 (cherry picked from commit 44a7b9baa45c4ab939c7d996519b5e3de3e13c5a) >--------------------------------------------------------------- 8bed140099f8ab78e3e728fd2e50dd73d7210e84 compiler/typecheck/TcErrors.hs | 33 +++++---- compiler/typecheck/TcInstDcls.hs | 84 ++++++++++++++++++---- compiler/typecheck/TcRnTypes.hs | 66 +++++++++++------ compiler/typecheck/TcSMonad.hs | 34 +++++---- compiler/typecheck/TcSimplify.hs | 39 +++++----- compiler/typecheck/TcUnify.hs | 38 +++++----- testsuite/tests/deriving/should_compile/T15398.hs | 20 ++++++ .../tests/deriving/should_compile/T8128.stderr | 14 ---- .../tests/deriving/should_compile/T8740.stderr | 18 ----- testsuite/tests/deriving/should_compile/all.T | 1 + 10 files changed, 209 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 8bed140099f8ab78e3e728fd2e50dd73d7210e84